
Hi, The Graham Scan function I wrote, looks like running well. But when I put it in QuickCheck, it just failed in some case. Anyone can show me some clues about the problem? Thanks. When I test it in ghci with some example, it returns the right result. *Main> let xs = [Point {x = 1.0, y = 1.0},Point {x = 0.0, y = 4.0},Point {x = 0.0, y = 6.0},Point {x = 3.0, y = 5.0},Point {x = 4.0, y = 4.0},Point {x = 4.0, y = 1.0},Point {x = 3.0, y = 3.0},Point {x = 2.0, y = 2.0},Point {x = 5.0, y = 5.0}] *Main> grahamScan xs [Point {x = 1.0, y = 1.0},Point {x = 4.0, y = 1.0},Point {x = 5.0, y = 5.0},Point {x = 0.0, y = 6.0},Point {x = 0.0, y = 4.0}] *Main> grahamScan it [Point {x = 1.0, y = 1.0},Point {x = 4.0, y = 1.0},Point {x = 5.0, y = 5.0},Point {x = 0.0, y = 6.0},Point {x = 0.0, y = 4.0}] However, QuickCheck find some points which can fail it. Could it be a data type overflow problem? prop_scan_idempotent xs = not (null xs) ==> (grahamScan . grahamScan) xs == grahamScan xs *Main> quickCheck prop_scan_idempotent *** Failed! Falsifiable (after 13 tests and 4 shrinks): [Point {x = -6.29996952110807, y = -91.37172300100718},Point {x = 9.353314917365527, y = 64.35532141764591},Point {x = -23.826685687218355, y = 60.32049750442556},Point {x = -1.4281411275074123, y = 31.54197550020998},Point {x = -2.911218918860731, y = 15.564623822256719}] === code === module GrahamScan (grahamScan, Point(..)) where import Data.List import Data.Ratio data Point = Point { x :: Double, y :: Double } deriving (Eq, Show) instance Ord Point where compare (Point x1 y1) (Point x2 y2) = compare (y1, x1) (y2, x2) data Vector = Vector { start :: Point, end :: Point } deriving (Eq) cosine :: Vector -> Double cosine (Vector (Point x1 y1) (Point x2 y2)) = (x2 - x1) / ((x2 - x1) ^ 2 + (y2 - y1) ^ 2) instance Ord Vector where compare a b = compare (f a) (f b) where f = negate . cosine sort' :: [Point] -> [Point] sort' xs = pivot : fmap end sortedVectors where sortedVectors = sort . fmap (Vector pivot) . delete pivot $ xs pivot = minimum xs counterClockwise :: Point -> Point -> Point -> Bool counterClockwise (Point x1 y1) (Point x2 y2) (Point x3 y3) = (x2 - x1) * (y3 - y1) > (y2 - y1) * (x3 - x1) scan :: [Point] -> [Point] scan (p1 : p2 : p3 : xs) | counterClockwise p1 p2 p3 = p1 : scan (p2 : p3 : xs) | otherwise = scan (p1 : p3 : xs) scan xs = xs grahamScan :: [Point] -> [Point] grahamScan = scan . sort' . nub === code === Best regards, Zhi-Qiang Lei zhiqiang.lei@gmail.com

Hi, I was just looking through the 'Monad Transformers' chapter in Real World Haskell. They are using the "reader" monad to illustrate the transformer structure but I fell off at the first bend when I saw the following: class (Monad m) => MonadReader r m | m -> r where ask :: m r local :: (r -> r) -> m a -> m a Could someone explain the use of a guard here / how to read this with the "| m -> r" ? I haven't come across this usage before (as far as I have noticed :-) and the meaning hasn't jumped out at me yet... Thanks in advance. Henry

On Sun, Jan 8, 2012 at 10:29 AM, Henry Lockyer
Hi, I was just looking through the 'Monad Transformers' chapter in Real World Haskell. They are using the "reader" monad to illustrate the transformer structure but I fell off at the first bend when I saw the following:
class (Monad m) => MonadReader r m | m -> r where ask :: m r local :: (r -> r) -> m a -> m a
Could someone explain the use of a guard here / how to read this with the "| m -> r" ? I haven't come across this usage before (as far as I have noticed :-) and the meaning hasn't jumped out at me yet...
It's not a "guard", it's a functional dependency : "m -> r" tells the compiler that for any m, r is uniquely determined. That is if you have the monad "ReaderT Int Identity" for m, it is clear that "Int" is the only possibility for r. This is necessary for type inference to process in more case (often the type of the monad is fixed by the context, but not the type of r, thanks to the FD, the compiler can confidently use the instance it found for m). Note that this solution never really satisfied the Haskell users/developers since it is more from the logic paradigm (like Prolog) than the functional paradigm, so since two or three years now, this tends to be replaced by a new solution, more functional in style, called type family, which would read like that :
class (Monad m) => MonadReader m where type RC :: * -> * -- Reader content ask :: m (RC m) local :: (RC m -> RC m) -> m a -> m a
where RC is like a "function on type". -- Jedaï

OK - thanks (both)! On 8 Jan 2012, at 11:44, Chaddaï Fouché wrote:
On Sun, Jan 8, 2012 at 10:29 AM, Henry Lockyer
wrote: Hi, I was just looking through the 'Monad Transformers' chapter in Real World Haskell. They are using the "reader" monad to illustrate the transformer structure but I fell off at the first bend when I saw the following:
class (Monad m) => MonadReader r m | m -> r where ask :: m r local :: (r -> r) -> m a -> m a
Could someone explain the use of a guard here / how to read this with the "| m -> r" ? I haven't come across this usage before (as far as I have noticed :-) and the meaning hasn't jumped out at me yet...
It's not a "guard", it's a functional dependency : "m -> r" tells the compiler that for any m, r is uniquely determined. That is if you have the monad "ReaderT Int Identity" for m, it is clear that "Int" is the only possibility for r. This is necessary for type inference to process in more case (often the type of the monad is fixed by the context, but not the type of r, thanks to the FD, the compiler can confidently use the instance it found for m).
Note that this solution never really satisfied the Haskell users/developers since it is more from the logic paradigm (like Prolog) than the functional paradigm, so since two or three years now, this tends to be replaced by a new solution, more functional in style, called type family, which would read like that :
class (Monad m) => MonadReader m where type RC :: * -> * -- Reader content ask :: m (RC m) local :: (RC m -> RC m) -> m a -> m a
where RC is like a "function on type".
-- Jedaï

While this won't solve your problem at all, you may want to take a look at [1]. Cheers! [1] http://hackage.haskell.org/packages/archive/Hipmunk/5.2.0.6/doc/html/src/Phy... -- Felipe.

Did you actually try running grahamScan on the counterexample to see what happens? *GrahamScan> quickCheck prop_scan_idempotent *** Failed! Falsifiable (after 10 tests and 5 shrinks): [Point {x = -24.059102740955122, y = -21.293809017449384},Point {x = -15.007588300013, y = -10.510812985305158},Point {x = 4.1243142492942395, y = -6.124011867063609},Point {x = -14.22151555204262, y = -15.374749757396115}] *GrahamScan> let ps = [Point {x = -24.059102740955122, y = -21.293809017449384},Point {x = -15.007588300013, y = -10.510812985305158},Point {x = 4.1243142492942395, y = -6.124011867063609},Point {x = -14.22151555204262, y = -15.374749757396115}] *GrahamScan> grahamScan ps [Point {x = -24.059102740955122, y = -21.293809017449384},Point {x = -14.22151555204262, y = -15.374749757396115},Point {x = 4.1243142492942395, y = -6.124011867063609}] *GrahamScan> (grahamScan . grahamScan) ps [Point {x = -24.059102740955122, y = -21.293809017449384},Point {x = 4.1243142492942395, y = -6.124011867063609}] It seems like each time 'grahamScan' is run on this list of points, one point disappears from the end of the list. I think the problem is your 'scan' function, which can delete one of the points even when there are only three points left. -Brent On Sun, Jan 08, 2012 at 03:31:44PM +0800, Zhi-Qiang Lei wrote:
Hi,
The Graham Scan function I wrote, looks like running well. But when I put it in QuickCheck, it just failed in some case. Anyone can show me some clues about the problem? Thanks.
When I test it in ghci with some example, it returns the right result. *Main> let xs = [Point {x = 1.0, y = 1.0},Point {x = 0.0, y = 4.0},Point {x = 0.0, y = 6.0},Point {x = 3.0, y = 5.0},Point {x = 4.0, y = 4.0},Point {x = 4.0, y = 1.0},Point {x = 3.0, y = 3.0},Point {x = 2.0, y = 2.0},Point {x = 5.0, y = 5.0}] *Main> grahamScan xs [Point {x = 1.0, y = 1.0},Point {x = 4.0, y = 1.0},Point {x = 5.0, y = 5.0},Point {x = 0.0, y = 6.0},Point {x = 0.0, y = 4.0}] *Main> grahamScan it [Point {x = 1.0, y = 1.0},Point {x = 4.0, y = 1.0},Point {x = 5.0, y = 5.0},Point {x = 0.0, y = 6.0},Point {x = 0.0, y = 4.0}]
However, QuickCheck find some points which can fail it. Could it be a data type overflow problem?
prop_scan_idempotent xs = not (null xs) ==> (grahamScan . grahamScan) xs == grahamScan xs
*Main> quickCheck prop_scan_idempotent *** Failed! Falsifiable (after 13 tests and 4 shrinks): [Point {x = -6.29996952110807, y = -91.37172300100718},Point {x = 9.353314917365527, y = 64.35532141764591},Point {x = -23.826685687218355, y = 60.32049750442556},Point {x = -1.4281411275074123, y = 31.54197550020998},Point {x = -2.911218918860731, y = 15.564623822256719}]
=== code === module GrahamScan (grahamScan, Point(..)) where
import Data.List import Data.Ratio
data Point = Point { x :: Double, y :: Double } deriving (Eq, Show)
instance Ord Point where compare (Point x1 y1) (Point x2 y2) = compare (y1, x1) (y2, x2)
data Vector = Vector { start :: Point, end :: Point } deriving (Eq)
cosine :: Vector -> Double cosine (Vector (Point x1 y1) (Point x2 y2)) = (x2 - x1) / ((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
instance Ord Vector where compare a b = compare (f a) (f b) where f = negate . cosine
sort' :: [Point] -> [Point] sort' xs = pivot : fmap end sortedVectors where sortedVectors = sort . fmap (Vector pivot) . delete pivot $ xs pivot = minimum xs
counterClockwise :: Point -> Point -> Point -> Bool counterClockwise (Point x1 y1) (Point x2 y2) (Point x3 y3) = (x2 - x1) * (y3 - y1) > (y2 - y1) * (x3 - x1)
scan :: [Point] -> [Point] scan (p1 : p2 : p3 : xs) | counterClockwise p1 p2 p3 = p1 : scan (p2 : p3 : xs) | otherwise = scan (p1 : p3 : xs) scan xs = xs
grahamScan :: [Point] -> [Point] grahamScan = scan . sort' . nub === code ===
Best regards, Zhi-Qiang Lei zhiqiang.lei@gmail.com
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

The 'scan' is flawed. A counterwise angle formed by the first three points does not guarantee p1's existence in the hull. 2012-1-8 下午3:32 於 "Zhi-Qiang Lei"寫道: > > Hi, > > The Graham Scan function I wrote, looks like running well. But when I put it in QuickCheck, it just failed in some case. Anyone can show me some clues about the problem? Thanks. > > When I test it in ghci with some example, it returns the right result. > *Main> let xs = [Point {x = 1.0, y = 1.0},Point {x = 0.0, y = 4.0},Point {x = 0.0, y = 6.0},Point {x = 3.0, y = 5.0},Point {x = 4.0, y = 4.0},Point {x = 4.0, y = 1.0},Point {x = 3.0, y = 3.0},Point {x = 2.0, y = 2.0},Point {x = 5.0, y = 5.0}] > *Main> grahamScan xs > [Point {x = 1.0, y = 1.0},Point {x = 4.0, y = 1.0},Point {x = 5.0, y = 5.0},Point {x = 0.0, y = 6.0},Point {x = 0.0, y = 4.0}] > *Main> grahamScan it > [Point {x = 1.0, y = 1.0},Point {x = 4.0, y = 1.0},Point {x = 5.0, y = 5.0},Point {x = 0.0, y = 6.0},Point {x = 0.0, y = 4.0}] > > However, QuickCheck find some points which can fail it. Could it be a data type overflow problem? > > prop_scan_idempotent xs = not (null xs) ==> (grahamScan . grahamScan) xs == grahamScan xs > > *Main> quickCheck prop_scan_idempotent > *** Failed! Falsifiable (after 13 tests and 4 shrinks): > [Point {x = -6.29996952110807, y = -91.37172300100718},Point {x = 9.353314917365527, y = 64.35532141764591},Point {x = -23.826685687218355, y = 60.32049750442556},Point {x = -1.4281411275074123, y = 31.54197550020998},Point {x = -2.911218918860731, y = 15.564623822256719}] > > === code === > module GrahamScan (grahamScan, Point(..)) > where > > import Data.List > import Data.Ratio > > data Point = Point { > x :: Double, > y :: Double > } deriving (Eq, Show) > > instance Ord Point where > compare (Point x1 y1) (Point x2 y2) = compare (y1, x1) (y2, x2) > > data Vector = Vector { > start :: Point, > end :: Point > } deriving (Eq) > > cosine :: Vector -> Double > cosine (Vector (Point x1 y1) (Point x2 y2)) = (x2 - x1) / ((x2 - x1) ^ 2 + (y2 - y1) ^ 2) > > instance Ord Vector where > compare a b = compare (f a) (f b) where > f = negate . cosine > > sort' :: [Point] -> [Point] > sort' xs = pivot : fmap end sortedVectors where > sortedVectors = sort . fmap (Vector pivot) . delete pivot $ xs > pivot = minimum xs > > counterClockwise :: Point -> Point -> Point -> Bool > counterClockwise (Point x1 y1) (Point x2 y2) (Point x3 y3) = (x2 - x1) * (y3 - y1) > (y2 - y1) * (x3 - x1) > > scan :: [Point] -> [Point] > scan (p1 : p2 : p3 : xs) > | counterClockwise p1 p2 p3 = p1 : scan (p2 : p3 : xs) > | otherwise = scan (p1 : p3 : xs) > scan xs = xs > > grahamScan :: [Point] -> [Point] > grahamScan = scan . sort' . nub > === code === > > > Best regards, > Zhi-Qiang Lei > zhiqiang.lei@gmail.com > > > _______________________________________________ > Beginners mailing list > Beginners@haskell.org > http://www.haskell.org/mailman/listinfo/beginners
participants (6)
-
Brent Yorgey
-
Chaddaï Fouché
-
Felipe Almeida Lessa
-
Henry Lockyer
-
Ray Song
-
Zhi-Qiang Lei