From 2993b0e41d9647c4e13a414c6dbb766aea11d009 Mon Sep 17 00:00:00 2001 From: totycro Date: Tue, 29 May 2012 19:17:17 +0200 Subject: added aufgabe 8 template --- AufgabeFFP8.hs | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) create mode 100644 AufgabeFFP8.hs (limited to 'AufgabeFFP8.hs') diff --git a/AufgabeFFP8.hs b/AufgabeFFP8.hs new file mode 100644 index 0000000..c2e3583 --- /dev/null +++ b/AufgabeFFP8.hs @@ -0,0 +1,42 @@ +module AufgabeFFP8 +where + +import Data.Char +import Data.List hiding ((\\), insert, delete) +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 + +-- countlist +--minfree_col :: [Int] -> Int + +-- basic divice-and-conquer +--minfree_b :: [Int] -> Int + +-- refined divice-and-conquer +--minfree_r :: [Int] -> Int + +-- optimised divice-and-conquer +--minfree_o :: [Int] -> Int +-- +-- basic divice-and-conquer mittels higher order function +--minfree_bhof :: [Int] -> Int + +-- refined divice-and-conquer mittels higher order function +--minfree_rhof :: [Int] -> Int + +-- optimised divice-and-conquer mittels higher order function +--minfree_ohof :: [Int] -> Int + + + +-- QuickCheck part -- cgit v1.2.3 From b9056493bf23c24a60ce0d259aa648033233e746 Mon Sep 17 00:00:00 2001 From: totycro Date: Tue, 29 May 2012 20:53:29 +0200 Subject: checklist & countlist --- AufgabeFFP8.hs | 46 ++++++++++++++++++++++++++++++++++++---------- 1 file changed, 36 insertions(+), 10 deletions(-) (limited to 'AufgabeFFP8.hs') diff --git a/AufgabeFFP8.hs b/AufgabeFFP8.hs index c2e3583..298898b 100644 --- a/AufgabeFFP8.hs +++ b/AufgabeFFP8.hs @@ -2,7 +2,8 @@ module AufgabeFFP8 where import Data.Char -import Data.List hiding ((\\), insert, delete) +import Data.Array +import Data.List hiding ((\\), insert, delete, sort) import Test.QuickCheck type Nat = [Int] @@ -14,27 +15,52 @@ minfree_bv :: [Int] -> Int minfree_bv xs = head ([0..] \\ xs) -- checklist ---minfree_chl :: [Int] -> Int +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 :: [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 divice-and-conquer ---minfree_b :: [Int] -> Int +-- basic divide-and-conquer +minfree_b :: [Int] -> Int --- refined divice-and-conquer +-- refined divide-and-conquer --minfree_r :: [Int] -> Int --- optimised divice-and-conquer +-- optimised divide-and-conquer --minfree_o :: [Int] -> Int -- --- basic divice-and-conquer mittels higher order function +-- basic divide-and-conquer mittels higher order function --minfree_bhof :: [Int] -> Int --- refined divice-and-conquer mittels higher order function +-- refined divide-and-conquer mittels higher order function --minfree_rhof :: [Int] -> Int --- optimised divice-and-conquer mittels higher order function +-- optimised divide-and-conquer mittels higher order function --minfree_ohof :: [Int] -> Int -- cgit v1.2.3 From 036885a5375d0eada3b03d200fcc6353985a624b Mon Sep 17 00:00:00 2001 From: totycro Date: Tue, 29 May 2012 21:04:14 +0200 Subject: minfree divide & conquer von folien --- AufgabeFFP8.hs | 34 +++++++++++++++++++++++++++++++--- 1 file changed, 31 insertions(+), 3 deletions(-) (limited to 'AufgabeFFP8.hs') diff --git a/AufgabeFFP8.hs b/AufgabeFFP8.hs index 298898b..e667654 100644 --- a/AufgabeFFP8.hs +++ b/AufgabeFFP8.hs @@ -47,13 +47,41 @@ 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 ( Int +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 ( Int --- +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 ( Int -- cgit v1.2.3 From 5bb2754dfdd3c5a1d795b286ed5d762375e10752 Mon Sep 17 00:00:00 2001 From: totycro Date: Tue, 29 May 2012 21:32:15 +0200 Subject: quickcheck --- AufgabeFFP8.hs | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) (limited to 'AufgabeFFP8.hs') diff --git a/AufgabeFFP8.hs b/AufgabeFFP8.hs index e667654..f6d9bfd 100644 --- a/AufgabeFFP8.hs +++ b/AufgabeFFP8.hs @@ -82,6 +82,16 @@ minfrom_o a (n, xs) 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 @@ -94,3 +104,32 @@ minfrom_o a (n, xs) -- QuickCheck part + +functions = [ minfree_bv, minfree_chl, minfree_col, + minfree_b, minfree_r, minfree_o ] + +-- 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) + -- cgit v1.2.3 From 46e188c83e0ca7456420f4010b5b7b0422dc6acd Mon Sep 17 00:00:00 2001 From: totycro Date: Tue, 29 May 2012 22:17:38 +0200 Subject: first minfree hof (basic) --- AufgabeFFP8.hs | 27 +++++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) (limited to 'AufgabeFFP8.hs') diff --git a/AufgabeFFP8.hs b/AufgabeFFP8.hs index f6d9bfd..9d244e6 100644 --- a/AufgabeFFP8.hs +++ b/AufgabeFFP8.hs @@ -93,10 +93,32 @@ divideAndConquer indiv solve divide combine initPb = dAC initPb -- basic divide-and-conquer mittels higher order function ---minfree_bhof :: [Int] -> Int +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 ( [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 @@ -106,7 +128,8 @@ divideAndConquer indiv solve divide combine initPb = dAC initPb -- QuickCheck part functions = [ minfree_bv, minfree_chl, minfree_col, - minfree_b, minfree_r, minfree_o ] + minfree_b, minfree_r, minfree_o, + minfree_bhof] -- calc values of all function calc_all :: [Int] -> [Int] -- cgit v1.2.3