PointExperiment.hs

-- Test for type classes

class Eq a => Point a where
    radian :: a -> Float
    coordinates :: Float -> Float -> a
    x :: a -> Float
    y :: a -> Float

    -- Minimal complete definition: radian, coordinates, x, and y
    (+~) :: Point b => a -> b -> a
    a +~ b = coordinates (x a + x b) (y a + y b)
    degree :: a -> Float
    degree p = 360 / (2 * pi) * radian p

data CartesianPoint =  Cartesian Float Float deriving Show

instance Eq CartesianPoint where
    Cartesian x y == Cartesian x' y' = x == x' && y == y'

instance Point CartesianPoint where
    coordinates x y = Cartesian x y
    x (Cartesian x' y') = x'
    y (Cartesian x' y') = y'
    radian (Cartesian x'  y') = atan2 y' x'

data PolarPoint =  Polar Float Float deriving (Show, Eq)

instance Point PolarPoint where
    coordinates x y = Polar (sqrt (x * x + y * y)) (atan2 y x)
    x (Polar r theta) = r * cos theta
    y (Polar r theta) = r * sin theta
    radian (Polar r theta) = theta

-- Cartesian 1 2 +~ Cartesian 3 4 == Cartesian 4 6
-- degree (Cartesian 1 1) == 45
-- (coordinates 1 2 :: PolarPoint) +~ (coordinates 3 4 :: PolarPoint) == (coordinates 4 6 :: PolarPoint)
-- degree (Polar 1 (pi / 4)) == 45
-- x (Polar 10 pi) == -10

PointExperiment.st

Object subclass: #GenericPoint
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PointExperiment'!

!GenericPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 10:52'!
coordinates: x with: y
	self subclassResponsibility! !

!GenericPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 10:54'!
degree
	^ 360 / (2 * Float pi) * self radian! !

!GenericPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 11:06'!
hash
	^(self x hash hashMultiply + self y hash) hashMultiply! !

!GenericPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 10:52'!
radian
	self subclassResponsibility! !

!GenericPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 10:52'!
x
	self subclassResponsibility! !

!GenericPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 10:52'!
y
	self subclassResponsibility! !

!GenericPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 11:14'!
+~ p
	^ self coordinates: self x + p x with: self y + p y! !

!GenericPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 11:04'!
= p 
	^ self x = p x and: [self y = p y]! !


GenericPoint subclass: #CartesianPoint
	instanceVariableNames: 'x y'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PointExperiment'!

!CartesianPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 11:13'!
coordinates: x0 with: y0
	^ self class new x: x0 y: y0! !

!CartesianPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 11:03'!
radian
	^ y arcTan: x! !

!CartesianPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 11:03'!
x
	^ x! !

!CartesianPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 11:04'!
y
	^ y! !


!CartesianPoint methodsFor: 'initialize' stamp: 'tak 6/22/2009 11:12'!
x: x0 y: y0
	x := x0.
	y := y0.! !


TestCase subclass: #PointExperienceTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PointExperiment'!

!PointExperienceTest methodsFor: 'as yet unclassified' stamp: 'tak 6/22/2009 11:14'!
testCartesianPoint
	"self debug: #testCartesianPoint"
	self assert: (CartesianPoint new x: 1 y: 2) +~
		(CartesianPoint new x: 3 y: 4) = 
		(CartesianPoint new x: 4 y: 6).
	self assert: (CartesianPoint new x: 1 y: 1) degree = 45.! !

!PointExperienceTest methodsFor: 'as yet unclassified' stamp: 'tak 6/22/2009 14:18'!
testPolarPoint
	"self debug: #testPolarPoint"
	self assert: (PolarPoint new coordinates: 1 with: 2) +~
		(PolarPoint new coordinates: 3 with: 4) = 
		(PolarPoint new coordinates: 4 with: 6).
	self assert: (PolarPoint new r: 1 theta: Float pi / 4) degree = 45.
	self assert: (PolarPoint new r: 10 theta: Float pi) x = -10! !


GenericPoint subclass: #PolarPoint
	instanceVariableNames: 'r theta'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PointExperiment'!

!PolarPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 14:09'!
coordinates: x with: y 
	^ self class new
		r: (x * x + (y * y)) sqrt
		theta: (y arcTan: x)! !

!PolarPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 11:20'!
radian
	^ theta! !

!PolarPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 11:20'!
x
	^ r * theta cos! !

!PolarPoint methodsFor: 'accessing' stamp: 'tak 6/22/2009 11:20'!
y
	^ r * theta sin! !


!PolarPoint methodsFor: 'initialize' stamp: 'tak 6/22/2009 11:18'!
r: distance theta: radian
	r := distance.
	theta := radian.! !