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)]

--