關(guān)于SICP3.3.4的agenda

PeterGhostWolf

書中只說了after-delay和propagate的實(shí)現(xiàn),但是沒有提到其中agenda的實(shí)現(xiàn).
我看了一下置頂,似乎答案里也沒有提到這個(gè)...
但是為了能讓里面的東西跑起來,我自己實(shí)現(xiàn)了一個(gè)agenda,經(jīng)過了簡(jiǎn)單的測(cè)試.
如果以后有人做到這里,可以拿來參考一下
技巧拙劣,還望指教:
(其中propagate的用法略有不同,我增加了一個(gè)表參數(shù)
還擅自增加了一個(gè)"執(zhí)行到設(shè)定的某個(gè)時(shí)間停止"的操作act-to-time,第一個(gè)參數(shù)是時(shí)間(沒有判斷是否會(huì)逆向),第二個(gè)參數(shù)是待處理表)

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))
    

復(fù)制代碼

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

win_hate

書上有的。

第 195 頁下方，有一節(jié)：“待處理表的實(shí)現(xiàn)”

不過自己實(shí)現(xiàn)一個(gè)比從書上抄更好，支持！ :wink:

PeterGhostWolf

原帖由 win_hate 于 2009-3-17 18:24 發(fā)表
書上有的。

第 195 頁下方，有一節(jié)：“待處理表的實(shí)現(xiàn)”

不過自己實(shí)現(xiàn)一個(gè)比從書上抄更好，支持！ :wink:

我頓時(shí)淚奔了....
不過可以看一下自己的實(shí)現(xiàn)和書上的區(qū)別和差距...