[plt-scheme] Cost of string creation? / Euler 8 code review

From: Matthias Felleisen (matthias at ccs.neu.edu)
Date: Tue Jul 3 11:47:10 EDT 2007

Here is the code review you asked for, plus a speed-up of 3 or so. --  
Matthias


(module euler8 mzscheme

   ; Problem Euler 8: http://projecteuler.net/index.php? 
section=view&id=8
   ; Find the greatest product of five consecutive digits in the 1000- 
digit number.

   (define the-number
      
"73167176531330624919225119674426574742355349194934969835203127745063262 
395783180169848018694788518438586156078911294949545950173795833195285320 
880551112540698747158523863050715693290963295227443043557668966489504452 
445231617318564030987111217223831136222989342338030813533627661428280644 
448664523874930358907296290491560440772390713810515859307960866701724271 
218839987979087922749219016997208880937766572733300105336788122023542180 
975125454059475224352584907711670556013604839586446706324415722155397536 
978179778461740649551492908625693219784686224828397224137565705605749026 
140797296865241453510047482166370484403199890008895243450658541227588666 
881164271714799244429282308634656748139191231628245861786645835912456652 
947654568284891288314260769004224219022671055626321111109370544217506941 
658960408071984038509624554443629812309878799272442849091888458015616609 
791913387549920052406368991256071760605886116467109405077541002256983155 
20005593572972571636269561882670428252483600823257530420752963450")

   (require (prefix ri13: (lib "13.ss" "srfi"))
            (prefix srfi1: (lib "1.ss" "srfi"))
            (lib "testing.ss" "htdp")
            (lib "etc.ss"))

   ;! Get the greatest product of consecutive digits in a number
   ;; cpu time: 3253 real time: 3377 gc time: 535
   (define (grant-s-product str digits)
     (let* ([len (string-length str)]
            [stop (add1 (- len digits))])
       (let loop ([start 0] [end digits] [found 0])
         (if (= start stop) found
             (let* ([candidate (apply * (map string->number (map  
string (ri13:string-fold cons '() (ri13:substring/shared str start  
end)))))]
                    [next-start (add1 start)]
                    [next-end (+ next-start digits)])
               (loop next-start next-end (if (> candidate found)  
candidate found)))))))

   ;; cpu time: 938 real time: 938 gc time: 183
   (define (mf-s-product.v1 str span)
     (define str-as-digits (string->digits str))
     (define candidate (srfi1:take str-as-digits span))
     (let loop ([candidate candidate][rest (cdr str-as-digits)][found  
(apply * candidate)])
       (if (>= (length rest) span)
           (let ([candidate (srfi1:take rest span)])
             (loop candidate (cdr rest) (max (apply * candidate)  
found)))
           found)))

   ;; cpu time: 907 real time: 905 gc time: 192
   (define (mf-s-product.v2 str span)
     (define str-as-digits (string->digits str))
     (define candidate (srfi1:take str-as-digits span))
     (define rest (cdr str-as-digits))
     (let loop ([candidate candidate][rest rest][len (length rest)] 
[found (apply * candidate)])
       (if (>= len span)
           (let ([candidate (srfi1:take rest span)])
             (loop candidate (cdr rest) (- len 1) (max (apply *  
candidate) found)))
           found)))

   ;; you can't rule out 0 digits
   (define (mf-s-product-WRONG str span)
     (define str-as-digits (string->digits str))
     (define candidate (apply * (srfi1:take str-as-digits span)))
     (define first (car str-as-digits))
     (define rest (srfi1:drop str-as-digits span))
     (let loop ([candidate candidate][first first][rest rest][found  
candidate])
       (if (pair? rest)
           (let* ([nufst (car rest)]
                  [candidate (/ (* candidate nufst) first)])
             (loop candidate nufst (cdr rest) (max candidate found)))
           found)))

   ;; String -> [Listof (union 0 ... 9)]
   (define (string->digits str)
     (define ch0 (char->integer #\0))
     (map (lambda (d) (- (char->integer d) ch0)) (string->list str)))

   ;; Tests
   (check-expect (grant-s-product "1209" 2) 2)
   (check-expect (grant-s-product "9238" 3) 54)
   (check-expect (grant-s-product "1234" 2) 12)

   (check-expect (mf-s-product "1209" 2) 2)
   (check-expect (mf-s-product "9238" 3) 54)
   (check-expect (mf-s-product "1234" 2) 12)

   (generate-report)

   ;; Performance Tests
   (define (perform f)
     (define ten-thousand-times (build-list 100000 add1))
     (collect-garbage)
     (time (begin (printf "the result ~s\n" (f the-number 5))
                  (for-each (lambda (x) (f "1234567890" 2)) ten- 
thousand-times))))

   (perform grant-s-product)
   (perform mf-s-product)

   (require (lib "contract.ss"))

   (provide/contract
    [grant-s-product (->r ((s (and/c string? string->number))
                           (span (and/c natural-number/c (</c (length  
s)))))
                          natural-number/c)])

   )



Posted on the users mailing list.