Declaratieve Talen/oplossingAlternatieveOrdes

Een oplossing

Een oplossing voor het eerste deel van de opgave. Het is een beetje Prolog-generate-and-test geïnspireerd.

 import List
 
 berekenorde::[String]->[String]
 berekenorde woorden = filter (correcteOrde paren) (permuteer letters)
 	where 
 		paren = woordenNaarParen woorden
 		letters = findLettersWoorden woorden
 
 woordenNaarParen::[String]->[(Char, Char)]
 woordenNaarParen list = nub $ woordenNaarParen' list
 woordenNaarParen' [] = []
 woordenNaarParen' (w:t) =
 	verwerkWoorden t w ++ woordenNaarParen t
 
 verwerkWoord::String->String->Maybe (Char, Char)
 verwerkWoord "" _ = Nothing
 verwerkWoord _ "" = Nothing
 verwerkWoord (c1:t1) (c2:t2)
 	| c1 /= c2 = Just (c1,c2)
 	| otherwise = verwerkWoord t1 t2
 
 -- geef woord en zoek naar paren met behulp van andere woordenlijst
 verwerkWoorden::[String]->String->[(Char, Char)]
 verwerkWoorden woorden woord = 
 	[ x | Just x <- map (verwerkWoord woord) woorden]	
 
 
 -- alle letters van alle woorden
 findLettersWoorden::[String]->[Char]
 findLettersWoorden lijst = 
 	nub $ concatenate lijst
 
 correcteOrde::[(Char,Char)]->[Char]->Bool
 correcteOrde [] letters = True
 correcteOrde ((c1,c2):t) letters = 
 	(elemIndex c1 letters) < (elemIndex c2 letters) && correcteOrde t letters
 
 permuteer::[a]->[[a]]
 permuteer [] = [[]]
 permuteer (h:t) = concatMap (permIns h) (permuteer t)
 permIns::a->[a]->[[a]]
 permIns x [] = [[x]]
 permIns x (h:t) = (x:h:t) : map (h:) (permIns x t)
 

--Roald 13 jan 2010 19:55 (UTC)

Een gedeeltelijke oplossing

Hieronder volgt een gedeeltelijke oplossing ('maakuniek' is niet geïmplementeerd) Het idee is dat de woorden als een soort van 'Boom' geparsed gaan worden: ["ab", "abd", "abc", "ba", "bd", "cc"] => [('a', ["b", "bd", "bc"]), ('b', ["a", "d"]), ('c', ["c"])] -- (a < b < c) => [('b', ["d", "c"])], [('a', []), ('d', [])] -- ( a < d) [('c', [])] => [('d', []), ('c', [])] -- (d < c) => Dus de orderingen zijn: (a < b < c) en ( a < d) en (d < c) =>(a<b<d<c) of (a<d<b<c) import List alle_letters :: [String] -> [Char] alle_letters woordenlijst = foldl union [] woordenlijst -- vb.: -- *Main> eerste_letters ["ab", "abd", "abc", "ba", "bd", "cc"] -- [('a',"b"),('a',"bd"),('a',"bc"),('b',"a"),('b',"d"),('c',"c")] eerste_letters :: [String] -> [(Char, String)] eerste_letters xs = [((head x), (tail x)) | x <- (filter (/= []) xs)] alle_eerste_letters :: [(Char, String)] -> [Char] alle_eerste_letters lijst = nub [x | (x, s) <- lijst] -- vb.: -- *Main> groepeer ["ab", "abd", "abc", "ba", "bd", "cc"] -- [('a',["b","bd","bc"]),('b',["a","d"]),('c',["c"])] groepeer :: [String] -> [(Char, [String])] groepeer xs = let eerste = (eerste_letters xs) in let letters = alle_eerste_letters eerste in [ (l, [s | (c,s) <- eerste, c == l]) | l <- letters] -- vb.: -- *Main> zoek_orde ["ab", "abd", "abc", "ba", "bd", "cc"] -- [('a','b'),('d','c'),('a','d'),('b','c')] zoek_orde :: [String] -> [(Char,Char)] zoek_orde [] = [] zoek_orde woordenlijst = nub (zoek_orde_rec (groepeer woordenlijst)) zoek_orde_rec :: [(Char, [String])] -> [(Char,Char)] zoek_orde_rec [] = [] zoek_orde_rec [(c,rest)] = (zoek_orde rest) zoek_orde_rec ((c1,rest1):(c2,rest2):cs) = ((c1,c2):(zoek_orde rest1)) ++ (zoek_orde rest2) ++ (zoek_orde_rec ((c2,rest2):cs)) berekenorde :: [String] -> [String] berekenorde woordenlijst = let letters = alle_letters woordenlijst orde = zoek_orde woordenlijst in [ p | p <- (permutations letters), (correcte_ordening p orde)] correcte_ordening :: String -> [(Char,Char)] -> Bool correcte_ordening orde lijst = foldl (\a b -> (correcte_orde orde b) && a) True lijst correcte_orde :: String -> (Char,Char) -> Bool correcte_orde orde (c1,c2)= (findIndex (== c1) orde) < (findIndex (== c2) orde) permutations :: Eq a => [a] -> [[a]] permutations [] = [[]] permutations xs = [ x:ys | x <- xs, ys <- permutations (delete x xs)]

--