GPS

有兴趣的可以wiki上的简述，闲得无聊看PAIL的时候，自己写了一个Mini-GPS玩。GPS说是一个“AI”程序，在实现的时候，发现和
图的路径查找十分相似，用图的想法去实现GPS,甚至比PATL上面的实现简单点。

1
2
3
4
5
6
7
8
(define pic 
	(translate-pic'(("poor" "job" "finding-job") 
				("job" "rich" "harding-work") 
				("poor" "rich" "robbery") 
				("rich" "beautiful" "sleeping") 
				("poor" "healthy" "sleeping")))
(find-roads "poor" "rich" pic)

程序如下

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
(define GPS find-roads)
(define find-roads
	(lambda (start-node end-node pic)
		(if (equal? start-node end-node)
			(list (list))	;;;;;;;;;;;;;;;;;;in there, have some confuse
			(let ((next-nodes (find-next-nodes pic start-node))
				(road-names (find-road-names pic start-node)))
				(if (null? next-nodes)
					"not-roads"
					(let ((list-roadss 
							(map (lambda (node)
									(find-roads node end-node pic))
								next-nodes))) 
							(convert list-roadss road-names)))))))

(define delete-not-roads
	(lambda (list-roadss road-names)
		(if (null? list-roadss)
			(list (list) (list))
			(if (equal? "not-roads" (car list-roadss))
				(delete-not-roads (cdr list-roadss) (cdr road-names))
				(let ((roadss&names 
						(delete-not-roads
							(cdr list-roadss) 
							(cdr road-names))))
					(let ((roadss (car roadss&names))
						(names (cadr roadss&names)))
						(list 
							(cons
								(car list-roadss)
								roadss)
							(cons
								(car road-names)
								names))))))))
(define accumulate
	(lambda (ope lst)
		(if (null? lst)
			(list)
			(ope (car lst) 
				(accumulate ope (cdr lst))))))

(define convert
	(lambda (list-roadss road-names)
		(let ((roadss&names 
				(delete-not-roads 
					list-roadss
					road-names)))
			(let ((roadss (car roadss&names))
				(names (cadr roadss&names)))
				(if (null? roadss)
					"not-roads"
					(accumulate append
						(map (lambda (roads road-name)
								(map (lambda (road)
										(cons road-name road))
									roads))
							roadss names)))))))
(define translate-pic
	(lambda (lines)
		(let ((nodes (get-nodes lines (list))))
			(map (lambda (node) 
					(get-pic-element node lines))
				nodes))))
(define get-nodes
	(lambda (lines nodes)
		(if (null? lines)
			nodes
			(let ((s (car (car lines)))
				(e (cadr (car lines))))
				(if (have? s nodes)
					(if (have? e nodes)
						(get-nodes (cdr lines)
							nodes)
						(get-nodes (cdr lines)
							(cons e nodes)))
					(if (have? e nodes)
						(get-nodes lines
							(cons s nodes))
						(get-nodes lines
							(cons e (cons s nodes)))))))))
(define have?
	(lambda (var vars)
		(if (null? vars)
			#f
			(if (equal? var (car vars))
				#t
				(have? var (cdr vars))))))
(define get-pic-element
	(lambda (node lines)
		(if (null? lines)
			(list node (list) (list))
			(let ((pic-element
					(get-pic-element node 
						(cdr lines))))
				(let ((next-nodes (cadr pic-element))
					(roads (caddr pic-element)))
					(if (equal? node (car (car lines)))
						(let ((next-node (cadr (car lines)))
							(road (caddr (car lines))))
							(list node (cons next-node next-nodes)
									(cons road roads)))
						pic-element)))))) 
(define find-next-nodes
	(lambda (pic node)
		(if (null? pic)
			(list)
			(let ((line (car pic)))
				(if (equal? node (car line))
						(cadr line)
					(find-next-nodes (cdr pic) node))) )))
(define find-road-names
	(lambda (pic node)	
		(if (null? pic)
			(list)
			(let ((line (car pic)))
				(if (equal? node (car line))
					(caddr line)
					(find-road-names (cdr pic) node))))))