Master of the Universe

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
module Data.Universe where

import Control.Comonad               -- http://lpaste.net/107661

{--

The Universe data type (not from logic) of universal extent to the left 
and right; perfect for cellular automata http://lpaste.net/108632

So, fun fact: the fifty-zillion best seller "50 Shades of Grey(er)(est)"
was originally Twilight fan-fiction (submissive Bella meets smoky-eyed
Dom Edward, in case you missed the obvious parallels) written under the
pen name of, and I'm not joking here, 'Master of the Universe.'

I mention this in passing.

So. An universe is a type of universal extent to the left and to the right:

 --}

data U a = U [a] a [a]

right :: U a -> U a
right (U a b (c:cs)) = U (b:a) c cs

left :: U a -> U a
left (U (a:as) b c) = U as a (b:c)

instance Functor U where
   fmap f (U a b c) = U (map f a) (f b) (map f c)

instance Copointed U where
   extract (U _ b _) = b

instance Comonad U where
   duplicate a = U (tail $ iterate left a) a (tail $ iterate right a)

shift :: Int -> U a -> U a
shift i u = (iterate (if i < 0 then left else right) u) !! abs i

toList :: Int -> Int -> U a -> [a]
toList i j u = take (j-i) $ half $ shift i u 
   where half (U _ b c) = b:c

instance Show a => Show (U a) where
   show univ = "U " ++ show (toList (-10) 20 univ)

showCompact :: Show a => U a -> Int -> String
showCompact univ haWidth =
   "U " ++ concatMap show (toList (negate haWidth) (2 * haWidth) univ)

{--

(Debt of gratitude to sigfpe for the type from his article on Comonadic
cellular automata. 

http://blog.sigfpe.com/2006/12/evaluating-cellular-automata-is.html)

This type is used for, e.g. modelling cellular automata, particularly
the rules for generation of the same. See: http://lpaste.net/107206

And there you have it! An Universe, just for you! So don't tell me I 
never did anything for you, eh?

 --}
39:13: Warning: Redundant bracket
Found:
(iterate (if i < 0 then left else right) u) !! abs i
Why not:
iterate (if i < 0 then left else right) u !! abs i