Declaratieve Talen/Oplossing Medicijnen

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