{-# LANGUAGE FlexibleInstances #-}

module AufgabeFFP6
where

import Data.Array

type F  = Array Int Int
type Op = Int -> Int -> Int
type G  = Array Int (Op)
type W  = Int

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

(./.) :: Int -> Int -> Int
(./.) = div

myfoldl :: [(a -> b -> a)] -> a -> [b] -> a
myfoldl _ f1 [] = f1
myfoldl (g:gs) f1 (f2:fs) = myfoldl gs (g f1 f2) fs

myfoldl' :: [(a -> a -> a)] -> [a] -> a
myfoldl' g (f:fs) = myfoldl g f fs

eval :: F -> G -> W
eval f g = myfoldl' (elems g) (elems f)

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

yield :: F -> W -> [G]
yield = yield_bt
--yield = yield_gtf

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

instance Eq (Integer -> Integer -> Integer) where
  (==) op1 op2 = ((op1 3 3) - (op2 3 3)) == 0
instance Eq (Int -> Int -> Int) where
  (==) op1 op2 = ((op1 3 3) - (op2 3 3)) == 0

check_divByZero :: F -> G -> Bool
check_divByZero f g = check_divByZero' (tail (elems f)) (elems g)
  where
    check_divByZero' _ [] = True
    check_divByZero' [] _ = True
    check_divByZero' (f:fs) (g:gs)
      | f == 0 && g == (./.) = False
      | otherwise = True && check_divByZero' fs gs

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

type Node = ([Int], [Int], W, [Op])

goal_yield_bt :: Node -> Bool
goal_yield_bt (_, _, _, []) = False -- no operators
goal_yield_bt (f, [], w, g) = check_divByZero f' g' && eval f' g' == w
  where
    f' = listArray (1, length f) f
    g' = listArray (1, length g) g
goal_yield_bt (_, _, _, _) = False

succ_yield_bt :: Node -> [Node]
succ_yield_bt (_, [], _, _) = []
succ_yield_bt (f, f', w, g) = [(f_new, f'_new, w, g ++ [g_new]) | g_new <- ops]
  where
    f_new  = f ++ [head f']
    f'_new = tail f'
    ops    = [(+), (-), (*), (./.)]

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

yield_bt :: F -> W -> [G]
yield_bt f w = map (\(_, _, _, g) -> listArray (1, length g) g) nodes
  where
    f_elem1 = head (elems f)
    f_tail  = tail (elems f)
    nodes   = searchDfs succ_yield_bt goal_yield_bt ([f_elem1], f_tail, w, [])

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

yield_gtf :: F -> W -> [G]
yield_gtf = filt . transform . generate

-- produce [G] by using get_combinations
generate :: F -> W -> (F, W, [G])
generate f w =  (f, w, [ array (1,n) entries | entries <- get_combinations n ])
  where
    n = (snd $ bounds f) - 1

-- provide all selections of length n, work recursively and attach index for
-- level (convenient for creating arrays)
get_combinations :: Int -> [[(Int, Op)]]
get_combinations 1 = [[(1,(+))], [(1,(-))], [(1,(*))], [(1,(./.))]]
get_combinations n = [ (up i) ++ entr  | entr <- get_combinations (n-1), i <- get_combinations 1 ]
  where
    up = map (\(num, x) -> ((num + n - 1), x))

-- attaches a list of results
transform ::  (W -> (F, W, [G])) -> W -> ((F, W, [G]), [W])
transform fun w = ((f, w, g'), map (eval f) g')
  where
    (f, w, g) = fun w
    g' = filter (check_divByZero f) g

-- take those, where the entry in the result list corresponds to
filt :: (W -> ((F, W, [G]), [W]) ) -> W -> [G]
filt fun w = [ g!!i | i <- [0..n], res!!i == w ]
  where
    ( (f, _, g), res ) = fun w
    n = (length g) - 1

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

instance Show (Integer -> Integer -> Integer) where
  show op = case (3 `op` 3) of
    6 ->  "plus"
    0 ->  "minus"
    9 ->  "times"
    1 ->  "div"
    _ ->  "unknown"

instance Show (Int -> Int -> Int) where
  show op = case (3 `op` 3) of
    6 ->  "plus"
    0 ->  "minus"
    9 ->  "times"
    1 ->  "div"
    _ ->  "unknown"