Project Euler 335 - wvogel日記

で........できた......
数日前から時勉強の合間合間、否、これを考える時間の合間合間に勉強しながら完成。
euler335の問題。
と言っても、未完成なんですけど。
本当はk=0→10^18Σ(2k+1)の豆の移動数をmod7^9で出力、としなければならないんですが。
きっとそのままIntegerに拡張しても、また前のようにメモリが足りなくなるのは目に見えているので（逃げた）
とりあえず、その部分はひとまずおいとくとして。
豆の移動回数を純粋に求めます。
ソースコードは後ろに掲載（とても汚い。特に豆移動関数）

はじめ、すべてのさらに豆は一つずつなので[1,1..]です。
それに対し、豆の移動元となる皿から豆をとった状態dish'と、
それを皿に分配する様子moveとにわけて処理を行い、
その二つの和を出すことで次の皿の状態を求めています。
例に、皿数4とすると、
はじめ[1,1,1,1]
dish' == [0,1,1,1]
move == [0,1,0,0]
dish -> [0,2,1,1]
といった感じ。
そして次の豆の移動元となる皿の一位置を、upDateN関数から導いています
ふー。
リストモジュールからcycleを見つけるまでなかなかに手間取った.....
move関数がとても気持ち悪い形をしているので、なんとかならないものかな.....
とりあえずこれで答えは出ます.....
但し、Intの範囲に限りますけど
takeが、Intを引数にとるというのが厄介
今試しに単純にfromInteger 10^18と無限リストをtake関数に渡してみたけど、
空リストが返って来ました。
ちゃんと解こうと思ったらやはり力技では無理なようです、アルゴリズムを考えないと。
うーん。
難しい
この問題の場合は帰納法とかでしょうかね

import Data.List

bean = [1,1..]

euler335 :: Int -> Int
euler335 n = euler335' 0 $ take n bean

euler335' :: Int->[Int]->Int
euler335' n dish= case any (==long) dish of
           True -> 1
           False ->1+ euler335' upDateN
                   (dishAfterMove [(dish' n dish),move $dish!!n])
 where
   long :: Int
   long = length dish

   upDateN ::Int
   upDateN = (n+dish!!n)`mod` long

   dishAfterMove :: [[Int]]->[Int]
   dishAfterMove dandb = map sum $ transpose dandb
    
   dish' ::Int -> [Int]->[Int]
   dish' 0 (_:dish)= 0:dish
   dish' n (d:dish)= d:dish' (n-1) dish

   move :: Int->[Int]
   move b=take long.drop (long-1-n).cycle.take long$take b bean++[0,0..]

main =getLine >>= \n-> (print $ euler335 (read n))