[plt-scheme] Project Euler #4 solution refactor?

Here is how I would approach this

(require (lib "40.ss" "srfi"))
(require (lib "13.ss" "srfi"))

(define (stream-list-merge s1 s2 pred)
  (cond ((stream-null? s1) s2)
        ((stream-null? s2) s1)
        (else
         (let ((s1car (stream-car s1))
               (s2car (stream-car s2)))
           (cond ((pred s1car s2car)
                  (stream-cons s1car (stream-list-merge (stream-cdr s1) s2
pred)))
                 ((pred s2car s1car)
                  (stream-cons s2car (stream-list-merge s1 (stream-cdr s2)
pred)))
                 (else
                  (stream-cons s1car
                               (stream-list-merge (stream-cdr s1)
                                                  (stream-cdr s2)
pred))))))))

(define (join-series s1 s2 f order)
  (let ((e1 (stream-car s1))
        (e2 (stream-car s2)))
    (stream-cons (f e1 e2)
                 (stream-delay
                  (stream-list-merge
                   (stream-map (lambda (e) (f e e2)) (stream-cdr s1))
                   (join-series s1 (stream-cdr s2) f order)
                   order)))))

(define (stream-down-from n)
  (if (zero? n) stream-null
      (stream-cons n (stream-down-from (- n 1)))))

(define (palindrome? n)
  (let ((s (number->string n)))
    (string=? s (string-reverse s))))

(stream-car (stream-filter palindrome? (join-series (stream-down-from 999)
(stream-down-from 999) * >)))

Which looks overly complicated, but join-series and stream-list-merge are
tools that I had written for other projects.

All of which leads me to ask two questions.  Can someone help me to
understand why I need the stream-delay in join-series?  I would have thought
that stream-cons delayed its second argument.
Also, does anyone what happened to the quasi-proposed srfi-41?




On 6/17/07, Jens Axel Søgaard <jensaxel at soegaard.net> wrote:
>
> Grant Rettke wrote:
>
> > It works, and it makes sense, but it is sort of tricky/ugly to read in
> > that it logically has an inner and outer loop.
> >
> > (define psum
> >    (λ ()
> >      (let ([top 999] [bot 1])
> >        (let loop ([x top] [y top] [max 0])
> >          (let* ([prod (* x y)]
> >                 [str (number->string prod)]
> >                 [ispal (string=? str (srfi13:string-reverse str))]
> >                 [newmax (if (and ispal (> prod max)) prod max)])
> >            (cond [(> newmax (* x x)) newmax]
> >                  [(= x y bot) newmax]
> >                  [(> y bot) (loop x (sub1 y) newmax)]
> >                  [else (loop (sub1 x) top newmax)]))))))
>
> One way is to nest two named loops, and copy the max value from
> the outer loop to the inner loop:
>
> (define (psum)
>    (let ([top 999] [bot 1])
>      (let loopx ([x top] [max 0])
>        (if (= x bot) max
>            (loopx (- x 1)
>              (let loopy ([y x] [max max])
>                (if (= y bot) max
>                    (let* ([prod (* x y)]
>                           [str (number->string prod)]
>                           [ispal (string=? str
>                                            (srfi13:string-reverse str))]
>                           [newmax (if (and ispal (> prod max))
>                                        prod max)])
>                      (loopy (- y 1) newmax)))))))))
>
> But, erm, I think your version is prettier.
>
> You might want to look at either (lib "for.ss") or srfi-42.
> With srfi-42 it becomes:
>
> (require (lib "42.ss" "srfi"))
>
> (define (palindromic? s)
>    (equal? (string->list s)
>            (reverse (string->list s))))
>
> (max-ec (: x 999 99 -1)   ; loop from 999 to 100 with step -1
>          (: y x 99 -1)     ; loop from x ti 100 with step -1
>          (if (palindromic? (number->string (* x y))))
>          (* x y))
>
> --
> Jens Axel Søgaard
>
> _________________________________________________
>   For list-related administrative tasks:
>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20070618/d5f0f7e6/attachment.html>