Declaratieve Talen/Oplossing Medicijnen

Uit Wina Examenwiki
Naar navigatie springen Naar zoeken springen 
import Data.List

-- Dit maakt de type signatures duidelijker.
type Capaciteit = Integer
type Apotheek = String
type Levering = (Apotheek,Integer)
type Ophaling = (Apotheek,Integer)
type Pad = [String]

-- Bereken een route waarbij elke apotheek één keer bezocht wordt
-- en waarbij men zo weinig mogelijk moet terugkeren naar het depot.
ronde :: Capaciteit -> [Levering] -> [Ophaling] -> Pad
ronde c l o = 
  bestePad (map reverse (ronde' []))
  where ronde' h 
          | sort h == sort (apotheken l o) = [[]]
          | otherwise = [ voegToe a rest | a <- apotheken l o, a `notElem` h, rest <- ronde' (a:h)]
        voegToe a rest = if kanErBij c a l o rest then a:rest else a:"depot":rest

-- Geef een lijst met alle apotheken waar iets opgehaald/geleverd moet worden.
apotheken :: [Levering] -> [Ophaling] -> [Apotheek]
apotheken leveringen ophalingen = nub [a|(a,_) <- (leveringen ++ ophalingen)]

-- Controleer of de koerier een volgende apotheek er nog bij kan nemen 
-- zonder te moeten terugkeren naar het depot.
kanErBij :: Capaciteit -> Apotheek -> [Levering] -> [Ophaling] -> Pad -> Bool
kanErBij c a l o p =  let leveren = (leverenAantal a l) + (capaciteitVertrek l p)
                          ophalen = (ophalenAantal a o) + (capaciteitEind o p)
                          combo   = (leverenAantal a l) + (capaciteitEind o p)
                      in leveren <= c && ophalen <= c && combo <= c
                      
-- Bepaal hoeveel er geleverd moet worden in een apotheek.
leverenAantal :: Apotheek -> [Levering] -> Integer
leverenAantal a [] = 0
leverenAantal a ((b,h):ls)| a == b = h
                          | otherwise = leverenAantal a ls

-- Bepaal hoeveel er opgehaald moet worden in een apotheek.
ophalenAantal :: Apotheek -> [Ophaling] -> Integer
ophalenAantal a [] = 0
ophalenAantal a ((b,h):ls)| a == b = h
                          | otherwise = ophalenAantal a ls

-- Geef het deel van het pad na het laatste bezoek aan het depot.
padNaDepot :: Pad -> Pad
padNaDepot [] = []
padNaDepot (a:p)  | "depot" `elem` (a:p) = padNaDepot p
                  | otherwise = (a:p)

-- Bereken de capaciteit die nodig is voor de leveringen.     
-- (Pad bevat geen depot)
capaciteitVertrek :: [Levering] -> Pad -> Capaciteit                              
capaciteitVertrek ((a,h):ls) p = capaciteitVertrek' ((a,h):ls) p 0
    where capaciteitVertrek' [] p acc = acc
          capaciteitVertrek' ((a,h):ls) p acc | a `elem` p = capaciteitVertrek' ls p (acc + h)
                                              | otherwise = capaciteitVertrek' ls p acc
                                              
-- Bereken de gebruikte capaciteit bij het ophalen.
-- (Pad bevat geen depot)
capaciteitEind :: [Ophaling] -> Pad -> Capaciteit                              
capaciteitEind ((a,h):ls) p = capaciteitEind' ((a,h):ls) p 0
    where capaciteitEind' [] p acc = acc
          capaciteitEind' ((a,h):ls) p acc  | a `elem` p = capaciteitEind' ls p (acc + h)
                                            | otherwise = capaciteitEind' ls p acc
                                            
-- Haal uit een lijst van paden het pad waarbij de koerier het minste
-- moet terugkeren naar de depot. Indien er meerdere minimale paden zijn
-- kiezen we het alfabetisch eerste pad.
bestePad :: [Pad] -> Pad
bestePad paden = (sort (filter (\x -> (aantalDepot x) == mini) paden)) !! 0
  where mini = minimum (map aantalDepot paden)
   
-- Tel het aantal keer dat de koerier langs het depot passeert in een pad.     
aantalDepot :: Pad -> Int
aantalDepot p = sum $ map (\x -> if x == "depot" then 1 else 0) p



-- Idee: Elke ronde begint met een nieuw paar van (ophaalcapaciteit, aflevercapaciteit)
-- Na elk bezoek moeten beide capaciteiten >= 0 en <= kamionetcapaciteit zijn

ronde :: Int -> [(String, Int)] -> [(String, Int)] -> [String]
ronde cap heen terug = 
	let
		joined = join heen terug
	in
		doall cap joined

doall :: Int -> [(String, (Int, Int))] -> [String]
doall _ [] = []
doall cap deliveries = 
	let
		(steden, remainingdeliveries) = ronde2 cap (0, cap) deliveries
	in
		steden ++ "depot" : doall cap remainingdeliveries

join :: [(String, Int)] -> [(String, Int)] -> [(String, (Int, Int))]
join [] [] 			= []
join [(s1, h1)] [] 	= [(s1, (h1, 0))]			-- stad waar enkel geleverd moet worden
join [] [(s2, h2)] 	= [(s2, (0, h2))]			-- stad waar enkel afgehaald moet worden
join heen@((s1, h1) : hs) terug@((s2, h2) : ts)
	| s1 == s2		= (s1, (h1, h2)): join hs ts	-- stad waar geleverd als opgehaald moet worden
	| s1 < s2		= (s1, (h1, 0))	: join hs terug	-- stad waar enkel geleverd moet worden
	| s1 > s2		= (s2, (0, h2))	: join heen ts 	-- stad waar enkel afgehaald moet worden
	
ronde2 :: Int -> (Int, Int) -> [(String, (Int, Int))] -> ([String], [(String, (Int, Int))])
ronde2 _ _ [] = ([], [])
ronde2 cap (afcap, opcap) (entry@(stad, (af, op)) : xs) =
	let
		remafcap = afcap + af
		remopcap = opcap - op
		remafcapok = remafcap <= cap && remafcap >= 0
		remopcapok = remopcap <= cap && remopcap >= 0
	in
		if remafcapok && remopcapok
		then
			let	(a, b) = ronde2 cap (remafcap, remopcap) xs
			in	(stad : a, b) 
		else
			let	(a, b) = ronde2 cap (afcap, opcap) xs
			in	(a, entry : b)




import List

ronde::Int->[([Char],Int)]->[([Char],Int)]->[[Char]]
ronde max heen terug = (minOpl (zoekOplossingen (permuteer (zetOm heen terug)) max))


zetOm::[([Char],Int)]->[([Char],Int)]->[([Char],Int,Int)]
zetOm [] [] = []
zetOm [] ((a,y):ys) = [(a,0,y)] ++ (zetOm [] ys)
zetOm ((a,x):xs) ys|(zoekZelfde a ys) == 0 = [(a,x,0)]++ (zetOm xs ys)
		   |otherwise = [(a,x,(zoekZelfde a ys))] ++ (zetOm xs (delete (a,(zoekZelfde a ys)) ys))


zoekZelfde::[Char]->[([Char],Int)]->Int
zoekZelfde a [] = 0
zoekZelfde a ((b,x):xs)|a==b = x
		       |otherwise = (zoekZelfde a xs)


permuteer::[([Char],Int,Int)]->[[([Char],Int,Int)]]
permuteer [] = [[]]
permuteer (h:t) = concatMap (permIns h) (permuteer t)
permIns::([Char],Int,Int)->[([Char],Int,Int)]->[[([Char],Int,Int)]]
permIns x [] = [[x]]
permIns x (h:t) = (x:h:t) : map (h:) (permIns x t)


zoekOplossingen::[[([Char],Int,Int)]]->Int->[([[Char]],Int)]
zoekOplossingen [] _ = []
zoekOplossingen (x:xs) max = [(zoekOpl x max)] ++ (zoekOplossingen xs max)


zoekOpl::[([Char],Int,Int)]->Int->([[Char]],Int)
zoekOpl ((a,x,y):xs) max= ([a] ++ (zoekOpl2 x y xs max) , (hoeveelDep (zoekOpl2 x y xs max)))


zoekOpl2::Int->Int->[([Char],Int,Int)]->Int->[[Char]]
zoekOpl2 _ _ [] _ = ["depot"]
zoekOpl2 x1 y1 ((a,x2,y2):xs) max = if (and [((x1+x2)<=max),((y1+x2)<=max),((y1+y2)<=max)]) then [a] ++ (zoekOpl2 (x1+x2) (y1+y2) xs max)
				    else ["depot",a] ++ (zoekOpl2 x2 y2 xs max)

hoeveelDep::[[Char]]->Int
hoeveelDep [] = 0
hoeveelDep (x:xs)|x=="depot" = 1 + (hoeveelDep xs)
		 |otherwise = 0 + (hoeveelDep xs)


minOpl::[([[Char]],Int)]->[[Char]]
minOpl ((x,aantal):xs) = (minOpl2 x aantal xs)

minOpl2::[[Char]]->Int->[([[Char]],Int)]->[[Char]]
minOpl2 x aantal [] = x
minOpl2 x aantal ((x2,aantal2):xs)|aantal2<aantal = (minOpl2 x2 aantal2 xs)
				  |otherwise = (minOpl2 x aantal xs)

--Lynn 17 jan 2011 15:56 (UTC) 


import List
import Data.Ord

gewicht (loc,lev,oph) = oph - lev

prioriteit:: [(String,Int,Int)] -> [(String,Int,Int)] 
prioriteit lijst = sortBy (comparing gewicht) lijst

kanLeveren:: Int -> Int -> Int -> (String,Int,Int) -> Bool
kanLeveren waren afval capaciteit (_,gevraagd,vuil)
					| gevraagd <= waren, afval + waren - gevraagd + vuil <= capaciteit = True
					 | otherwise = False
kanErgensLeveren:: Int -> Int -> Int -> [(String,Int,Int)] -> Bool
kanErgensLeveren _ _ _ [] = False
kanErgensLeveren waren afval capaciteit (x:xs) | kanLeveren waren afval capaciteit x = True
												| otherwise = kanErgensLeveren waren afval capaciteit xs
					 
ronde:: Int -> [(String,Int)] -> [(String,Int)] -> [String]
ronde cap leveren ophalen = refill cap $ join leveren ophalen

refill:: Int -> [(String,Int,Int)] -> [String]
refill _ [] = ["depot"]
refill cap lijst = ("depot") : (ronde' cap 0 cap (prioriteit lijst))

ronde':: Int -> Int -> Int -> [(String,Int,Int)] -> [String]
ronde' _ _ cap [] = refill cap []
ronde' waren afval cap (x@(loc,telev,teoph):xs) |(kanLeveren waren afval cap x) 
												= loc : (ronde' (waren-telev) (afval+teoph) cap xs)
												|(kanErgensLeveren waren afval cap (x:xs))  
												= ronde' waren afval cap (xs++[x])
												| otherwise = refill cap (x:xs)
												
												
join :: [(String, Int)] -> [(String, Int)] -> [(String, Int, Int)]
join [] [] 			= []
join [(s1, h1)] [] 	= [(s1, h1, 0)]			-- stad waar enkel geleverd moet worden
join [] [(s2, h2)] 	= [(s2, 0, h2)]			-- stad waar enkel afgehaald moet worden
join heen@((s1, h1) : hs) terug@((s2, h2) : ts)
	| s1 == s2		= (s1, h1, h2): join hs ts	-- stad waar geleverd als opgehaald moet worden
	| s1 < s2		= (s1, h1, 0)	: join hs terug	-- stad waar enkel geleverd moet worden
	| s1 > s2		= (s2, 0, h2)	: join heen ts 	-- stad waar enkel afgehaald moet worden

--Gebruiker:Laurent Indekeu 16 jan 2012 22:46 (UTC)

Nog eentje. 


import List

-- (capaciteit)->(ophaal)->(afhaal)->(route)
ronde::Int->[(String,Int)]->[(String,Int)]->[String]
ronde c heen terug = ronde2 c (city heen terug)

ronde2::Int->[(String,(Int,Int))]->[String]
ronde2 _ [] = []
ronde2 c list@(x:xs) = let delivRound = [fst x] ++ (findCompatibleCitys c x xs []) ++ ["depot"]
		in delivRound ++ (ronde2 c (otherCitys delivRound list)) 

otherCitys::[String]->[(String,(Int,Int))]->[(String,(Int,Int))]
otherCitys [] list = list
otherCitys (x:xs) list
	| lookup x list == Nothing 	= otherCitys xs list
	| otherwise			= otherCitys xs (delete (x,(lookup2 x list)) list)

findCompatibleCitys::Int->(String,(Int,Int))->[(String,(Int,Int))]->[(String,(Int,Int))]->[String]
findCompatibleCitys _ _ [] cc = map fst cc
findCompatibleCitys cap town@(t,(a,b)) (x:xs) cc =
	let target = (fst x,(getHeen x,getTerug x)) in
	if 	cap >= a + getHeen x + getHeenAll cc
		&& cap >= b + getHeen x + getHeenAll cc
		&& cap >= b + getTerug x + getHeenAll cc
		&& cap >= b + getTerug x + getTerugAll cc
		then findCompatibleCitys cap town xs (target:cc)
	else findCompatibleCitys cap town xs cc


getHeenAll::[(String,(Int,Int))]->Int
getHeenAll [] = 0
getHeenAll (x:xs) = (fst (snd x)) + (getHeenAll xs)

getTerugAll::[(String,(Int,Int))]->Int
getTerugAll [] = 0
getTerugAll (x:xs) = (snd (snd x)) + (getTerugAll xs)

getHeen::(String,(Int,Int))->Int
getHeen (_,(a,_)) = a

getTerug::(String,(Int,Int))->Int
getTerug (_,(_,b)) = b

city::[(String,Int)]->[(String,Int)]->[(String,(Int,Int))]
city [] (y:ys) = (fst y,(0,snd y)):(city [] ys)
city (x:xs) [] = (fst x,(snd x,0)):(city xs [])
city [] [] = []
city (x:xs) (y:ys)
	| fst x == fst y	= (fst x,(snd x,snd y)):(city xs ys)
	| otherwise	= city (x:xs) ys

allDest::[(String,Int)]->[(String,Int)]->[String]
allDest heen terug = List.nub $ (map fst heen) ++ (map fst terug)

lookup2::String->[(String,(Int,Int))]->(Int,Int)
lookup2 _ [] = (0,0)
lookup2 a (x:xs)
	| a == (fst x)	= snd x
	| otherwise	= lookup2 a xs

--Gebruiker:Andries 17 jan 2012

Overgenomen van "http://examens.wina.be/index.php?title=Declaratieve_Talen/Oplossing_Medicijnen&oldid=15849"