ぷよぷよ19連鎖JavaScript版

JavaScript

ゲーム「ぷよぷよ」で、フィールドの状態がテキストで与えられたとき、消える「ぷよ」を消して次のフィールドの状態を出力するプログラムを書け。
http://okajima.air-nifty.com/b/2011/01/2011-ffac.html

前回書いたHaskell版のアルゴリズムのままJavaScriptに移植してみた。

const partition = (f,xs) => xs.reduce(([y,z],x) => f(x) ? [[...y,x],z] : [y,[...z,x]],[[],[]])
const cat = (x,[ok,ng]) => [[x,...ok.flat()],...ng]
const cmp = ([i,j,],[ii,jj,]) => i==ii ? j-jj : i-ii

const near = ([i,j,c],[ii,jj,cc]) => c==cc && (ii-i)**2+(jj-j)**2==1
const xyc = (n,xs) => xs.map((x,i) => [i/n|0,i%n,x])
const tr = xs => xs.map(([i,j,c]) => [j,i,c])
const str = xs => xs.sort(cmp).map(([,,c])=>c)

const joins = xs => xs.filter(([,,c])=>c.match(/\S/))
  .reduce((r,x)=>cat(x,partition(ys=>ys.some(y=>near(x,y)),r)),[])

const puyo = obj => {
  const xs = tr(xyc(obj.cols,obj.value.split("")))
  const j4 = joins(xs).filter(x=>x.length>3).flat()
  obj.value = str(tr(xyc(obj.rows,str(xs.map(x=>j4.some(y=>x+""==y+"") ? [x[0],-1," "] : x))))).join("")
}

<!DOCTYPE html>
<title>puyo</title>
<script src=puyo.js></script>
<form name=f>
<input type=button value=next onclick='puyo(document.f.t)'>
<input type=reset value=reset><br>
<textarea name=t rows=13 cols=7>
  GYRR
RYYGYG
GYGYRR
RYGYRG
YGYRYG
GYRYRG
YGYRYR
YGYRYR
YRRGRG
RYGYGG
GRYGYR
GRYGYR
GRYGYR
</textarea>
</form>

ぷよぷよ19連鎖

Haskell

ゲーム「ぷよぷよ」で、フィールドの状態がテキストで与えられたとき、消える「ぷよ」を消して次のフィールドの状態を出力するプログラムを書け。
http://okajima.air-nifty.com/b/2011/01/2011-ffac.html

この問題を見たときに、Haskellで解いてみたいと思ったのだが、フラグ等の副作用を使わないうまい書き方が思いつかなくてお蔵入りにしてた。
今回、ふとしたことで方針を思いついたので書いてみた。

import Data.List
input =
  ["  GYRR"
  ,"RYYGYG"
  ,"GYGYRR"
  ,"RYGYRG"
  ,"YGYRYG"
  ,"GYRYRG"
  ,"YGYRYR"
  ,"YGYRYR"
  ,"YRRGRG"
  ,"RYGYGG"
  ,"GRYGYR"
  ,"GRYGYR"
  ,"GRYGYR"]
h = length input
w = length $ head input

near (i,j,c) (i',j',c') = c==c' && abs(i'-i)+abs(j'-j)==1
xyc n cs = [(div i n,mod i n,c) | (i,c) <- zip [0..] cs]
tr xs = [(j,i,c) | (i,j,c) <- xs]
str xs = [c | (_,_,c) <- sort xs]

joins xs = foldr f [] [x | x@(_,_,c) <- xs, c/=' ' && c/='\n']
 where f x r = let (ok,ng) = partition (any $ near x) r in (x : concat ok) : ng

puyo xs = (str $ tr xs) : if xs==ys then [] else puyo ys
 where j4 = concat [x | x <- joins xs, length x > 3]
       ys = xyc h $ str [if elem x j4 then (i,-1,' ') else x | x@(i,_,_) <- xs]

main = mapM_ putStrLn $ puyo $ tr $ xyc (w+1) $ unlines input

ポイントフリーコンバータ

Haskell

Haskell風に書かれた関数定義やラムダ式を、(.)やflipを使ったポイントフリースタイルに変換するプログラムを作ってみた。
http://kar.s206.xrea.com/js/pointfree.html

使用例1

例えばここにある問題を解かせてみる。

ポイントフリースタイル入門 - melpon日記
問題1
foo x y = f (g x y)

http://d.hatena.ne.jp/melpon/20111031/1320024473

入力欄に、

foo x y = f (g x y)

と書いて実行を押すと、

(f.).g

と表示される。

使用例2

次に、同じ変数を複数箇所で使う例

ポイントフリー - 西尾泰和のはてなダイアリー
square = (*)<*>id -- \x -> x * x

http://d.hatena.ne.jp/nishiohirokazu/20100520/1274364170

入力欄に、

\x -> x * x

と書いて実行を押すと、

(*)<*>id

と表示される。

とりあえずこの2つはあってたけど、いろいろミスあるかも。

タイピング測定

JavaScript

タイピング速度を測定するプログラムをつくってみた。
http://jsdo.it/katona/typing

上段のtextareaの課題文を下段のtextareaに入力する。
1文字目の打ち始めから計測を開始するやや有利（？）な仕様。

<html>
<head>
<title>Typing</title>
<script>
function key(f){
  while(f.src.value.indexOf(f.usr.value)!=0) f.usr.value = f.usr.value.slice(0,-1);
  if(f.now.value.match(/GOAL/)) return;
  if(f.start.value=="") f.start.value = new Date().getTime();
  f.now.value = (new Date().getTime() - f.start.value) / 1000;
  if(f.usr.value==f.src.value) f.now.value += ' GOAL';
}
</script>
</head>
<body onload='document.f.usr.focus()'>
<form name=f>
<input name=now><input type=reset><input name=start style='display:none'><br>
<textarea name=src rows=3 style='width:100%'>The razor-toothed piranhas of the genera Serrasalmus and Pygocentrus are the most ferocious freshwater fish in the world. In reality they seldom attack a human.</textarea>
<textarea name=usr rows=3 style='width:100%' onkeyup='key(document.f)'></textarea>
</form>
</body>
</html>

サンプルの課題文はこれと同じもの

ケータイ早打ちの世界最速記録更新、iPhoneで達成 - スラッシュドット・ジャパン
課題文は以下の通り。ギネス認定を受けるための標準テキストになっている。
The razor-toothed piranhas of the genera Serrasalmus and Pygocentrus are the most ferocious freshwater fish in the world. In reality they seldom attack a human.
それまでの最速は、SamsungのGalaxy Sを使ってイギリスの女性が23日に達成した25.94秒だった。ブライアンさんはiPhoneを使って21.8秒で入力したという。

http://slashdot.jp/mobile/article.pl?sid=10/08/30/0811226

しかし、PCのキーボードでやってみても、30秒台しかでない…
携帯のOpera mobileでは、いったんフォーカスしてテキスト入力状態になると、入力を確定してフォーカスを解除するまでonkeyupのイベントが発生しないようだ。
そんな状況下、携帯では2タッチ入力で200秒超だった…

高階関数クイズ

lambda 
# let twice f x = f (f x)

これは f という関数と値 x をもらって、f を二回 x に適用する関数です。
さて、では、

# twice twice twice twice add1 0

は何が帰って来ると思いますか？

http://d.hatena.ne.jp/camlspotter/20100710/1278752186

・twiceはチャーチ数での2と同じ。
・チャーチ数xにチャーチ数yを適用すると y^x になる。
よって、問題の答えは、2^(2^(2^2))の計算結果と同じになる、と思う。

コンビネータ版チャーチ数の加減乗除

Haskell

たった１つの関数から出発して昨日やったチャーチ数の加減乗除 - MEMO:はてな支店を再現する。
最初に生成している各種コンビネータはコメントをつけているが、m=のところからは基本的に昨日と同じなので省略。
最初の関数x(Fokker版の一点基底コンビネータ)だけは普通の関数定義だが、
それ以降は関数xの適用のみのため、unsafeCoerceもx内で１度使うだけで済む。

import Unsafe.Coerce
x f = f (\x y z -> x z $ y $ unsafeCoerce z) (\x y z -> x)

k  = x x            -- k  x y     = x
s  = x k            -- s  f g x   = f x (g x)
ki = s k            -- ki x y     = y
i  = ki x           -- i  x       = x
b  = s (k s) k      -- b  f g x   = f (g x)
d  = b b            -- d  f x g y = f x (g y)
c  = s (d s) (k k)  -- c  f x y   = f y x
t  = c i            -- t  x f     = f x 
v  = b c t          -- v  x y f   = f x y
s' = b (b s) b      -- s' f g h x = f (g x) (h x)
b' = b (b b) b      -- b' f g h x = f (g (h x))
c' = b (b c) b      -- c' f g x y = f (g y) x

m = s i i
y = b m (c b m)

true  = k
false = ki
not'  = v false true
and'  = c c false
or'   = t true

cons = v
car  = t true
cdr  = t false

inc  = s b
incs = s (b cons cdr) (b inc cdr)
dec  = b car (c (t incs) (k n0))

n0 = ki
n1 = i
n2 = inc n1
n4 = n2 n2
n5 = inc n4

add = b s d
mul = b
pow = t
sub = c (t dec)

is0 = v (k false) true
le  = d b is0 sub
ge  = c le
lt  = d b not' ge
gt  = c lt

rsub = c (c' c' s' sub) i     -- rsub f m n = f (sub m n) n
mod' = y $ b  (s' s (s' c lt i)) rsub
div' = y $ b' (s' s (c' c lt n0)) (d b inc) rsub

num n = n (+1) 0 :: Int
main = print $ map (\f -> num $ f n5 n2) [add,mul,pow,sub,mod',div']

実行結果
それぞれ5+2, 5*2, 5^2, 5-2, 5%2, 5/2の計算結果になっている。

[7,10,25,3,1,2]

おまけ

上記のソースは段階的に適用結果を変数に入れていてxだけで動いているという実感がわかないが、
例えばn2とmulをxだけで書くと以下のとおり。

import Unsafe.Coerce
x f = f (\x y z -> x z $ y $ unsafeCoerce z) (\x y z -> x)

n2  = x (x x) (x (x x) (x x (x (x x))) (x x)) (x (x x) (x x) x)
mul = x (x x) (x x (x (x x))) (x x)

num n = n (+1) 0 :: Int
main = print $ map num [n2,mul n2 n2,mul n2 (mul n2 n2)]

実行結果
それぞれ2, 2*2, 2*2*2の表示結果

[2,4,8]

チャーチ数の加減乗除

Haskell

型推論を無効にする方法を発見。

型推論をごまかす Y コンビネータ
L の定義は、本当は L x y = x (y y) です。(y y)の部分が自己言及になって、GHC ではこの部分の型をうまく処理できません。そこで、unsafeCoerce で型推論をごまかしています。

http://d.hatena.ne.jp/kazu-yamamoto/20100519/1274240859

おかげで、断念していたHaskell版のチャーチ数の引き算とYコンビネータを使った割り算(と剰余)が作れた。
これで加減乗除の基本演算がそろった。感謝。

import Unsafe.Coerce

m x = x (unsafeCoerce x)
y f = m (\x -> f (m x))

true  x y = x
false x y = y
not'  p   = p false true
and'  p q = p q false
or'   p q = p true q

cons x y f = f x y
car p = p true
cdr p = p false

inc n f x = f (n f x)
incs p = cons (cdr p) (inc (cdr p))
dec n = car (n incs (const n0))

n0 f x = x
n1 f x = f x
n2 = inc n1
n4 = n2 n2
n5 = inc n4

add m n f x = m f (n f x)
mul m n f   = m (n f)
pow m n     = unsafeCoerce n m
sub m n     = unsafeCoerce n dec m

is0  n = n (const false) true
le m n = is0 (sub m n)
ge m n = le n m
lt m n = not' (ge m n)
gt m n = lt n m

mod' f m n = (lt m n) m       (f (sub m n) n)
div' f m n = (lt m n) n0 (inc (f (sub m n) n))

num n = n (+1) 0 :: Int
main = print $ map (\f -> num $ f n5 n2) [add,mul,pow,sub,y mod',y div']

実行結果
それぞれ5+2, 5*2, 5^2, 5-2, 5%2, 5/2の計算結果になっている。

[7,10,25,3,1,2]

結局unsafeCoerceを使ったのはmコンビネータとpowとsubの3カ所。
n4 = n2 n2はそのまま通るのに、なぜpowはunsafeCoerceをつけないとエラーになるのかが謎。