43 lines
1.5 KiB
Scheme
43 lines
1.5 KiB
Scheme
(define (entropy input)
|
|
(define (close? a b)
|
|
(define (norm x y)
|
|
(define (infinite_norm m n)
|
|
(define (absminus p q)
|
|
(cond ((null? p) '())
|
|
(else (cons (abs (- (car p) (car q))) (absminus (cdr p) (cdr q))))))
|
|
(define (mm l)
|
|
(cond ((null? (cdr l)) (car l))
|
|
((> (car l) (cadr l)) (mm (cons (car l) (cddr l))))
|
|
(else (mm (cdr l)))))
|
|
(mm (absminus m n)))
|
|
(if (pair? x) (infinite_norm x y) (abs (- x y))))
|
|
(let ((epsilon 0.2))
|
|
(< (norm a b) epsilon)))
|
|
(define (freq-list x)
|
|
(define (f x)
|
|
(define (count a b)
|
|
(cond ((null? b) 1)
|
|
(else (+ (if (close? a (car b)) 1 0) (count a (cdr b))))))
|
|
(let ((t (car x)) (tt (cdr x)))
|
|
(count t tt)))
|
|
(define (g x)
|
|
(define (filter a b)
|
|
(cond ((null? b) '())
|
|
((close? a (car b)) (filter a (cdr b)))
|
|
(else (cons (car b) (filter a (cdr b))))))
|
|
(let ((t (car x)) (tt (cdr x)))
|
|
(filter t tt)))
|
|
(cond ((null? x) '())
|
|
(else (cons (f x) (freq-list (g x))))))
|
|
(define (scale x)
|
|
(define (sum x)
|
|
(if (null? x) 0.0 (+ (car x) (sum (cdr x)))))
|
|
(let ((z (sum x)))
|
|
(map (lambda(m) (/ m z)) x)))
|
|
(define (cal x)
|
|
(if (null? x) 0 (+ (* (car x) (/ (log (car x)) (log 2))) (cal (cdr x)))))
|
|
(- (cal (scale (freq-list input)))))
|
|
|
|
(entropy (list 1 2 2 3 3 3 4 4 4 4))
|
|
(entropy (list (list 1 1) (list 1.1 1.1) (list 1.2 1.2) (list 1.3 1.3) (list 1.5 1.5) (list 1.6 1.6)))
|