phorth---（その1.6）積み残したrollの実装

Haskell

rollの実装

保留していたrollに戻ります．
rollはn個の要素をk回だけ「上に」巡回させます．例えば，

10 20 30 40 50 3 1 roll => 10 20 50 30 40  
10 20 30 40 50 3 2 roll => 10 20 40 50 30  
10 20 30 40 50 3 3 roll => 10 20 30 40 50

という具合です．大きなkに関してはmod nで考えることになります．kが負の数の場合は「下に」巡回します．例えば

10 20 30 40 50 3 -1 roll => 10 20 40 50 30  
10 20 30 40 50 3 -2 roll => 10 20 50 30 40  
10 20 30 40 50 3 -3 roll => 10 20 30 40 50

となります．このとき小さな負の値（絶対値が大きい負の値）の場合は，kの絶対値のmod nにkの符号をつけたもので考えます．例えば-13だったら，-13 mod 3 = 2ですがそうはせず，13 mod 3=1 として，sign(-13)*1=-1と同じと考えます．

話を単純化します．リストの要素のうち，最初のn個のものを1個だけ上に動かす関数は

roll n xs = (drop 1 $ take n xs) ++ [head xs] ++ (drop n xs)

と表せます．これを再帰的に書き換えて

roll n k xs 
    = case k of
          k | n <  k          -> roll n (k mod n) xs
            | 1 < k && k <= n -> roll n (k-1) $ roll n 1 xs
            | k == 1          -> (drop 1 $ take n xs) ++ [head xs] ++ (drop n xs)
            | k == 0          -> xs

これでk>=0のリスト版rollができました．k<0のときも同様に処理します．リストの要素のうち，最初のn個のものを1個だけ下に動かす関数は，同様に考えて

roll' n k xs  
    = case k of
          k | n < k           -> roll' n (k `mod` n) xs
            | 1 < k && k <= n -> roll' n (k-1) $ roll' n 1 xs
            | k == 1          -> [last $ take n xs] ++ (take (n-1) xs) ++ (drop n xs)

です．これらをあわせて

roll::Int->Int->[a]->[a]
roll n k xs  = case k of
          k | k < 0           -> roll' n (abs k) xs
            | n < k           -> roll n (k `mod` n) xs
            | 1 < k && k <= n -> roll n (k-1) $ roll n 1 xs
            | k == 1          -> (drop 1 $ take n xs) ++ [head xs] ++ (drop n xs)
            | k == 0          -> xs
    where roll' n k xs = case k of
              k | n < k           -> roll' n (k `mod` n) xs
                | 1 < k && k <= n -> roll' n (k-1) $ roll' n 1 xs
                | k == 1          -> [last $ take n xs] ++ (take (n-1) xs) ++ (drop n xs)

とすることで，リストに対するrollが定義できます．

この関数rollをprocStackに与えることでオペレータrollを定めます．IntegerとIntの違いに注意です．

procExp i (Invoke "roll")
    = procStack i (\((Pushed k):(Pushed n):xs)->roll (fromInteger n) (fromInteger k) xs)

これでとりあえず電卓程度には使える程度にオペレータは定めたと思います（まだまだ整理されてないですけど）．ここまで手元では155行のソースになってますが，まだ入出力用のシェルができてません．とりあえず動くだけでもシェルがなければいけません．

おまけ

rollの実装中に間違って作った関数swap．

swap::Int->Int->[a]->[a]
swap m n xs = map (\(i,x) -> case i of
                                 i | i==m -> xs!!n
                                   | i==n -> xs!!m
                                 _        -> x)
                  $ zip [0,1..] xs

リストの任意の2要素を交換します．たとえば

swap 1 2 [10,20,30,40] = [10,30,20,40]
swap 0 3 [10,20,30,40] = [40,20,30,10]

です．