PasteRack.org
Paste # 21999
2019-04-21 19:51:59

Fork as a new paste.

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