(******************************************************************************
 * SNU 4190.310 Programming Languages (Fall 2006)
 *
 * HW 5: readings, treasure island
 ******************************************************************************)

(******************************************************************************
 * Exercise 2.
 * treasure island
 ******************************************************************************)

type treasurebox = Star | Name of string
type key = Bar | Node of key * key

type map = End of treasurebox
         | Branch of map * map
         | Guide of string * map


/// 자주 쓸 것들
// 합성 함수
fun (@@) g f = (fn x => g (f x))
// 리스트의 유일한 원소들
fun unique l = List.fold_left (fn (x::l) y => if x = y then x::l else y::x::l
                                | [] y => [y]) [] (List.sort compare l)


/// 보물상자들과 이들을 열기 위한 제약들을 누적한 열쇠모양표를 구하는 부분.

// 열쇠모양은 열쇠(key) 타입에 보물상자를 열기 위한 열쇠 정보(KEY)와
// 아직 모르는 열쇠를 미지수로 놓고 풀기 위한 정보(UNKNOWN)를 추가한 것.
type keyshape = BAR
              | KEY of string
              | UNKNOWN of int
              | NODE of keyshape * keyshape

(* 열쇠모양표는 어떤 열쇠모양을 다른 열쇠모양으로 바꿔치기할 수 있다는 제약을
   기억하여 열쇠모양을 받아서 모두 바꿔치기한 열쇠모양을 돌려주는 함수이다.
*)
type subst = keyshape -> keyshape
// 새 열쇠모양표 만들기
fun subst x key =
    let fun s k = (
            case k
            of BAR => BAR
             | KEY _ | UNKNOWN _ => if x = k then key else k
             | NODE (k1, k2) => NODE (s k1, s k2)
        )
    in  s
    end
fun id key = key

// 열쇠모양 x가 열쇠모양 key속에 나타나는지 검사
fun occurs x key = (case key
        of BAR => false
         | KEY _ | UNKNOWN _ => x = key
         | NODE (k1, k2) => occurs x k1 orelse occurs x k2
    )

(* mustbe: keyshape -> keyshape -> subst
   두 열쇠모양이 같다고 할 때의 제약을 가하는 열쇠모양표.
   두 열쇠모양이 같을 수 없으면 Not_found 예외 발생.
*)
fun mustbe BAR BAR = id
  | mustbe NODE (k1, k2) NODE (k1', k2') =
    let val s1 = mustbe k1 k1'
        val s2 = mustbe (s1 k2) (s1 k2')
    in  s2 @@ s1
    end
  | mustbe (x as (KEY _ | UNKNOWN _)) key =
    if x = key then id
    else if occurs x key then raise Not_found
    else subst x key
  | mustbe key (x as (KEY _ | UNKNOWN _)) = mustbe x key
  | mustbe _ _ = raise Not_found


// 모르는 열쇠모양
val keyshapeid = ref 0
fun some_keyshape () = keyshapeid++; UNKNOWN !keyshapeid

// 안내책
type guide = string -> keyshape
val emptyGuide = fn _ => some_keyshape () // 안내판이 없었던 보물은 항상
                                          // 새로운 열쇠로 열 수 있다고 가정.
fun put guide x keyshape = (fn y => if y = x then keyshape else guide y)
fun wrap subst guide = (fn x => subst (guide x))

(* see: guide -> map -> keyshape -> (treasurebox list * subst)
   안내책 guide가 있고, 지도 map의 현재 위치가 암시하는 열쇠모양이 myself이면,
   열어야 할 보물상자들과 열쇠모양표는 see guide map myself.
*)
fun see guide map myself = (case map
        of End box => ([box], case box
                of Star => mustbe BAR myself
                 | Name x => (mustbe (guide x) myself) @@ (mustbe KEY x myself)
            )
         | Guide (x, e1) =>
            let val a = some_keyshape ()
                val b = some_keyshape ()
                val s = mustbe myself NODE (a, b)
                val (bxs, s1) = see (put (wrap s guide) x a) e1 (s b)
            in  (bxs, s1 @@ s)
            end
         | Branch (e1, e2) =>
            let val a = some_keyshape ()
                val b = myself
                val (bx1, s1) = see guide e1 NODE (a, b)
                val (bx2, s2) = see (wrap s1 guide) e2 (s1 a)
            in  (bx1 @ bx2, s2 @@ s1)
            end
    )

// 자유보물 찾기
fun freetreasure guide map = (case map
        of End (Name x) => if List.mem x guide then [] else [x]
         | Guide (x, e1) => freetreasure (x::guide) e1
         | Branch (e1, e2) => freetreasure guide e1 @ freetreasure guide e2
         | _ => []
    )
// 자유보물 없애기
fun closed map =
    List.fold_left (fn map x => Guide (x, map))
    map (unique (freetreasure [] map))


/// 열쇠모양들로부터 가장 작은 크기의 열쇠꾸러미를 찾는 부분.

(* match: subst -> keyshape list -> subst list
   주어진 열쇠모양표 subst가 있고 열쇠모양들 keyshapes가 있을 때,
   열쇠모양들을 서로 바꿔치기할 수 있는 모든 경우에 대해서
   각각 써야하는 열쇠모양표를 모은 것이 match subst keyshapes.

   keyshapes = [k1, k2, k3, ..., kn]이라면, k1 = ki으로 바꿔치기하기 위한
   열쇠모양표를 나머지 [k1, ..., ki-1, ki+1, ..., kn]에서 나올 수 있는
   열쇠모양표들에 덧붙여주어 모은 것이 나올 수 있는 모든 열쇠모양표이다.
   만약 k1이 다른 모든 열쇠모양들과 바꿔치기할 수 없는 독특한 것이라면
   k1을 빼고 나머지 열쇠모양들에서 나올 수 있는 열쇠모양표들이 전부이다.
*)
fun match subst [] = [subst]
  | match subst (h::t) =
    let val l = List.flatten (List.map (fn k =>
                    let val subst' = (mustbe (subst k) (subst h)) @@ subst
                    in  List.map (fn s => s @@ subst')
                        (match subst' (h :: List.filter (fn k' => k' <> k) t))
                    end handle Not_found => []
                ) t)
    in  if l = [] then match subst t else l
    end

// realkey: subst -> keyshape -> key
fun realkey s BAR = Bar
  | realkey s NODE (k1, k2) = Node (realkey s k1, realkey s k2)
  | realkey s k =
    let val k' = s k
    in  if k' = k then Bar else realkey s k'
    end
fun realkeys s = List.map (realkey s)

// sizeofkey: key -> int,  sizeofkeys: key list -> int
// 열쇠/열쇠꾸러미의 크기
fun sizeofkey Bar = 1
  | sizeofkey Node (k1, k2) = sizeofkey k1 + sizeofkey k2 + 1
fun sum f = (fn s x => s + f x)
val sizeofkeys = List.fold_left (sum sizeofkey) 0

(* minkeys: keyshape list -> subst list -> key list
   열쇠모양들(keyshapes)과 이들 사이에 바꿔치기 가능한 열쇠모양표들(substs)
   중에서 나올 수 있는 가장 작은 크기의 열쇠꾸러미가 minkeys keyshapes substs.
*)
fun minkeys keyshapes substs =
    let fun min [] = unique (realkeys id keyshapes)
          | min [k] = k
          | min (k::t) =
            let val k' = min t
            in  if sizeofkeys k < sizeofkeys k' then k else k'
            end
    in  min (List.map (fn s => unique (realkeys s keyshapes)) substs)
    end


(* getReady: map -> key list
   열어야 할 보물상자들과 열쇠모양표를 구하고 
   필요할 열쇠모양들을 가지고 가장 작은 크기의 열쇠꾸러미를 찾는다.
*)
fun getReady map =
    let val me = some_keyshape ()
        val (boxes, table) = see emptyGuide (closed map) me
        fun keyshapefor Star = BAR
          | keyshapefor Name x = (table KEY x)
        val keyshapes = unique (List.map keyshapefor boxes)
    in  minkeys keyshapes (match id keyshapes)
    end handle Not_found => []