DouKaku?beta

Comment detail

正しい文(クイズ) (Nested Flatten)
#4373 を参考にリミットを設定して、全てのパターンを並行処理するようにしたものです。
ただし、うちの環境 (Mac OS X 10.5 PPC64) ではリソースの問題で radix が 5 までしか計算できませんでした。

% time ./quiz 5
この文は0が1個, 1が3個, 2が2個, 3が3個, 4が1個あります。
./quiz 5  1.66s user 2.02s system 86% cpu 4.269 total

おそらくパターン数が爆発的に増える関係で、全てのシステムスレッドがブロックしてしまい、先に進まなくなるんじゃないかと思います。
この方式は Erlang じゃないと無理かもしれないです。 
  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
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
let limit radix =
   match radix with
   | 2 -> 8
   | n -> n + 2

let char_table =
   Array.map begin fun i ->
      Printf.sprintf "%x" i
   end (Array.init 16 (fun i -> i))

let lstring_of_radix_num radix num =
   let rec loop n acc =
      if n < radix then
         char_table.(n) :: acc
      else
         let rem = n mod radix in
         loop ((n - rem) / radix) (char_table.(rem) :: acc)
   in
   loop num []

let string_of_lstring str =
   List.fold_left begin fun acc ch ->
      acc ^ ch
   end "" str

let string_of_radix_num radix num =
   string_of_lstring (lstring_of_radix_num radix num)

let slist_of_alist radix alist =
   List.map begin fun i ->
      lstring_of_radix_num radix i
   end (List.flatten alist)

let count_digits radix str_list num =
   match lstring_of_radix_num radix num with
   | [ch] ->
        List.fold_left begin fun sum ch' ->
           sum + (if ch = ch' then 1 else 0)
        end 0 (List.flatten str_list)
   | _ -> failwith "unknown"

let validate radix alist =
   let str = List.flatten (slist_of_alist radix alist) in
   List.for_all begin fun pair ->
      match pair with
      | [i; num] -> begin
           match lstring_of_radix_num radix i with
           | [ch] ->
                num =
                   List.fold_left begin fun sum ch' ->
                      sum + (if ch = ch' then 1 else 0)
                   end 0 str
           | _ -> failwith "unknown"
        end
      | _ -> failwith "unknown"
   end alist

let search radix =
   let lim = limit radix in
   def search'(num, start, acc) =
      def result(alist) & wait() = reply alist to wait in
      def search''(n) =
         let acc' = [num; n] :: acc in
         match num - 1 with
         | next when next < 0 ->
              if validate radix acc'
              then result(acc')
              else 0
         | next ->
              let start' =
                 (count_digits radix (slist_of_alist radix acc') next) + 1
              in
              if start > lim then failwith "unknown";
              result(search'(next, start', acc'))
      in
      for i = start to lim do
         spawn search''(i)
      done;
      reply wait() to search'
   in
   search'(radix - 1, 1, [])

let print_result radix alist =
   let str =
      List.fold_left begin fun acc pair ->
         match List.map (string_of_radix_num radix) pair with
         | [i; n] ->
              acc ^ i ^ "が" ^ n ^ "個" ^ ", "
         | _ -> failwith "unknown"
      end "この文は" alist
   in
   let str' = (String.sub str 0 ((String.length str) - 2)) ^ "あります。" in
   print_endline str'

let main () =
   match Sys.argv with
   | [|_; radix |] ->
        let radix' = int_of_string radix in
        let result = search(radix') in
        print_result radix' result
   | _ -> print_endline "usage: command radix"

let () = if not !Sys.interactive then main ()
#4381 を、ちゃんと動くように修正しました。
その分、おもしろみは減った気がしますが。
結局、この問題の場合、一つ一つの処理はあまり重くないので、プロセスをなるべく生成しない方が速いみたいですね。
jocamlopt でコンパイルしたもので、
 
% time ./quiz 16
この文は0が1個, 1が11個, 2が2個, 3が1個, 4が1個, 5が1個, 6が1個, 7が1個, 8が1個, 9が1個, aが1個, bが1個, cが1個, dが1個, eが1個, fが1個あります。
^C
./quiz 16  1.48s user 0.04s system 63% cpu 2.369 total

こんな感じでした。

答を全て表示しようとするように変更したので、止まらなくなりました。
上記の実行例もキーボード割り込みで止めています。
一応、第二引数に何か入れると、前回と同じように一つ目を見付けた時点で終了します。 
  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
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
let limit radix =
   match radix with
   | 2 -> 8
   | n -> n + 2

let char_table =
   Array.map begin fun i ->
      Printf.sprintf "%x" i
   end (Array.init 16 (fun i -> i))

let lstring_of_radix_num radix num =
   let rec loop n acc =
      if n < radix then
         char_table.(n) :: acc
      else
         let rem = n mod radix in
         loop ((n - rem) / radix) (char_table.(rem) :: acc)
   in
   loop num []

let string_of_lstring str =
   List.fold_left begin fun acc ch ->
      acc ^ ch
   end "" str

let string_of_radix_num radix num =
   string_of_lstring (lstring_of_radix_num radix num)

let slist_of_alist radix alist =
   List.map begin fun i ->
      lstring_of_radix_num radix i
   end (List.flatten alist)

let count_digits radix str_list num =
   match lstring_of_radix_num radix num with
   | [ch] ->
        List.fold_left begin fun sum ch' ->
           sum + (if ch = ch' then 1 else 0)
        end 0 (List.flatten str_list)
   | _ -> failwith "unknown"

let validate radix alist =
   let str = List.flatten (slist_of_alist radix alist) in
   List.for_all begin fun pair ->
      match pair with
      | [i; num] -> begin
           match lstring_of_radix_num radix i with
           | [ch] ->
                num =
                   List.fold_left begin fun sum ch' ->
                      sum + (if ch = ch' then 1 else 0)
                   end 0 str
           | _ -> failwith "unknown"
        end
      | _ -> failwith "unknown"
   end alist

def result_post(alist) & result_get() = reply alist to result_get

def search(radix) =
   let lim = limit radix in
   let rec search' label num acc =
      if label < 0 then
         (if validate radix acc then spawn result_post(acc))
      else
         let acc' = [label; num] :: acc in
         for i = 1 to lim do
            search' (label - 1) i acc'
         done
   in
   for i = 1 to lim do
      search' (radix - 1) i []
   done;
   0

let print_result radix alist =
   let str =
      List.fold_left begin fun acc pair ->
         match List.map (string_of_radix_num radix) pair with
         | [i; n] ->
              acc ^ i ^ "が" ^ n ^ "個" ^ ", "
         | _ -> failwith "unknown"
      end "この文は" alist
   in
   let str' = (String.sub str 0 ((String.length str) - 2)) ^ "あります。" in
   print_endline str'

let main () =
   match Sys.argv with
   | [|_; radix |] ->
        let radix' = int_of_string radix in
        spawn search(radix');
        let rec loop cache =
           let result = result_get() in
           if List.mem result cache then
              loop cache
           else
              begin
                 print_result radix' (result_get());
                 loop (result :: cache)
              end
        in
        loop []
   | [|_; radix; _|] ->
        let radix' = int_of_string radix in
        spawn search(radix');
        print_result radix' (result_get())
   | _ -> print_endline "usage: command radix"

let () = if not !Sys.interactive then main ()

Index

Feed

Other

Link

Pathtraq

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