[plt-scheme] help writing idiomatic plt scheme

On Jun 14, 2008, at 10:39 PM, Martin DeMello wrote:

> I've pasted a program fragment in at http://pastebin.com/f152f0ea4 - I
> would like some help improving it in terms of making it more concise
> and idiomatic, since I have the feeling I'm doing too much work for a
> fundamentally simple problem.


1. I don't think this problem is that simple. (It's easy but it has a  
twist.)

2. I don't think idiomatic PLT Scheme exists but it is emerging. The  
addition of for & Co shows that we're trying to broaden 'idiomatic'  
especially for those who cross over from languages that prefer loop-y  
things.

3. Here is my take on 'idiomatic' coming from a design perspective.  
Everything is based on the data def file = eof | line * file

I am using this contract:

;; InputPort ->* [Listof String] [Listof String]

And I assume that your purpose statement holds.

Version 1: read line by line; for each line, gather all lines that  
come with the same starting char; then filter and cut of beginning of  
each line

(define (collect.v0 iport)
   (define (cut line) (substring line 2))
   (define (drive N)
     (cond
       [(eof-object? N) '()]
       [else (let-values ([(N fst) (gather-same N)]) (cons fst (drive  
N)))]))
   (define (gather-same str)
     (define C (string-ref str 0))
     (let L ([str str])
       (define N (read-line iport))
       (cond
         [(eof-object? N) (values N str)]
         [(char=? (string-ref N 0) C) (L (string-append str "\n" (cut  
N)))]
         [else (values N str)])))
   (define all (drive (read-line iport)))
   (define (select str) (lambda (line) (string=? str (substring line  
0 2))))
   (values (list->vector (map cut (filter (select "# ") all)))
           (list->vector (map cut (filter (select "= ") all)))))

Version 2: realize that these recursive functions can be "merged"

(define (collect.v1 iport)
   (define (cut line) (substring line 2))
   (define (drive N)
     (cond
       [(eof-object? N) '()]
       [else (gather-same N)]))
   (define (gather-same str)
     (define C (string-ref str 0))
     (let L ([str str])
       (define N (read-line iport))
       (cond
         [(eof-object? N) (list str)]
         [(char=? (string-ref N 0) C) (L (string-append str "\n" (cut  
N)))]
         [else (cons str (drive N))])))
   (define all (drive (read-line iport)))
   (define (select str) (lambda (line) (string=? str (substring line  
0 2))))
   (values (list->vector (map cut (filter (select "# ") all)))
           (list->vector (map cut (filter (select "= ") all)))))

;; Version 3: simplify syntax

(define (collect iport)
   (define (cut line) (substring line 2))
   (define (drive N) (if (eof-object? N) '() (gather-same N)))
   (define (gather-same str)
     (define C (string-ref str 0))
     (let L ([str str])
       (define N (read-line iport))
       (cond
         [(eof-object? N) (list str)]
         [(char=? (string-ref N 0) C) (L (string-append str "\n" (cut  
N)))]
         [else (cons str (drive N))])))
   (define all (drive (read-line iport)))
   (define (select str) (lambda (line) (string=? str (substring line  
0 2))))
   (values (list->vector (map cut (filter (select "# ") all)))
           (list->vector (map cut (filter (select "= ") all)))))


I do not like that eof-object has to be tested twice. But we need to  
do so because we lack the knowledge that the file isn't empty.

;; ---

The rest of the message is a test suite, comparing my current version  
with yours. -- Matthias

#lang scheme


(require rnrs/io/ports-6)

(define input #<<eof
# 1
# 2
= 3
# 4
= 5
= 6
eof
   )

; every line of input-file starts with either "# " or "= ".
; (we assume the input is well-formed in that this always holds)
; we want to collect the lines into two global vectors, lines-o and  
lines-p.
; runs of "# " or "= " lines should be collected into single strings;
; that is, "# " strings and "= " strings should strictly alternate

;; InputPort ->* [Listof String] [Listof String]
(define (given-solution input-file)
   (define (append-to-car str lst)
     (cond [(null? lst) (list str)]
           [else (cons (string-append (car lst) "\n" str) (cdr lst))]))

   (define-values (read-o read-p _)
     (for/fold ([o '()] [p '()] [c "# "])
               ([line (in-lines input-file)])

               (match (list (substring line 0 2) (substring line 2))
                 [(list "# " rest)
                  (cond [(equal? c "# ") (values (append-to-car rest  
o) p "# ")]
                        [else            (values (cons rest o) p "#  
")])]
                 [(list "= " rest)
                  (cond [(equal? c "= ") (values o (append-to-car  
rest p) "= ")]
                        [else            (values o (cons rest p) "=  
")])])))
   (define _1 (close-input-port input-file))
   (values (list->vector (reverse read-o)) (list->vector (reverse  
read-p))))


;; --- test ---

(define (run f)
   (define input-file (open-string-input-port input))
   (f input-file))

(let*-values  ([(m# m=) (run collect)]
                [(g# g=) (run given-solution)])
   (cond
     [(and (equal? g# m#) (equal? g= m=)) (void)]
     [(equal? g# m#) (printf "differing in =:\n~a\n~a\n" g= m=)]
     [(equal? g= m=) (printf "differing in #:\n~a\n~a\n" g# m#)]
     [else (printf "differing in all:\n~a\n~a\n~a\n~a\n" g= m= g# m#)]))












>
> martin
>
> p.s. code below if you don't feel like clicking through to pastebin
>
> ; every line of input-file starts with either "# " or "= ".
> ; (we assume the input is well-formed in that this always holds)
> ; we want to collect the lines into two global vectors, lines-o and  
> lines-p.
> ; runs of "# " or "= " lines should be collected into single strings;
> ; that is, "# " strings and "= " strings should strictly alternate
>
> (define (append-to-car str lst)
>   (cond [(null? lst) (list str)]
>         [else (cons (string-append (car lst) "\n" str) (cdr lst))]))
>
> (define-values (read-o read-p _)
>   (for/fold ([o '()] [p '()] [c "# "])
>     ([line (in-lines input-file)])
>
>     (match (list (substring line 0 2) (substring line 2))
>       [(list "# " rest)
>        (cond [(equal? c "# ") (values (append-to-car rest o) p "# ")]
>              [else            (values (cons rest o) p "# ")])]
>       [(list "= " rest)
>        (cond [(equal? c "= ") (values o (append-to-car rest p) "= ")]
>              [else            (values o (cons rest p) "= ")])])))
>
> (close-input-port input-file)
>
> (define lines-o (list->vector (reverse read-o)))
> (define lines-p (list->vector (reverse read-p)))
> _________________________________________________
>   For list-related administrative tasks:
>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme