PasteRack.org
Paste # 74914
2019-04-21 21:11:39

Forked from paste # 98267.

Fork as a new paste.

Paste viewed 134 times.


Embed:

  1. #lang racket
  2.  
  3. (define make-tswb
  4.   (lambda ()
  5.     (let ((records '()))
  6.       (lambda (command . args)
  7.         (cond
  8.           ((equal? command 'empty?)
  9.            (null? records))
  10.           ((equal? command 'add!)
  11.            (set! records (cons (car args) records)))
  12.           ((equal? command 'get)
  13.            (letrec ((sort-records (lambda (r) (sort r (lambda (x y) (<= (car x) (car y)))))))
  14.              (if (null? args)
  15.                  (sort-records records)
  16.                  (sort-records (filter (car args) records)))))
  17.           ((equal? command 'clear!)
  18.            (set! records '()))
  19.           ((equal? command 'analytic)
  20.            (if (< (length args) 2)
  21.                ((car args) records)
  22.                ((car args) (filter (cadr args) records)))))))))
  23.  
  24.  
  25. (define list-average
  26.   (lambda (x)
  27.     (/ (apply + x) (length x))))
  28.  
  29. (define average
  30.   (lambda (x)
  31.     (list-average (map cadddr x))))
  32.  
  33. (define list-sum
  34.   (lambda (x)
  35.     (if (null? x)
  36.         0
  37.         (+ (car x) (list-sum(cdr x))))))
  38.  
  39. (define sum
  40.   (lambda (x)
  41.     (list-sum (map cadddr x))))
  42.  
  43. (define (square x)
  44.   (* x x))
  45.  
  46. (define get-std-dev
  47.   (lambda (lst avg)
  48.     (cond
  49.      ((null? lst) 0)
  50.      ((+ (square (- (car lst) avg)) (get-std-dev (cdr lst) avg))))))
  51.  
  52. (define std-dev
  53.   (lambda (x)
  54.     (sqrt(/(get-std-dev (map cadddr x) (average x))(length x)))))
  55.  
  56. (define list-min
  57.   (lambda (lst num)
  58.     (cond
  59.       ((null? lst) num)
  60.       ((< num (car lst))
  61.        (list-min (cdr lst) num))
  62.        (else
  63.         (list-min (cdr lst) (car lst))))))
  64.  
  65. (define minimum
  66.   (lambda (x)
  67.     (list-min (cdr (map cadddr x))(car (map cadddr x)))))
  68.  
  69. (define list-max
  70.   (lambda (lst num)
  71.     (cond
  72.       ((null? lst) num)
  73.       ((> num (car lst))
  74.        (list-max (cdr lst) num))
  75.        (else
  76.         (list-max (cdr lst) (car lst))))))
  77.  
  78. (define maximum
  79.   (lambda (x)
  80.     (list-max (cdr (map cadddr x))(car (map cadddr x)))))
  81.  
  82. (define counter
  83.   (lambda (x)
  84.     (length x)))
  85.  
  86. (define count
  87.   (lambda (x)
  88.     (counter (map cadddr x))))
  89.  
  90. (define odd
  91.   (lambda (sorted-list num-list med)
  92.     (if (null? num-list)
  93.         med
  94.         (odd (cdr sorted-list) (cdr num-list) (car sorted-list)))))
  95.  
  96. (define even
  97.   (lambda (sorted-list num-list)
  98.     (if (equal? (length num-list) 1)
  99.         (/(+(car sorted-list)(cadr sorted-list))2)
  100.         (even (cdr sorted-list) (cdr num-list)))))
  101.  
  102. (define get-median
  103.   (lambda (sorted-list num-list)
  104.     (cond
  105.       ((odd? (length sorted-list))
  106.        (odd sorted-list num-list 0))
  107.       ((even? (length sorted-list))
  108.        (even sorted-list num-list)))))
  109.  
  110. (define median
  111.   (lambda (x)
  112.     (get-median (sort (map cadddr x) <) (range (/ (length x) 2)))))
  113.  
  114. (define range
  115.   (lambda (x)
  116.     (- (maximum x) (minimum x))))
  117.  
  118.  
  119. (define tswb (make-tswb))
  120.  
  121. ;(tswb 'empty?)
  122. (tswb 'add!     '(2 123 "temp1"  72.1))
  123. (tswb 'add!     '(1 123 "temp1"  72.0))
  124. ;(tswb 'add!     '(3 123 "temp1"  72.5))
  125. ;(tswb 'add!     '(4 123 "temp1"  72.4))
  126. ;(tswb 'add!     '(5 123 "temp1"  72.15))
  127. ;(tswb 'add!     '(7 123 "temp1"  72.5))
  128. ;(tswb 'add!     '(6 123 "temp1"  72.5))
  129. (tswb 'add!     '(2 123 "press1" 29.9213))
  130. (tswb 'add!     '(1 123 "press1" 29.9212))
  131. (tswb 'add!     '(1 456 "temp1"  87.3))
  132. (tswb 'add!     '(1 456 "temp2"  87.4))
  133. (tswb 'add!     '(1 456 "press1" 28.9234))
  134. ;(tswb 'empty?)
  135. ;(tswb 'get)
  136. ;(tswb 'get(lambda (l) (eqv? (cadr l) 456)))                      ; return records for device 456 in time order
  137. ;(tswb 'get(lambda (l) (eqv? (caddr l) "temp1")))           ; return the temp1 fields for all devices
  138.  
  139. (define (temp1-123 l)
  140.   (and (eqv? (cadr l) 123) (eqv? (caddr l) "temp1")))
  141.  
  142. (tswb 'get temp1-123)                   ;get all the temp1 fields for device 123
  143. "Sum of temp1-123"
  144. (tswb 'analytic sum temp1-123)
  145. "Average"
  146. (tswb 'analytic average temp1-123)
  147. "Standard Deviation"
  148. (tswb 'analytic std-dev)
  149. "Minimum"
  150. (tswb 'analytic minimum temp1-123)
  151. "Maximum"
  152. (tswb 'analytic maximum temp1-123)
  153. "Count"
  154. (tswb 'analytic count temp1-123)
  155. "Median"
  156. (tswb 'analytic median temp1-123)
  157. "Range"
  158. (tswb 'analytic range temp1-123)
  159. "Sum of all data"
  160. (tswb 'analytic sum)                          ;sum of all data in the database
  161. (tswb 'clear!)                                ;clear the db
  162. (tswb 'empty?)
  163. ;(tswb 'get (lambda (l) (eqv? (cadr l) 456)))    ; return records for device 456 in time order
  164. ;(tswb 'get temp1-123)                       ; get all the temp1 fields for device 123
  165.  
  166.  
  167. ; ---------------------------------------------------------------------------------------
  168. ;(display (tswb 'get (lambda(x) (> (list-ref x 3) 72.1))))
  169.  
  170. ;(define stk (make-stack))
  171. ;stk
  172. ;(define stk2 (make-stack))
  173. ;stk2
  174. ;(sort '(2 3 4 3 1) >)

=>

'((1 123 "temp1" 72.0) (2 123 "temp1" 72.1))

"Sum of temp1-123"

144.1

"Average"

72.05

"Standard Deviation"

25.465917780605736

"Minimum"

72.0

"Maximum"

72.1

"Count"

2

"Median"

72.05

"Range"

0.09999999999999432

"Sum of all data"

407.56590000000006

#t