50 lines
1.9 KiB
Racket
50 lines
1.9 KiB
Racket
#lang racket
|
|
|
|
(require graph)
|
|
|
|
(struct conj [name] #:transparent)
|
|
(struct requirement [name] #:transparent)
|
|
(struct item [name] #:transparent)
|
|
|
|
(define (requirements->req-graph requirements)
|
|
(define G (directed-graph '()))
|
|
(for ([(req-name deps-any-of) (in-hash requirements)])
|
|
(define d (requirement req-name))
|
|
(add-vertex! G d)
|
|
(for ([deps-all-of (in-list deps-any-of)])
|
|
(define c (conj (gensym)))
|
|
(add-directed-edge! G d c)
|
|
(for ([dep (in-list (if (list? deps-all-of) deps-all-of (list deps-all-of)))])
|
|
(add-directed-edge! G c (if (hash-has-key? requirements dep)
|
|
(requirement dep)
|
|
(item dep))))))
|
|
G)
|
|
|
|
(define (attainable-list held requirements)
|
|
(define G (requirements->req-graph requirements))
|
|
(define-vertex-property G attainable?
|
|
#:init (or (and (item? $v) (set-member? held (item-name $v)))
|
|
(conj? $v)
|
|
(and (requirement? $v) (empty? (get-neighbors G $v)))))
|
|
(define-vertex-property G visited? #:init #f)
|
|
(do-dfs G
|
|
#:prologue: (visited?-set! $to #t)
|
|
#:visit?: (not (visited? $to))
|
|
#:epilogue: (cond
|
|
[(and (conj? $from) (not (attainable? $to)))
|
|
(attainable?-set! $from #f)]
|
|
[(and (requirement? $from) (attainable? $to))
|
|
(attainable?-set! $from #t)]))
|
|
(for/list ([v (in-vertices G)] #:when (and (requirement? v) (attainable? v)))
|
|
(requirement-name v)))
|
|
|
|
(define requirements
|
|
(hash "a" (list (list "apples" "bananas" "meows") (list "bananas") (list "c"))
|
|
"b" '()
|
|
"d" (list (list "apples" "d"))
|
|
"c" (list (list "apples" "meows"))))
|
|
(define held (set "apples" "bananas" "clementines"))
|
|
|
|
(module+ main
|
|
(displayln (attainable-list held requirements)))
|