[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Fun with guile, Erastones + goldbach conjecture
From: |
Ian Price |
Subject: |
Re: Fun with guile, Erastones + goldbach conjecture |
Date: |
Wed, 10 Apr 2013 01:11:13 +0100 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/23.3 (gnu/linux) |
Stefan Israelsson Tampe <address@hidden> writes:
> Hi all,
>
> The program below is an interesting variant of a sieve that given an
> even number seams to constructs two primes that added together becomes
> the even
> number, the file below does this construction for n = 3 ... 1000.
Amusing, but I feel that code like that needs a big massive disclaimer
at the top saying "CAUTION: DO NOT ACTUALLY WRITE SCHEME LIKE THIS".
Mutable circular lists? No thank you :)
Actually, I think you understand this yourself, since the circularity
infected all the procedures, and made them a little more complex than
they'd usually be.
For the newer Schemers, I've added a bunch of annotations.
> (use-modules (srfi srfi-1))
>
> (define (analyze k)
> (define n (* k 2))
> (define l (apply circular-list (map (lambda (X) #f) (iota n))))
Personally, I would move l down closer to where it is being mutated,
rather than having a bunch of procedures in the way.
> (define (shift l k)
> (let loop ((l l) (k k))
> (if (= k 0)
> l
> (loop (cdr l) (- k 1)))))
(define shift drop)
> (define (next loop)
> (let lp ((ll l) (i 0))
> (if (= i n)
> l
> (if (car ll)
> (lp (cdr ll) (+ i 1))
> (loop i l 0)))))
The continuation passing here is a bit weird, I would do two mutually
recursive procedures instead.
The additional state makes it harder to break into separate procedures,
but it feels to me like you should be able change this into a
drop-while.
>
> (define (M)
> (let lp ((l l) (k n) (M -1))
> (if (= k 0)
> M
> (let ((c (caar l)))
> (if (< M c)
> (lp (cdr l) (- k 1) c)
> (lp (cdr l) (- k 1) M))))))
M was a terrible name. :)
I'd either suggest moving the if into the third clause of loop, or
rewriting this as
(define (M)
;; maybe factor into procedure 'maximum-by'
(fold-right (lambda (x prev) (max (car x) prev))
-1
(take l n)))
Yeah it allocates, but it was either that or write a foldr for
cyclic lists.
> (define (place x)
> (let loop ((ll l) (i 0))
> (if (equal? (car ll) x)
> i
> (loop (cdr ll) (+ i 1)))))
(define (place x)
(list-index (lambda (y) (eqv? x y)) l))
> (set-car! (cdr l) (cons 1 0))
> (set-car! (shift l (- n 1)) (cons 1 0))
> (let loop ((m 2) (ll l) (k 0))
> (let ((ll (shift ll m)))
> (if (and (pair? (car ll)) (eq? (caar ll) m))
> (next loop)
> (begin
> (unless (car ll) (set-car! ll (cons m k)) (set! k (+ k 1)))
> (loop m ll k)))))
Not quite sure what to make of this.
> (let* ((M (M))
> (ll (let lp ((ll l) (k n))
> (if (= k 0)
> '()
> (cons (car ll) (lp (cdr ll) (- k 1))))))
(ll (take l n))
> (ll (fold (lambda (k r)(if (eq? (car k) M) (cons k r) r)) '() ll))
(ll (filter (lambda (x) (eq? (car x) M)) ll))
Granted, that doesn't have the same ordering, but you are sorting the
result anyway.
> (ll (sort ll (lambda (x y) (< (cdr x) (cdr y))))))
>
> (cond
> ((= (length ll) 1)
> (* (place (car ll)) 2))
> (else
> (+ (place (car ll)) (place (car (last-pair ll))))))))
(+ (place (car l1)) (place (last l1)))
For the purposes of your demonstration, it doesn't really matter, but it
would be a better idea to return those two values, rather than the sum.
Otherwise, analyze just becomes a very long-winded doubling function :)
> (let lp ((i 3))
> (if (= i 1000)
> (pk 'ok)
> (begin
> (if (not (= (* 2 i) (analyze i)))
> (format #t "~a != (analyze ~a) == ~a~%" (* 2 i) (* 2 i)
> (analyze (* 2i))))
btw, Typo here ^^^^^^
> (lp (+ i 1)))))
>
Maybe I'll meditate on this more, and post a "schemier" version.
--
Ian Price -- shift-reset.com
"Programming is like pinball. The reward for doing it well is
the opportunity to do it again" - from "The Wizardy Compiled"