-- Haskell source code for a 2-3 hour course
--
-- "Programming with Infinite Data"
--
-- aimed at mathematically literate high school students.
-- This is the "solutions" file containing code for all functions.
-- For teaching purposes, some function definitions should be removed
-- so that the code can be rewritten in collaboration with students.
----------------------
-- SUMMARY OF TASKS --
----------------------
-- Task 1: Compute (and record the results) iterates of the logistic map
-- using single and double precision floating point
--
-- e.g., iter 75 logistic (1.0/3.0)
--
-- notice that the values are different (and this occurs much before 75)
--
-- Since the logistic map is here defined using a rational coefficient (4),
-- it is natural to try the calculation using the Rational type
--
-- e.g., iter 75 ratlogistic (1%3)
--
-- but this does not return a value in reasonable time as the computation
-- gets bogged down in calculating with unmanageably large finite data
-- structures
-- Task 2: The general idea of the exercise is that computing with infinite
-- data structures is (a) possible, and (b) can be more efficient than
-- computing with large finite data structures. Some simple functions
-- on streams illustrate the idea of computing with infinite data.
--
-- e.g., mapsquare naturals
-- Task 3: Introduce the notion of signed binary representation of a
-- number in the interval [-1,1]. Then, together with the students
-- come up with code defining some simple rational numbers: one, minusone,
-- half, third, etc.
-- Task 4: Implement some functions on reals. In particular, together
-- with the students implement the functions: addone and double, which
-- compute \x -> (x + 1) and \x -> (2x) truncated to [-1,1].
-- Functions for binary average and multiplication, which are too
-- complicated to write together with the students, are predefined.
-- Task 5: Put things together to calculate iterates of the logistic map
-- using signed binary. Students should be able to work out the definition:
--
-- reallogistic xs = double (double (times (addone (negation xs)) xs))
--
-- The result can be converted to a Double using the pre-implemented
-- "precision" function
----------
-- CODE --
----------
import Data.Ratio
----------------------
-- THE LOGISTIC MAP --
----------------------
-- Function for the logistic map
logistic :: Float -> Float
logistic x = 4 * (1 - x) * x
-- Iterating a function
iter 0 f x = x
iter n f x = iter (n - 1) f (f x)
-- Double precision
dbllogistic :: Double -> Double
dbllogistic x = 4 * (1 - x) * x
-- Rational version
ratlogistic :: Rational -> Rational
ratlogistic x = 4 * (1 - x) * x
-------------
-- STREAMS --
-------------
zeros, naturals :: [Int]
zeros = 0: zeros
-- first n xs = the first n values from the stream xs
first 0 _ = []
first n (x:xs) = x: first (n-1) xs
from n = n: from (n+1)
naturals = from 0
mapsquare (x:xs) = x*x : mapsquare xs
---------------------
-- REAL ARITHMETIC --
---------------------
type Interval = [Int]
one, zero, half, minusone, third :: Interval
one = 1:one
zero = 0:zero
half = 1:zero
minusone = -1:minusone
third = 0:1:third
twothirds = 1:third
negation :: Interval -> Interval
negation (1:xs) = -1: (negation xs)
negation (0:xs) = 0: (negation xs)
negation (-1:xs) = 1: (negation xs)
addone :: Interval -> Interval
addone (1:_) = one
addone (0:xs) = 1: addone xs
addone (-1:xs) = 1: xs
subtractone :: Interval -> Interval
subtractone xs = negation (addone (negation xs))
double :: Interval -> Interval
double (1:xs) = addone xs
double (0:xs) = xs
double (-1:xs) = subtractone xs
average :: Interval -> Interval -> Interval
times :: Interval -> Interval -> Interval
averagecarry (x1:x2:xs) (y1:y2:ys) n
| x1%4 + x2%8 + y1%4 + y2%8 + n%2 >= 1%4
= 1: (averagecarry (x2:xs) (y2:ys) (x1 + y1 + 2*n - 2))
| x1%4 + x2%8 + y1%4 + y2%8 + n%2 <= -1%4
= -1: (averagecarry (x2:xs) (y2:ys) (x1 + y1 + 2*n + 2))
| otherwise
= 0: (averagecarry (x2:xs) (y2:ys) (x1 + y1 + 2*n))
average xs ys = averagecarry xs ys 0
times (0:xs) ys = 0: times xs ys
times xs (0:ys) = 0: times xs ys
times (1: -1:xs) ys = 0: times (1:xs) ys
times xs (1: -1:ys) = 0: times xs (1:ys)
times (-1:1:xs) ys = 0: times (-1:xs) ys
times xs (-1:1:ys) = 0: times xs (-1:ys)
times (1:1:xs) (1:1:ys) =
let zs = average xs ys
in 1: average zs (average zs (1: times xs ys))
times (1:1:xs) (-1: -1:ys) =
let zs = average (negation xs) ys
in -1: average zs (average zs (-1: times xs ys))
times (-1: -1:xs) (1:1:ys) =
let zs = average xs (negation ys)
in -1: average zs (average zs (-1: times xs ys))
times (-1: -1:xs) (-1: -1:ys) =
let zs = negation (average xs ys)
in 1: average zs (average zs (1: times xs ys))
times (1:xs) (1:ys) = average (average xs ys) (1: times xs ys)
times (1:xs) (-1:ys) = average (average (negation xs) ys) (-1: times xs ys)
times (-1:xs) (1:ys) = average (average xs (negation ys)) (-1: times xs ys)
times (-1:xs) (-1:ys) = average (negation (average xs ys)) (1: times xs ys)
---------------------------
-- THE REAL LOGISTIC MAP --
---------------------------
reallogistic xs = double (double (times (addone (negation xs)) xs))
precision :: Int -> Interval -> Double
-- precision n x computes a Double value in [-1,1] from the first n
-- signed-binary digits of x
precision 0 _ = 0.0
precision n (1:xs) = 0.5 + (precision (n-1) xs)/2.0
precision n (0:xs) = (precision (n-1) xs)/2.0
precision n (-1:xs) = -0.5 + (precision (n-1) xs)/2.0