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