From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Israelsson Tampe Newsgroups: gmane.lisp.guile.devel,gmane.lisp.guile.user Subject: Fun with guile, Erastones + goldbach conjecture Date: Tue, 09 Apr 2013 00:03:11 +0200 Message-ID: <1551498.g80VkUsTQo@warperdoze> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="nextPart10755002.HJmHzfCoMa" Content-Transfer-Encoding: 7Bit X-Trace: ger.gmane.org 1365458608 15091 80.91.229.3 (8 Apr 2013 22:03:28 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 8 Apr 2013 22:03:28 +0000 (UTC) To: guile-devel@gnu.org, guile-user@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Tue Apr 09 00:03:32 2013 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1UPK9t-0001zv-NN for guile-devel@m.gmane.org; Tue, 09 Apr 2013 00:03:25 +0200 Original-Received: from localhost ([::1]:55589 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UPK9t-0005Nf-9c for guile-devel@m.gmane.org; Mon, 08 Apr 2013 18:03:25 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:57827) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UPK9n-0005NY-8P for guile-devel@gnu.org; Mon, 08 Apr 2013 18:03:21 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UPK9m-0006Y0-7F for guile-devel@gnu.org; Mon, 08 Apr 2013 18:03:19 -0400 Original-Received: from mail-lb0-f169.google.com ([209.85.217.169]:48090) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UPK9l-0006XP-Vf; Mon, 08 Apr 2013 18:03:18 -0400 Original-Received: by mail-lb0-f169.google.com with SMTP id p11so6259918lbi.14 for ; Mon, 08 Apr 2013 15:03:16 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=x-received:from:to:subject:date:message-id:user-agent:mime-version :content-type:content-transfer-encoding; bh=FiSybavgkOTXYOwqPDdMmgL5vlNy4k9DQLPfx4EL9LY=; b=ZtK0T0Ch+fz85BH/L5VehoprM/SWjvRsq/dSjTN0lelc0z0yWTG0xVDxrdqk4O5ctA dwRXnbVSkW/UIm05qa7uy4Yz/Qd8pXf4+PxMoSutcXAnWcE0rOMEJEGlJ95vvmq5KyYK TAxGDLjqAoU5t1MvWUUAIhU2dUnARAjuk3tXvhXsEw/b2q+GocTSEa1CHEGbkDPTnQlF 2gY8qoNJVaVAJesPzL5l9hHSGbrcrkXL9BFwfOHvOy+BVm6d3g7q5sxHkTeCFBMIediE VcLu7N39l6Cv1gPH+vLVsj8S7Ahg2133X52hpC/oSeZUK5HdByU82biTcPxo/DJgeor3 pKAA== X-Received: by 10.112.130.102 with SMTP id od6mr12520962lbb.122.1365458596390; Mon, 08 Apr 2013 15:03:16 -0700 (PDT) Original-Received: from warperdoze.localnet (1-1-1-39a.veo.vs.bostream.se. [82.182.254.46]) by mx.google.com with ESMTPS id xw14sm11888171lab.6.2013.04.08.15.03.13 (version=TLSv1.1 cipher=ECDHE-RSA-RC4-SHA bits=128/128); Mon, 08 Apr 2013 15:03:14 -0700 (PDT) User-Agent: KMail/4.9.5 (Linux/3.5.0-26-generic; KDE/4.9.5; x86_64; ; ) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [fuzzy] X-Received-From: 209.85.217.169 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:16201 gmane.lisp.guile.user:10250 Archived-At: This is a multi-part message in MIME format. --nextPart10755002.HJmHzfCoMa Content-Transfer-Encoding: 7Bit Content-Type: text/plain; charset="us-ascii" 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. Have fun! /Stefan (use-modules (srfi srfi-1)) (define (analyze k) (define n (* k 2)) (define l (apply circular-list (map (lambda (X) #f) (iota n)))) (define (shift l k) (let loop ((l l) (k k)) (if (= k 0) l (loop (cdr l) (- k 1))))) (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))))) (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)))))) (define (place x) (let loop ((ll l) (i 0)) (if (equal? (car ll) x) i (loop (cdr ll) (+ i 1))))) (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))))) (let* ((M (M)) (ll (let lp ((ll l) (k n)) (if (= k 0) '() (cons (car ll) (lp (cdr ll) (- k 1)))))) (ll (fold (lambda (k r)(if (eq? (car k) M) (cons k r) r)) '() ll)) (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)))))))) (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)))) (lp (+ i 1))))) --nextPart10755002.HJmHzfCoMa Content-Disposition: attachment; filename="goldbach.scm" Content-Transfer-Encoding: 7Bit Content-Type: text/x-scheme; charset="UTF-8"; name="goldbach.scm" (use-modules (srfi srfi-1)) (define (analyze k) (define n (* k 2)) (define l (apply circular-list (map (lambda (X) #f) (iota n)))) (define (shift l k) (let loop ((l l) (k k)) (if (= k 0) l (loop (cdr l) (- k 1))))) (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))))) (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)))))) (define (place x) (let loop ((ll l) (i 0)) (if (equal? (car ll) x) i (loop (cdr ll) (+ i 1))))) (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))))) (let* ((M (M)) (ll (let lp ((ll l) (k n)) (if (= k 0) '() (cons (car ll) (lp (cdr ll) (- k 1)))))) (ll (fold (lambda (k r)(if (eq? (car k) M) (cons k r) r)) '() ll)) (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)))))))) (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)))) (lp (+ i 1))))) --nextPart10755002.HJmHzfCoMa--