0

ネタバレ: これはプロジェクト オイラーの問題 #18 です。自己責任でお読みください

問題は、パスカル三角形の頂点から厳密に下に向かうすべての非決定論的経路の「最大和」を見つけることです。三角形の行を折り畳んで合計を計算しようとしています。

入力文字列といくつかの基本的な準備を次に示します。

inputLines = ["75",
              "95 64",
              "17 47 82",
              "18 35 87 10",
              "20 04 82 47 65",
              "19 01 23 75 03 34",
              "88 02 77 73 07 63 67",
              "99 65 04 28 06 16 70 92",
              "41 41 26 56 83 40 80 70 33",
              "41 48 72 33 47 32 37 16 94 29",
              "53 71 44 65 25 43 91 52 97 51 14",
              "70 11 33 28 77 73 17 78 39 68 17 57",
              "91 71 52 38 17 14 91 43 58 50 27 29 48",
              "63 66 04 68 89 53 67 30 73 16 69 87 40 31",
              "04 62 98 27 23 09 70 98 73 93 38 53 60 04 23"]

input = map (map (read ::String ->Integer) . words) inputLines

prepareElems :: [[Integer]] -> [[Elem Integer]]
prepareElems = map mkElemsFromTri

ここには 2 つのアイデアがあります。木の列を持つことと、三角形の列を持つことです。型レベルの抽象化はあまり行いませんでしたが、それほど重要ではありません。アイデアは、三角形のすべての行がその長さ全体の二項式の「並列列挙」であり (つまり: [(4,0), (3,1), (2,2), ... (0,4)])、ラベル付きの三角形の行がツリーの行に適用される前に、ツリーのすべての行が「コピーフォーク」されるというものです。分岐するたびに、非決定論の完全性が保持されるようにします。ここに私のテクニックがどのように見えるかがあります：

data BiLabel = BiLabel Integer Integer
  deriving (Show, Eq)

leftLabel (BiLabel x _) = x
rightLabel (BiLabel _ y) = y

parEnumBiLabel :: Integer -> [BiLabel]
parEnumBiLabel n = map ( \x ->BiLabel x $ (n-1)-x ) [0..(n-1)]


forkBiLabel :: BiLabel -> (BiLabel, BiLabel)
forkBiLabel (BiLabel x y) = (BiLabel (x+1) y,BiLabel x (y+1))

data Elem a = Elem {label :: BiLabel, element :: a}
  deriving (Show, Eq)

forkElem :: Elem a -> [Elem a]
forkElem (Elem l a) = [Elem left a,Elem right a]
  where
    (left,right) = forkBiLabel l

-- Does a binomial expansion, but cloning the elements and making new labels
cloneNextLevel :: [Elem Integer] -> [Elem Integer]
cloneNextLevel = concatMap forkElem

私の問題は、コードが1行の入力に対して機能することですが、複数の行を折りたたむと失敗します。私の「コピーフォーク」手法は、アクセスできると予想されるラベルを介しoverElemsて関数を適用する前に、新しいラベルを作成していることを直感しています。ここに私の主な機能があります：

-- this applys a 1-ary function to all Elems of a list that match the label
onLabel :: (a -> a) -> BiLabel -> [Elem a] -> [Elem a]
onLabel f (BiLabel la lb) (x:xs) | label x == BiLabel la lb = processHead : processTail
                                 | otherwise = x : processTail
   where
    processHead = Elem (BiLabel la lb) $ f (element x)
    processTail = onLabel f (BiLabel la lb) xs 
onLabel _ _ [] = []


-- this _tries_ to do the equivalent of `onLabel`, but over lists and 2-ary functions
overElems :: (a -> a -> a) -> [Elem a] -> [Elem a] -> [Elem a]
overElems f (x:xs) ys = overElems f xs ( onLabel (f $ element x) (label x) ys )
overElems _ [] ys = ys


-- This starts with the first element of `input` as an accumulator, just because
-- then I won't have to copy it over as part of the fold, and can simply 
-- `cloneNextLevel` before I process it with `overElems`.
calculate :: [[Elem Integer]] -> [Elem Integer]
calculate = foldr (\z acc -> overElems (+) z (cloneNextLevel acc)) [Elem (BiLabel 0 0) (head $ head input)]

奇妙なことに、1 行を折りたたむと機能しますが、複数行を折りたたむと高次関数が適用されず、結果が正しいサイズに拡張されます。入力例をいくつか示します。

\> calculate $ prepareElems [[2,3]]

[Elem {label = BiLabel 1 0, element = 78},Elem {label = BiLabel 0 1, element = 77}]
-- that's correct, because the first element of the tree is 75

\> calculate $ prepareElems [[2,3],[10,20,30]]

[Elem {label = BiLabel 2 0, element = 75},Elem {label = BiLabel 1 1, element = 75},
Elem {label = BiLabel 1 1, element = 75},Elem {label = BiLabel 0 2, element = 75}]
-- this is the correct size and labeling, but not the right contents.

私のリスト処理の怠惰はこれを引き起こしますか? 私の感覚では、ラベルの列挙は、ラベルoverWithを介して関数を適用する前に行われています。これも私のコードの全ページです。

4

0 に答える 0