Solutions to Problem Set 6 ========================== Written by Paul Hudak in literate Haskell style. October 23, 2004 > module PS6 where > import Fal > import Picture > import SOEGraphics 1. Exercise 14.6 in SOE. "Consider the problem of symbolically manipulating polynomials in a single variable, such as: 1 + 2x^2 - 4x^3 + 3x^5 with the assumption that all polynomials contain an infinite number of terms (ones we normally think of as finite simply have zeros for the higher-order coefficients). So let's represent such polynomials by an infinite list of floating-point coefficients: type Poly = [Float] For example, the above polynomial can be represented by: pn :: Poly pn = 1 : 0 : 2 : (-4) : 0 : 3 : repeat 0 There are several things we might wish to do with polynomials. One is multiply them by a constant; here's a function "scale" that will do just that: scale :: Float -> Poly -> Poly scale a = map (*a) Your job is to provide the following additional functions over polynomials: addPoly :: Poly -> Poly -> Poly is a function that takes two polynomials and returns their sum. subPoly :: Poly -> Poly -> Poly is a function that takes two polynomials and returns their difference. mulPoly :: Poly -> Poly -> Poly is a function that takes two polynomials and returns their product. divPoly :: Poly -> Poly -> Poly is a function that takes two polynomials and returns their quotient. The first two of these -- addPoly and subPoly -- are easy to define. For the other two, it might be helpful to review some basic algebra. Consider first multiplying two polynomials: [ see text ] This derivation should serve as a strong hint for developing a definition of mulPoly. Similarly, by a derivation similar to the above, we can show that: [ see text ] which should help you to define divPoly." Solution: > type Poly = [Float] > > scale :: Float -> Poly -> Poly > scale a = map (*a) > > addPoly :: Poly -> Poly -> Poly > addPoly = zipWith (+) > > subPoly :: Poly -> Poly -> Poly > subPoly = zipWith (-) > > mulPoly :: Poly -> Poly -> Poly > mulPoly (a:as) bs = > addPoly (scale a bs) (0 : mulPoly as bs) > > divPoly :: Poly -> Poly -> Poly > divPoly (a:as) (b:bs) = > if (a==0) && (b==0) then divPoly as bs > else let c = a/b > in c : divPoly (subPoly as (scale c bs)) (b:bs) For convenience: > poly :: [Float] -> Poly > poly xs = xs ++ zeros > > zeros :: Poly > zeros = repeat 0 The following tests are based on: (x+1)*(x+2) = x^2 + 3x + 2 > pn1,pn2 :: Poly > pn1 = poly [1,1] > pn2 = poly [2,1] > pn3 = poly [2,3,1] > > testAdd,testSub,testMul,testDiv :: Poly > testAdd = take 10 (addPoly pn3 pn2) > testSub = take 10 (subPoly pn1 pn3) > testMul = take 10 (mulPoly pn1 pn2) > testDiv = take 10 (divPoly pn3 pn1) 2. Exercise 14.7 in SOE. "Recall from first-grade math that: 1 / (1-x-x^2) = 1 + x + 2x^2 + 3x^3 + 5x^4 + 8x^5 + ... Use this result to write the world's most convoluted Fibonacci sequence generator, and check its correctness by "take"ing the first 10 elements." Solution: > fibs :: [Integer] > fibs = map round (divPoly (poly [1]) (poly [1,-1,-1])) For testing: > testFib :: [Integer] > testFib = take 20 fibs 2. Exercise 15.2 in SOE. "Simulate a bouncing ball under the influence of gravity within a four-sided box, and add `reciprocity' to the ball. That is, when the ball hits a wall it should lose a bit of its energy, and thus should gradually slow down until it is sitting at the bottom of the box." Solution: > bouncingBall :: Float -> -- initial x velocity > Float -> -- initial y velocity > Float -> -- initial x position > Float -> -- initial y position > Float -> -- gravity > Behavior Picture > bouncingBall xVel0 yVel0 xPos0 yPos0 g = > let xPos = lift0 xPos0 + integral xVel > xVel = xVel0 `stepAccum` xBounce ->> negate.(*0.8) > xBounce = when (xPos >* 2 ||* xPos <* -2) > yPos = lift0 yPos0 + integral yVel > yVel = (lift0 yVel0 + integral (lift0 g)) `switch` > (yBounce `snapshot_` yVel =>> \v-> > 0.8 * (- lift0 v) + integral (lift0 g)) > yBounce = when (yPos >* 2 ||* yPos <* -2) > in paint yellow (translate (xPos, yPos) (ell 0.2 0.2)) > > ballInABox :: Behavior Picture > ballInABox = bouncingBall 4 8 0 0 (-4) `over` > paint black (rec 4.4 4.4) `over` > paint red (rec 4.5 4.5) For testing: > testBB :: IO () > testBB = test ballInABox 4. Define a new FAL primitive called "derivative" that is the dual of integral: i.e., it differentiates its time-varying behavior instead of integrating it. Test it in some interesting way involving graphics. Solution: > derivative :: Behavior Float -> Behavior Float > derivative (Behavior fb) > = Behavior (\uts@(us,t:ts) -> let v:vs = fb uts > in 0 : loop vs ts v t 0) > where loop (v1:vs) (t1:ts) v0 t0 d0 > = if t1 == t0 > then d0 : loop vs ts v0 t0 d0 > else let d = (v1-v0) / (t1-t0) > in d : loop vs ts v1 t1 d One simple test is to compare these two pulsating balls: > t1 = test (paint red (ell (derivative (sin time)) > (derivative (cos time))) ) > > t2 = test (paint red (ell (sin time) > (cos time)) ) Here's another test, using an idea from Kevin Yip: Compute the speed of the mouse: > mSpe :: Behavior Float > mSpe = let sx = derivative (fst mouse) > sy = derivative (snd mouse) > in sqrt (sx*sx + sy*sy) and its acceleration: > mAcc :: Behavior Float > mAcc = abs (derivative mSpe) Now track the mouse x- and y-positions, velocity, and acceleration with "status bars": > mouseProp :: Behavior Picture > mouseProp = > let w = 0.5 > in bar w (fst mouse) (-0.75, 0) red `over` > bar w (snd mouse) (-0.25, 0) yellow `over` > bar w (mSpe / 10) ( 0.25, 0) green `over` > bar w (mAcc / 250) ( 0.75, 0) blue > > type CoordinateB = (Behavior Float, Behavior Float) > > bar :: Behavior Float -> -- Width > Behavior Float -> -- Height > CoordinateB -> -- Location > Behavior Color -> -- Color > Behavior Picture -- The bar > bar w h (x,y) c = paint c (translate (x,y+h/2) (rec w h)) > > t0 = test mouseProp