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
|
module AufgabeFFP8
where
import Data.Char
import Data.Array
import Data.List hiding ((\\), insert, delete, sort)
import Test.QuickCheck
type Nat = [Int]
(\\) :: Eq a => [a] -> [a] -> [a]
xs \\ ys = filter (\x -> x `notElem` ys) xs
minfree_bv :: [Int] -> Int
minfree_bv xs = head ([0..] \\ xs)
-- checklist
minfree_chl :: [Int] -> Int
minfree_chl = search . checklist
search :: Array Int Bool -> Int
search = length . takeWhile id . elems
checklist :: [Int] -> Array Int Bool
checklist xs = accumArray (||) False (0, n)
(zip (filter (<=n) xs) (repeat True))
where n = length xs
-- countlist
minfree_col :: [Int] -> Int
minfree_col = search_countlist . countlist
countlist :: [Int] -> Array Int Int
countlist xs = accumArray (+) 0 (0, n) (zip xs (repeat 1))
where n = safe_maximum xs
safe_maximum :: [Int] -> Int
safe_maximum [] = 0
safe_maximum xs = maximum xs
-- unused
sort :: [Int] -> [Int]
sort xs = concat [replicate k x | (x, k) <- assocs ( countlist xs ) ]
search_countlist :: Array Int Int -> Int
search_countlist = length . takeWhile (/= 0) . elems
-- basic divide-and-conquer
minfree_b :: [Int] -> Int
minfree_b xs = if (null ([0..b-1] \\ us))
then (head ([b..] \\ vs))
else (head ([0..] \\ us))
where
(us, vs) = partition (<b) xs
b = 1 + (length xs) `div` 2
-- refined divide-and-conquer
minfree_r :: [Int] -> Int
minfree_r xs = minfrom 0 xs
minfrom :: Int -> [Int] -> Int
minfrom a xs
| null xs = a
| length us == b-a = minfrom b vs
| otherwise = minfrom a us
where
(us, vs) = partition (<b) xs
b = a + 1 + (length xs) `div` 2
-- optimised divide-and-conquer
minfree_o :: [Int] -> Int
minfree_o xs = minfrom_o 0 (length xs, xs)
minfrom_o :: Int -> (Int, [Int]) -> Int
minfrom_o a (n, xs)
| n == 0 = a
| m == b-a = minfrom_o b (n-m, vs)
| otherwise = minfrom_o a (m, us)
where
(us, vs) = partition (<b) xs
b = a + 1 + n `div` 2
m = length us
-- from slide 154
divideAndConquer :: (p -> Bool) -> (p -> s) -> (p -> [p]) -> (p -> [s] -> s) -> p -> s
divideAndConquer indiv solve divide combine initPb = dAC initPb
where
dAC pb
| indiv pb = solve pb
| otherwise = combine pb (map dAC (divide pb))
-- basic divide-and-conquer mittels higher order function
minfree_bhof :: [Int] -> Int
minfree_bhof xs = divideAndConquer b_indiv b_solve b_divide b_combine (length xs, xs)
b_indiv :: (Int, [Int]) -> Bool
b_indiv (0, _) = True -- empty list
b_indiv (n, xs) = n /= length xs -- only divide on first call
b_solve :: (Int, [Int]) -> Int
b_solve (n, xs) = head $ [n..] \\ xs
b_divide :: (Int, [Int]) -> [ (Int, [Int]) ]
b_divide (n, xs) = [(0, us), (b, vs)]
where
b = 1 + (length xs) `div` 2
(us, vs) = partition (<b) xs
b_combine :: (Int, [Int]) -> [Int] -> Int
b_combine xs sols = head sols
-- refined divide-and-conquer mittels higher order function
--minfree_rhof :: [Int] -> Int
--minfree_rhof = divideAndConquer r_indiv r_solve r_divide r_combine
--
--r_indiv :: (Int, [Int]) -> Bool
--r_indiv (a, xs)
-- optimised divide-and-conquer mittels higher order function
--minfree_ohof :: [Int] -> Int
-- QuickCheck part
functions = [ minfree_bv, minfree_chl, minfree_col,
minfree_b, minfree_r, minfree_o,
minfree_bhof]
-- calc values of all function
calc_all :: [Int] -> [Int]
calc_all xs = [ f xs | f <- functions ]
-- check if all values of a list are the same
all_eq :: [Int] -> Bool
all_eq (x:[]) = True
all_eq (x:y:xs)
| x == y = all_eq (y:xs)
| otherwise = False
-- check if a list contains no duplicates
--no_dups :: [Int] -> Bool
--no_dups [] = True
--no_dups (x:xs)
-- | x `elem` xs = False
-- | otherwise = no_dups xs
prop_allImplsEq_a :: [Int] -> Bool
prop_allImplsEq_a xs = all_eq $ calc_all (nub xs)
-- keine negativen listenelemented durch vorbedingung entfernt
prop_allImplsEq_b :: [Int] -> Property
prop_allImplsEq_b xs = all (>=0) xs ==> all_eq $ calc_all (nub xs)
|
