リストのネストの深さ via lethevertさんとこ。
-- 深さを指定して concat その１ （変なdepthを指定したら実行時エラー）
class Conc a where
concatN :: Integer -> [a] -> a
instance Conc a where
concatN _ _ = error "concatN: too deep"
instance (Conc a) => Conc [a] where
concatN _ [] = []
concatN 1 xs = concat xs
concatN n (x:xs) = concatN (n-1) x : concatN n xs
色々バリエーション。
-- [ ] の深さ
class Depth a where
depth :: a -> Integer
instance Depth [a] where
depth _ = 1
instance (Depth [a]) => Depth [[a]] where
depth _ = depth (undefined::[a]) + 1
-- 一番内側のリストを concat
class ConcI a where
concatI :: [[a]] -> [a]
instance ConcI a where
concatI = concat
instance (ConcI a) => ConcI [a] where
concatI [] = []
concatI (x:xs) = concatI x : concatI xs
-- 深さを指定して concat その２（変なdepthを指定したらコンパイルエラー）
data Z = Z
data S a = S a
class ConcC n a where
concatC :: n -> [[a]] -> [a]
instance ConcC Z a where
concatC _ = concat
instance (ConcC n a) => ConcC (S n) [a] where
concatC _ [] = []
concatC (S t) (x:xs) = concatC t x : concatC (S t) xs
-- 実行例
theList :: [[[[Integer]]]]
theList = [[[[1,2], [3,4]], [[5,6], [7,8]]]]
main = do
print $ depth theList -- 4
print $ concatN 1 theList -- [[[1,2],[3,4]],[[5,6],[7,8]]]
print $ concatN 2 theList -- [[[1,2],[3,4],[5,6],[7,8]]]
print $ concatN 3 theList -- [[[1,2,3,4],[5,6,7,8]]]
print $ concatC Z theList -- [[[1,2],[3,4]],[[5,6],[7,8]]]
print $ concatC (S Z) theList -- [[[1,2],[3,4],[5,6],[7,8]]]
print $ concatC (S (S Z)) theList -- [[[1,2,3,4],[5,6,7,8]]]
print $ concatI theList -- [[[1,2,3,4],[5,6,7,8]]]
ただし Haskell 98 だと無理だと思うので色々と拡張機能を有効に。
> ghc -fglasgow-exts
-fallow-undecidable-instances -fallow-overlapping-instances test.hs
それでもtheListの型指定を外したり多相型関数の中に depth や concat* を放り込むと incoherent-instances 関係などで怒られるみたいです。あと調子に乗って super_flat を書こうとして 撃沈しました。素で 「こうですか！？わかりません！」 状態で書いているので、識者が もっと適切な書き方を指摘してくれるに違いないのです。
あー、型さえ明示指定してやれば、すごい簡単でした。
class Fla a b where
super_flatten :: [a] -> [b]
instance Fla a a where
super_flatten = id
instance (Fla a b) => Fla [a] b where
super_flatten = super_flatten . concat
test1 = super_flatten [[[True]],[[False,True]],[]] :: [Bool]
test2 = super_flatten [[1::Int,2,3],[4]] :: [Int]
酒井さんのは型注釈もいらないっぽい。凄いな…
昔 大文字を小文字に
変換しながらecho を書いたときにはまだかなり最適化の余地
があると言いつつ
何もその先を考えていませんでした。が、最近インタプリタ実装のテストに使っていただいたりしているのを見ているとやっぱり、インタプリタの性能以前に、
このBfプログラム自体が遅すぎます。というわけで改良してみました。当社比60倍の
高速化です。3000命令/文字程度。ついでにEOFが-1ならそこで終了するようにしました。
>>,+[-[-<+<+>>]++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+<[->->+<[>-]>[>]<[-<<[->+<]++++++++++++++++++++++++++[->>+<[>-]>[>]<[-<<<+++++
+++++++++++++++++++++++++++>[-]>>]<-<]>>]<<]<.[-]>>,+]
右側の注釈は正確ではありませんが、だいたいこんな感じのアルゴリズム。
>>,+ z = getchar()+1
[- while( z-- )
[-<+<+>>] x = y = z
++++++++++++++++++++++++++++++++ z = 'A'
+++++++++++++++++++++++++++++++++<
[- while( y-- )
>->+<[>-]>[>]< w = !(--z)
[- if( w-- )
<<[->+<] z = y
++++++++++++++++++++++++++ y = 26
[- while( y-- )
>>+<[>-]>[>]< w = !z
[- if( w-- )
<<<++++++++++++++++++++++++++++++++ x += 0x20
>[-]>> y = 0
] endif
<-< z--
]>> endwhile
]<< endif
] endwhile
<.[-] putchar(x); x = 0
>>,+ z = getchar()+1
] endwhile
個人的なポイントは、ptr[1] と ptr[2] が 0 の時に、論理否定の計算
ptr[1] = (ptr[0]!=0 ? 0 : 1) を下のコードで
とても高速かつ ptr[0] を壊さずに実現できるのに気づけたところでした。
>+<[>-]>[>]<<
いやいやもっとずっと速く書けるぞという突っ込み募集中です。
Brainfuckで検索していろいろ眺めてまわってたら、 id:hiuchida さんの エントリを発見。こちらは「小文字を大文字にするecho」なんですが…ぎゃーす！そうか！ 最初に問答無用でいきなり 'A' を引いてしまった方が明らかに速い！なにやってんだ俺！ めんどいのでEOFはチェックは省いてますが、この方法を取り入れるとこんな感じ。 さらに倍速くなって1600命令/文字くらいです。
>>,
[
[->+>+<<]
>>-----------------------------------------------------------------
<<++++++++++++++++++++++++++
[-
>>>+<[>-]>[>]<
[-
<<++++++++++++++++++++++++++++++++<[-]>>>
]
<-<<
]
>.[-]>,
[-<+<+>>]
<<-----------------------------------------------------------------
>>++++++++++++++++++++++++++
[-
<<<+>[<-]<[<]>
[-
>>++++++++++++++++++++++++++++++++>[-]<<<
]
>->>
]
<.[-]<,
]
ループの上半分と下半分は < と > を入れ替えただけで全く同じコードです。 基本的に作業用のセルは次の文字の処理に移る前にゼロクリアしておかないといけないん ですが、ゼロクリア処理 [-] はそんなに軽くはない(*)ので、できれば避けたい。なので、 唯一ゼロクリア不要な作業用セルであるgetcharの結果代入先を１文字ごとに切り替える べくこんなんになっています。
(*) 特に値が負である可能性も正である可能性もある場合。 セルの型がbyteの処理系だとせいぜい255回ループすれば終わるんですが、 セルの型が4byteのintの処理系だと最悪なことになるので、コピーして[-]と[+]を 両方試してどっちかがゼロになったら止める的な処理がたぶん必要になってそれはそれは 酷いことに。
花谷さんのが速いです。なるほど…
template<int A, class D> struct Cons {
static const int car = A;
typedef D cdr;
};
template<class L> struct Tail
: L::cdr {};
template<class LA, class LB> struct mapPlus
: Cons< LA::car + LB::car,
mapPlus<typename LA::cdr, typename LB::cdr> > {};
struct fib
: Cons<1, Cons<1, mapPlus<fib,Tail<fib> > > > {};
// pretty? printer
#include <iostream>
template<class L, int N>
struct print { print() {
std::cout << L::car << ' ';
print<typename L::cdr, N-1>();
} };
template<class L>
struct print<L,0> {};
int main() {
print<fib, 10>(); // 1 1 2 3 5 8 13 21 34 55
}
や、まあ、print<fib, 15> 辺りにするととたんに識別子の長さエラーかなにかで コンパイル通らなくなるんですが…
向井さんの Brainf*ckインタプリタ by Haskell を見て、'[' でループ開始位置をスタックに 積んで ']' で取り出す形にすれば綺麗にならないかな、と思ってやってみました。
-- Haskell
evalBF :: (MonadState (Zipper Int) m, MonadIO m) => [String] -> m [Int]
evalBF [[]] = gets zipperToList
evalBF r@(('[':t):s) = gets obtain >>= evalBF . branch
where skip (']':t) = t
skip ('[':t) = skip (skip t)
skip ( _ :t) = skip t
branch 0 = skip t:s
branch _ = t:r
evalBF ((']':t):s) = evalBF s
evalBF ((cmd:t):s) = op cmd >> evalBF (t:s)
where op '>' = modify next
op '<' = modify prev
op '+' = modify (change (+1))
op '-' = modify (change (subtract 1))
op '.' = gets obtain >>= liftIO . putChar . chr
op ',' = liftIO getChar >>= modify . set . ord
op _ = return ()
runBF :: String -> IO [Int]
runBF s = evalStateT (evalBF [s]) (listToZipper $ repeat 0)
うーむ。あんまり変わらず。分岐の部分（branch）がこのくらい単純になれば 何かうまいライブラリ関数を適用できるかとか考えてたんですが、そういう もんでもなさそう。
マイナーなものが好きな自分が好きであるというメジャーな嗜好を持つ自分としては、 まあどうせと 語られるくらい評価の高い作品に対してそう感じるのはなんか悔しいものがなきにしもあらず なのですけど、『狼と香辛料』が 面白いです。特に一昨日読んだ第２巻、メインの経済/商売話もいいですが、 新キャラの羊飼いの少女が牧羊犬と羊達を巧みに操って、襲いかからんとする 狼の群れを翻弄する…というシーンが描かれていて、そこで一気に引き込まれました。 剣と魔法でもない、ペンと舌峰でもない"戦い"というのもなかなか。
いろんなとこ経由。せっかくなので <algorithm> と比べて知名度が低い 気がする <numeric> で遊ぼう。
// C++
#include <iostream>
#include <vector>
#include <numeric>
#include <functional>
using namespace std;
int main() {
for( vector<int> p ;;
adjacent_difference(p.begin(), p.end(), p.begin(), plus<int>()), p.push_back(1) )
cout << p << endl;
}
本当は どっかにvectorを出力するためのoperator<<を定義しないといけないですが省略。
> g++ pascal.cc > ./a | head -5 [ ] [ 1 ] [ 1 1 ] [ 1 2 1 ] [ 1 3 3 1 ]
adjacent_difference なる名前の関数で和を取るというアレなことになってますが、 SmallTalk の #overlappingPairsCollect: とだいたい同じ処理です。Cryoliteさんとこの uniqueの話 でも 思ったのですけど、STLのアルゴリズムは、その適用範囲に比べて名前が狭すぎるものが ちらほら。
『Remember me』 げっと。やっぱり一作目と比べてみると別人のような声。重さが違う。 このアルバムで自分が一番好きなのは圧倒的に11曲目、"I believe ～海の底から～" ですね。
I believe この声は 届いてるはず
このままどこまでも おちていっても
私は 一雫の憂いを落として
海の底に花を咲かせてみせるわ きっと
各行の頭の部分の歌い出し方、なんていうんだろう、あれ凄い。"鳥肌が立つ"という 言い回しがよくわかる。しかしそれでも CDではまだ足りないと熱く語っておられる方を発見。
↑の歌を『Haevest』 ていうWeb漫画（絵がえちぃ漫画に見えるといわれたのですけど、読んでみると純粋に硬派な ファンタジーなので苦手な人も安心です、はい）を読みながら聴いていたら、偶然にも絵と曲と ストーリーと歌詞がいい具合にマッチして引き込まれてしまいました。おすすめ。