Problem 222

222 Sphere Packing

球のパッキング．一般のパッキングは難しい（ナップサック，ビン・パッキング）．

しかし，これは状況がかなり特殊．

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

そして，予測．あってた．

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 がまだ，入ってなかった．

ところで，最小性の証明は？

あとで，フォーラムを探してみよう．

コンテンツ