-
Notifications
You must be signed in to change notification settings - Fork 1
/
relations_playground.rkt
48 lines (40 loc) · 1.27 KB
/
relations_playground.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
#lang racket/base
(require "kanren.rkt")
(define (parent c p)
(conde
[(== c 'teddy) (== p 'saraih)]
[(== c 'andrew) (== p 'steve)]
[(== c 'brook) (== p 'steve)]
[(== c 'caroline) (== p 'steve)]
[(== c 'peter) (== p 'steve)]
[(== c 'steve) (== p 'bill)]
[(== c 'roger) (== p 'bill)]
[(== c 'will) (== p 'roger)]
[(== c 'andy) (== p 'roger)]
[(== c 'earnest) (== p 'roger)]
[(== c 'jack) (== p 'bill)]
[(== c 'anne) (== p 'john)]
[(== c 'danni) (== p 'john)]
[(fresh (s) (married p s) (parent c s))]
[(fresh (s) (married s p) (parent c s))]))
(define (married h w)
(conde
[(== h 'steve) (== w 'anne)]
[(== h 'nate) (== w 'danni)]
[(== h 'bill) (== w 'katie)]
[(== h 'john) (== w 'kitty)]
[(== h 'andrew) (== w 'saraih)]))
(define (grandparent g s)
(fresh (p) (parent g p) (parent p s)))
(define (cousin c1 c2)
(fresh (gp)
(grandparent c1 gp)
(grandparent c2 gp)))
;; (run 20 (rel p c) (conj+ (grandparent c p) (== (cons c p) rel)))
;; (list->set (run 10 (gp) (grandparent 'andrew gp)))
;; unfortunately we need to gather 93 results until we get all the
;; answers for bill's grandchildren:
;; (list->set (run 93 (c) (grandparent c 'bill)))
(define (fav-num n)
(disj (== n 42)
(== (cons '? even?) n)))