Problem 212

212 Combined Volume of Cuboids

はじめは平面走査で行こうと思ったが…

遅い。おそらく、直方体が密に存在するから。

そこで、方針を変更。

分割統治で。大きな直方体はないから、大丈夫でしょう。

import Data.List ((!!),  mapAccumL)
import Control.Arrow ((***))
type Cuboid = ([Int], [Int])
lagFib :: [Integer]
lagFib = map s [1..55] ++ zipWith add lagFib (drop 31 lagFib)
where s k = (100003 - 200003*k + 300007*k^3) `mod` 1000000
add x y = (x + y) `mod` 1000000
cuboids :: [Cuboid]
cuboids = map h.getCube $ lagFib
where getCube (x:y:z:dx:dy:dz:fibs) = (map f [x,y,z], map g [dx,dy,dz]) : getCube fibs
f x = fromIntegral $ x `mod` 10000
g x = fromIntegral $ 1 + (x `mod` 399)
h (p,dp) = (p, zipWith (+) p dp)
replace :: Int -> a -> [a] -> [a]
replace n x xs = let (a,b:cs) = splitAt n xs
in a ++ x:cs
split :: Int -> Int -> Cuboid -> ([Cuboid], [Cuboid])
split n t c@(p1, p2) | t <= p1!!n = ([], )
| p2!!n <= t = (, [])
| otherwise  = ([c1], [c2])
where c1 = (p1, replace n t p2)
c2 = (replace n t p1, p2)
partition :: [Cuboid] -> (Int, Int) -> ([Cuboid], [Cuboid])
partition cs (n,t) = (concat***concat).unzip.map (split n t) $ cs
volume :: Cuboid -> Integer
volume (p1,p2) = product.map toInteger.zipWith (-) p2 $ p1
combineVolume :: [Cuboid] -> Integer
combineVolume [] = 
combineVolume (c@(p1,p2):cs) = volume c + sum (map combineVolume $ outer ++ inner)
where (rs,outer) = mapAccumL partition cs $ zip [..2] p2
(_,inner)  = mapAccumL partition' rs $ zip [..2] p1
partition' xs = ((a,b) -> (b,a)).partition xs
main :: IO ()
main = print.combineVolume.take 50000 $ cuboids

ついでに、ダメだった平面走査。

{-# LANGUAGE BangPatterns #-}
import Data.List (sort, foldl')
import Data.Set (empty, toList, insert, delete)
lagFib :: [Integer]
lagFib = map s [1..55] ++ zipWith add lagFib (drop 31 lagFib)
where s k = (100003 - 200003*k + 300007*k^3) `mod` 1000000
add x y = (x + y) `mod` 1000000
cuboids = getCube lagFib
where getCube (x:y:z:dx:dy:dz:fibs) = ((f x,f y,f z),(g dx,g dy,g dz)):getCube fibs
f x = fromIntegral $ x `mod` 10000
g x = fromIntegral $ 1 + (x `mod` 399)
data Event = L | U deriving (Eq, Ord, Show)
type Coord = Int
type Line = (Coord, Coord)
type Box  = ((Coord, Coord), (Coord,Coord))
type Cube = ((Coord, Coord, Coord), (Coord, Coord, Coord))
combineLine :: [Line] -> Integer
combineLine = fst.foldl' step (,).sort
step (!s,!p) (!x,!dx) | x+dx < p  = (s, p)
| p < x     = (s+ toInteger dx, x+dx)
| otherwise = (s+ toInteger (x+dx-p), x+dx)
boxToEvent :: Box -> [(Coord, Line, Event)]
boxToEvent ((x,y), (dx,dy)) = [(y,l,L),(y+dy,l,U)]
where l = (x,dx)
combineBox :: [Box] -> Integer
combineBox = snd.foldl' sweep ((,empty,), ).sort.concatMap boxToEvent
where sweep ((!h,!ls,!w), !a) (!y,!l,!e) =
let a' = a + w*(toInteger (y-h))
ls' = case e of L -> insert l ls
U -> delete l ls
w' = combineLine.toList $ ls'
in ((y,ls',w'), a')
cubeToEvent :: Cube -> [(Coord, Box, Event)]
cubeToEvent ((x,y,z), (dx,dy,dz)) = [(z,b,L),(z+dz,b,U)]
where b = ((x,y), (dx,dy))
combineCube :: [Cube] -> Integer
combineCube = snd.foldl' sweep ((,empty,), ).sort.concatMap cubeToEvent
where sweep ((!h,!bs,!a), !v) (!z,!b,!e) =
let v' = v + a*(toInteger(z-h))
bs' = case e of L -> insert b bs
U -> delete b bs
a' = combineBox.toList $ bs'
in ((z,bs',a'), v')
main :: IO ()
main = print.combineCube.take 100 $ cuboids

コンテンツ