[plt-scheme] Cost of string creation? / Euler 8 code review
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)])
)