#lang racket ;Примерен граф (define G '((a ((b 1) (c 2) (d 3) (e 2) (f 2))) (b ((a 1) (d 3) (e 1))) (c ((a 2) (e 2) (f 1))) (d ((a 3) (b 3))) (e ((a 2) (b 1) (c 2))) (f ((a 2) (c 2))) ) ) ;Извлича всички ребра на графа в списък - без повторенията (define (extractEdges G) ;Извлича ребрата като наследници на всеки връх (define (generateEdges) (if (null? G) '() (append (map (lambda (x) (cons (caar G) x)) (cadar G)) (extractEdges (cdr G))) ) ) ;Премахва повтарящите се ребра ot вида (a b)-(b a) (define (distinct L) (if (null? L) '() (cons (car L) (distinct (filter (lambda (x) (not (and (eq? (car x) (cadar L)) (eq? (caar L) (cadr x)))) ) (cdr L) ) ) ) ) ) (distinct (generateEdges)) ) ;Намира най-малкото по дължина ребро в списък ребра (define (minEdge E) (define (min x y) (if (< (caddr x) (caddr y)) x y)) (if (null? (cdr E)) (car E) (min (car E) (minEdge (cdr E))) ) ) ;подрежда ребрата в нарастващ ред по дължината (define (sortEdges E) (if (null? E) E (let ((m (minEdge E))) (cons m (sortEdges(remove m E))) ) ) ) ;Извлича списък от върховете от графа G (define (extractNodes G) (foldr cons '() (map car G))) ;Проверява дали дърво съдържа даден възел (define (contains? node tree) (if (eq? (car tree) node) #t (if (null? (cadr tree)) #f (foldr (lambda (x y) (or x y)) #f (map (lambda (x) (contains? node x)) (cadr tree))) ) ) ) ;Връща първото дърво от списъка с дървета trs, което съдържа дадения възел (define (selectTree node trs) (if (null? trs) '() (if (contains? node (car trs)) (car trs) (selectTree node (cdr trs)) ) ) ) ;Слива две дървета от списъка trees посредством реброто edge (define (joinTrees trees edge) (let ((first (selectTree (car edge) trees)) (second (selectTree (cadr edge) trees))) (cons (car first) (list(cons second (cadr first)))) ) ) ;Премахва от списъка trees дърветата, които съдържат върховете на реброто edge (define (filterTrees edge trees) (let ((first (selectTree (car edge) trees)) (second (selectTree (cadr edge) trees))) (remove second (remove first trees)) ) ) ;И най-накрая - имплементира алгоритъма на Прим върху претегления граф G (define (primAlgorithm G) ; На всяка стъпка алгоритъма взима най-малкото по тегло ребро от списъка и ;ако двата му края са в различни дървета ги свързва (define (primStep trees edges) ;Проверява дали двата края на ребро са в различни дървета от списъка trees (define (okEdge? edge) (let ((t1 (selectTree (car edge) trees))) ;за целта гледаме дали единият край попада в дърво от списъка ; и другия попада в дърво от списъка след премахване на намереното дърво (and (not (null? t1)) (not (null? (selectTree (cadr edge) (remove t1 trees))))) ) ) ;Основнат стъпка на алгоритъма - дъното е когато няма повече ребра или е останало само едно дърво (if (or (= 1 (length trees)) (null? edges)) (car trees) ;Ако може да използваме първото ребро (if (okEdge? (car edges)) ;премахваме от списъка с дърветата двете в които попадат крайщата на реброто ;и добавяме ново дърво получено от тяхното слепване. (primStep (cons (joinTrees trees (car edges)) (filterTrees (car edges) trees)) (cdr edges)) ;иначе просто изпускаме реброто (primStep trees (cdr edges)) ) ) ) ;Стартираме алгоритъма с начален списък от дървета само с един връх - получени от върховете на графа ;и сортиран списък от ребрата (primStep (map (lambda (x) (cons x '(()))) (extractNodes G)) (sortEdges (extractEdges G))) ) (primAlgorithm G)