• API
• FAQ
• Tools
• Trends
• Archive
daily pastebin goal
42%
SHARE
TWEET

# Minimum Sum of All Travel Times

a guest Feb 20th, 2012 195 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. module Main where
2. import Data.List
3. import Data.Ord
4.
5. -- For testing purpose
6. import Test.QuickCheck
7. import Test.QuickCheck.Gen
8. import System.Random
9.
10. type Z  = Integer
11. type Pt = (Z,Z)
12. type Dir = Pt
13. type Cost = Z
14.
15. sumV :: [Pt] -> Pt
16. sumV = foldr addV (0,0)
17.
18. addV :: Pt -> Pt -> Pt
19. addV (x,y) (u,v) = (x+u,y+v)
20.
21. divV :: Pt -> Z -> Pt
22. divV (x,y) d = (x `div` d,y `div` d)
23.
24. second :: (a,b,c) -> b
25. second (_,y,_) = y
26.
27. third :: (a,b,c) -> c
28. third (_,_,z) = z
29.
30. mean :: [Pt] -> Pt
31. mean xs = sumV xs `divV` genericLength xs
32.
33. dir0 :: [Dir]
34. dir0 = [(-1,1) ,(0,1) ,(1,1)
35.        ,(-1,0)        ,(1,0)
36.        ,(-1,-1),(0,-1),(1,-1)]
37.
38. -- Tweaking this would result 2x speed-up
39. restrict :: Dir -> [Dir] -> [Dir]
40. restrict d ds = ds
41.
42. d :: Pt -> Pt -> Z
43. d (x,y) (u,v) = max (abs (x-u)) (abs (y-v))
44.
45. costAt :: [Pt] -> Pt -> Cost
46. costAt xs p = sum \$ map (d p) xs
47.
48. cand :: Pt -> [Dir] -> [Pt]
49. cand p ds = map (addV p) ds
50.
51. step :: [Pt] -> (Pt,Cost,[Dir]) -> (Pt,Cost,[Dir])
52. step xs (p,c,ds)
53.     |  c' < c    =  (p',c', restrict d ds)
54.     |  otherwise =  (p ,c , [])
55.     where
56.       (p',c',d) = minimumBy (comparing second) \$ map (look xs p) ds
57.
58. look :: [Pt] -> Pt -> Dir -> (Pt,Cost,Dir)
59. look xs p d = (p',costAt xs p',d)
60.     where p' = p `addV` d
61.
62. -- seems like a reasonable guess
63. start :: [Pt] -> (Pt,Cost,[Dir])
64. start xs = (p0,c0,dir0)
65.     where
66.       p0  = mean xs
67.       c0  = costAt xs p0
68.
69.
70. opt :: [Pt] -> (Pt,Cost,[Dir])
71. opt xs =  head \$ dropWhile (not . null . third) \$ iterate (step xs) \$ start xs
72.
73. optDebug :: [Pt] -> (Bool,[(Pt,Cost,[Dir])])
74. optDebug xs =  (check xs p,head ns : ms)
75.     where
76.       (ms,ns) = span (not . null . third) \$ iterate (step xs) \$ start xs
78. -------------------------------------------------
79. -- test code
80. -------------------------------------------------
81.
82. check :: [Pt] -> Pt -> Bool
83. check xs p = costAt xs p <= minimum (map (costAt xs) (cand p dir0))
84.
85. prop_opt :: [Pt] -> Bool
86. prop_opt xs = let (p,c,_) = opt xs
87.               in check xs p
88.
89. rollDice :: IO Int
90. rollDice = getStdRandom random
91.
92. randomPts :: Int -> IO [Pt]
93. randomPts n = do rollDice
94.                  gen <- getStdGen
95.                  return \$ unGen (vectorOf n arbitrary) gen 1000
96.
97. main = do xs <- randomPts 100000
98.           print \$ optDebug xs
99.
100. sample0,sample1,sample2 :: [Pt]
101. sample0 = [(0,0)]
102. sample1 = [(0,0),(1,1)]
103. sample2 = [(0,2),(1,2),(2,2)
104.           ,      (1,1)
105.           ,            (2,0) ]
106.
107. sample3 = [(0,3)
108.           ,(0,2),(1,2)
109.           ,(0,1),(1,1),(2,1)
110.           ,(0,0),(1,0),(2,0),(3,0)]
111.
112.
113. sample4 = [(0,3)
114.           ,(0,2),(1,2)
115.           ,(0,1),(1,1),(2,1)
116.           ,(0,0),(1,0),(2,0),(3,0)]
117.
118. sample5 = [ (-3, 0), (-2, 0), (-1, 0), (0, 0), (10, 0), (50, 0) ]
RAW Paste Data
Top