함수형 프로그래밍 4.5강 : n-Bishops 문제

위의 사진은 8 x 8 체스판에 각 비숍이 최대 한개의 다른 비숍에게만 공격받도록 해서 비숍을 최대한 놓은 배치이다.

이 답을 어떻게 구했나가 오늘의 주제이다.

아 그리고 오늘은 4.5강인데, 이때까지 배운 문법과 개념들을 활용하는거라서 .5강으로 했다. 앞으로 중간중간에 .5강이 있을수도 있고 없을수도 있을 예정이다.

1. n-Bishops 문제

우리가 풀 n-Bishops 문제는 다음과 같다 : 비숍은 대각선으로만 공격할 수 있는 체스 기물이다. 각 비숍이 최대 한개의 다른 비숍에 공격당할 수 있을때, 비숍을 n x n 체스판에 얼마나 많이 배치할 수 있는가?

예를 들어 4x4 체스판에는 다음과 같이 8개의 비숍을 배치할 수 있다.

비숍이 하나라도 더 많이 배치되면 두개 이상의 비숍에게 공격받는 비숍이 생긴다. 예를 들어 (3, 1)에 비숍을 놓으면 (1, 3)에 있는 비숍이 (3, 1) 비숍과 (2, 4) 비숍에게 공격받게 된다.

일단 문제를 풀기 위해 필요한 기본적인 함수를 보여주겠다. 각 함수가 어떤 일을 하는지만 훑고 넘어가자.

(* 체스판의 포지션을 나타내는 int쌍이다. *)
type pos = int * int

(* cart : int list * int list -> pos list
   cart (xs, ys)는 {1, ..., xs} 와 {1, ..., ys}의 곱집합 리스트(cartesian product)를 리턴한다. *)
fun cart ([], B) = []
  | cart (a::A, B) = map (fn b => (a, b)) B @ cart (A, B)

(* upto : int -> int -> int list
   upto 1 n = [1, 2, ..., n]      *)
fun upto i j = if i > j then [] else i::upto (i+1) j

(*  board : int -> pos list
    board n = n x n 체스판의 pos 리스트
    예를 들어 board 2 = [(1, 1), (1, 2), (2, 1), (2, 2)] *)
fun board n =
    let
        val xs = upto 1 n
    in
        cart (xs, xs)
    end

비숍이 다른 비숍을 공격한다는걸 어떻게 확인할 수 있을까?

(x, y)에 있는 비숍이 (i, j)에 있는 비숍을 공격한다고 하자. 이게 일어나는 때는 이 둘이 같은 대각선상에 있을때 뿐이므로 abs(x - i) = abs(y - j)일때 일어난다.

(* threat : pos -> pos -> int
   비숍이 공격당하면 리턴값은 1, 아니면 0이다. *)
fun threat (x, y) (i, j) =
    if (abs(x - i) = abs(y - j))     
    then 1
    else 0

이 함수에 의하면 모든 비숍은 자기 자신을 공격한다. 보통은 코드를 수정해야겠지만 우리는 이걸 버그로 치지 않을 것이다. 원한다면 threat 함수를 바꿔서 진행하면 된다.

(* attacks : pos * pos list -> int
   attacks (b L)은 L에 있는 비숍중 b를 공격하는 비숍의 수를 구한다. *)
fun attacks (b, L) = foldr (fn (c, k) => threat b c + k) 0 L

(* forall : (pos -> bool) -> pos list -> bool
   forall p L은 L의 모든 포지션이 p를 만족하면 true를 리턴한다. *)
fun forall p L = foldr (fn (x, t) => (p x) andalso t) true L 

(* safe : pos list -> bool
   safe L은 L의 원소 중에서 1개 이상의 다른 비숍에게 공격받는 비숍이 없을때 true를 리턴한다. 
   또 모든 비숍은 자기 자신을 공격하기 때문에 <= 1이 아니라 <= 2로 두었다. *)
fun safe L = forall (fn b => attacks (b, L) <= 2) L

safe [(1, 1), (1, 2), (1, 3), (2, 1)] (* true *)
safe [(1, 1), (1, 2), (1, 3), (2, 1), (2, 2)] (* false *)

문제를 본격적으로 풀기 전에 체스판을 프린트하는 함수를 작성하자.

(* isin : pos list -> pos -> bool
   x가 L 리스트 안에 있으면 in L x = true이다. *)
fun isin ([] : pos list) (x : pos) = false 
  | isin (p::ps) x = if p = x then true else isin ps x  

(* displayRow : int -> int -> pos list -> string 
   displayRow n k L은 n x n 체스판의 k번째 줄이 담긴 string을 리턴한다. *)
fun displayRow (n : int) (k : int) (L : pos list) = 
    foldl (fn (p, s) => if isin L p 
                        then s ^ "1" 
                        else s ^ "0") "" (cart ([k], upto 1 n)) ^ "\n"

(* display : int -> pos list -> string  
   display n L은 L에 리스트 형식으로 저장되어있는 n x n 체스판를 출력한다. *)
fun display (n : int) (L : pos list) = 
    foldl (fn (k, s) => s ^ displayRow n k L) "" (upto 1 n)

2. 일반적인 백트래킹을 활용한 해법

상태를 이용해 문제를 풀어보자. 상태는 현재 해와 비숍을 놓아도 괜찮은 포지션의 리스트(rest)로 이루어진다.

현재 상태에서 rest에 있는 포지션을 하나씩 확인해서 문제조건을 만족하는지 확인하고 아니면 백트래킹을 하는 식으로 풀것이다. 따라서 아래의 함수들이 필요하다.

type sol = pos list (* solution; 해 *)
(* 상태는 현재 해와 비숍을 놓아도 괜찮은 포지션의 리스트로 이루어진다. *)
type state = sol * pos list 

(* isValidState : state -> bool
   isValidState (bs, rest)는 현재 해가 문제조건을 만족하는지 확인한다. *)
fun isValidState (bs, rest) = safe bs

(* del : pos -> pos list -> pos list 
   del b L은 L에서 b를 지운다. *)
fun del b [] = []  
  | del b (c::cs) = if b = c then cs else c::del b cs

(* steps : state -> state list 
   steps (bs, rest) 는 bs에서 비숍을 하나 더 놓아도 조건을 만족하는 상태의 리스트를 리턴한다. *)
fun steps (bs, rest) = 
    let  
        val R = filter (fn b => safe(b::bs)) rest
    in  
        map (fn b => (b::bs, del b rest)) R
    end

이제 핵심 함수인 search를 보자.

datatype 'a option = NONE | SOME of 'a

(* search : (pos -> bool) -> state list -> (pos list) option
   search p L 은 S가 p를 만족하고 L에 있는 상태를 확장할때 SOME S를 리턴하고,
   아니면 NONE을 리턴한다. *)
fun search p [] = NONE 
  | search p ((bs, rest)::xs) = 
        if (p bs) 
        then SOME bs 
        else search p (steps (bs, rest) @ xs)

search p L은 L의 상태를 보고 p를 만족하면 그대로 그 상태를 리턴하고, 아니라면 그 상태를 steps로 확장시켜 재귀한다.

이제 다 왔다. 다음 함수를 보자.

(* init : int -> state *)
fun init n = ([], board n)

(* bishopsDirect : int -> int -> sol option
   bishopsDirect n m은 S가 문제조건을 만족하는 비숍의 배치 (len(s) = m)이면 SOME S를 리턴하고, 
   그러한 배치가 없다면 NONE을 리턴한다. *)
fun bishopsDirect n m = search (fn bs => (length bs = m)) [init n]

bishopsDirect는 빈 체스판에서 시작하여 문제조건에 맞는 해를 계속 탐색해나가는 함수이다.

bishopsDirect 6 14
(* SOME [(6,6),(6,4),(6,3),(6,1),(5,6),(5,1),(3,5),(3,2),(1,6),(1,5),(1,4),(1,3), 
     (1,2),(1,1)] *)

이 함수를 이용해 주어진 n x n 체스보드에서 가장 많은 수의 비숍을 놓는 배치를 찾는 함수를 생각해볼 수 있다.

다만 한가지 문제점이 있는데, 느리다는 것이다.

6x6 체스보드에서 14개의 비숍을 놓는 배치는 금방 찾아내지만, 8x8 체스보드에서 20개의 비숍을 놓는 배치는 시간이 꽤 걸린다.

원인은 여러가지이다. 그중 몇개만 말하자면 함수가 가능한 해의 모든 후보를 리스트로 갖고 있고, 이 리스트는 꽤 커질 수 있다는 것이다. 또 주어진 상태에서 가능한 모든 확장방법을 구하는것도 낭비가 심하다.

우리는 4강에서 배웠던 CPS를 써서 시간을 줄일 것이다.

3. CPS를 활용한 백트래킹 해법

핵심 함수인 search를 빠르게 하기위해 CPS로 바꿔보자.

이 새로운 solveCPS 함수는 상태의 리스트 대신 상태 하나만 처리하며, 4강의 백트래킹 방법처럼 success continuation (성공했을때 호출하는 컨티뉴에이션)와 failure continuation(실패했을때 호출하는 컨티뉴에이션) 인자를 가질 것이다.

(* solveCPS : (pos list -> bool) -> state -> (pos list -> 'a) -> (unit -> 'a) -> 'a 
   solveCPS p (bs, rest) sc fc 는 L이 해일때 sc L을 출력하고 해가 존재하지 않으면 fc ()를 출력한다. *)

다시 설명하지만 현재 상태는 (bs, rest)이고 bs는 현재 해, rest는 현재 해에서 추가로 비숍을 놓아도 문제없는 포지션의 리스트이다.

만약 bs가 p를 만족하면 sc 컨티뉴에이션을 호출한다.

fun solveCPS p (bs, rest) sc fc = 
    if p bs then sc bs

아니라면, rest를 본다. rest 가 빈 리스트라면 더이상 해를 확장할 수 없으므로 해는 존재하지 않는다.

fun solveCPS p (bs, rest) sc fc =
    if p bs then sc bs else
      (case rest of 
          [] => fc ()

x::xs의 형태라면 현재 해의 x 포지션에 비숍을 하나 더 놓은 x::bs가 문제조건을 만족하는지 확인한다.

fun solveCPS p (bs, rest) sc fc =
    if p bs then sc bs else
        (case rest of
            [] => fc () 
          | x::xs => if safe (x::bs) 

그렇다면 확장한 해인 (x::bs, xs)가 p를 만족하는지 확인해야하므로 재귀호출을 하고, 이때 실패했을때 부르는 컨티뉴에이션은 x 포지션을 확인할 필요가 없으므로 (bs, xs)를 상태로 한다.

fun solveCPS p (bs, rest) sc fc =
    if p bs then sc bs else
        (case rest of        
            [] => fc ()   
          | x::xs => if safe (x::bs) 
                   then solveCPS p (x::bs, xs) sc (fn () => solveCPS p (bs, xs) sc fc)

그게 아니라면 백트래킹을 한다.

fun solveCPS p (bs, rest) sc fc = 
    if p bs then sc bs else
        (case rest of  
            [] => fc ()
          | x::xs => if safe (x::bs)
                     then solveCPS p (x::bs, xs) sc (fn () => solveCPS p (bs, xs) sc fc)
                     else solveCPS p (bs, xs) sc fc)

이제 아까와 같이 문제의 해답을 구하는 함수, 그리고 자동으로 놓을 수 있는 비숍의 최대 개수를 구하는 함수를 작성하자.

(* bishopsCPS : int -> int -> sol option *)
fun bishopsCPS n m = solveCPS (fn L => length L = m) (init n) SOME (fn () => NONE)

fun maximumBishopsCPS n =
    let 
        fun loop m =
            (print ("Trying " ^ Int.toString m ^ "\n"); 
            (case bishopsCPS n m of 
                SOME _ => loop(m+1) | 
                NONE => m-1))
    in 
        loop 1
    end 

실행해보면 이전 해법보다 훨씬 빠르게 답을 구하는걸 알 수 있다.

val SOME L17 = bishopsCPS 7 17
display 7 L17
(* 1 1 1 1 1 1 1
   0 0 0 0 0 0 0
   0 1 0 0 0 0 0
   0 1 0 0 0 0 0
   0 0 0 0 0 0 1
   1 0 1 0 0 0 1
   1 0 1 1 0 0 1*)

(* smlnj REPL은 문자열이 일정길이를 넘어가면 자동으로 뒤를 #로 대체하므로
   최대 프린트 가능한 문자길이를 재지정해야 한다. *)
Control.Print.stringDepth := 100
val SOME L20 = bishopsCPS 8 20
display 8 L20
(* 1 1 1 1 1 1 1 1
   0 0 0 0 0 0 0 0
   0 1 0 0 0 0 1 0
   0 0 0 0 0 0 0 0
   0 0 0 0 0 0 0 0
   1 0 0 0 0 0 0 1
   1 0 0 1 1 0 0 1
   1 0 0 1 1 0 0 1*)