This commit is contained in:
xenia 2021-06-10 05:59:48 -04:00
parent 5902a5b7e2
commit fc14f5ee76
1 changed files with 46 additions and 0 deletions

46
racket/efi/meow.rkt Normal file
View File

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