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