guile-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

guile-vm 0.4


From: Keisuke Nishida
Subject: guile-vm 0.4
Date: Sat, 07 Apr 2001 09:11:49 -0400
User-agent: Wanderlust/2.4.0 (Rio) SEMI/1.13.7 (Awazu) FLIM/1.13.2 (Kasanui) Emacs/21.0.102 (i686-pc-linux-gnu) MULE/5.0 (SAKAKI)

This is the latest snapshot of my Guile VM implementation:

  http://home.cwru.edu/~kxn30/guile-vm-0.4.tar.gz

Try with the latest Guile and slib.

This time, the VM solves at least the N-queens problem:

  % guile-vm
  Guile Scheme interpreter 0.4 on Guile 1.4.1
  Copyright (C) 2001 Free Software Foundation, Inc.

  Enter `,help' for help.
  address@hidden> ,load queens.scm
  address@hidden> ,trace (queens 1)
  (queens 1)
  (queen-cols 1)
  | (queen-cols 0)
  | (())
  | (flatmap #<program 80c78b0> (()))
  | | | (#<program 80c78b0> ())
  | | | | (enumerate-interval 1 1)
  | | | | | (enumerate-interval 2 1)
  | | | | | ()
  | | | | (1)
  | | | | | (#<program 80c788b> 1)
  | | | | | (adjoin-position 1 1 ())
  | | | | | (1)
  | | | ((1))
  | (accumulate #<primitive-procedure append> () (((1))))
  | | (accumulate #<primitive-procedure append> () ())
  | | ()
  | ((1))
  (filter #<program 80c7855> ((1)))
  | (#<program 80c7855> (1))
  | (safe? 1 (1))
  | #t
  | (filter #<program 80c7855> ())
  | ()
  ((1))
  address@hidden> (queens 2)
  $1 = ()
  address@hidden> (queens 3)
  $2 = ()
  address@hidden> (queens 4)
  $3 = ((2 4 1 3) (3 1 4 2))
  address@hidden> (queens 5)
  $4 = ((1 3 5 2 4) (1 4 2 5 3) (2 4 1 3 5) (2 5 3 1 4) (3 1 4 2 5) (3 5 2 4 1) 
(4 1 3 5 2) (4 2 5 3 1) (5 2 4 1 3) (5 3 1 4 2))
  address@hidden> (queens 6)
  $5 = ((2 4 6 1 3 5) (3 6 2 5 1 4) (4 1 5 2 6 3) (5 3 1 6 4 2))

Have fun.

Keisuke


(define (filter predicate sequence)
  (cond ((null? sequence) '())
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define (flatmap proc seq)
  (accumulate append '() (map proc seq)))

(define (enumerate-interval low high)
  (if (> low high)
      '()
      (cons low (enumerate-interval (+ low 1) high))))

(define empty-board '())

(define (queens board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

(define (adjoin-position new-row k rest-of-queens)
  (append rest-of-queens (list new-row)))

(define (safe? k positions)
  (let ((new  (car (last-pair positions)))
        (bottom (car positions)))
    (cond ((= k 1) #t)
          ((= new bottom) #f)
          ((or (= new (- bottom (- k 1))) (= new (+ bottom (- k 1)))) #f)
          (else (safe? (- k 1) (cdr positions))))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]