DouKaku? 4384 jijixi: #4381 を、ちゃんと動くように修正し...(正しい文(クイズ))

Comment detail

This comment is reply for 4381 jijixi: #4373 を参考にリミットを設定して、...(正しい文(クイズ)). Go to thread root.

#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

こんな感じでした。

答を全て表示しようとするように変更したので、止まらなくなりました。
上記の実行例もキーボード割り込みで止めています。
一応、第二引数に何か入れると、前回と同じように一つ目を見付けた時点で終了します。

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 ()

DouKaku?

Comment detail

Index

Feed

Other

Link

Pathtraq