Solutions to Problem Set 5
==========================

Written by Paul Hudak in literate Haskell style.
October 17, 2004

> module PS5 where
>
> import Animation
> import Picture

1. Exercise 12.2 in SOE.
       
"Write out appropriate instance declarations for the Color type in the
classes Eq, Ord, and Enum."

(See p. 333 for a definition of the Enum class -- and note the default
methods!!)

Solution:

I will rename the Color data type and its constructors to avoid
clashing with the original version, for which the instances had been
derived:

> data Color' = Black' | Blue' | Green' | Cyan'
>             | Red' | Magenta' | Yellow' | White'
>      deriving Show

The Eq class is easy, requiring only the specification of (==):

> instance Eq Color' where
>   Black'   == Black'    =  True
>   Blue'    == Blue'     =  True
>   Green'   == Green'    =  True
>   Cyan'    == Cyan'     =  True
>   Red'     == Red'      =  True
>   Magenta' == Magenta'  =  True
>   Yellow'  == Yellow'   =  True
>   White'   == White'    =  True
>   _        == _         =  False

The Ord class has default methods for every operator, requiring at a
minimum the definition of "compare" or (<=).  I will choose specifying
the latter:

> instance Ord Color' where
>   c1 <= c2  =  colorToInt c1 <= colorToInt c2
>
> colorToInt Black'    =  0
> colorToInt Blue'     =  1
> colorToInt Green'    =  2
> colorToInt Cyan'     =  3
> colorToInt Red'      =  4
> colorToInt Magenta'  =  5
> colorToInt Yellow'   =  6
> colorToInt White'    =  7


Similarly, Enum has default methods for everything except toEnumm and
fromEnum, which need to be specified:

> instance Enum Color' where
>   fromEnum  =  colorToInt
>   toEnum 0  =  Black'  
>   toEnum 1  =  Blue'   
>   toEnum 2  =  Green'  
>   toEnum 3  =  Cyan'   
>   toEnum 4  =  Red'    
>   toEnum 5  =  Magenta'
>   toEnum 6  =  Yellow' 
>   toEnum 7  =  White'  
>   toEnum _  =  error "Index out of bounds for Color type."

However, the following note appears in the Standard Prelude concerning
the default methods:

  -- NOTE: these default methods only make sense for types
  --   that map injectively into Int using fromEnum
  --   and toEnum.

I believe that "injectively" should really be "BIjectively, but in
fact Color' does NOT map bijectively into Int, because it is a finite
enumeration.  Thus, although this works:

PS3> [Black' .. White']
[Black',Blue',Green',Cyan',Red',Magenta',Yellow',White']

this does not:

PS3> [Black' ..]
[Black',Blue',Green',Cyan',Red',Magenta',Yellow',White',
Program error: {instEnum_v7049_v7068 8}

To fix this requires additionally specifying different behaviors for
the methods that depend on infinite enumerations (specifically,
enumFrom and enumFromThen):

>   enumFrom x       =  map toEnum [fromEnum x .. 7]
>   enumFromThen x y =  map toEnum [fromEnum x, fromEnum y .. 7]

Now the above example works properly:

PS3> [Black' ..]
[Black',Blue',Green',Cyan',Red',Magenta',Yellow',White']


2. Exercise 13.1 in SOE.

"Create instances for Regions and Shapes in the class Combine.  Can you
think of a reasonable instance for strings?  How about floating-point
numbers?"

Also: Can you think of any useful laws that instances of class Combine
should obey?

Solution:

I will rename Combine to avoid conflict with existing instances.
Unfortunately, I cannot think of any reasonable instance of Shape in
the class Combine.

> class Combine' a where
>   empty' :: a
>   over'  :: a -> a -> a
>
> instance Combine' Region where
>   empty' = Empty
>   over'  = Union
>
> instance Combine' [Char] where
>   empty' = []
>   over'  = (++)
>
> instance Combine' Float where
>   empty' = 0
>   over'  = (+)

For example, in Hugs:

PS3> empty' `over'` empty' :: Region
Empty `Union` Empty
PS3> "hello " `over'` ("there" `over'` empty')
"hello there"
PS3> 1 `over'` empty' :: Float
1.0

Useful laws that Combine might obey:

empty `over` x  =  x
x `over` empty  =  x
x `over` (y `over` z)  ==  (x `over` y) `over` z

Strings and Floats obey these laws, although Region does not.  On the
other hand, the INTERPRETATION of Regions DOES satisfy these laws.

Note that I did not include commutativity:

x `over` y  =  y `over` x

since it violates the intuitive meaning of "over", and in fact the
above instances all violate commutativity (including the
interpretation of Regions) except for Float.


3. Exercise 13.2 in SOE.

"Make the planets example more realistic by doing the following:
a. Create two orbiting systems: one of a moon around a planet, the
other of the planet-moon system itself revolving around a sun.
b. Make the orbits elliptical.
c. Have the orbiting body move behind the other body during one-half
of the cycle, and in front during the other half (this is the
trickiest part).
d. Finally, have the orbiting body get larger as it approaches the
observer, and smaller as it gets farther away."

Note: Your solution should be modular.  In particular, it should be
easy to add more planets and/or planet-moon systems.  To do this
right, you will probably want to translate (and possibly scale)
Pictures and, more importantly, values of type Behavior Picture.  Your
grade will be based partially on how well your code is structured.
       
Solution:

The core of my solution is the function solarSys:

> solarSys ::
>      Behavior Picture         -- planet
>   -> Behavior Picture         -- moon
>   -> Behavior Float           -- orbit's x radius
>   -> Behavior Float           -- orbit's y radius
>   -> Behavior Float           -- orbit's period
>   -> Behavior Picture
> solarSys planet moon ox oy op =
>   let vt = 2*time*pi/op       -- virtual time
>       xp = ox * sin vt        -- moon's x position
>       yp = oy * cos vt        -- moon's y position
>       b  = cond (ox>*oy)      -- based on which orbit is larger,
>                 (cos vt)      --   choose a function to both scale
>                 (sin vt)      --   moon and control when it's behind
>       s  = (b+2)/2            -- moon's scaling factor
>       moon' = tran (xp,yp) (scal (s,s) moon)
>   in  cond (b>*0)                 -- if b is positive,
>            (moon' `over` planet)  --   moon is in front,
>            (planet `over` moon')  --   else it's behind

Notice the convention that if the orbit's x radius is greater than its
y radius, it is assumed that the orbit is oriented horizontally,
otherwise it is oriented vertically.  This affects both the scaling of
the moon and when it is in front or behind.

Also note the use of "tran" and "scal", which translate and scale,
respectively, values of type Behavior Picture.  They are defined
below.

The complete animation as requested in the assignment is main1:

> main1 = animateB "Solar System" $
>         let ss1 = let planet = ball red    0.3 
>                       moon   = ball yellow 0.1
>                   in solarSys planet moon 0.25 0.5 1.5
>             sun = ball blue 1.0
>         in solarSys sun ss1 1.5 0.75 5

An alterntive animation demonstrating the power os "solarSystem":

> main2 = animateB "Solar System" $
>         let ss1 = let planet = ball red    0.3 
>                       moon   = ball yellow 0.1
>                   in solarSys planet moon 0.25 0.5 1.5
>             ss2 = let planet = ball green  0.3 
>                       moon   = ball red    0.1
>                   in solarSys planet moon 0.5 0.25 2.0
>             sun = ball blue 1.0
>             ss3 = solarSys sun ss1 1.5 0.75 5
>         in solarSys ss3 ss2 0.75 1.5 4

Auxillary stuff:

> ball c r = reg c (shape (ell r r))
> 
> blue    = lift0 Blue
> green   = lift0 Green
> magenta = lift0 Magenta
>
> scale (Beh a1, Beh a2) (Beh r)
>        = Beh (\t -> Scale (a1 t, a2 t) (r t))
> 
> type Vector = (Float, Float)
> 
> translateP :: Vector -> Picture -> Picture
> translateP v p =
>   case p of Region c r   -> Region c (Translate v r)
>             p1 `Over` p2 -> translateP v p1 `Over` translateP v p2
>             EmptyPic     -> EmptyPic
> 
> tran (Beh a1, Beh a2) (Beh p)
>        = Beh (\t -> translateP (a1 t, a2 t) (p t))
>
> scaleP :: Vector -> Picture -> Picture
> scaleP v p =
>   case p of Region c r   -> Region c (Scale v r)
>             p1 `Over` p2 -> scaleP v p1 `Over` scaleP v p2
>             EmptyPic     -> EmptyPic
>
> scal (Beh a1, Beh a2) (Beh p)
>        = Beh (\t -> scaleP (a1 t, a2 t) (p t))


4. Extra credit: Exercise 13.3 in SOE

"Build a clock, complete with a face, second hand, minute hand, and
hour hand.  Implement the hands as animations."

---