Changeset 39348 in project


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

add seq-utils for sequence sort, add sort test

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

Legend:

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

    r39343 r39348  
    88 (test-dependencies test)
    99 (components
     10  (extension seq-utils
     11    (types-file)
     12    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings") )
    1013  (extension micro-stats
    1114    (types-file)
    12     (cond-expand
    13       (linux
    14         (csc-options "-lrt" "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings"))
    15       (else
    16         (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings")) ) ) ) )
     15    (component-dependencies seq-utils)
     16    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings") ) ) )
  • release/5/micro-stats/trunk/micro-stats.scm

    r39343 r39348  
    2323  (chicken foreign)
    2424  (only (srfi 1) first append! list-copy)
    25   (prefix sequences seq:))
     25  (prefix sequences seq:)
     26  (prefix seq-utils seq*:))
    2627
    2728;;;
    2829
     30;FIXME should be in an include file from the seq-utils egg but C5 bug
     31(define-type seq (or list vector string #;linear-sequence #;random-access-sequence))
     32(define-type binary-predicate (* * --> boolean))
     33(define-type alist (or null (list-of (pair * *))))
     34(define-type histogram-list list)
     35
    2936(define-type real (or integer float ratnum))
    3037
    31 (define-type seq (or list vector string #;linear-sequence #;random-access-sequence))
    32 
    33 (define-type binary-predicate (* * --> boolean))
    34 
    35 (define-type alist (or null (list-of (pair * *))))
    3638(define-type statistics-alist (or null (list-of (pair symbol *))))
    37 
    38 (define-type histogram-list list)
    39 
    40 (: seq*:histogram (seq #!optional binary-predicate --> histogram-list))
    41 (: seq*:unfold-alist (seq procedure * #!optional binary-predicate --> alist))
    4239
    4340(: statistics-sets (#!optional alist -> alist))
     
    5855(: mean (seq --> real real real))
    5956(: percentile (seq #!optional real binary-predicate --> real))
    60 
    61 ;;
    62 
    63 (define *example-vector* (vector))
    64 
    65 (import (chicken sort))
    66 
    67 (define (seq*:sort! seq less?)
    68   ;FIXME yes, i know, a very special case
    69   (let* (
    70     (seqv (if (vector? seq) seq (seq:coerce *example-vector* seq)))
    71     (resv (sort! seqv less?)) )
    72     (if (vector? seq) resv (seq:coerce seq resv)) ) )
    73 
    74 (define (seq*:sort seq less?) (seq:coerce seq (sort! seq less?)))
    75 
    76 ;;
    77 
    78 (define (seq*:histogram seq #!optional (eqal? equal=?))
    79   (seq*:unfold-alist seq (lambda (_ occurs) (add1 occurs)) 0 eqal?) )
    80 
    81 (define (seq*:unfold-alist seq next seed #!optional (eqal? equal=?))
    82   (define (kons bins value)
    83     (let ((cur (alist-ref value bins eqal? seed)))
    84       (alist-update! value (next value cur) bins eqal?)) )
    85   (seq:foldl kons '() seq) )
    8657
    8758;;;
     
    338309;
    339310(define (chi-square observed expected)
    340   (seq:smap *example-vector* (cut chi-sample <> expected) observed) )
     311  (seq:smap seq*:*empty-vector* (cut chi-sample <> expected) observed) )
    341312
    342313;samples : (seq-of observed)
     
    345316;
    346317(define (chi-squares samples expected)
    347   (seq:smap *example-vector* (cut chi-square <> expected) samples) )
     318  (seq:smap seq*:*empty-vector* (cut chi-square <> expected) samples) )
    348319
    349320;;
     
    359330      (if (seq:sequence? expected)
    360331        (seq:smap*
    361           *example-vector*
     332          seq*:*empty-vector*
    362333          (lambda (value it)
    363334            (component value (seq:elt expected (seq:index it))) )
    364335          observed)
    365         (seq:smap *example-vector* (cut component <> expected) observed) ) ) )
     336        (seq:smap seq*:*empty-vector* (cut component <> expected) observed) ) ) )
    366337    (seq:foldl + 0 components) ) )
    367338
  • release/5/micro-stats/trunk/tests/micro-stats-test.scm

    r39343 r39348  
    2020(define R1 #(1 2 3 4 5 6 7 8 9))
    2121(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))
     30)
    2231
    2332(test-group "mean"
Note: See TracChangeset for help on using the changeset viewer.