Changeset 39353 in project


Ignore:
Timestamp:
11/23/20 19:34:41 (5 months ago)
Author:
Kon Lovett
Message:

add merge & sorted, based on list, add tests

Location:
release/5/micro-stats/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/micro-stats/trunk/micro-stats.scm

    r39349 r39353  
    125125
    126126;;
     127
     128(define *empty-vector* (vector))
    127129
    128130(define NORMAL-STATISTICS '(
     
    311313;
    312314(define (chi-square observed expected)
    313   (seq:smap seq*:*empty-vector* (cut chi-sample <> expected) observed) )
     315  (seq:smap *empty-vector* (cut chi-sample <> expected) observed) )
    314316
    315317;samples : (seq-of observed)
     
    318320;
    319321(define (chi-squares samples expected)
    320   (seq:smap seq*:*empty-vector* (cut chi-square <> expected) samples) )
    321 
    322 ;;
    323 
    324 (define (component o e) (let ((r (o - e))) (/ (* r r) e)))
     322  (seq:smap *empty-vector* (cut chi-square <> expected) samples) )
     323
     324;;
     325
     326(define (component o e) (let ((r (- o e))) (/ (* r r) e)))
    325327
    326328;observed : (seq-of real)
     
    332334      (if (seq:sequence? expected)
    333335        (seq:smap*
    334           seq*:*empty-vector*
    335           (lambda (value it)
    336             (component value (seq:elt expected (seq:index it))) )
     336          *empty-vector*
     337          (lambda (value it) (component value (seq:elt expected (seq:index it))))
    337338          observed)
    338         (seq:smap seq*:*empty-vector* (cut component <> expected) observed) ) ) )
     339        (seq:smap *empty-vector* (cut component <> expected) observed) ) ) )
    339340    (seq:foldl + 0 components) ) )
    340341
  • release/5/micro-stats/trunk/seq-utils.scm

    r39348 r39353  
    77
    88(;export
    9   sort! sort
     9  merge merge!
     10  sort sort! sorted?
    1011  histogram
    11   unfold-alist
    12   *empty-vector*)
     12  unfold-alist)
    1313
    1414(import scheme
     
    2929(define-type histogram-list list)
    3030
     31(: sorted? (seq binary-predicate --> boolean))
     32(: merge! (seq seq binary-predicate -> seq))
     33(: merge (seq seq binary-predicate -> seq))
    3134(: sort! (seq binary-predicate -> seq))
    3235(: sort (seq binary-predicate -> seq))
     
    3740;;
    3841
    39 (define *empty-vector* (vector))
     42(define *empty-list* (list))
    4043
     44(define (sorted? seq less?)
     45  (let ((seqv (if (or (list? seq) (vector? seq)) seq (seq:coerce *empty-list* seq))))
     46    (chicken:sorted? seqv less?) ) )
     47
     48(define (merge! a b less?)
     49  (let* (
     50    (as (if (list? a) a (seq:coerce *empty-list* a)))
     51    (bs (if (list? b) b (seq:coerce *empty-list* b)))
     52    (rs (chicken:merge! as bs less?)) )
     53    (if (list? a) rs (seq:coerce a rs)) ) )
     54
     55(define (merge a b less?)
     56  (let* (
     57    (as (if (list? a) a (seq:coerce *empty-list* a)))
     58    (bs (if (list? b) b (seq:coerce *empty-list* b)))
     59    (rs (chicken:merge as bs less?)) )
     60    (if (list? a) rs (seq:coerce a rs)) ) )
    4161
    4262(define (sort! seq less?)
    43   ;FIXME yes, i know, a very special case
     63  ;FIXME fill-in original from sorted-list
    4464  (let* (
    45     (seqv (if (vector? seq) seq (seq:coerce *empty-vector* seq)))
    46     (resv (chicken:sort! seqv less?)) )
    47     (if (vector? seq) resv (seq:coerce seq resv)) ) )
     65    (seqv (if (or (list? seq) (vector? seq)) seq (seq:coerce *empty-list* seq)))
     66    (rs (chicken:sort! seqv less?)) )
     67    (if (or (list? seq) (vector? seq)) rs (seq:coerce seq rs)) ) )
    4868
    4969(define (sort seq less?)
    50   (seq:coerce seq (chicken:sort! (seq:coerce *empty-vector* seq) less?)) )
     70  (seq:coerce seq (chicken:sort! (seq:coerce *empty-list* seq) less?)) )
    5171
    5272;;
  • release/5/micro-stats/trunk/tests/micro-stats-test.scm

    r39349 r39353  
    44
    55(include "test-gloss.incl")
     6
     7;;;
     8
     9(define R1 #(1 2 3 4 5 6 7 8 9))
     10(define R2 '(1.1 2.2 3.3 4.4 5.5 6.6 7.7 8.8 9.9))
     11
     12;;;
     13
     14(test-begin "seq-utils")
     15
     16(import seq-utils)
     17
     18(test-group "sort"
     19  (define V1 #(5 3 4 2 1 9 7 8 6))
     20  (test "Performs Sort" R1 (sort V1 <))
     21  (test-assert "And Source is Unsorted" (not (sorted? V1 <)))
     22  (test "Performs Sort!" R1 (sort! V1 <))
     23  (test-assert "And Source is Sorted" (sorted? V1 <))
     24)
     25
     26(test-group "merge"
     27  (define RV #(1 1.1 2 2.2 3 3.3 4 4.4 5 5.5 6 6.6 7 7.7 8 8.8 9 9.9))
     28  (define RS '(1 2 3 4 5 6 7 8 9))
     29  (define R2x '(1.1 2.2 3.3 4.4 5.5 6.6 7.7 8.8 9.9))
     30  (test "Merges into same type" RV (merge R1 R2 <))
     31  ;must copy R2 since destructive, but only defined on lists so vector ok
     32  (test "Merges into same type" RV (merge! R1 (append R2 '()) <))
     33  ;must copy R2 since destructive, but only defined on lists so vector ok
     34  (test "Merges into same list" RS (merge! RS (append R2 '()) <))
     35)
     36
     37(test-end "seq-utils")
     38
     39;;;
    640
    741(test-begin "micro-stats")
     
    1650  (test (alist-ref 'normal (statistics-sets) eq?) (statistics-set #f))
    1751  (test (alist-ref 'verbose (statistics-sets) eq?) (statistics-set #t))
    18 )
    19 
    20 (define R1 #(1 2 3 4 5 6 7 8 9))
    21 (define R2 '(1.1 2.2 3.3 4.4 5.5 6.6 7.7 8.8 9.9))
    22 
    23 (test-group "sort"
    24   (import seq-utils)
    25   (define V1 #(5 3 4 2 1 9 7 8 6))
    26   (test "Performs Sort" R1 (sort V1 <))
    27   (test "And Source is Unsorted" V1 #(5 3 4 2 1 9 7 8 6))
    28   (test "Performs Sort!" R1 (sort! V1 <))
    29   (test "And Source is Sorted" V1 #(1 2 3 4 5 6 7 8 9))
    3052)
    3153
Note: See TracChangeset for help on using the changeset viewer.