Haskell 中的旋转卡尺

Question

我正在尝试从 Wikipedia 在 Haskell 中实现旋转卡尺。与维基百科的唯一区别是，我计算凸多边形最大宽度的平方而不是最小宽度来测试旋转卡尺的实现。看来这个实现不正确，因为我在 TFOSS 的最后一个测试用例中得到了 97 而不是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> :加载你的程序.hs
   ghci>补偿点 (P 0 0) (P 0 0)
   情商
   ghci>

   尝试使用不同的参数调用compPoint，直到您确信它是正确的。然后转到下一个函数。

2. 使用 Test.QuickCheck。

   这本质上是使之前的方法自动化。

   <前><代码>ghci> :加载你的程序.hs
   ghci> :m +测试.QuickCheck
   ghci 测试.QuickCheck>让 prop_equalPointsAreEqual xy = EQ == compPoint (P xy) (P xy)
   ghci 测试.QuickCheck>快速检查 prop_equalPointsAreEqual

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

   Google 获取 QuickCheck 教程。

3. 如果您更喜欢打印中间值作为调试方式，请使用 trace 和/或 traceShow。 org/ghc/docs/latest/html/libraries/base/Debug-Trace.html" rel="nofollow">Debug.Trace。

注意：我的示例从测试较低级别的功能开始并向上进行，但您可能更喜欢从较高级别开始并向下进行。

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