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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164

--- Implementation of Arrays with Braun Trees. Conceptually, Braun trees
--- are always infinite. Consequently, there is no test on emptiness.
---
--- @authors {bbr, fhu}@informatik.uni-kiel.de
--- @category algorithm

module Data.Array
  (Array,

   emptyErrorArray, emptyDefaultArray,
   listToDefaultArray,listToErrorArray,

   (//), update, applyAt,

   (!),

   combine, combineSimilar)

  where


import Integer

infixl 9  !, //

data Array b = Array (Int -> b) (Entry b)

data Entry b = Entry b (Entry b) (Entry b) | Empty


--- Creates an empty array which generates errors for non-initialized
--- indexes.
emptyErrorArray :: Array b
emptyErrorArray = emptyDefaultArray errorArray

errorArray :: Int -> _
errorArray idx =  error ("Array index "++show idx++" not initialized")

--- Creates an empty array, call given function for non-initialized
--- indexes.
--- @param default - function to call for each non-initialized index
emptyDefaultArray :: (Int -> b) -> Array b
emptyDefaultArray dflt = Array dflt Empty

--- Inserts a list of entries into an array.
--- @param array - array to modify
--- @param modifications - list of new (indexes,entries)
--- If an index in the list was already initialized, the old value
--- will be overwritten. Likewise the last entry with a given index
--- will be contained in the result array.
(//) :: Array b -> [(Int,b)] -> Array b
(//) (Array dflt array) modifications =
  Array dflt
    (foldr (\ (n,v) a -> at (dflt n) a n (const v)) array modifications)

--- Inserts a new entry into an array.
--- @param array - array to modify
--- @param idx - index of update
--- @param val - value to update at index idx
--- Entries already initialized will be overwritten.
update :: Array b -> Int -> b -> Array b
update (Array dflt a) i v =
  Array dflt (at (dflt i) a i (const v))

--- Applies a function to an element.
--- @param array - array to modify
--- @param idx - index of update
--- @param fun - function to apply on element at index idx

applyAt :: Array b -> Int -> (b->b) -> Array b
applyAt (Array dflt a) n f = Array dflt (at (dflt n) a n f)


at :: b -> Entry b -> Int -> (b -> b) -> Entry b
at dflt Empty n f
  | n==0      = Entry (f dflt) Empty Empty
  | odd n     = Entry dflt (at dflt Empty (n `div` 2) f) Empty
  | otherwise = Entry dflt Empty (at dflt Empty (n `div` 2 - 1) f)
at dflt (Entry v al ar) n f
  | n==0      = Entry (f v) al ar
  | odd n     = Entry v (at dflt al (n `div` 2) f) ar
  | otherwise = Entry v al (at dflt ar (n `div` 2 - 1) f)


--- Yields the value at a given position.
--- @param a - array to look up in
--- @param n - index, where to look 
(!) :: Array b -> Int -> b
(Array dflt array) ! i = from (dflt i) array i

from :: a -> Entry a -> Int -> a
from dflt Empty _ = dflt
from dflt (Entry v al ar) n
  | n==0      = v
  | odd n     = from dflt al (n `div` 2)
  | otherwise = from dflt ar (n `div` 2 - 1)


split :: [a] -> ([a],[a])
split [] = ([],[])
split [x] = ([x],[])
split (x:y:xys) = let (xs,ys) = split xys in
                    (x:xs,y:ys)

--- Creates a default array from a list of entries.
--- @param def - default funtion for non-initialized indexes
--- @param xs - list of entries
listToDefaultArray ::  (Int -> b) -> [b] -> Array b
listToDefaultArray def = Array def . listToArray

--- Creates an error array from a list of entries.
--- @param xs - list of entries
listToErrorArray :: [b] -> Array b
listToErrorArray = listToDefaultArray errorArray


listToArray :: [b] -> Entry b
listToArray [] = Empty
listToArray (x:xs) = let (ys,zs) = split xs in
                       Entry x (listToArray ys)
                               (listToArray zs)


--- combine two arbitrary arrays

combine :: (a -> b -> c) -> Array a -> Array b -> Array c
combine f (Array def1 a1) (Array def2 a2) =
  Array (\i -> f (def1 i) (def2 i)) (comb f def1 def2 a1 a2 0 1)

comb :: (a -> b -> c) -> (Int -> a) -> (Int -> b)
     -> Entry a -> Entry b -> Int -> Int -> Entry c
comb _ _ _ Empty Empty _ _ = Empty
comb f def1 def2 (Entry x xl xr) Empty b o =
  Entry (f x (def2 (b+o-1)))
        (comb f def1 def2 xl Empty (2*b) o)
        (comb f def1 def2 xr Empty (2*b) (o+b))
comb f def1 def2 Empty (Entry y yl yr) b o =
  Entry (f (def1 (b+o-1)) y)
        (comb f def1 def2 Empty yl (2*b) o)
        (comb f def1 def2 Empty yr (2*b) (o+b))
comb f def1 def2 (Entry x xl xr) (Entry y yl yr) b o =
  Entry (f x y)
        (comb f def1 def2 xl yl (2*b) o)
        (comb f def1 def2 xr yr (2*b) (o+b))



--- the combination of two arrays with identical default function
--- and a combinator which is neutral in the default 
--- can be implemented much more efficient

combineSimilar :: (a -> a -> a) -> Array a -> Array a -> Array a
combineSimilar f (Array def a1) (Array _ a2) =  Array def (combSim f a1 a2)

combSim :: (a -> a -> a) -> Entry a -> Entry a -> Entry a
combSim _ Empty a2 = a2
combSim _ (Entry x y z) Empty = Entry x y z
combSim f (Entry x xl xr) (Entry y yl yr) =
  Entry (f x y) (combSim f xl yl) (combSim f xr yr)