DouKaku?beta

challenge 与えられた並べ替えを実現するあみだくじの生成

お題#4476を見て思いつきました。

0からn (n>=1) までの数字を任意の順で並べたリストが与えられた時、0からnまでが順に並んだ状態から出発して、与えられたリストの順で結果が得られるようなあみだくじを作成して出力するプログラムを書いてください。

与えられたリストが (3 5 2 4 0 1) の場合、出力の1例を示します： 

 0 1 2 3 4 5
 | | |-| |-|
 | |-| |-| |
 |-| |-| | |
 | |-| |-| |
 | | |-| |-|
 | | | |-| |
 3 5 2 4 0 1

一応、制約条件を示しておきます。

  • あみだの横棒は縦棒をまたぐことはできません。常に隣接する縦棒同士の交換となります 。
  • 同じ行に複数の横棒があっても良いですが、ひとつの縦棒の同じ点からふたつ横棒が出ることはありません。

一つのリストに対して複数の解があり得ます。ナイーブな解に飽き足らなければ出力行数をなるべく少なくする解を求める方法を考えてみてください。

post comment

Posted feedbacks - OCaml

全探索を行って、最も行数が少なく、横線の本数が少ない解答を出力します。

[xsd@celldev dk109]$ ./dk109
0 1 2 3 4 5
| |-| | | |
|-| |-| |-|
| |-| |-| |
|-| |-| |-|
| |-| |-| |
3 5 2 4 0 1
Height=5, Lines=11
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
let comb n =
    let rec comb1 mask cost acc = function
        | 0 -> if cost = 0 then acc else (mask, cost) :: acc
        | x ->
            let acc = comb2 (mask lor x) (cost+1) acc (x lsr 1) in
                      comb1  mask         cost    acc (x lsr 1)
    and comb2 mask cost acc = function
        | 0 -> (mask, cost) :: acc
        | x -> comb1 mask cost acc (x lsr 1) in
    comb1 0 0 [] (1 lsl (n - 2))

let apply mask cost (state, (c1, c2)) =
    let rec apply' prev mask = function
        | []    -> [ prev ]
        | head :: tail ->
            if (mask land 1)=1 then head :: apply' prev (mask lsr 1) tail
                               else prev :: apply' head (mask lsr 1) tail in
    (match state with
    | []       -> []
    | hd :: tl -> apply' hd mask tl), (c1 + 1, c2 + cost)

let drawamida mask n =
    let rec amida s mask = function
        | 0 -> s
        | x -> if (mask land 1) = 0 then amida (s ^ " |") (mask lsr 1) (x-1)
                                    else amida (s ^ "-|") (mask lsr 1) (x-1) in
    amida "|" mask (n - 1)

let rec equal arg1 arg2 = match arg1, arg2 with
    | [], []                -> true
    | h1 :: t1, h2 :: t2    -> if h1 <> h2 then false else equal t1 t2
    | _, _                  -> false

let solve targetstate options limitcost initstate =
    let rec loop target options best current =
        let bestsoln, bestcost  = best in
        let curstate, curoption, cursoln, curcost = current in
        let costcomp (c1, c2) (m1, m2) = c1 >= m1 ||  c2 >= m2 in
        if (costcomp curcost bestcost) then best else (
            if equal target curstate then cursoln, curcost else (
                match curoption with
                    | []       -> best
                    | (mask, cost) :: tl ->
                        let newstate, newcost = apply mask cost (curstate, curcost) in
                        let best =  loop target options best (newstate, options, (mask :: cursoln), newcost) in
                                    loop target options best (curstate, tl, cursoln, curcost)
            )
        ) in
    loop targetstate options ([], limitcost) (initstate, options, [], (0, 0))

let main target =
    let rec prt = function | [] -> print_endline "" | hd :: tl -> let _ = Printf.printf "%d " hd in prt tl in
    let rec seq n   = function [] -> [] | _ :: tl -> n :: (seq (n+1) tl) in
    let len         = List.length target in
    let start       = seq 0 target in
    let _           = prt start in
    let best, (c,d) = solve target (comb len) (len, len * len) start in
    let rec prt2 n  = function [] -> () | hd :: tl -> (print_endline (drawamida hd n); prt2 n tl) in
    let _           = prt2 len (List.rev best) in
    let _           = prt target  in
    Printf.printf "Height=%d, Lines=%d\n" c d

let _ = main [ 3; 5; 2; 4; 0; 1]

問題を一般化して考えてみます。
あみだくじは、ある状態から別の状態への遷移関数と考えることができます。
すると、この問題は初期状態と目的の状態が与えられたときに遷移関数を求めよ、という問題と解釈することができます。

ただし遷移関数を0から作るのではなく、与えられた部分遷移関数群を組み合わせて目的の遷移関数を作り出すことを考えます。
また、関数同士の同一性を比較するのは困難なので、同じ初期状態から同じ目的状態に達成する関数が最小コストで合成できたら完了とします。
目的状態に達成できたかは与えられたユニットテストが通るかどうかで判断します。

簡単にいうと、初期状態と部分関数群とユニットテストを与えると、ユニットテストが通るような(最小コストの)関数を合成して返すような関数を作ってみました。

下のコードのsolve関数がその関数で、関数群(options)、ユニットテスト(unittest)、コスト比較関数(costfunc)、制限コスト(limitcost)、初期状態(initstate)、初期コスト(initcost)、初期解(initsoln)を渡すと、最小コストと最良解のタプルを返します。

実際にはどんな関数でも合成できるわけではなく、あみだくじのように取りうる状態が限られているものだから適用できるのだと思いますが、可能性として面白いと感じました。 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
let solve options unittest costfunc limitcost ((initstate, initcost, initsoln) as initcontext) =
    let rec loop ((bestcost, bestsoln) as best) ((curstate, curcost, cursoln) as current) = function
        | []            -> best
        | func :: tail  -> (match costfunc curcost bestcost, unittest curstate with
            | true, _   -> best
            | _,   true -> curcost, cursoln
            | _,   _    -> let best = loop best current tail in loop best (func current) options
        ) in
    loop (limitcost, initsoln) initcontext options

let comb n =
    let apply mask cost (state, (c1, c2), soln) =
        let rec apply' prev mask = function
            | []    -> [ prev ]
            | head :: tail ->
                if (mask land 1)=1 then head :: apply' prev (mask lsr 1) tail
                                   else prev :: apply' head (mask lsr 1) tail in
        (match state with
        | []       -> []
        | hd :: tl -> apply' hd mask tl), (c1 + 1, c2 + cost), (mask :: soln) in

    let rec comb1 mask cost acc = function
        | 0 -> if cost = 0 then acc else (apply mask cost) :: acc
        | x ->
            let acc = comb2 (mask lor x) (cost+1) acc (x lsr 1) in
                      comb1  mask         cost    acc (x lsr 1)
    and comb2 mask cost acc = function
        | 0 -> (apply mask cost) :: acc
        | x -> comb1 mask cost acc (x lsr 1) in
    comb1 0 0 [] (1 lsl (n - 2))

let main target =
    let drawamida mask n =
        let rec amida s mask = function
            | 0 -> s
            | x -> if (mask land 1) = 0 then amida (s ^ " |") (mask lsr 1) (x-1)
                                        else amida (s ^ "-|") (mask lsr 1) (x-1) in
        amida "|" mask (n - 1) in

    let rec equal arg1 arg2 = match arg1, arg2 with
        | [], []            -> true
        | h1 :: t1, h2 :: t2-> if h1 <> h2 then false else equal t1 t2
        | _, _              -> false in

    let rec prt = function
        | []        -> print_newline ()
        | hd :: tl  -> (Printf.printf "%d " hd; prt tl) in

    let rec prt2 n = function
        | []       -> ()
        | hd :: tl -> let _ = prt2 n tl in print_endline (drawamida hd n) in

    let start =
        let rec seq n = function
            | [] -> []
            | _  :: tl -> n :: (seq (n+1) tl) in
        seq 0 target in

    let costfunc (c1, c2) (m1, m2) = c1 > m1 || c2 > m2 in

    let len         = List.length target in
    let (c,d), best = solve (comb len) (equal target) costfunc (len+1, len * len) (start, (0, 0), []) in
    let _ = prt start       in
    let _ = prt2 len best   in
    let _ = prt target      in
    Printf.printf "Height=%d, Lines=%d\n" c d

let _ = main [ 5; 4; 3; 2; 1; 0]

Index

Feed

Other

Link

Pathtraq

loading...
Creative Commons License このサイトの内容は、 クリエイティブ・コモンズ・ライセンスの下でライセンスされています。 [詳細]