diff --git a/racket/efi/meow.rkt b/racket/efi/meow.rkt new file mode 100644 index 0000000..389c8bf --- /dev/null +++ b/racket/efi/meow.rkt @@ -0,0 +1,46 @@ +#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))))) + (do-dfs G + #:visit?: #t + #: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" '() + "c" (list (list "apples" "meows")))) +(define held (set "apples" "bananas" "clementines")) + +(module+ main + (displayln (attainable-list held requirements)))