Hatena::ブログ(Diary)

みずぴー日記

2010-08-24(火)

改行しかしない

| 改行しかしない - みずぴー日記 を含むブックマーク

30分プログラム、その797。anarchy golf - Carriage no returnインスパイアされました。

使い方

- no_return "abc\ndef";
val it = "abc\n   def" : string

ソースコード

fun lines s =
    String.tokens (fn c => c = #"\n") s;
fun unlines xs =
    String.concatWith "\n" xs;

fun pad n =
    String.implode (List.tabulate (n,(fn _ => #" ")));

fun fst (x,_) = x;
fun snd (_,y) = y;

fun concat_with_pad xs =
    List.foldl
	(fn (x,(n,ys)) => (String.size x + n, (pad n) ^ x :: ys))
	(0,[])
	xs;

fun no_return str =
    unlines (List.rev (snd (concat_with_pad (lines str))));

参考

2010-08-05(木)

文字を重複させる

| 文字を重複させる - みずぴー日記 を含むブックマーク

30分プログラム、その791。anarchy golf - Duplicate charactersインスパイアされました。

使い方

- dup_str "hello";;
val it = "hheelllloo" : string

ソースコード

fun dup [] = []
  | dup (x::xs) = x :: x :: dup xs;

fun dup_str str = String.implode (dup (String.explode str))

参考

2010-07-08(木)

括弧の対応のチェック

| 括弧の対応のチェック - みずぴー日記 を含むブックマーク

30分プログラム、その782。anarchy golf - Bracket Matchingインスパイアされました。

問題の詳細はリンク先を参照してください。要するに括弧の対応がとれているかどうかのチェックです。正規表現じゃ無理なことで有名なアレです。

簡易パーサコンビネータを書いて...、みたいなことも考えたのですが、まあこれぐらいなら明示的にスタックを持ち回れば十分でしょう。

使い方

- isParen "";
val it = true : bool
- isParen "(<>)[]";
val it = true : bool
- isParen "(((";
val it = false : bool

ソースコード

structure Stack : sig
    type 'a t
    val push : 'a -> 'a t -> 'a t
    val pop  : 'a t ->  ('a  * 'a  t)
    val isEmpty : 'a t -> bool
    val empty  : 'a t
end = struct
   type 'a t = 'a list

   fun isEmpty [] = true
     | isEmpty _  = false

   fun push x xs = x :: xs

   fun pop (x::xs) = (x,xs)
     | pop [] = raise Empty

   val empty = []
end

val map = [(#"(", #")"),
	   (#"[", #"]"),
	   (#"{", #"}"),
	   (#"<", #">")]


fun isBegin c = List.exists (fn (x,_) =>  c = x) map

fun toBegin c =
    case List.find (fn (_,y) =>  y = c) map of
	NONE       =>  raise Empty
      | SOME (x,_) =>  x

fun paren [] st = Stack.isEmpty st
  | paren (c::cs) st =
    if isBegin c then
	paren cs (Stack.push c st)
    else
	let
	    val (x,st') = Stack.pop st
	in
	    if x = toBegin c then
		paren cs st'
	    else
		false
	end

fun isParen s = paren (String.explode s) Stack.empty

参考

2010-06-28(月)

縦書き出力

| 縦書き出力 - みずぴー日記 を含むブックマーク

30分プログラム、その777。anarchy golf - Vertical writingインスパイアされて縦書き出力をやってみました。

使い方

- run "Hello";
H
e
l
l
o

ソースコード

fun interperse x []      = []
  | interperse x (y::ys) = y::x::interperse x ys;

fun vertical s =
    String.implode (interperse #"\n" (String.explode s));

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

fun run s =
    println (vertical s);

参考

2010-06-03(木)

二進数変換

| 二進数変換 - みずぴー日記 を含むブックマーク

30分プログラム、その770。整数を二進数に変換してみる。

SMLには右シフトとかのビット演算ないらしく、ちょっととまどった。

使い方

- bits 0;
val it = [0] : int list
- bits 3;
val it = [1,1] : int list
- bits 2;
val it = [1,0] : int list

ソースコード

fun bits n =
    let
	fun bits_rev n =
	    if n = 0 then
		[]
	    else
		(n mod 2) :: bits_rev (n div 2)
    in
	if n = 0 then
	    [0]
	else
	    List.rev (bits_rev n)
    end;

参考

2010-04-14(水)

でかいXを出力する

| でかいXを出力する - みずぴー日記 を含むブックマーク

30分プログラム、その756。

anarchy golf - Xインスパイアされて、でっかいXを出力してみました。

使い方

- print (x 3);
x     x
 x   x
  x x
   x
  x x
 x   x
x     xval it = () : unit

ソースコード

open String;

fun repeat _ 0 = []
  | repeat c n = List.tabulate (n, (fn _ => c));

fun make_string c n =
    String.implode (repeat c n);

fun range from to =
    if from = to then
	[]
    else
	from :: range (from + 1) to;

fun row n =
    let
	val m   = 2 * n + 1
	val mid = make_string #" " m
    in
	"x" ^ mid ^ "x"
    end;

fun padding width str =
    let
	val n   = (width - String.size str) div 2
	val pad = make_string #" " n
    in
	pad ^ str ^  pad
    end;

fun x n =
    let
	val downside = List.map row (range 0 n)
	val upside   = List.rev downside
	val width    = 2 * n + 1
	val big_x    = List.map (padding width) (upside @ [ "x" ] @ downside)
    in
	String.concatWith "\n" big_x
    end;

参考

2010-04-02(金)

チェックサムの計算を目指した何か

| チェックサムの計算を目指した何か - みずぴー日記 を含むブックマーク

30分プログラム、その749。チェックサムの計算をしようといて失敗しました。

wikipedia:チェックサムによると、チェックサムは「各ワードの合計の下位nビット」の合計として定義されています。

が、これを勘違いして「全ワードの合計の下位nビット」だと思ってコードを書いてしまいました。でも、せっかく書いたので貼っておきます。

SMLでビット演算する方法がわからず結構調べました。お気楽 Standard ML of New Jersey 入門によるとWordストラクチャを使えばできるらしいです。

使い方

- checksum 8 [1,2,3];
val it = 0wx6 : word

ソースコード

open Word;
infix 6 << andb;

fun mask n =
    (0wx1 << (Word.fromInt n)) - 0wx1;

fun add mask (x,y) =
    (x + y) andb mask;

fun checksum bits xs =  List.foldl (add (mask bits)) 0wx0 (List.map Word.fromInt xs);

(* from wikipedia(ja) *)
val test = checksum 8 [
	   0x08,0x09,0x0A,0x0B,0x0C,
	   0x0D,0x0E,0x0F,0x00,0x01,
	   0x02,0x03,0x04,0x05,0x06,
	   0x07
	   ];

参考

2010-03-14(日)

円周率を求めてみる

| 円周率を求めてみる - みずぴー日記 を含むブックマーク

30分プログラム、その743。今日3/14は円周率の日らしいです。というわけで、円周率を求めてみました。

計算式は円周率の計算 - みずぴー日記で使ったやつと同じです。

直接計算するのは芸がないので、無限ストリームを定義して、その上でだんだんと精度が上っていくπのストリームを作りました。

使い方

- Stream.nth pi 100;
val it = 3.09616152646 : real
- Stream.nth pi 1000;
val it = 3.13659268484 : real
- Stream.nth pi 1000;
val it = 3.14109265362 : real

ソースコード

structure Stream =
struct
  type 'a thunk = unit -> 'a;
  datatype 'a stream = Cons of 'a * ('a stream) thunk;

  fun force f = f ();
  fun cons x y = Cons (x,y);
  fun hd (Cons(x,_)) = x;
  fun tl (Cons(_,xs)) = force xs;

  fun nth xs 0 = hd xs
    | nth xs n = nth (tl xs) (n-1);

  fun scanl f init (Cons (x,xs)) =
      cons init (fn () => scanl f (f (x,init)) (force xs));

  fun map f (Cons (x,xs)) =
      cons (f x) (fn () => (map f (force xs)));
end;

fun term i =
    let
	val a = (Real.fromInt i) * 4.0 + 1.0
	val b = a + 2.0
    in
	1.0 / (a * b)
    end;

fun pi_8 n =
    Stream.cons (term n) (fn () => pi_8 (n+1));

val pi =
    Stream.map (fn x => 8.0 * x) (Stream.scanl (fn (x,y) => x + y) 0.0 (pi_8 0));

参考

2010-02-18(木)

HQ9+のインタプリタを作ってみた

| HQ9+のインタプリタを作ってみた - みずぴー日記 を含むブックマーク

30分プログラム、その737。HQ9+のインタプリタを作ってみました。

HQ9+の仕様はHQ9+ - Wikipediaを見てください。要するに、おどろくほど実用性ををもたないネタ言語です。

使い方

sml> run "HHQ+HQ++";
val it = "Hello,world!Hello,world!HHQ+HQ++Hello,world!HHQ+HQ++" : string

ソースコード

fun beer 0 =
    ["No more bottles of beer on the wall, no more bottles of beer.",
     "Go to the store and buy some more, 99 bottles of beer on the wall."]
  | beer 1 =
    "1 bottle of beer on the wall, 1 bottle of beer."::
    "Take one down and pass it around, no more bottles of beer on the wall."::
    "" ::
    beer 0
  | beer n =
    (String.concat [Int.toString n,
		    " bottles of beer on the wall, ",
		    Int.toString n,
		    " bottles of beer."]) ::
    (String.concat ["Take one down and pass it around, ",
		    Int.toString (n-1),
		    " bottles of beer on the wall."]) ::
    "" ::
    beer (n-1)

fun runChar self c =
    case c of
	#"H" => ["Hello,world!"]
      | #"Q" => [self]
      | #"9" => beer 99
      | _ => []

fun run src =
    String.concat
	(List.concat (List.map (runChar src) (explode src)));

参考

2010-02-01(月)

破壊的なstack

| 破壊的なstack - みずぴー日記 を含むブックマーク

30分プログラム、その729。破壊的なstack。

SMLの参照型ってどうやって使うのか気になったので作ってみた。SML vs. Ocamlによるとmutableレコードはないらしい。

使い方

- val s : (int Stack.t) = Stack.make();
val it = - : int Stack.t
- Stack.push 4 s;;
val it = () : unit
- Stack.push 3 s;
val it = () : unit
- Stack.pop s;
val it = 3 : int
- Stack.pop s;
val it = 4 : int
- Stack.pop s;

ソースコード

signature STACK =
sig
    type 'a t;
    val make : unit -> 'a t
    val push : 'a -> 'a t -> unit
    val pop  : 'a t -> 'a
    val empty : 'a t -> bool
end;

structure Stack :> STACK =
struct
  type 'a t = { content : 'a list ref }

  fun make () = { content = ref [] };
  fun push v {content=c} = c := v :: !c;
  fun pop {content=c} =
      case !c of
	  []    => raise Empty
	| x::xs => (c := xs; x);

  fun empty {content=c} =
      case !c of
	  [] => true
	| _ => false;
end

参考