module AufgabeFFP4
where

import List
import Data.Array

type Weight    = Int             -- Gewicht
type Value     = Int             -- Wert
type MaxWeight = Weight          -- Hoechstzulaessiges Rucksackgewicht
type Object    = (Weight, Value) -- Gegenstand als Gewichts-/Wertpaar
type Objects   = [Object]        -- Menge der anfaenglich gegebenen Gegenstaende
type SolKnp    = [Object]        -- Auswahl aus der Menge der anfaenglich
                                 -- gegebenen Gegenstaende; moegliche
                                 -- Rucksackbeladung, falls zulaessig

type NodeKnp   = (Value, Weight, MaxWeight, [Object], SolKnp)

-------------------------------------------------------------------------------

filterOne :: (a -> Bool) -> [a] -> [a]
filterOne p [] = []
filterOne p (x:xs)
  | p x = xs
  | otherwise = x : filterOne p xs

succKnp :: NodeKnp -> [NodeKnp]
succKnp (v, w, limit, objects, psol) =
  map (
    \(w', v') -> (
      v + v',
      w + w',
      limit,
      filterOne (== (w', v')) objects2,
      (w', v') : psol
    )
  ) objects2
  where
    objects2 = filter (\(w', v') -> (w + w') <= limit) objects

-------------------------------------------------------------------------------

goalKnp :: NodeKnp -> Bool
goalKnp (_, _, _, [], _) = True
goalKnp (_, w, limit, ((w', _) : _), _) = (w + w') > limit

-------------------------------------------------------------------------------

-- see lecture slide #167 ff.
data Stack a = EmptyStk
               | Stk a (Stack a)

push :: a -> Stack a -> Stack a
push x s = Stk x s

pop :: Stack a -> Stack a
pop EmptyStk = error "pop from an empty stack"
pop (Stk _ s) = s

top :: Stack a -> a
top EmptyStk = error "top from an empty stack"
top (Stk x _) = x

emptyStack :: Stack a
emptyStack = EmptyStk

stackEmpty :: Stack a -> Bool
stackEmpty EmptyStk = True
stackEmpty _  = False

searchDfs :: (Eq node) => (node -> [node]) -> (node -> Bool) -> node -> [node]
searchDfs succ goal x = search' (push x emptyStack)
  where
    search' s
      | stackEmpty s = []
      | goal (top s) = top s : search' (pop s)
      | otherwise =
        let x = top s
        in search' (foldr push (pop s) (succ x))

-------------------------------------------------------------------------------

cmpObject :: Object -> Object -> Ordering
cmpObject (w, v) (w', v')
  | w == w' = compare v v'
  | otherwise = compare w w'

-- it's safe to use maximum here as it will look at the first value of each tuple only
knapsack :: Objects -> MaxWeight -> (SolKnp, Value)
knapsack objects limit = (psol, v)
  where
    (v, _, _, _, psol) = maximum (searchDfs succKnp goalKnp (0, 0, limit, sortBy cmpObject objects, []))

-------------------------------------------------------------------------------

-- see lecture slide #207 ff.
newtype Table a b = Tbl (Array b a)
  deriving Show

newTable :: (Ix b) => [(b, a)] -> Table a b
newTable l = Tbl (array (lo, hi) l)
  where
    indices = map fst l
    lo = minimum indices
    hi = maximum indices

findTable :: (Ix b) => Table a b -> b -> a
findTable (Tbl a) i = a ! i

updTable :: (Ix b) => (b, a) -> Table a b -> Table a b
updTable p@(i, x) (Tbl a) = Tbl (a // [p])

dynamic :: (Ix coord) => (Table entry coord -> coord -> entry) -> (coord, coord) -> (Table entry coord)
dynamic compute bnds = t
  where
    t = newTable (map (\coord -> (coord, compute t coord)) (range bnds))

-------------------------------------------------------------------------------

bndsB :: (Integer, Integer) -> ((Integer, Integer), (Integer, Integer))
bndsB (n, k) = ((0, 0), (n, k))

compB :: Table Integer (Integer, Integer) -> (Integer, Integer) -> Integer
compB t (n, k)
  | k == 0 = 1
  | n == k = 1
  | k == 1 = n
  | n < k  = 0
  | otherwise = findTable t (n - 1, k - 1) + findTable t (n - 1, k)

binomDyn :: (Integer, Integer) -> Integer
binomDyn (n, k) = findTable t (n, k)
  where
    t = dynamic compB (bndsB (n, k))