Exercise index of this lecture   Alphabetic index   Course home   

Exercises and solutions
Document Description and Processing in Scheme


false.1   Time tables  

In this exercise we will make a local Cottbus - Görlitz train time table.

Assume, for instance, that we have the following list of defined stations:

 (define stations
  (list "Cottbus" "Spremberg" "Weisswasser" "Horka" "Görlitz"))

Also assume, that the following list gives the number of minutes in between the stations

 (define minutes
  (list 22 12 26 18))

Write a function (time-table start-time) that generates a time table given that the train leaves Cottbus at start-time. Thus for instance this table.

Next, write a function (time-table list-of-start-times) that can generate a more comprehensive time table. Like this one.

I will propose that you give start-time in the universal time format. The Scheme function (current-time) gives the current time.

You can use these functions if you prefer.

Solution
(define laml-dir "c:/programs/laml/")

(load (string-append laml-dir "laml.scm"))
(laml-style "simple-xhtml1.0-transitional-validating")
; (lib-load "xhtml1.0-convenience.scm")

; (fake-startup-parameters "tt.laml" "c:/users/kurt/temp/")

(define current-xml-language 'xhtml10-transitional)
(define laml-generation-meta (meta 'name "Generator" 'content "LAML"))
(define meta-props (list 'http-equiv "Content-Type" 'content "text/html; charset=iso-8859-1"))
(define html-props (list 'xmlns "http://www.w3.org/1999/xhtml"))

; Insert the LAML template "Processing Options" here
; if you need variations in the LAML processing

(define stations
  (list "Cottbus" "Spremsberg" "Weisswasser" "Horka" "Görlitz"))

; The number of minute in between stations
(define minutes
  (list 22 12 26 18))

; The similar number of seconds
(define seconds
  (map (lambda (s) (* s 60)) (list 22 12 26 18)))

; Accumulated number of seconds
(define (accumulate-seconds lst)
  (accumulate-list-helper lst 0 '()))

(define (accumulate-list-helper lst sum-until-now res)
  (cond ((null? lst) (reverse res))
        (else (accumulate-list-helper 
                 (cdr lst)
                 (+ sum-until-now (car lst))
                 (cons (+ (car lst) sum-until-now)
                       res))))) 

; Make a time table with a single start time
(define (time-table-1 station-list second-list start-time)
 (table 'border "0"
   (map (lambda (st sec)
          (tr (td (b st)) (td (actual-hour-minute (+ sec start-time)))))
        station-list (cons 0 second-list))))

; Make a time table with a list of start times
(define (time-table-n station-list second-list start-time-list)
 (table 'border "0"
   (map (lambda (st sec)
          (tr (td (b st)) 
              (map (lambda (st) (td (actual-hour-minute (+ sec st)))) start-time-list)))
        station-list (cons 0 second-list))))

; Nice rendering of the time of second count (like (current-time)).
(define (actual-hour-minute sc)
 (let ((dt (time-decode sc)))
  (string-append 
     (as-string (hour-of-time dt))
     ":"
     (if (< (minute-of-time dt) 10) "0" "")
     (as-string (minute-of-time dt)))))


(write-html '(pp prolog)
 (html html-props
  (head 
   (meta meta-props) laml-generation-meta
   (title "Time" (em "Tables") ))
  (body 
    (time-table-1 stations (accumulate-seconds seconds) (current-time))
      
  )
 )

)


(end-laml)


false.2   A color-text function  

Write a Scheme markup function color-text of the following form:

  (color-text r g b . content-and-attributes)

The three first parameters are integers between 0 and 255. The tail parameter list text-and-attributes is arbitrary XML contents and attributes.

Examples of calls:

  (color-text 255 0 0 "This is some nice text")
  (color-text 255 0 0 "This is some" (em "nice") "text")
  (color-text 255 0 0 'class "my-class" "This is some" (em "nice") "text" _ ".")

Alternatively you may go for a form:

  (color-text 'red r 'green g 'blue b content-and-attributes)

such as

  (color-text 'red 255 'green 0 'blue 0 "This is some nice text")

Implement the desired function in terms of an HTML span element. Use the function xml-in-laml-positional-abstraction to implement the mixed positional and LAML parameter passing. The function rgb-color-encoding is also useful.

Solution
(load (string-append laml-dir "laml.scm"))
(laml-style "simple-xhtml1.0-transitional-validating")
; (lib-load "xhtml1.0-convenience.scm")

(define color-text
  (xml-in-laml-positional-abstraction  3 0 
    (lambda (r g b cont attr)
      (span 'css:color  (rgb-color-encoding r g b) cont attr))))

(define other-color-text
  (xml-in-laml-abstraction
    (lambda (cont attr)
       (let ((r (as-number (get-prop 'red attr)))
             (g (as-number (get-prop 'green attr)))
             (b (as-number (get-prop 'blue attr))))
        (span 'css:color 
          (rgb-color-encoding  r g b) cont (but-props attr '(red green blue)))))))

(define current-xml-language 'xhtml10-transitional)
(define laml-generation-meta (meta 'name "Generator" 'content "LAML"))
(define meta-props (list 'http-equiv "Content-Type" 'content "text/html; charset=iso-8859-1"))
(define html-props (list 'xmlns "http://www.w3.org/1999/xhtml"))

(write-html '(raw prolog)
 (html html-props
  (head 
   (meta meta-props) laml-generation-meta
   (title "TITLE"))
  (body 
  
    (p "Here is some" (color-text 0 255 0 "Very" "interesting color text" _ "."))

    (p "Here is some other"
       (other-color-text 'red "255" 'green "0" 'blue "255" "Very" "interesting color text" _ "."))
  

  )
 )
)


(end-laml) 


 


false.3   Table Column Exercise  

This exercises is oriented towards columns of tabular data.

Given three columns of numeric data. Each column is a list of numbers or boolean false values.

The column length may vary from column to column

As an example, the first column col1 may be the list:

  (1 5 #f 9 17)

This column may, together with two other columns, give the following table:


   1 15  8
   5 #f #f
  #f  0 11
   9  6 
  17 

Now, write a Scheme program supported by LAML that presents the table of columns. The table can be represented as the three individual columns. (And this is of course a little tricky, because HTML works with list of rows). #f values should be presented as blank table entries. In the fourth column, you should add the values in each row. When adding, the #f value and missing values (due to short columns) should be treated as 0.

Thus, a function call like (present-table table) should show this table.

Solution
(load (string-append laml-dir "laml.scm"))
(laml-style "simple-xhtml1.0-transitional-validating")

(set-xml-accept-only-string-valued-attributes-in 'xhtml10-transitional #f)
(set-xml-accept-extended-contents-in 'xhtml10-transitional #t)

; The table columns:
(define col1 (list 1 5 #f 9 17))
(define col2 (list 15 #f 0 6))
(define col3 (list 8 #f 11))

; For a table with rows (a list of rows) of the three columns
(define (form-full-table-with-rows col1 col2 col3)
  (let ((number-of-rows (max (length col1) (length col2) (length col3))))
    (map (lambda (row-number) 
            (get-row-number row-number col1 col2 col3))
         (number-interval 1 number-of-rows))))

; Return row number n from the three columns
(define (get-row-number n col1 col2 col3)
  (list
    (get-element col1 n) (get-element col2 n) (get-element col3 n)))

; Get element number n of list. Return #f if the element is not there.
; The first element of a list counts as number 1
(define (get-element lst n)
  (let ((lgt (length lst)))
    (if (<= n lgt)
        (list-ref lst (- n 1))
        #f)))

(define (present-table col1 col2 col3)
  (table 'border 1
    (map (compose tr td-mapper)
         (add-rows (form-full-table-with-rows col1 col2 col3)))))

(define (td-mapper lst)
  (map td lst))

; Add the elements in all rows of list-of-rows. Be careful to handle #f as zero.
(define (add-rows list-of-rows)
  (map
    (lambda (row)
      (append row (list (sum-list-special row))))
    list-of-rows))       

; Add the elements in lst, handling #f as zero.
(define (sum-list-special lst)
  (accumulate-right plus-special 0 lst))

; Specialized plus.
(define (plus-special x y)
  (cond ((and (and (boolean? x) (not x)) (and (boolean? y) (not y))) 0)
        ((and (boolean? x) (not x)) y)
        ((and (boolean? y) (not y)) x)
        (else (+ x y))))


; Web page generation stuff:

(define current-xml-language 'xhtml10-transitional)
(define laml-generation-meta (meta 'name "Generator" 'content "LAML"))
(define meta-props (list 'http-equiv "Content-Type" 'content "text/html; charset=iso-8859-1"))
(define html-props (list 'xmlns "http://www.w3.org/1999/xhtml"))

; Insert the LAML template "Processing Options" here
; if you need variations in the LAML processing

(write-html '(raw prolog)
 (html html-props
  (head 
   (meta meta-props) laml-generation-meta
   (title "Table Columns"))
  (body 
    (present-table col1 col2 col3))
 )
)


(end-laml)


Generated: Monday December 19, 2005, 14:16:58