0
다음 코드가 실행될 때 결과의 특정 위치에서 #<procedure:me>의 반복이 계속 발생하며 이유를 파악할 수 없습니다. 테스트하려면Scheme match-maker의 버그
: 실행 여기에 (match-make men women)
코드입니다 : 라켓
(define (write-line x)
(display x)
(newline))
(define (append! a b)
(if (null? (cdr a))
(set-cdr! a b)
(append! (cdr a) b)))
에 대한
; 호환성; 이것은 매치 메이킹 프로그램을 시작하고 ; 초기 제안자와 제안자는 자신의 상태를 다시 설정하고 ; 구애 절차에 그들을 보낸다 ; 제안이 시작됩니다.
(define (match-make proposers proposees)
(send proposers 'reset)
(send proposees 'reset)
(courtship proposers proposers)
(zip-together (send proposers 'name)
(send (send proposers 'intended) 'name)))
; 계약되지 않은 각 제안자는 이 없을 때까지 제안합니다. 더 많은 미 체결 된 제안자
(define (courtship unengaged-proposers proposers)
(if (null? unengaged-proposers)
(display "match-make complete")
(begin ((car unengaged-proposers) 'propose)
(courtship (currently-unengaged unengaged-proposers) proposers))))
; 현재 연결되지 않은 사람들을 얻습니다.
(define (currently-unengaged list-of-people)
(filter unengaged list-of-people))
; 사람이 연결되지 않았는지 확인합니다.
(define (unengaged person)
(if (null? (person 'intended))
#t
#f))
; 주어진 메시지를 각 사람에게 보냅니다. ; 주어진 사람 목록에
(define (send list-of-people message)
(if (null? list-of-people)
'()
(begin ((car list-of-people) message)
(send (cdr list-of-people) message))))
; 주어진 사람이 두명인지 확인합니다. ; 한 쌍입니다
(define (couple? person1 person2)
(if ((eq? (person1 'intended) person2) #t)
#t
#f))
; 주어진 두 목록을 결합합니다.
(define (zip-together list1 list2)
(if (null? list1)
'()
(cons (list (car list1) (car list2))
(zip-together (cdr list1) (cdr list2)))))
; 사실 인 각 요소를 결합합니다. ; 주어진 술어에 대해
(define (filter pred lst)
(cond ((null? lst) '())
((pred (car lst)) (cons (car lst) (filter pred (cdr lst))))
(else (filter pred (cdr lst)))))
; 두 개의 목록 (list1)과 다른 목록을 가져옵니다. ; 길이 목록 (list2)을 반환하고 을 반환합니다. 목록 1에있는 두 가지 중 먼저 나타나는 부분 ; 목록 2에서
(define (preference list1 list2)
(write (list list1 list2))
(cond ((eq? (car list1) (car list2)) (car list1))
((eq? (cadr list1) (car list2)) (cadr list1))
(else (preference list1 (cdr list2)))))
; 특정 상태의 사람을 만듭니다. ; 그리고 어떤 메시지는 이라고 부를 수 있습니다. 그 사람. 나는 그 (것)들 곳에 표를했다 ; 문제 1에 추가되었고 문제 2는 ; 어디에서든 디스플레이 및 개행을 말합니다.
(define (make-person my-name)
(let ((preference-list '())
(possible-mates '())
(current-intended '()))
(define (i-like-more person1 person2) ;Problem 1
(preference (list person1 person2) preference-list)
(cond ((eq? (car (me 'loves)) person1) #t)
((eq? (car (me 'loves)) person2) #f)
(else (preference (list person1 person2) (cdr preference-list)))))
(define (me message)
(cond ((eq? message 'name) my-name)
((eq? message 'intended) current-intended)
((eq? message 'loves) preference-list)
((eq? message 'possible) possible-mates)
((eq? message 'reset)
(set! current-intended '())
(set! possible-mates preference-list)
'reset-done)
((eq? message 'load-preferences)
(lambda (plist)
(set! preference-list plist)
(set! possible-mates plist)
(set! current-intended '())
'preferences-loaded))
((eq? message 'propose)
(let ((beloved (car possible-mates)))
(begin
(set! possible-mates (cdr possible-mates))
(begin
(display (me 'name))
(display " proposed to ")
(display (beloved 'name))
(newline))
(if (eq? ((beloved 'i-love-you) me)
'i-love-you-too)
(begin
(display (me 'name))
(display " and ")
(display (beloved 'name))
(display " are engaged ")
(newline)
(set! current-intended beloved)
'we-are-engaged)
(begin
(display "no one loves me")
'no-one-loves-me)))))
((eq? message 'i-love-you) ;Problem 1
(lambda (proposer)
(cond
((null? (me 'intended))
(begin
(set! current-intended proposer)
(display (me 'intended))
(display " says i love you too")
(newline)
'i-love-you-too))
((i-like-more proposer (me 'intended))
(begin
(set! current-intended proposer)
(display (me 'intended))
(display " dumped ")
(display (me 'intended))
(newline)
(((me 'intended) 'i-changed-my-mind) me)
'i-love-you-too))
(else (begin
(display (me 'intended))
(display " rejected ")
(display (me 'name))
'buzz-off-creep)))))
((eq? message 'i-changed-my-mind)
(lambda (lost-love)
(cond ((eq? current-intended lost-love)
(set! current-intended '())
'dumped!)
(else
'there-must-be-some-misunderstanding))))
(else
(display "Bad message to a person")
(newline)
(list my-name message))))
me))
; 이것은 사용되는
(define alan (make-person 'Alan))
(define bob (make-person 'Bob))
(define charles (make-person 'Chuck))
(define david (make-person 'Dave))
(define ernest (make-person 'Ernie))
(define franklin (make-person 'Frank))
(define agnes (make-person 'Agnes))
(define bertha (make-person 'Bertha))
(define carol (make-person 'Carol))
(define deborah (make-person 'Debbie))
(define ellen (make-person 'Ellen))
(define francine (make-person 'Fran))
((alan 'load-preferences)
(list agnes carol francine bertha deborah ellen))
((bob 'load-preferences)
(list carol francine bertha deborah agnes ellen))
((charles 'load-preferences)
(list agnes francine carol deborah bertha ellen))
((david 'load-preferences)
(list francine ellen deborah agnes carol bertha))
((ernest 'load-preferences)
(list ellen carol francine agnes deborah bertha))
((franklin 'load-preferences)
(list ellen carol francine bertha agnes deborah))
((agnes 'load-preferences)
(list charles alan bob david ernest franklin))
((bertha 'load-preferences)
(list charles alan bob david ernest franklin))
((carol 'load-preferences)
(list franklin charles bob alan ernest david))
((deborah 'load-preferences)
(list bob alan charles franklin david ernest))
((ellen 'load-preferences)
(list franklin charles bob alan ernest david))
((francine 'load-preferences)
(list alan bob charles david franklin ernest))
(define men (list alan bob charles david ernest franklin))
(define women (list agnes bertha carol deborah ellen francine))
로 정의되어야한다. 질문자가 겪고있는 문제가 명확하지 않습니다. – dyoo
질문이 뭐니? 더 명확하게하십시오. –
질문이 답할 수있을 때까지 답을 내릴 수 있습니다. 지금은 불행히도 아닙니다. – dyoo