222 Sphere Packing

Problem 222 – Project Euler

球のパッキング.一般のパッキングは難しい(ナップサック,ビン・パッキング).

しかし,これは状況がかなり特殊.

最小ではどうせ,綺麗に並ぶんだよ,と思い,小さい数で実験.

そして,予測.あってた.

height :: Int -> Int -> Int -> Double
height l r1 r2 = sqrt.fromIntegral $ l * ( 2 * (r1 + r2) - l)
pipe l rs = (+r).sum.map2 (height l) $ rs
where map2 f xs = zipWith f xs $ tail xs
r = fromIntegral $ head rs + last rs
p222 :: Integer
p222 = round.(1000*).pipe 100 $ [49,47..31] ++ [30,32..50]

実験も含めたコード.

import Data.List (minimumBy)
import Data.Ord (comparing)
import Control.Monad (liftM)
import System.Environment (getArgs)
height :: Int -> Int -> Int -> Double
height l r1 r2 = sqrt.fromIntegral $ l * ( 2 * (r1 + r2) - l)
pipe l rs = (+r).sum.map2 (height l) $ rs
where map2 f xs = zipWith f xs $ tail xs
r = fromIntegral $ head rs + last rs
p222 :: Integer
p222 = round.(1000*).pipe 100 $ [49,47..31] ++ [30,32..50]
minPipe :: Int -> [Int] -> (Double, [Int])
minPipe l rs = minimumBy (comparing fst) [(pipe l rs', rs') | rs' <- permutations rs]
main :: IO ()
main = do n <- liftM (read.head) getArgs
print.minPipe 100 $ [50-n..50]
permutations            :: [a] -> [[a]]
permutations xs0        =  xs0 : perms xs0 []
where
perms []     _  = []
perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
where interleave    xs     r = let (_,zs) = interleave' id xs r in zs
interleave' _ []     r = (ts, r)
interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
in  (y:us, f (t:y:us) : zs)

ghc 6.8.2 には permutations がまだ,入ってなかった.

ところで,最小性の証明は?

あとで,フォーラムを探してみよう.