This is a webchurch implementation of a model in Ref:Xu2007dt.
Consider the following tree:
[o] (height = 1) | [a] (height = 0.8) / \ / \ [b] [e] (height = 0.3) / \ / \ [c] [d] [f] [g] (height = 0) 1 4 5 7 2 6 8 3 9
Here, inner nodes represent hierarchical category labels (e.g., living thing, mammal, dog). The height of a node is a proxy for the size of its extension (e.g., because [o] is high, it might denote a large class, like “objects that can be thought about”).
Leaves represent objects that are nameable. The inference problem is this: suppose that a single label (e.g., dog) has been used to label multiple objects (e.g., 1, 2, and 4). which ontological category does this label map onto?
(define nodes '(a b c d e f g)) (define heights '((o 1) (a 0.8) (b 0.3) (e 0.3) (c 0) (d 0) (f 0) (g 0) )) (define parents '((o #f) (a o) (b a) (e a) (c b) (d b) (f e) (g e) (1 c) (2 c) (3 c) (4 d) (5 f) (6 f) (7 g) (8 g) (9 g))) (define all-nodes (append nodes '(1 2 3 4 5 6 7 8 9))) ;; check whether q is a descendent of r (define (is-child? q r) (if (equal? q #f) #f (if (equal? q r) #t (is-child? (node->parent q) r)))) (define (node->height x) (second (assoc x heights)) ) (define (node->parent x) (second (assoc x parents)) ) ;; define unnormalized prior probabilities (define weights* (map (lambda (x) (- (node->height (node->parent x)) (node->height x))) nodes)) ;; normalize prior probabilities (define weights (let ([denom (sum weights*)]) (map (lambda (x) (/ x denom)) weights*))) ;; data that we've observed (define data '(1 2)) (define k (length data)) (define epsilon 0.05) (define (likelihood* x) (expt (+ (node->height x) epsilon) (- 0 k))) (define likelihood-denom (sum (map likelihood* nodes))) (define (likelihood h) (/ (likelihood* h) likelihood-denom)) (define samples (mh-query 1000 10 ;; draw hypothesis according to prior (define node (multinomial nodes weights)) ;; query node ;; condition (if (all (map (lambda (x) (is-child? x node)) data)) (flip (likelihood node)) #f))) (hist samples)