关于SICP3.3.4的agenda

PeterGhostWolf

书中只说了after-delay和propagate的实现,但是没有提到其中agenda的实现.
我看了一下置顶,似乎答案里也没有提到这个...
但是为了能让里面的东西跑起来,我自己实现了一个agenda,经过了简单的测试.
如果以后有人做到这里,可以拿来参考一下
技巧拙劣,还望指教:
(其中propagate的用法略有不同,我增加了一个表参数
还擅自增加了一个"执行到设定的某个时间停止"的操作act-to-time,第一个参数是时间(没有判断是否会逆向),第二个参数是待处理表)

1. 
   
2. ;Agenda
   
3. 
   
4. (define (get-time pro-element)
   
5.   (car pro-element))
   
6. 
   
7. (define (get-action pro-element)
   
8.   (cdr pro-element))
   
9. 
   
10. (define (make-agenda)
    
11.   (cons 0 '()))
    
12. 
    
13. (define (empty-agenda? agenda)
    
14.   (null? (cdr agenda)))
    
15. 
    
16. (define (first-agenda-item agenda)
    
17.   (cadr agenda))
    
18. 
    
19. (define (remove-first-agenda-item! agenda)
    
20.   (if (empty-agenda? agenda) (display "Try to delete an empty agenda")
    
21.       (set-cdr! agenda (cddr agenda)))
    
22.   'done)
    
23. 
    
24. (define (set-agenda-time! time agenda)
    
25.   (set-car! agenda time))
    
26. 
    
27. (define (add-to-agenda! time action agenda)
    
28.   (if (or (null? (cdr agenda))
    
29.           (> (get-time (cadr agenda)) time)) (let ((new-procedure (cons time action)))
    
30.                                                (let ((new-list (cons new-procedure (cdr agenda))))
    
31.                                                  (set-cdr! agenda new-list)
    
32.                                                  'ok))
    
33.       (add-to-agenda! time action (cdr agenda))))
    
34. 
    
35. (define (action-first! agenda)
    
36.   (if (empty-agenda? agenda) (display "Try to act an empty agenda!")
    
37.       (let ((first-element (first-agenda-item agenda)))
    
38.         ((get-action first-element))
    
39.         (set-agenda-time! (get-time first-element) agenda)
    
40.         (remove-first-agenda-item! agenda)
    
41.         'ok
    
42.         )))
    
43. 
    
44. (define (act-to-time! time agenda)
    
45.   (if (or (empty-agenda? agenda)
    
46.           (< time (get-time (first-agenda-item agenda)))) (begin
    
47.                                                            (set-agenda-time! time agenda)
    
48.                                                            'done)
    
49.       (begin
    
50.         (set-agenda-time! (get-time (first-agenda-item agenda)) agenda)
    
51.         (action-first! agenda)
    
52.         (act-to-time! time agenda))))
    
53.       
    
54. 
    
55. (define (current-time agenda)
    
56.   (car agenda))
    
57. 
    
58. (define (propagate agenda)
    
59.   (if (empty-agenda? agenda) 'done
    
60.       (begin
    
61.         (action-first! agenda)
    
62.         (propagate agenda))))
    
63. 
    
64. (define (reset-agenda! agenda)
    
65.   (set-agenda-time! 0 agenda)
    
66.   (set-cdr! agenda '())
    
67.   'done)
    
68. 
    
69. (define the-agenda (make-agenda))
    
70. 
    
71. (define (after-delay delay action)
    
72.   (add-to-agenda! (+ delay (current-time the-agenda))
    
73.                   action
    
74.                   the-agenda))
    

复制代码

[ 本帖最后由 PeterGhostWolf 于 2009-3-17 18:12 编辑 ]

win_hate

书上有的。

第 195 页下方，有一节：“待处理表的实现”

不过自己实现一个比从书上抄更好，支持！ :wink:

PeterGhostWolf

原帖由 win_hate 于 2009-3-17 18:24 发表
书上有的。

第 195 页下方，有一节：“待处理表的实现”

不过自己实现一个比从书上抄更好，支持！ :wink:

我顿时泪奔了....
不过可以看一下自己的实现和书上的区别和差距...