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