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

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

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

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

Posted feedbacks - Nested

Flatten Hidden

行数減らす工夫は何もしてないのに表示の方が長い……

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
(defun make-amida (list)
  (unless (equal list '(0))
    (let ((n (1- (length list))))
      (nconc (make-amida (remove n list))
             (loop for x from (1- n) downto (position n list) collect x)))))

(defun print-amida (x result)
  (let ((n (1- (length result))))
    (format t "~{~D~^ ~}~&" (loop for x from 0 to n collect x))
    (dolist (i x)
      (let ((str (format nil "~V@{| ~}|" n t)))
        (setf (aref str (+ i i 1)) #\-)
        (write-line str)))
    (format t "~{~D~^ ~}~&" result)))

(let ((list '(3 5 2 4 0 1)))
  (print-amida (make-amida list) list))
とりあえずこんな感じ。

0 1 2 3 4 5
| |-| | | |
|-| |-| |-|
| |-| |-| |
|-| |-| |-|
| |-| |-| |
3 5 2 4 0 1
 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
import std.stdio;
import std.string;

void amidaSort(uint[] origList){
    auto sortedList = origList.dup.sort;
    auto tmpList = origList.dup;
    auto amidaRowProto = cast(char[])repeat("| ", origList.length)[0..($ - 1)];
    string[] amida;
    while(tmpList != sortedList){
        for(uint start; start <= 1; start++){
            uint[] swap;
            for(uint i = start; i < tmpList.length - 1; i += 2){
                if(tmpList[i] > tmpList[i + 1]){
                    swap ~= i;
                    auto tmp = tmpList[i + 1];
                    tmpList[i + 1] = tmpList[i];
                    tmpList[i] = tmp;
                }
            }
            if(swap.length){
                auto amidaRow = amidaRowProto.dup;
                foreach(i; swap){
                    amidaRow[(i * 2) + 1] = '-';
                }
                amida ~= cast(string)amidaRow;
            }
        }
    }
    string[] s;
    foreach(n; sortedList){
        s ~= toString(n);
    }
    string[] o;
    foreach(n; origList){
        o ~= toString(n);
    }
    if(!amida.length){
        amida ~= cast(string)amidaRowProto.dup;
    }
    writefln((s.join(" ") ~ amida.reverse ~ o.join(" ")).join("\n"));
}

void main(){
    amidaSort([3, 5, 2, 4, 0, 1]);
}
ごくナイーブにバブルソート。出力は長いです。バブルソートそのまんまの結果がでてきます。
3 5 2 4 0 1
| | | |-| |
| | |-| | |
| |-| | | |
|-| | | | |
| | | | |-|
| | | |-| |
| | |-| | |
| |-| | | |
| | | |-| |
| | |-| | |
| | | | |-|
0 1 2 3 4 5
 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
using System;
using System.Collections.Generic;
static class Program {
    static void Main() {
        List<string> data = new List<String>(new string[]{"3", "5", "2", "4", "0", "1"});
        Console.WriteLine(String.Join(" ", data.ToArray()));
        Console.WriteLine(String.Join("\n", AmidaSort(data)));
        Console.WriteLine(String.Join(" ", data.ToArray()));
    }
    static string[] AmidaSort<T>(List<T> data) where T: IComparable {
        List<string> result = new List<string>();
        for(int i = 0; i < data.Count - 1; i++){
            for(int j = data.Count - 1; i < j; j--){
                if(data[j].CompareTo(data[j - 1]) < 0) {
                    result.Add(Swap(data, j - 1));
                }
            }
        }
        return result.ToArray();
    }
    static string Swap<T>(List<T> data, int index) where T: IComparable {
        T temp = data[index];
        data[index] = data[index + 1];
        data[index + 1] = temp;
        string[] amida = new string[data.Count - 1];
        for(int i = 0; i < amida.Length; i++) {
            amida[i] = i == index ? "-" : " ";
        }
        return "|" + String.Join("|", amida) + "|";
    }
}
あ、しまった出力が逆だ。適当にひっくり返しておこう。
お題の例と同じ出力になります。
高さは極小にはなりますが、最小とは限らない気がします。
 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
def ins(pos, amida, n)
  idx = amida.size
  amida.reverse_each do |row|
    break if row[pos,1] == '-' ||
      pos-2 > 0 && row[pos-2,1] == '-' ||
      pos+2 < row.size && row[pos+2,1] == '-'
    idx -= 1
  end
  if idx == amida.size
    amida.push(Array.new(n, '|').join(' '))
  end
  amida[idx][pos] = '-'
end

def make_amida(goal)
  n = goal.size
  amida = []
  cur = Array.new(n) {|i| i}
  puts cur.join(' ')
  for i in 0...n
    j = cur.index(goal[i])
    while j > i
      cur[j], cur[j-1] = cur[j-1], cur[j]
      ins(2*j-1, amida, n)
      j -= 1
    end
  end
  puts amida
  puts goal.join(' ')
end

make_amida [3, 5, 2, 4, 0, 1]
全探索を行って、最も行数が少なく、横線の本数が少ない解答を出力します。

[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]

おお、すごい。

ちなみに、横棒の数の最小値は、与えられたリストをpermutationと見た場合のinversionの数と同じであることが知られているそうです。(inversionとは、リストのi番目の要素をa_iと書く時、 i < j かつ a_i > a_j となっている箇所。(3 5 2 4 0 1) の場合は、(3,2) (3,0) (3,1) (5,2) (5,4) (5,0) (5,1) (2,0) (2,1) (4,0) (4,1) の11個。)

ああそうか.
inversion を求めて,隣接するものを採用,残りを採用したもので変換,
というのを繰り返せばいいのか.これで多分,横棒数,段数ともに最小になるはず?

印字系は手抜きです(縦棒10本まで対応).置換を与えると,阿弥陀籤を印字します.

実行結果
*Main> :main [3,5,2,4,0,1]
0 1 2 3 4 5
| |-| | |-|
|-| |-| | |
| |-| |-| |
|-| |-| |-|
| |-| |-| |
3 5 2 4 0 1
*Main> :main [5,4,3,2,1,0]
0 1 2 3 4 5
|-| |-| |-|
| |-| |-| |
|-| |-| |-|
| |-| |-| |
|-| |-| |-|
| |-| |-| |
5 4 3 2 1 0
 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
module Main (main) where

import Data.List
import System.Environment

main :: IO ()
main = do { a:_ <- getArgs
          ; let { e = read a :: [Int]
                ; s = sort e
                ; caption = putStrLn . concat . intersperse " " . map show
                }
          ; caption s >> putStr (showAmida (length e - 1) (amida e)) >> caption e
          }

amida :: [Int] -> [[(Int,Int)]]
amida p = reverse $ fst $ head $ dropWhile (not . null . snd) $ iterate f ([],invs)
  where invs = inversions p
        f (acc,invs) = case select invs of
                         (xs,ys) -> (xs:acc, foldr map ys (map exchange xs))

inversions :: [Int] -> [(Int,Int)]
inversions [] = []
inversions (y:ys) = map (flip (,) y) (filter (y >) ys) ++ inversions ys

select :: [(Int,Int)] -> ([(Int,Int)],[(Int,Int)])
select invs = case partition ((1==) . uncurry subtract) $ sort $ invs of
                ([]  ,ys)       -> ([],ys)
                (x:xs,ys) 
                  -> case partition (share x) (xs++ys) of
                        (zs,ws) -> case select ws of
                                     (us,vs) -> (x:us,zs++vs)

share :: (Int,Int) -> (Int,Int) -> Bool
share (x,y) (p,q) = x == p || x == q || y == p || y == q

exchange :: (Int,Int) -> (Int,Int) -> (Int,Int)
exchange (x,y) pq@(p,q) | x == p    = (y,q)
                        | x == q    = (p,y)
                        | y == p    = (x,q)
                        | y == q    = (p,x)
                        | otherwise = pq

showAmida :: Int -> [[(Int,Int)]] -> String
showAmida n = unlines . map (showStep n)

showStep :: Int -> [(Int,Int)] -> String
showStep n xs = '|':step n 0 xs
  where step n m xs 
          | n == m    = ""
          | otherwise = case xs of
                          [] -> nostep $ step n (m+1) xs
                          (i,_):rs | m == i    -> astep  $ step n (m+1) rs
                                   | otherwise -> nostep $ step n (m+1) xs
        nostep = (' ':).('|':)
        astep  = ('-':).('|':)

(5 4 3 2 1 0)でテストしたところ、正しく解を見つけないバグがあったので、修正します。

プラス評価いただいていたのに申し訳ないです。

コメント元の投稿は自分でマイナスしておきました。

1
2
3
4
5
6
7
8
--- dk109.bug.ml        2007-12-17 23:28:16.000000000 +0900
+++ dk109.ml    2007-12-17 23:28:55.000000000 +0900
@@ -38 +38 @@
-        let costcomp (c1, c2) (m1, m2) = c1 >= m1 ||  c2 >= m2 in
+        let costcomp (c1, c2) (m1, m2) = c1 > m1 ||  c2 > m2 in
@@ -57 +57 @@
-    let best, (c,d) = solve target (comb len) (len, len * len) start in
+    let best, (c,d) = solve target (comb len) (len+1, len * len) start in
あんまり綺麗じゃないけど。

gosh> (amida  '(3 5 2 4 0 1))
0 1 2 3 4 5
| |-| | | |
|-| |-| |-|
| |-| |-| |
|-| |-| |-|
| |-| |-| |
3 5 2 4 0 1
 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
(define (amida-sort1 state)
  (define (loop prev lis acc strs skip)
    (cond ((null? lis)
           (values (reverse (cons prev acc))
                   (reverse strs)))
          ((or skip (< prev (car lis)))
           (loop (car lis) (cdr lis) (cons prev acc)
                 (cons " " strs) #f))
          ((> prev (car lis))
           (loop prev (cdr lis) (cons (car lis) acc)
                 (cons "-" strs) #t))
          (else
           (error "must not happen"))))
  (loop (car state) (cdr state) '() '() #f))

(define (amida-sort final-state)
  (define (loop state strs)
    (cond ((apply < state) strs)
          (else
           (receive (state1 strs1) (amida-sort1 state)
             (loop state1 (cons strs1 strs))))))
  (loop final-state '()))

(define (make-amidakuji strs-list)
  (define (line strs)
    (string-append "|" (string-join strs "|") "|"))
  (string-join (map line strs-list) "\n"))

(define (amida final-state)
  (define (numbers->line nums)
    (string-join (map number->string nums) " "))
  (let ((start (numbers->line (iota (length final-state))))
        (end   (numbers->line final-state)))
    (print start)
    (print (make-amidakuji (amida-sort final-state)))
    (print end)))
問題を一般化して考えてみます。
あみだくじは、ある状態から別の状態への遷移関数と考えることができます。
すると、この問題は初期状態と目的の状態が与えられたときに遷移関数を求めよ、という問題と解釈することができます。

ただし遷移関数を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]
置換を互換の積に変換する方法で悩んだのですが、バブルソートを応用すれば
できる事に気付きました(考え易くするため逆変換を求めて反転させています)。

バブルソートをアレンジして、隣接する互換が連続で起きないようにしています。
これによって例題では例示よりも1行短い解を出力します。

引数に得たいリストを与えて起動してください。

0 1 2 3 4 5 
| |-| | | | 
|-| |-| |-| 
| |-| |-| | 
|-| |-| |-| 
| |-| |-| | 
3 5 2 4 0 1 
 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
import java.util.*;

public class Sample {
    public static void main(String[] args) {
        int[] sequence = new int[args.length];
        List<String> amida = new ArrayList<String>();
        String seed = "";
        String nums = "";
        for (int i = 0; i < args.length; i++) {
            sequence[i] = Integer.parseInt(args[i]);
            seed = seed + "| ";
            nums = nums + args[i] + " ";
        }
        amida.add(nums);
        boolean change;
        do {
            StringBuilder am = new StringBuilder(seed);
            change = false;
            for (int i = 0; i < sequence.length - 1; i++) {
                if (sequence[i] > sequence[i + 1]) {
                    int a = sequence[i];
                    sequence[i] = sequence[i + 1];
                    sequence[i + 1] = a;
                    change = true;
                    am.setCharAt(2 * i + 1, '-');
                    i++;
                }
            }
            if (change)
                amida.add(am.toString());
        } while (change);
        nums = "";
        for (int i = 0; i < sequence.length; i++)
            nums = nums + Integer.toString(sequence[i]) + " ";
        amida.add(nums);
        Collections.reverse(amida);
        for (String s : amida) {
            System.out.println(s);
        }
    }
}
逆変換を求めて反転させるのが本質的な操作でないのが気になって、
直接求めるプログラムも作ってみました。

ほとんど同じなのですが、余分な操作がなくなった分だけかえって
直感的になったような気もします。

当然ですが、出力する解は違います。

0 1 2 3 4 5 
| |-| | |-| 
|-| |-| | | 
| |-| |-| | 
|-| |-| |-| 
| |-| |-| | 
3 5 2 4 0 1 
 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
import java.util.*;

public class Sample2 {
    public static void main(String[] args) {
        int[] sequence = new int[args.length];
        Map<Integer, Integer> order = new HashMap<Integer, Integer>();
        String seed = "";
        for (int i = 0; i < args.length; i++) {
            order.put(Integer.parseInt(args[i]), i);
            sequence[i] = i;
            seed = seed + "| ";
            System.out.print(Integer.toString(i) + " ");
        }
        System.out.println();
        boolean change;
        do {
            StringBuilder am = new StringBuilder(seed);
            change = false;
            for (int i = 0; i < sequence.length - 1; i++) {
                if (order.get(sequence[i]) > order.get(sequence[i + 1])) {
                    int a = sequence[i];
                    sequence[i] = sequence[i + 1];
                    sequence[i + 1] = a;
                    change = true;
                    am.setCharAt(2 * i + 1, '-');
                    i++;
                }
            }
            if (change)
                System.out.println(am.toString());
        } while (change);
        for (int i = 0; i < sequence.length; i++)
            System.out.print(Integer.toString(sequence[i]) + " ");
        System.out.println();
    }
}
自力では解けなかったので、カバレッジ100%目的で
pythonに移植させて頂きました。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
def f(args):
  order = {}
  sequence = [order.setdefault(j, i) for i, j in enumerate(args)]</