0 | module Data.Colist1
  1 |
  2 | import Data.Colist
  3 | import Data.List
  4 | import Data.List1
  5 | import Data.Nat
  6 | import Data.Stream
  7 | import public Data.Zippable
  8 |
  9 | %default total
 10 |
 11 | ||| A possibly finite, non-empty Stream.
 12 | public export
 13 | data Colist1 : (a : Type) -> Type where
 14 |   (:::) : a -> Colist a -> Colist1 a
 15 |
 16 | --------------------------------------------------------------------------------
 17 | --          Creating Colist1
 18 | --------------------------------------------------------------------------------
 19 |
 20 | ||| Convert a `List1` to a `Colist1`.
 21 | public export
 22 | fromList1 : List1 a -> Colist1 a
 23 | fromList1 (h ::: t) = h ::: fromList t
 24 |
 25 | ||| Convert a stream to a `Colist1`.
 26 | public export
 27 | fromStream : Stream a -> Colist1 a
 28 | fromStream (x :: xs) = x ::: fromStream xs
 29 |
 30 | ||| Try to convert a `Colist` to a `Colist1`. Returns `Nothing` if
 31 | ||| the given `Colist` is empty.
 32 | public export
 33 | fromColist : Colist a -> Maybe (Colist1 a)
 34 | fromColist Nil       = Nothing
 35 | fromColist (x :: xs) = Just (x ::: xs)
 36 |
 37 | ||| Try to convert a list to a `Colist1`. Returns `Nothing` if
 38 | ||| the given list is empty.
 39 | public export
 40 | fromList : List a -> Maybe (Colist1 a)
 41 | fromList = fromColist . fromList
 42 |
 43 | ||| Create a `Colist1` of only a single element.
 44 | public export
 45 | singleton : a -> Colist1 a
 46 | singleton a = a ::: Nil
 47 |
 48 | ||| An infinite `Colist1` of repetitions of the same element.
 49 | public export
 50 | repeat : a -> Colist1 a
 51 | repeat v = v ::: repeat v
 52 |
 53 | ||| Create a `Colist1` of `n` replications of the given element.
 54 | public export
 55 | replicate : (n : Nat) -> {auto 0 prf : IsSucc n} -> a -> Colist1 a
 56 | replicate 0     _ impossible
 57 | replicate (S k) x = x ::: replicate k x
 58 |
 59 | ||| Produce a `Colist1` by repeating a sequence
 60 | public export
 61 | cycle : List1 a -> Colist1 a
 62 | cycle (x ::: xs) = x ::: cycle (xs ++ [x])
 63 |
 64 | ||| Generate an infinite `Colist1` by repeatedly applying a function.
 65 | public export
 66 | iterate : (f : a -> a) -> a -> Colist1 a
 67 | iterate f a  = a ::: iterate f (f a)
 68 |
 69 | ||| Generate a `Colist1` by repeatedly applying a function.
 70 | ||| This stops once the function returns `Nothing`.
 71 | public export
 72 | iterateMaybe : (f : a -> Maybe a) -> a -> Colist1 a
 73 | iterateMaybe f a  = a ::: iterateMaybe f (f a)
 74 |
 75 | ||| Generate a `Colist1` by repeatedly applying a function
 76 | ||| to a seed value.
 77 | ||| This stops once the function returns `Nothing`.
 78 | public export
 79 | unfold : (f : s -> Maybe (s,a)) -> s -> a -> Colist1 a
 80 | unfold f s a = a ::: unfold f s
 81 |
 82 | --------------------------------------------------------------------------------
 83 | --          Basic Functions
 84 | --------------------------------------------------------------------------------
 85 |
 86 | ||| Convert a `Colist1` to a `Colist`
 87 | public export
 88 | forget : Colist1 a -> Colist a
 89 | forget (h ::: t) = h :: t
 90 |
 91 | ||| Convert an `Inf (Colist1 a)` to an `Inf (Colist a)`
 92 | public export
 93 | forgetInf : Inf (Colist1 a) -> Inf (Colist a)
 94 | forgetInf (h ::: t) = h :: t
 95 |
 96 | ||| Prepends an element to a `Colist1`.
 97 | public export
 98 | cons : (x : a) -> (xs : Colist1 a) -> Colist1 a
 99 | cons x xs = x ::: forget xs
100 |
101 | ||| Concatenate two `Colist1`s
102 | public export
103 | append : Colist1 a -> Colist1 a -> Colist1 a
104 | append (h ::: t) ys = h ::: append t (forget ys)
105 |
106 | ||| Append a `Colist1` to a `List`.
107 | public export
108 | lappend : List a -> Colist1 a -> Colist1 a
109 | lappend Nil       ys = ys
110 | lappend (x :: xs) ys = x ::: lappend xs (forget ys)
111 |
112 | ||| Append a `List` to a `Colist1`.
113 | public export
114 | appendl : Colist1 a -> List a -> Colist1 a
115 | appendl (x ::: xs) ys = x ::: appendl xs ys
116 |
117 | ||| Take a `Colist1` apart
118 | public export
119 | uncons : Colist1 a -> (a, Colist a)
120 | uncons (h ::: tl) = (h, tl)
121 |
122 | ||| Extract the first element from a `Colist1`
123 | public export
124 | head : Colist1 a -> a
125 | head (h ::: _) = h
126 |
127 | ||| Drop the first element from a `Colist1`
128 | public export
129 | tail : Colist1 a -> Colist a
130 | tail (_ ::: t) = t
131 |
132 | ||| Take up to `n` elements from a `Colist1`
133 | public export
134 | take : (n : Nat) -> {auto 0 prf : IsSucc n} -> Colist1 a -> List1 a
135 | take 0     _          impossible
136 | take (S k) (x ::: xs) = x ::: take k xs
137 |
138 | ||| Take elements from a `Colist1` up to and including the
139 | ||| first element, for which `p` returns `True`.
140 | public export
141 | takeUntil : (p : a -> Bool) -> Colist1 a -> Colist1 a
142 | takeUntil p (x ::: xs) = if p x then singleton x else x ::: takeUntil p xs
143 |
144 | ||| Take elements from a `Colist1` up to (but not including) the
145 | ||| first element, for which `p` returns `True`.
146 | public export
147 | takeBefore : (p : a -> Bool) -> Colist1 a -> Colist a
148 | takeBefore p = takeBefore p . forget
149 |
150 | ||| Take elements from a `Colist1` while the given predicate `p`
151 | ||| returns `True`.
152 | public export
153 | takeWhile : (p : a -> Bool) -> Colist1 a -> Colist a
154 | takeWhile p = takeWhile p . forget
155 |
156 | ||| Extract all values wrapped in `Just` from the beginning
157 | ||| of a `Colist1`. This stops, once the first `Nothing` is encountered.
158 | public export
159 | takeWhileJust : Colist1 (Maybe a) -> Colist a
160 | takeWhileJust = takeWhileJust . forget
161 |
162 | ||| Drop up to `n` elements from the beginning of the `Colist1`.
163 | public export
164 | drop : (n : Nat) -> Colist1 a -> Colist a
165 | drop n = drop n . forget
166 |
167 | ||| Try to extract the `n`-th element from a `Colist1`.
168 | public export
169 | index : (n : Nat) -> Colist1 a -> Maybe a
170 | index n = index n . forget
171 |
172 | ||| Produce a `Colist1` of left folds of prefixes of the given `Colist1`.
173 | ||| @ f the combining function
174 | ||| @ acc the initial value
175 | ||| @ xs the `Colist1` to process
176 | export
177 | scanl : (f : a -> b -> a) -> (acc : a) -> (xs : Colist1 b) -> Colist1 a
178 | scanl f acc (x ::: xs) = acc ::: scanl f (f acc x) xs
179 |
180 | --------------------------------------------------------------------------------
181 | --          Interfaces
182 | --------------------------------------------------------------------------------
183 |
184 | public export
185 | Semigroup (Colist1 a) where
186 |   (<+>) = append
187 |
188 | public export
189 | Functor Colist1 where
190 |   map f (x ::: xs) = f x ::: map f xs
191 |
192 | public export
193 | Applicative Colist1 where
194 |   pure = repeat
195 |
196 |   (f ::: fs) <*> (a ::: as) = f a ::: (fs <*> as)
197 |
198 | public export %hint %inline
199 | ZippableColist1 : Zippable Colist1
200 | ZippableColist1 = FromApplicative
201 |
202 | --------------------------------------------------------------------------------
203 | -- Interleavings
204 | --------------------------------------------------------------------------------
205 |
206 | -- zig, zag, and cantor are taken from the paper
207 | -- Applications of Applicative Proof Search
208 | -- by Liam O'Connor
209 |
210 | public export
211 | zig : List1 (Colist1 a) -> Colist (Colist1 a) -> Colist a
212 |
213 | public export
214 | zag : List1 a -> List (Colist1 a) -> Colist (Colist1 a) -> Colist a
215 |
216 | zig xs = zag (head <$> xs) (mapMaybe (fromColist . tail) $ forget xs)
217 |
218 | zag (x ::: []) [] [] = x :: []
219 | zag (x ::: []) (z :: zs) [] = x :: zig (z ::: zs) []
220 | zag (x ::: []) zs (l :: ls) = x :: zig (l ::: zs) ls
221 | zag (x ::: (y :: xs)) zs ls = x :: zag (y ::: xs) zs ls
222 |
223 | public export
224 | cantor : Colist1 (Colist1 a) -> Colist1 a
225 | cantor (xxs ::: []) = xxs
226 | cantor ((x ::: xs) ::: (yys :: zzss))
227 |   = x ::: zig (yys ::: mapMaybe fromColist [xs]) zzss
228 |
229 | namespace Colist
230 |
231 |   public export
232 |   cantor : List (Colist a) -> Colist a
233 |   cantor xs =
234 |     let Just (l ::: ls) = List.toList1' $ mapMaybe fromColist xs
235 |           | Nothing => []
236 |     in zig (l ::: []) (fromList ls)
237 |
238 |   -- Exploring the (truncated) Nat*Nat top right quadrant of the plane
239 |   -- using Cantor's zig-zag traversal:
240 |   example :
241 |      let nats : Colist Natnats = fromStream Stream.nats in
242 |      take 10 (Colist.cantor [ map (0,) nats
243 |                             , map (1,) nats
244 |                             , map (2,) nats
245 |                             , map (3,) nats])
246 |      === [ (0, 0)
247 |          , (1, 0), (0, 1)
248 |          , (2, 0), (1, 1), (0, 2)
249 |          , (3, 0), (2, 1), (1, 2), (0, 3)
250 |          ]
251 |   example = Refl
252 |
253 | namespace DPair
254 |
255 |   ||| Explore the plane corresponding to all possible pairings
256 |   ||| using Cantor's zig zag traversal
257 |   public export
258 |   planeWith : {0 p : a -> Type} ->
259 |               ((x : a) -> p x -> c) ->
260 |               Colist1 a -> ((x : a) -> Colist1 (p x)) ->
261 |               Colist1 c
262 |   planeWith k as f = cantor (map (\ x => map (k x) (f x)) as)
263 |
264 |   ||| Explore the plane corresponding to all possible pairings
265 |   ||| using Cantor's zig zag traversal
266 |   public export
267 |   plane : {0 p : a -> Type} ->
268 |           Colist1 a -> ((x : a) -> Colist1 (p x)) ->
269 |           Colist1 (x : a ** p x)
270 |   plane = planeWith (\ x, prf => (x ** prf))
271 |
272 | namespace Pair
273 |
274 |   ||| Explore the plane corresponding to all possible pairings
275 |   ||| using Cantor's zig zag traversal
276 |   public export
277 |   planeWith : (a -> b -> c) ->
278 |               Colist1 a -> (a -> Colist1 b) ->
279 |               Colist1 c
280 |   planeWith k as f = cantor (map (\ x => map (k x) (f x)) as)
281 |
282 |   ||| Explore the plane corresponding to all possible pairings
283 |   ||| using Cantor's zig zag traversal
284 |   public export
285 |   plane : Colist1 a -> (a -> Colist1 b) -> Colist1 (a, b)
286 |   plane = Pair.planeWith (,)
287 |
288 | --------------------------------------------------------------------------------
289 | -- Example
290 | --------------------------------------------------------------------------------
291 |
292 | -- Exploring the Nat*Nat top right quadrant of the plane
293 | -- using Cantor's zig-zag traversal:
294 | example :
295 |      let nats1 = fromStream Stream.nats in
296 |      Colist1.take 10 (Pair.plane nats1 (const nats1))
297 |      === (0, 0) :::
298 |          [ (1, 0), (0, 1)
299 |          , (2, 0), (1, 1), (0, 2)
300 |          , (3, 0), (2, 1), (1, 2), (0, 3)
301 |          ]
302 | example = Refl
303 |