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

Pardon the off-topic remark but I find it great that Einstein  
responds to queries concerning Euler's problems. I'd love to sign  
with Gauss :-)





On Jun 18, 2007, at 3:48 PM, David Einstein wrote:

> 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
>
> _________________________________________________
>   For list-related administrative tasks:
>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme