meo

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