Haskell中的旋转卡尺

Question

我想从Wikipedia开始在Haskell中实现旋转卡尺。与维基百科唯一的区别是，我正在计算凸多边形的最大宽度的平方而不是最小宽度来测试旋转卡尺的实现。看来这个实现是不正确的，因为我得到了最后一个测试用例TFOSS而不是98.请问有人可以告诉我这个实现有什么问题。如果出现缩进问题，我已将代码发布在ideone上。
谢谢

import Data.List 
import Data.Array 
import Data.Maybe 

data Point a = P a a deriving (Show , Ord , Eq) 
data Vector a = V a a deriving (Show , Ord , Eq) 
data Turn = S | L | R deriving (Show , Eq , Ord , Enum ) 


--start of convex hull 

compPoint :: (Num a , Ord a) => Point a -> Point a -> Ordering 
compPoint (P x1 y1) (P x2 y2) 
    | compare x1 x2 == EQ = compare y1 y2 
    | otherwise = compare x1 x2 

sortPoint :: (Num a , Ord a) => [ Point a ] -> [ Point a ] 
sortPoint xs = sortBy (\ x y -> compPoint x y) xs 

findTurn :: (Num a , Ord a , Eq a) => Point a -> Point a -> Point a -> Turn 
findTurn (P x0 y0) (P x1 y1) (P x2 y2) 
| (y1 - y0) * (x2- x0) < (y2 - y0) * (x1 - x0) = L 
| (y1 - y0) * (x2- x0) == (y2 - y0) * (x1 - x0) = S 
| otherwise = R 

hullComputation :: (Num a , Ord a) => [ Point a ] -> [ Point a ] -> [ Point a ] 
hullComputation [x] (z:ys) = hullComputation [z,x] ys 
hullComputation xs [] = xs 
hullComputation (y : x : xs) (z : ys) 
    | findTurn x y z == R = hullComputation (x:xs) (z : ys) 
    | findTurn x y z == S = hullComputation (x:xs) (z : ys) 
    | otherwise = hullComputation (z : y : x : xs) ys 

convexHull :: (Num a , Ord a) => [ Point a ] -> [ Point a ] 
convexHull [] = [] 
convexHull [ p ] = [ p ] 
convexHull [ p1 , p2 ] = [ p1 , p2 ] 
convexHull xs = final where 
    txs = sortPoint xs 
    (x : y : ys ) = txs 
     lhull = hullComputation [y,x] ys 
    (x': y' : xs') = reverse txs 
    uhull = hullComputation [ y' , x' ] xs' 
    final = (init lhull) ++ (init uhull) 

--end of convex hull 


--dot product for getting angle 
angVectors :: (Num a , Ord a , Floating a) => Vector a -> Vector a -> a 
angVectors (V ax ay) (V bx by) = theta where 
    dot = ax * bx + ay * by 
    a = sqrt $ ax^2 + ay^2 
    b = sqrt $ bx^2 + by^2 
    theta = acos $ dot/a/b 

--start of rotating caliper part http://en.wikipedia.org/wiki/Rotating_calipers 

--rotate the vector x y by angle t 
rotVector :: (Num a , Ord a , Floating a) => Vector a -> a -> Vector a 
rotVector (V x y) t = V (x * cos t - y * sin t) (x * sin t + y * cos t) 

--square of dist between two points 

distPoints :: (Num a , Ord a , Floating a) => Point a -> Point a -> a 
distPoints (P x1 y1) (P x2 y2) = (x1 - x2)^2 + (y1 - y2)^2 

--rotating caliipers 

rotCal :: (Num a , Ord a , Floating a) => [ Point a ] -> a -> Int -> Int -> Vector a -> Vector a -> a -> Int -> a 
rotCal arr ang pa pb ca@(V ax ay) cb@(V bx by) dia n 
    | ang > pi = dia 
    | otherwise = rotCal arr ang' pa' pb' ca' cb' dia' n where 
    P x1 y1 = arr !! pa 
    P x2 y2 = arr !! (mod (pa + 1) n) 
    P x3 y3 = arr !! pb 
    P x4 y4 = arr !! (mod (pb + 1) n) 
    t1 = angVectors ca (V (x2 - x1) (y2 - y1)) 
    t2 = angVectors cb (V (x4 - x3) (y4 - y3)) 
    ca' = rotVector ca $ min t1 t2 
    cb' = rotVector cb $ min t1 t2 
    ang' = ang + min t1 t2 
    pa' = if t1 < t2 then mod (pa + 1) n else pa 
    pb' = if t1 >= t2 then mod (pb + 1) n else pb 
    dia' = max dia $ distPoints (arr !! pa') (arr !! pb') 
    --dia' = max dia $ if t1 < t2 then distPoints (arr !! pa') (arr !! pb) else  distPoints (arr !! pb') (arr !! pa) 


solve :: (Num a , Ord a , Floating a) => [ Point a ] -> String 
solve [] = "0" 
solve [ p ] = "0" 
solve [ p1 , p2 ] = show $ distPoints p1 p2 
solve [ p1 , p2 , p3 ] = show $ max (distPoints p1 p2) $ max (distPoints p2 p3) (distPoints p3 p1) 
solve arr = show $ rotCal arr' 0 pa pb (V 1 0) (V (-1) 0) dia n where 
     arr' = convexHull arr 
     y1 = minimumBy (\(P _ y1) (P _ y2) -> compare y1 y2) arr' 
     y2 = maximumBy (\(P _ y1) (P _ y2) -> compare y1 y2) arr' 
     pa = fromJust . findIndex (\ t -> t == y1) $ arr' 
     pb = fromJust . findIndex (\ t -> t == y2) $ arr' 
     dia = distPoints (arr' !! pa) (arr' !! pb) 
     n = length arr' 

--end of rotating caliper 

--spoj code for testing 
final :: (Num a , Ord a , Floating a) => [ Point a ] -> String 
final [] = "0" 
final [ p ] = "0" 
final [ p1 , p2 ] = show $ distPoints p1 p2 
final [ p1 , p2 , p3 ] = show $ max (distPoints p1 p2) $ max (distPoints p2 p3) (distPoints p3 p1) 
final arr = solve . convexHull $ arr 

format :: (Num a , Ord a , Floating a) => [ Int ] -> [ [ Point a ]] 
format [] = [] 
format (x:xs) = t : format b where 
    (a , b) = splitAt (2 * x) xs 
    t = helpFormat a where 
     helpFormat [] = [] 
     helpFormat (x' : y' : xs') = (P (fromIntegral x') (fromIntegral y')) : helpFormat xs' 

readD :: String -> Int 
readD = read 


main = interact $ unlines . map final . format . concat . (map . map) readD . map words . tail . lines 

--end of spoj code 

Answer 1

我不想弄清楚错误在代码中的位置。

我打算告诉你一些简单的调试技巧。

1. 将代码加载到ghci中，交互式运行代码并检查结果是否如您期望的那样。

   $ ghci 
   ghci> :load your-program.hs 
   ghci> compPoint (P 0 0) (P 0 0) 
   EQ 
   ghci> 
   

   尝试调用compPoint使用不同的参数，直到您满意是正确的。然后转到下一个功能。

2. 使用Test.QuickCheck。

   这实质上是自动执行前面的方法。

   ghci> :load your-program.hs 
   ghci> :m +Test.QuickCheck 
   ghci Test.QuickCheck> let prop_equalPointsAreEqual x y = EQ == compPoint (P x y) (P x y) 
   ghci Test.QuickCheck> quickCheck prop_equalPointsAreEqual 
   

   ...并测试更复杂的属性，直到您满意compPoint是正确的。然后转到下一个功能。

   Google提供QuickCheck教程。

3. 如果您希望打印出中间值作为调试手段，请使用Debug.Trace中的trace和/或traceShow。

N.B.我的例子从测试低层功能开始，并开始工作，但您可能更喜欢从高层开始并逐渐减少。

Answer 2

我不知道什么是你的代码错误做，但我做了一点简单。

import Data.List 
import Data.Array 
import Data.Maybe 
import Data.Monoid 

data Point a = P a a deriving (Show, Ord, Eq) 
--data Vector a = V a a deriving (Show, Ord, Eq) 
--data Turn = S | L | R deriving (Show, Eq, Ord, Enum) 
-- L is LT, S is EQ, R is GT 

-- The is really the same as just compare on Point 
compPoint :: (Ord a) => Point a -> Point a -> Ordering 
compPoint (P x1 y1) (P x2 y2) = compare x1 x2 `mappend` compare y1 y2 

sortPoint :: (Ord a) => [Point a] -> [Point a] 
sortPoint = sortBy compPoint 
-- simpler sortPoint = sort 

findTurn :: (Num a, Ord a) => Point a -> Point a -> Point a -> Ordering 
findTurn (P x0 y0) (P x1 y1) (P x2 y2) = 
    compare ((y1 - y0) * (x2 - x0)) ((y2 - y0) * (x1 - x0)) 

hullComputation :: (Num a, Ord a) => [Point a] -> [Point a] -> [Point a] 
hullComputation [x] (z:ys) = hullComputation [z,x] ys 
hullComputation xs [] = xs 
hullComputation (y : x : xs) (z : ys) = 
    case findTurn x y z of 
    GT -> hullComputation (x : xs) (z : ys) 
    EQ -> hullComputation (x : xs) (z : ys) -- same as above 
    LT -> hullComputation (z : y : x : xs) ys