2016/01/15

SICP 問題 4.50

ランダムな順に探すrambを実装する.

(use srfi-27)
(define (random-car lst)
  (list-ref lst (random-integer (length lst))))

(define (rember item lst)
  (cond ((null? lst) '())
        ((eq? (car lst) item) (cdr lst))
        (else (cons (car lst)
                    (rember item (cdr lst))))))

(define (analyze-amb exp)
  (let ((cprocs (map analyze (amb-choices exp))))
    (lambda (env succeed fail)
      (define (try-next choices)
        (if (null? choices)
            (fail)
            ((car choices) env succeed (lambda ()
                                         (try-next (cdr choices))))))
      (try-next cprocs))))

(define (analyze-ramb exp)
  (let ((cprocs (map analyze (amb-choices exp))))
    (lambda (env succeed fail)
      (define (try-next choices)
        (if (null? choices)
            (fail)
            (let ((first (random-car choices)))
              (first env succeed (lambda ()
                                   (try-next (rember first choices)))))))
      (try-next cprocs))))

(define (ramb? exp) (tagged-list? exp 'ramb))

(define (analyze exp)
  (cond ((self-evaluating? exp) (analyze-self-evaluating exp))
        ((quoted? exp) (analyze-quoted exp))
        ((variable? exp) (analyze-variable exp))
        ((assignment? exp) (analyze-assignment exp))
        ((definition? exp) (analyze-definition exp))
        ((amb? exp) (analyze-amb exp))
        ((ramb? exp) (analyze-ramb exp))
        ((if? exp) (analyze-if exp))
        ((lambda? exp) (analyze-lambda exp))
        ((let? exp) (analyze (let->combination exp)))
        ((begin? exp) (analyze-sequence (begin-actions exp)))
        ((cond? exp) (analyze (cond->if exp)))
        ((application? exp) (analyze-application exp))
        (else (error "Unknown expression type: ANALYZE" exp))))

test

;;; Amb-Eval input:
(ramb 1 2 3 4 5 6)

;;; Starting a new problem
;;; Amb-Eval value:
6

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
5

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
1

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
4

© 2022 wat-aro