Real World Haskell Chapter 5 – Scheme

For the chapter 5 JSON exercises I needed to update the prelude scheme library to add intercalate. I also wrote the following scheme files which are just ported versions of the haskell equivalents.

• prettify.ss
• simple-json.ss
• pretty-json.ss
• put-json.ss

Data types – JValue

The main headache attacking these exercises was the data type declarations. I took a very simple approach using PLT’s define-structure. This involved writing a whole lot of boilerplate code for contructors and type predicates. I think in the long run it would be a good idea to write some syntax extensions to deal with data declarations – something that allows you to write something like (data jvalue (jnumber number?) (jnull jnull?) ...) which generates the structure definition, constructors and type predicates for you. I’m too lazy to bother for now, but I’ll probably add it to the prelude later.

The first step was to define the jvalue types – as I said I used define-structure for jvalue type. The simple constructors for jstring, jnull, jbool and jnumber are not too interesting but jobject and jarray need a little extra effort. I thought about using an assoc list but I plumped for a hash-table as the underlying storage for jobjects. As scheme isn’t statically typed, the type predicate jarray ought to be defensive and check that it’s elements are all jvalue types. Luckily define-structure automatically generates type predicates which help, so internally a jarray is a simple list of jvalue elements.

(define-struct jvalue (type data))

(define (jtype-eq? value jtype) 
  (and (jvalue? value) 
       (eq? jtype (jvalue-type value))))

(define (jobject? value) 
  (and (jtype-eq? value 'jobject)
       (andmap (hash-map (λ (k v) 
                           (and (string? k) (jvalue? v)))
                         (jvalue-data value)))))

(define (jobject value) 
  (if (hash? value)
      (make-jvalue 'jobject value)
      (error "jobject expects type hash : " value)))

(define (jarray? x) 
  (and (jtype-eq? x 'jarray) 
       (andmap jvalue? (jvalue-data x))))

(define (jarray value) 
  (if (list? value)
      (make-jvalue 'jarray value)
      (error "jobject expects type array : " value)))

The Doc data type and values

I took an identical approach to creating the doc data type – with the added need to deconstruct Union and Concat values with simple accessor procedures.

(define (concat? value) (doc-type=? value 'concat))
(define (concat l r) (make-doc 'concat (cons l r)))
(define (concat-l c) (car (doc-data c)))
(define (concat-r c) (cdr (doc-data c)))

(define (union? value) (doc-type=? value 'union))
(define (union l r) (make-doc 'union (cons l r)))
(define (union-l c) (car (doc-data c)))
(define (union-r c) (cdr (doc-data c)))

There wasn’t much else of interest writing nest or fill in the general pretty-printing exercises – just a straightforward port of the haskell versions.

Pretty printing JSON unicode characters

The other points worth noting were dealing with the pretty-printing of json values. The full unicode spec is a bit over my head as are the various implementations and encodings – especially as the haskell functions introduce writing astral characters – I had to look those up.

The first thing I needed to do was to find the correct way of representing the various simple escape character literals. I couldn’t find them searching the PLT scheme documentation. Still it was easy enough for example to find the character using (string-ref “\f” 0) and so I eventually constructed an alist which I’m posting here for posterity and my own future reference.

(define simple-escapes 
  '((#\backspace . "\\b")
    (#\newline   . "\\n")
    (#\page      . "\\f")
    (#\return    . "\\r")
    (#\tab       . "\\t")
    (#\\         . "\\\\")
    (#\"         . "\\\"")
    (#\/         . "\\/")))

A couple of nice things I discovered were (at least in mzscheme) support for unicode hex literal characters and formatting #\uFF is the character literal for the ascii 255 character.

(format "~c" #\page)  => "\f"
(format "~c" #\uFF)   => "ÿ"
(format "~c" #\uFFFF) => "\uFFFF"

Unfortunately there seems to be disagreement about formatting astral characters – in PLT scheme they use the literal form of #\un where n looks to be a 64 bit value.
I’ve no idea why the haskell astral values are represented the way they are:

\uA a\uB : 
A = upper 10 bits + 0xd800
B = lower 10 bits + 0xdc00

Presumably it’s all there in the unicode spec. somewhere. So I decided to follow the haskell version but I’m not sure which is better or correct for JSON values. I guess it’s all there in the JSON spec too.

Real World Haskell Chapter 4 – Scheme

Before I could tackle the exercises in chapter 4 I think it would be useful to have some of the nice functions from Haskell’s prelude, so I wrote a prelude library to help. I’ll be updating it as I work my way through the book.
Scheme prelude and the lazy version
Interact with text file framework
First words program
Transpose text program
Chapter 4 exercise solutions

The start of chapter 4 gives a framework for transforming text files which I needed to convert into Scheme.
The only complex part is being able to invoke a scheme text file as a script, but the PLT documentation gives the answer. I’m not sure how this would work under windows, but there must be an equivalent. I’m posting the magic part here for posterity and so I can find it more easily in the future.
Their script uses exec mzscheme -cu "$0" ${1+"$@"}.
The -c switch disables loading compiled files (which I think causes some/a;; of the library functions used to be loaded and compiled when the script runs but I got tired of the extra delay caused so I’m using:

#! /bin/sh
#|
exec mzscheme -u "$0" ${1+"$@"}
|#
#lang scheme/base

I realise I have no idea how the Haskell code schedules and performs the reading and writing of the files.
I began to wonder about efficiency though or more precisely the lazy nature of Haskell and how reading in a text file line by line and processing it actually works. According to the documentation readFile the file is read in lazily line by line as required so I expect it depends on how function uses the list of strings it is passed.

interactWith function inputFile outputFile = do
  input <- readFile inputFile
  writeFile outputFile (function input)

I tried 2 different approaches in Scheme:

1. Reading in the whole file into a list of strings, then performing the transformation on each line in the list.
2. Reading and writing the file a line at a time, performing the transformation and writing it as it is read.

I went with the second option initially and so the framework code for transforming a file:

(define (main)
  (define arguments (current-command-line-arguments))
  (if (= (vector-length arguments) 2)
      (let ([in  (vector-ref arguments 0)]
            [out (vector-ref arguments 1)])
        (interact-with my-function in out))
      (error "interact-with expects exactly 2 arguments  : interact-with in-file-path out-file-path\n\tProvided : " arguments)))

The procedure that applies the line by line transformation

(define (interact-with f in out)
  (with-output-to-file out #:mode 'text #:exists 'replace
    (λ () 
      (with-input-from-file in 
        (λ ()
          (let next-line ([line (read-line)])
            (cond [(eof-object? line) (void)]
                  [else (write-string (f line))
                        (newline)
                        (next-line (read-line))])))
            #:mode 'text))))

I thought of using call-with-input-file and call-with-input-file but I couldn’t find a neat way of capturing the procedure to transform each line without writing a nested procedure, but it doesn’t seem any more elegant.

I didn’t convert the FixLines to Scheme as mzscheme seems to cope with both Unix and Windows line separators (at least in the Ubuntu version.)

Exercise 1

I can see I’m going to get in a lot of trouble later on in the book coping with Haskell’s type system under Scheme but here goes with Maybe. I think there must be a way of using macros to cope with types like Maybe, but I’ll leave that as an exercise for myself. I have enough new concepts in Haskell to take on-board currently.

(define-struct maybe (value))
(define Just make-maybe)
(define Nothing (make-maybe 'Nothing))
(define (nothing? o) (equal? o Nothing))

(define (safe-head o) (if (null? o) Nothing (Just (first o))))
(define (safe-tail o) (if (null? o) Nothing (Just (rest o))))
(define (safe-last o) (if (null? o) Nothing (Just (last o))))
(define (safe-init o) (if (null? o) Nothing (Just (init o))))

The init and last procedures are in the Scheme Prelude library I wrote.

Exercise 2

I’m using values and let-values to implement an analogue of tuples for example in defining and using span and break but I ran into a problem with that which I’ll explain later. The split-with that preserves all list members:

(define (split-with+ p xs)
  (cond [(null? xs) null] 
        [else (let-values ([(head) (first xs)]
                           [(pre suf) (span p (rest xs))])
                (cons (cons head pre)
                      (split-with+ p suf)))]))

The non-preserving version:

(define (split-with p xs)
  (define (split-suffix suf) (split-with p (drop-while (combine not p) suf)))
  (if (null? xs)
      null
      (let-values ([(pre suf) (span p xs)])
        (if (null? pre)
            (split-suffix suf)
            (cons pre (split-suffix suf))))))

Exercise 3

Once again it’s a little messier dealing with strings – using a higher order functional approach to deal with strings requires converting strings into lists of characters and back again. Still at least Scheme has procedures for that.

(define char-nonspace? (compose not char-whitespace?))
(define (first-word line)
  (list->string
   (take-while char-nonspace? 
               (drop-while char-whitespace? (string->list line)))))

Exercise 4

The transpose procedure needs all the lines of text before it can work and so I had to switch back to my first approach for dealing with text files, namely to read the whole file into a list of strings, then apply the transformation, then write out the result.

(define (interact-with f in out) (write-lines out (f (read-lines in))))
(define (read-lines in)
  (with-input-from-file in 
    (λ ()
      (let next-line ([line (read-line)])
        (if (eof-object? line) 
            null
            (cons line (next-line (read-line))))))
    #:mode 'text))
(define (write-lines out ls)
  (with-output-to-file out #:mode 'text #:exists 'replace
    (λ () (for-each (λ (line) (write-string line) (newline)) ls))))

Picking the first letter of each line and and the rest of the letters from each line is a little more fiddly in Scheme but for the Haskell version I also had to write extra functions to mimic head and tail to be able to use map safely on different length lines.
I’m still not entirely happy that it doesn’t pad spaces in front of transposed lines as you’d expect but it works for lines of the same length and so that’s goods enough for now.

(define (transpose-lines lines) 
  (let ([heads (apply string-append (map safe-string-first lines))]
        [tails (map safe-string-rest lines)])
    (if (string-empty? heads)
        null
        (cons heads (transpose-lines tails)))))

(define empty-string "")
(define (string-empty? s) (string=? s empty-string))
(define (safe-string-first s) (if (string-empty? s) empty-string (substring s 0 1)))
(define (safe-string-rest s)  (if (string-empty? s) empty-string (substring s 1)))

Folds Exercise 1

Basically the same as the Haskell version except for once again using string based functions instead of list based ones.

(define (as-int-fold ds)
  (cond [(string=? ds "") 0]
        [(char=? (string-ref ds 0) #\-) (- (as-int-fold (substring ds 1)))]
        [else (foldl shift-right-and-add 
                     0
                     (string->list ds))]))

(define (shift-right-and-add d acc)
  (+ (* 10 acc) 
     (char->digit d)))

Then for fun I decided to try using a right fold but I ran into a problem. Let’s say our string has 4 digits d1 d2 d3 d4 and the intermediate result after processing d4 and d3 is res so d1 * 1000 + (d2 * 100 + (d3 * 10 + (d4 * 1)))
At each iteration 3 values are needed – the current result, the current digit and the factor needs to be multiplied by 10 to give
So I wrote:

(define (shift-right-and-add+ d acc)
  (let-values ([(res factor) acc]) 
    (+ (* 10 acc) 
        (char->digit d)))

But calling it with (foldr shift-right-and-add+ (values 0 1) (string->list ds)) -> error: context expected 1 value, received 2 values: 0 1
Considering I’d finished the exercise with a left fold I checked out the comments for the exercise on the Real World Haskell web site and found the delightful:

asInt_fold:: String -> Int
asInt_fold ('-':rest) = -asInt_fold (filter isDigit rest)
asInt_fold str = foldr step 0 (reverse str)
where step i acc = acc * 10 + digitToInt i

I really wish I’d had the insight to think of that. Thank you Marcus Edwards.
This means the same step function can be used as with the left fold version and gives the much more elegant:

(define (as-int-foldr ds)
  (cond [(string=? ds "") 0]
        [(char=? (string-ref ds 0) #\-) (- (as-int-foldr (substring ds 1)))]
        [else (foldr shift-right-and-add 
                     0
                     (reverse (string->list ds)))]))

I won’t comment on the other solutions as they are pretty much just conversion from Haskell into the appropriate Scheme.
Except for the cycle exercise. The only way I could think of doing this in Scheme is to use delay, force and promise but that would mean re-writing all list handling functions but luckily PLT has a lazy scheme language which can be used almost interchangeably with regular scheme. I’m considering using this for future exercises, but for now this is a stand-alone exercise using the PLT lazy scheme language.

#lang lazy
(define (integers-from n) (cons n (integers-from (add1 n))))
(define (ba-cycle xs)
  (define (cycle-step x acc) (cons xs acc))
  (foldr cycle-step null (integers-from 0)))

Real World Haskell Chapter 3 – Scheme

Chapter 3 exercise solutions

The only interesting difference between the scheme and haskell versions lies is in the sorting.
The exercise in chapter 3 to sorts a list of lists by length suggested using sortBy and so I chose to use that in finding the initial point and in sorting by the points by angle.
sortBy takes a function argument which compares 2 values and returns either EQ, LT or GT as you’d expect.
There’s also a sort function that uses the default compare function which I couldn’t use “as is” because I implemented my Point type as a simple tuple of 2 double values, representing x and y, and compare only checks the first value of the tuple (the x component) in its comparison. To avoid having to coerce my Point type to be usable with compare I decided to use sortBy.

Scheme’s built in sort function though accepts a final procedure argument that’s used to determine if the first of its arguments is less than the second. It requires a slightly different approach in sorting points and on sorting by angles. However, the underlying logic comparing points to find the lowest is the same as is comparing points by angle.

(define (cotan<? pivot)
  (lambda (p q)
    (let* ([pivot-x (point-x pivot)]
           [pivot-y (point-y pivot)]
           [px (point-x p)] [py (point-y p)]
           [qx (point-x q)] [qy (point-y q)]
           [cotan-p (* (- py pivot-y) (- qx pivot-x))]
           [cotan-q (* (- qy pivot-y) (- px pivot-x))])
      (cond [( cotan-p cotan-q) false]
            [(> py qy)           true]
            [(< py qy)           false]
            [(< px qx)           true]
            [else                false]))))

Something unexpected happened though, when using cotan<?

(define (cotan-sort ps) 
  (let* ([initial-sort (sort ps point<=?)]
         [pivot (first initial-sort)])
     (sort initial-sort (cotan<? pivot))))

Here the points – ps – are sorted by their y co-ordinates to get the lowest point or pivot first in the list.
I expected the value return by ((cotan<? pivot) pivot pivot) to be first in the results but it wasn’t.
I think the reason is due to the calculations of co-incidental points – the cotan calculation is based on simplified arithmetic from calculating the tangent of an angle. If all three points forming the angle are identical there will be division by zero issues.
To overcome the problem I removed the pivot from the initial-sort results.

(define (cotan-sort ps) 
  (let* ([initial-sort (sort ps point<=?)]
         [pivot (first initial-sort)])
      (cons pivot (sort (rest initial-sort) (cotan<? pivot)))))

Chapter 6 – Scheme supermarket

Chapter 6 Supermarket solutions and analysis solutions.

Use of types

I decided to model the haskell type definitions using define-struct implemented in mzscheme. All of the frankly tedious boiler plate code fopr constructing and using simple composite types

(define type-of first)
(define (make-index bar-code name price) 
  (list ('index bar-code name price)))
(define (index? o)
  (eq? (type-of o) 'index))
(define index-bar-code second)
(define index-name third)
(define index-price fourth)
(define (set-index-bar-code! i bar-code)
  (make-index bar-code (index-name i) (index-price i)))
(define (set-index-name! i name)
  (make-index (index-bar-code i) name (index-price i)))
(define (set-index-bar-price! i price)
  (make-index (index-bar-code i) (index-name i) price))

can be replaced with:

 
(define-struct index (bar-code name price) #:mutable)

Hooray for macros!

I didn’t mention anything about the extended exercise analysing sets of tills but I wrote 2 types of analysis.

1. For each till roll count pairs of items that are directly next to each other
2. For each till roll count all combinations of pair of items

I didn’t check for or remove remove duplicates or treat pairs symmetrically so there are plenty of errors but these exercises are somewhat tedious.

Chapter 6 – Scheme Geometry

Solutions to Chapter 6 geometry exercises.

The haskell version of rotate270 repeatedly calls rotate90, but that results in iterating over the picture part of the image 3 times. In the scheme version I decided to take a different approach, but it highlights what I think is a poor design decision in the range generation of srfi 42 – at least as implemented in PLT scheme. Using (:range i 1 5) results in '(1 2 3 4) (sigh).
Compare this to haskell’s [1..5] which generates [1,2,3,4,5] and feels natural or at least obvious and preserves sanity. I guess the reason for that is the designers expect people to use procedures like length or string-length when specifying ranges. Maybe that’s a good enough reason but needless to say I’ve had a few off by 1 errors when using them.

(define (rotate-90 pic)
  (list-ec (:range i 0 (width pic))
           (pick i (reflect pic))))

(define (rotate-270 pic)
  (list-ec (:range i (sub1 (width pic)) -1 -1)
           (pick i pic)))

Type safety

The other thing highlighted by the geometry exercises is haskell’s type synonyms and type checking. In scheme, I don’t need to write any boiler-plate code to pick apart constructed types like image or position but it does make code more readable and more maintainable. So if a position is implemented as a list of x and y co-ordinates initially and later is changed to using a single cons cell, rather than having to change or check every place that co-ordinates are used, you will only need to change the constructor and selector procedures. This tends to result in plenty of boiler-plate code but protects you from your future self and vice-versa.

(define make-pos cons)
(define pos-x car)
(define pos-y cdr)

(define make-image cons)
(define image-pic car)
(define image-pos cdr)

So that

(define (move-image image x-delta y-delta)
  (let ([pos (image-pos image)])
    (make-image (image-pic image) (make-pos (+ x-delta (pos-x pos))
                                            (+ y-delta (pos-y pos))))))

For such simple exercises I didn’t bother to add type-checks but to do that there should be some type indicator and type checking procedures.

(define type first)
(define (make-pos x y) (list 'pos x y))
(define (pos? x) (and (pair? x) (eq? (type x) 'pos)))
(define (pos-x a) 
  (if (pos? a)
      (second a)
      (error "pos-x expects a pos" a)))
(define (pos-y a) 
  (if (pos? a)
      (third a)
      (error "pos-y expects a pos" a)))

It still doesn’t stop you from cheating – (pos-x '(pos "ooops")) – but it’s a good habit to get into and avoids lots of stupid runtime errors when programs become more complex. The haskell compiler automatically checks though and I suspect this may cause some extra work tackling the exercises in scheme and ruby later on in the book.

Chapter 5 – Scheme

Chapter 5 solutions.

The most interesting thing for me in this chapter was the fact that I haven’t used list comprehensions in scheme before so delving into SRFI 42 was interesting. Unfortunately that was the best documentation I could find so there was a fair bit of head scratching on my part before I managed to complete the exercises. Scheme comprehensions are eager, not lazy. The expression actually generates all the values at execution time rather than when the value(s) are needed – in contrast with haskell where laziness is one of the cornerstones of the language.

The main problem with SRFI 42 is the dazzling number of comprehension types and generators along with the terse documentation. It was nice to stumble across string-ec though – it’s a nice compact way of mapping over the characters in a string. It would have been nice to have the ordering of the terms the same as haskell – it doesn’t take long to get used to.

(define (capital-letters s)
  (string-ec (: c s)
             (if (char-alphabetic? c))
             (char-upcase c)))

The other thing worth mentioning is the lack of type checking in scheme now that types have been introduced – I added a minimal amount of type-checking in the library database prodcedures – haskell suddenly feels a lot safer.

Chapter 4 – Scheme

Chapter 4 Solutions.

One of the nice things about scheme is variable arity – so for example the procedure for weak ascending for 3 items is:
(define (weak-ascending a b c) (<= a b c))
This also works with others like + and * so cube becomes
(define (cube x) (* x x x))

Chapter 3 – Scheme

Chapter 3 solutions

The main interesting point about these exercises was again the string handling. Scheme has a string-upcase procedure which handles unicode strungs using the default locale. So for example

(string-upcase "Straße") -> "strasse". However

(char-upcase #ß) -> #ß

I donlt understand the technical problems of handling unicode, but it was a bit of a surprise that my procedure for exercise 3.12 gave me

(capitalise "Straße") -> "STRAßE".

Still, I revisited the haskell version and got similarly unexpected results

toUpper 'ß' -> '223'and so

capitalise "Straße" -> "STRA223E".

One thing I like about scheme is the simplicity of dealing with different format numbers. Many of the mathematical procedures work by internally coercing arguments to the same types which means there’s no need to be too concerned about whether we are comparing an integer to a floating point number other than the normal concerns about accuracy.

I know that haskell can handle this with type classes, but the book hasn’t introduced them yet so they are not really on the spirit of the exercises at this point.

Chapter 2 – Scheme

Solutions to chapter 2

#lang scheme
(require "pictures.ss")
(provide black-horse
         rotate
         rotate-horse
         black
         cross-hatch
         chess
         horse-hatch-1
         horse-hatch-2
         horse-hatch-3
         horse-hatch-4)

About the only interesting thing here is the use of the #lang declaration using the “module” language in PLT’s DrScheme which seems to be a bit of syntactic sugar to avoid having to wrap up the whole set of definitions in a module form. It looks like the same forms are available e.g. require, provide.

One thing that struck me in this chapter was the equivalence of using scheme’s cond with haskell’s use of guards against a functions arguments (as they’ve been used so far in the book.)

Exercise 2.1 – starting out with pictures

Before starting on the exercises in chapter 2, I need to translate the “library” functions in Picture.hs into the relevant languages; I’ll leave compiling and accessing foreign libraries for another day
Here are the Scheme and Ruby versions I’m going to use.

Answers: ex02.01.hs, ex02.01.rb, ex02.01.ss

A note on strings. I found the built-in string handling abilities of all of them to be quirky or lacking.

Scheme. There’s a string-map in SRFI 13, but unlike the regular map it doesn’t accept multiple arguments so I wrote a specialised version that dealt with two input strings. Note to self: extend that to accept an arbitrary number of  strings to another day. Or you could do that and send me the results.

Ruby. I wrote this to target 1.8.6 so 1.9 may have addressed this but it seems natural to me to write "string".each and have that enumerate the characters of the string.
Instead I used the uglier "string".split(//).each. I can see that string handling in the era of unicode is difficult but this just feels awkward and inconsistent. I might consider writing a charmap method and add it to the string class that does exactly that.

Haskell. I really like the rational approach haskell takes treating a string as a list of chars. It’s so nice to be able to write things like 'b':"ad"  "Con" ++ "cat" and use map, fold, filter et al.