PasteRack.org
Paste # 24066
2019-04-21 20:12:49

Forked from paste # 21999.

Fork as a new paste.

Paste viewed 83 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 stddev)
  48.     (square (- (car lst) avg))))
  49.      ;(get-std-dev (cdr lst) avg (square (- (car lst) avg))))))
  50.  
  51. (define std-dev
  52.   (lambda (x)
  53.     (get-std-dev (map cadddr x) (average x) 0)))
  54.  
  55. (define list-min
  56.   (lambda (lst num)
  57.     (cond
  58.       ((null? lst) num)
  59.       ((< num (car lst))
  60.        (list-min (cdr lst) num))
  61.        (else
  62.         (list-min (cdr lst) (car lst))))))
  63.  
  64. (define minimum
  65.   (lambda (x)
  66.     (list-min (cdr (map cadddr x))(car (map cadddr x)))))
  67.  
  68. (define list-max
  69.   (lambda (lst num)
  70.     (cond
  71.       ((null? lst) num)
  72.       ((> num (car lst))
  73.        (list-max (cdr lst) num))
  74.        (else
  75.         (list-max (cdr lst) (car lst))))))
  76.  
  77. (define maximum
  78.   (lambda (x)
  79.     (list-max (cdr (map cadddr x))(car (map cadddr x)))))
  80.  
  81. (define counter
  82.   (lambda (x)
  83.     (length x)))
  84.  
  85. (define count
  86.   (lambda (x)
  87.     (counter (map cadddr x))))
  88.  
  89. (define odd
  90.   (lambda (sorted-list num-list med)
  91.     (if (null? num-list)
  92.         med
  93.         (odd (cdr sorted-list) (cdr num-list) (car sorted-list)))))
  94.  
  95. (define even
  96.   (lambda (sorted-list num-list)
  97.     (if (equal? (length num-list) 1)
  98.         (/(+(car sorted-list)(cadr sorted-list))2)
  99.         (even (cdr sorted-list) (cdr num-list)))))
  100.  
  101. (define get-median
  102.   (lambda (sorted-list num-list)
  103.     (cond
  104.       ((odd? (length sorted-list))
  105.        (odd sorted-list num-list 0))
  106.       ((even? (length sorted-list))
  107.        (even sorted-list num-list)))))
  108.  
  109. (define median
  110.   (lambda (x)
  111.     (get-median (sort (map cadddr x) <) (range (/ (length x) 2)))))
  112.  
  113. (define range
  114.   (lambda (x)
  115.     (- (maximum x) (minimum x))))
  116.  
  117.  
  118. (define tswb (make-tswb))
  119.  
  120. ;(tswb 'empty?)
  121. (tswb 'add!     '(2 123 "temp1"  72.1))
  122. (tswb 'add!     '(1 123 "temp1"  72.0))
  123. ;(tswb 'add!     '(3 123 "temp1"  72.5))
  124. ;(tswb 'add!     '(4 123 "temp1"  72.4))
  125. ;(tswb 'add!     '(5 123 "temp1"  72.15))
  126. ;(tswb 'add!     '(7 123 "temp1"  72.5))
  127. ;(tswb 'add!     '(6 123 "temp1"  72.5))
  128. (tswb 'add!     '(2 123 "press1" 29.9213))
  129. (tswb 'add!     '(1 123 "press1" 29.9212))
  130. (tswb 'add!     '(1 456 "temp1"  87.3))
  131. (tswb 'add!     '(1 456 "temp2"  87.4))
  132. (tswb 'add!     '(1 456 "press1" 28.9234))
  133. ;(tswb 'empty?)
  134. ;(tswb 'get)
  135. ;(tswb 'get(lambda (l) (eqv? (cadr l) 456)))                      ; return records for device 456 in time order
  136. ;(tswb 'get(lambda (l) (eqv? (caddr l) "temp1")))           ; return the temp1 fields for all devices
  137.  
  138. (define (temp1-123 l)
  139.   (and (eqv? (cadr l) 123) (eqv? (caddr l) "temp1")))
  140.  
  141. (tswb 'get temp1-123)                   ;get all the temp1 fields for device 123
  142. "Sum of temp1-123"
  143. (tswb 'analytic sum temp1-123)
  144. "Average"
  145. (tswb 'analytic average temp1-123)
  146. "Standard Deviation"
  147. (tswb 'analytic std-dev temp1-123)
  148. "Minimum"
  149. (tswb 'analytic minimum temp1-123)
  150. "Maximum"
  151. (tswb 'analytic maximum temp1-123)
  152. "Count"
  153. (tswb 'analytic count temp1-123)
  154. "Median"
  155. (tswb 'analytic median temp1-123)
  156. "Range"
  157. (tswb 'analytic range temp1-123)
  158. "Sum of all data"
  159. (tswb 'analytic sum)                          ;sum of all data in the database
  160. (tswb 'clear!)                                ;clear the db
  161. (tswb 'empty?)
  162. ;(tswb 'get (lambda (l) (eqv? (cadr l) 456)))    ; return records for device 456 in time order
  163. ;(tswb 'get temp1-123)                       ; get all the temp1 fields for device 123
  164.  
  165.  
  166. ; ---------------------------------------------------------------------------------------
  167. ;(display (tswb 'get (lambda(x) (> (list-ref x 3) 72.1))))
  168.  
  169. ;(define stk (make-stack))
  170. ;stk
  171. ;(define stk2 (make-stack))
  172. ;stk2
  173. ;(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"

0.002499999999999716

"Minimum"

72.0

"Maximum"

72.1

"Count"

2

"Median"

72.05

"Range"

0.09999999999999432

"Sum of all data"

407.56590000000006

#t