求scheme大佬看一下这道题有偿回答!!!
scheme吧
全部回复
仅看楼主
level 1
男alittle 楼主
求scheme大佬看一下这道题
有偿回答!!![花心][花心][花心]
2020年03月21日 03点03分 1
level 6
(define (make-graph)
(define graph '())
(define (member-parent element parent lst)
(if (null? lst)
#f
(if (eq? element (car lst))
parent
(member-parent element lst (cdr lst)))))
(define (member-assoc-parent element parent lst)
(if (null? lst)
#f
(if (eq? element (caar lst))
parent
(member-assoc-parent element lst (cdr lst)))))
(define (add-node . s)
(if (member (car s) (map car graph))
#f
(begin
(set! graph (cons s graph))
#t)))
(define (add-edge . s)
(let ((from (assoc (car s) graph)))
(if from
(let ((to (assoc (cadr s) graph)))
(if to
(if (member (cadr s) (cdr from))
#f
(begin (set-cdr! from (cons (cadr s) (cdr from))) #t))
#f))
#f)))
(define (remove-edge . s)
(let ((lst (assoc (car s) graph)))
(if lst
(let ((delete-point-parent (member-parent (cadr s) lst (cdr lst))))
(if delete-point-parent
(begin (set-cdr! delete-point-parent (cddr delete-point-parent)) #t)
#f))
#f)))
(define (remove-node . s)
(let ((node-list-parent (member-assoc-parent (car s) '() graph)))
(if (not node-list-parent)
#f
(begin
(if (null? node-list-parent)
(set! graph (cdr graph))
(set-cdr! node-list-parent (cddr node-list-parent)))
(for-each
(lambda (node-link-list)
(let ((delete-point-parent (member-parent (car s) node-link-list (cdr node-link-list))))
(if delete-point-parent
(set-cdr! delete-point-parent (cddr delete-point-parent))
;Do nothing, = (void)
(set! graph graph))))
graph)
#t))))
(define (display-graph . s)
(for-each
(lambda (node-link-list)
(display (car node-link-list))
(display ":")
(for-each (lambda (linked-node) (display " ") (display linked-node)) (reverse (cdr node-link-list)))
(newline))
(reverse graph)))
(lambda (op)
(lambda s
(case op
((add-node) (apply add-node s))
((add-edge) (apply add-edge s))
((remove-edge) (apply remove-edge s))
((remove-node) (apply remove-node s))
((display) (apply display-graph s))
(else #t)))))
2020年03月30日 04点03分 4
1