DouKaku?beta

Language detail: StandardML

Coverage: 22.45%
number of '+' ratings
 contribution for coverage

Unsolved challenges

show all

codes

Feed

Used modules

next >>

文字列のセンタリング (Nested Flatten) 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
fun center s width =
  let
    open StringCvt

    val len = size s
    val m = abs (width - len)
    val (left, right) = (m div 2, m div 2 + m mod 2)
  in
    if width < len then substring (s, left, len - left - right)
    else (padLeft #" " (left + right + len) o padRight #" " (right + len)) s
  end
コラッツ・角谷の問題 (Nested Flatten) 
まんまの実装。MLtonでネイティブコンパイル、PenD 3.0GHz x86_64 Linuxで6.54s。

time ./collatz
f(837799) = 524
./collatz  6.54s user 0.00s system 99% cpu 6.550 total
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
open Int64

fun collatz n =
  let
    fun f (1, i) = i
      | f (n', i) =
      if n' mod 2 = 0 then f (n' div 2, i + 1)
      else f (n' * 3 + 1, i + 1)

    fun loop 0 max = max
      | loop n max =
      let
        val r = if n mod 2 = 0 then f (n div 2, 1) else f (n * 3 + 1, 1)
      in
        loop (n - 1) (if #2 max > r then max else (n, r))
      end
  in
    loop n (n, 0)
  end

val (n, step) = (collatz o fromLarge o IntInf.pow) (2, 20)
val _ = print ("f(" ^ toString n ^ ") = " ^ toString step ^ "\n")
コマンドライン引数の取得 (Nested Flatten)

Standard MLでは、CommandLineストラクチャのarguments関数を使います。 自分自身の名前を除く引数がリストで返ります。 自分自身の名前を得るには同ストラクチャのname関数を使います。

1
2
3
4
val name = CommandLine.name ()
val _ = print name
val args = CommandLine.arguments ()
val _ = app print args
法演算 (Nested Flatten) 
functorで。各演算子は正規化したものを表示して、結果を返すようにしています。

- structure M10 = Modular (val m = 10);
- open M10;
- map (fn x => x) [1 + 2, 7 + 3, 11 + 12];
1 + 2 = 3
7 + 3 = 0
11 + 12 = 1 + 2 = 3
val it = [3,0,3] : int list
- map (fn x => x) [3 - 2, 2 - 3];
3 - 2 = 1
2 - 3 = 9
val it = [1,9] : int list
- map (fn x => x) [2 * 3, 11 * 12, 18 * 39];
2 * 3 = 6
11 * 12 = 1 * 2 = 2
18 * 39 = 8 * 9 = 2
val it = [6,2,2] : int list
 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
functor Modular (val m : int) = struct
  infix 7 *
  infix 6 + -

  local
    fun calc f x y s =
      let
        open Int

        val _ = print (toString x ^ " " ^ s ^ " " ^ toString y ^ " = ")
        val x' = x mod m and y' = y mod m
        val _ = if x >= m orelse y >= m then
                  print (toString x' ^ " " ^ s ^ " " ^ toString y' ^ " = ")
                else ()
        val result = f (x', y') mod m
      in
        print (toString result ^ "\n");
        result
      end
  in
    fun x + y = calc Int.+ x y "+"
    fun x - y = calc Int.- x y "-"
    fun x * y = calc Int.* x y "*"
  end

end
Meertens数 (Nested Flatten) 
SMLにも移植。爆速になったけど、MLtonでもSBCLより遅い。。。
10桁で0.79秒、20桁で9時間56分。

  ./110 10  0.79s user 0.00s system 99% cpu 0.795 total
  ./110 20  35746.36s user 4.25s system 99% cpu 9:56:05.18 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
val p = [
   2,  3,  5,  7, 11, 13, 17, 19, 23, 29,
  31, 37, 41, 43, 47, 53, 59, 61, 67, 71
  ] : IntInf.int list

fun basis n = (rev o map (fn x => IntInf.pow (10, x)) o List.tabulate) (n, fn x => x)

fun meertens n = let
  val lst = List.tabulate (n, fn x => x + 1)

  open IntInf

  fun loop _ [] _ prod sum _ =
    if prod = sum then print (toString sum ^ "\n") else ()
    | loop (p::ps) (b::bs) bound prod sum start = let
      fun f x = let
        val pp = pow (p, x)
      in
        if pp <= bound then
          loop ps bs (bound div pp) (prod * pp) (sum + b * fromInt x) 0
        else ()
      end

      open Int
      val lst = List.tabulate (10 - start, fn x => x + start)
    in
      app f lst
    end
in
  app (fn i => loop p (basis i) (IntInf.pow (10, i)) 1 0 1) lst
end

val _ = (meertens o valOf o Int.fromString o hd o CommandLine.arguments) ()
重複する要素を取り除く (Nested Flatten)

まぁ、効率は良くない.。

1
2
3
4
5
6
7
8
val xs = [3, 1, 4, 1, 5, 9, 2, 6, 5]

fun uniq [] = []
  | uniq (x::xs) =
  if List.exists (fn y => y = x) xs then uniq (List.filter (fn z => z <> x) xs)
  else x :: uniq xs

val _ = uniq xs
Meertens数 (Nested Flatten) 
MLtonでコンパイルして、符号無し32bit整数までで約2時間40分。64bitでは834174年。遅すぎですね。

  mlton meertes.sml
  ./meertes 4294967295
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
fun goedel n = let
  open IntInf

  val p = [
     2,  3,  5,  7, 11, 13, 17, 19, 23, 29,
    31, 37, 41, 43, 47, 53, 59, 61, 67, 71
    ]
  val a = map (valOf o Int.fromString o str) ((explode o toString) n)
in
  ListPair.foldl (fn (x, y, z) => pow (x, y) * z) 1 (p, a)
end

fun meertens n = let
  fun loop i =
    if i > n then ()
    else
      if goedel n = n then (print (IntInf.toString n ^ "\n"); loop (i + 1))
      else loop (i + 1)
  in
    loop 0
  end

val _ = (meertens o valOf o IntInf.fromString o hd o CommandLine.arguments) ()
与えられた文字列でピラミッド (Nested Flatten)

適当。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
fun pyramid s =
let
  fun loop s' NONE = []
    | loop s' (SOME c) =
    let
      val ns = subst (str c) "" s'
    in
      loop ns (CharVector.find Char.isGraph ns) @ [s']
    end

  val ss = (String.concatWith " " o global_slice ".") s
in
  (app println o loop ss o SOME o sub) (ss, 0)
end

val _ = pyramid "hoge"
val _ = pyramid "abracadabra"
長方形の交差判定 (Nested Flatten)

Standard MLの論理積、andalsoは長いので別名定義。

1
2
3
4
5
infix &
fun x & y = x andalso y

fun overlap r1 r2 =
  (#t r1 > #b r2) & (#r r1 < #l r2) & (#b r1 < #t r2) & (#l r1 > #r r2)
ファイル更新の監視 (Nested Flatten)

監視は1秒毎。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
fun check filename =
let
  val t = OS.FileSys.modTime filename
in
  (OS.Process.sleep o Time.fromSeconds) 1;

  if t = OS.FileSys.modTime filename then
    check filename
  else
    (print ("modified!" ^ "\n"); check filename)
end

val _ = check "hoge.txt"
ピラミッドを作る (Nested Flatten) 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
fun pyramid n =
let
  open StringCvt

  fun f x = (padLeft #" " (n + x - 1) o padRight #"*" (x * 2 - 1)) ""
in
  (app println o map f o List.tabulate) (n, fn x => x + 1)
end

val _ = pyramid 4
擬似lsの実装 (Nested Flatten)

#4465も対処済み。

1
2
3
4
5
6
7
8
fun ls x y =
let
  fun uniq l = foldr (fn (b, a) => b :: List.filter (fn x => x <> b) a) [] l

  val p = y ^ (if String.isSuffix "/" y then "" else "/")
in
  (uniq o map (subst "/.*" "/" o subst p "") o List.filter (String.isPrefix p)) x
end
アレイのuniq (Nested Flatten)

こんなモンでしょう。

1
fun uniq l = foldr (fn (b, a) => b :: List.filter (fn x => x <> b) a) [] l
２進数の記述 (Nested Flatten)

リテラル表記はないので。

1
2
val b = (valOf o StringCvt.scanString (Int.scan StringCvt.BIN));
b"01101001" (* 105 *)
あみだくじ (Nested Flatten)

とりあえず。

 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
val s = [
"A B C D E",
"| | |-| |",
"|-| | |-|",
"| |-| |-|",
"|-| |-| |",
"|-| | | |"
]

fun amida [] = []
  | amida (a as (x::xs)) =
  let
    fun loop [] y = y
      | loop (s::ss) y =
      let
        fun f ((i, _), v) =
          substring (v, 0, i - 1) ^
          (implode o rev o explode o substring) (v, i - 1, 3) ^
          String.extract (v, i + 2, NONE)
      in
        loop ss (foldl f y (global_find "-" s))
      end
  in
    a @ [loop xs x]
  end

val _ = app println (amida s)
正整数のゲーデル数化？ (Nested Flatten)

素数生成が間違っていたので修正。 ついでに多倍長整数を使って、Overflowしないようにしてみた。

 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
fun prime n =
let
  val a = List.tabulate (n - 1, fn x => x + 2)

  fun loop [] = []
    | loop (x::xs) =
      x :: loop (List.filter (fn i => i mod x <> 0) xs)
in
  loop a
end


fun goedel (n : IntInf.int) =
let
  open IntInf

  val p = map fromInt (prime 100)
  val a = map (valOf o Int.fromString o str) ((explode o toString) n)
in
  toString (ListPair.foldl (fn (x, y, z) => pow (x, y) * z) 1 (p, a))
end


fun println s = print (s ^ "\n")

val _ = println (goedel 9)
val _ = println (goedel 81)
val _ = println (goedel 230)
val _ = println (goedel 19425463134)

10桁限定。それ以上は整数がoverflowします。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
fun prime n a 0 = a
  | prime n a i =
  if n mod 2 <> 0 andalso n mod 3 <> 0 then
    prime (n + 1) (a @ [n]) (i - 1)
  else
    prime (n + 1) a i


fun goedel n =
let
  val p = prime 5 [2, 3] 10
  val a = map (valOf o Int.fromString o str) ((explode o Int.toString) n)
in
  floor (ListPair.foldl (fn (x, y, z) => Math.pow (real x, real y) * z) 1.0 (p, a))
end

val printInt = println o Int.toString;

printInt (goedel 9);
printInt (goedel 81);
printInt (goedel 230)
ファイル内の重複行削除(後優先) (Nested Flatten) 
思いつくままに。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
fun uniq file =
let
  open TextIO

  val fs = openIn file

  fun f a =
    case inputLine fs of
        NONE => app print a
      | SOME s => f ((List.filter (fn x => x <> s) a) @ [s])
in
  f []
end;

uniq "hoge.txt"
倍数になる13進数 (Nested Flatten) 
Ocamlの二番煎じ。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
fun thirteen x =
let
  fun loop (0, x, t) = t
    | loop (q, x, t) =
    loop (q div 10, x * 13, t + x * (q mod 10))
in
  loop (x, 1, 0)
end

fun comp x =
  if (thirteen x) mod x = 0 then x else comp (x + 1);

println (Int.toString (comp 10))
税込み価格への修正 (Nested Flatten) 

	

	
	
	
    

      
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
fun includeTax str =
let
  val s = tokens "[0-9]+" str
  val yen = tokens "[^0-9]+" str
  val tax = map (fn x => itoa (atoi x * 105 div 100)) yen

  fun loop (a::a', b::[]) = a ^ b ^ (concat a')
    | loop (a::a', b::b') = a ^ b ^ (loop (a', b'))
in
  loop (s, tax)
end




    

	

  
  





    
    






next >>














Index





Feed










Other





Link




Pathtraq



loading...














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