PasteRack.org
Paste # 19170
2020-11-15 03:19:29

Fork as a new paste.

Paste viewed 540 times.


Embed:

contracts on units and conversions

  1. #lang racket/base
  2.  
  3. (require racket/contract)
  4. (require racket/generic)
  5.  
  6. (define ep/c (and/c exact? positive?))
  7.  
  8. (define-generics volume
  9.   (in-ml volume))
  10.  
  11. (define-generics mass
  12.   (in-g mass))
  13.  
  14. (struct/contract qty ([n ep/c]) #:transparent)
  15.  
  16. (struct kg qty ()
  17.   #:transparent
  18.   #:methods gen:mass
  19.   [(define (in-g m)
  20.      (* 1000 (qty-n m)))])
  21.  
  22. (struct g qty ()
  23.   #:transparent
  24.   #:methods gen:mass
  25.   [(define (in-g m)
  26.      (qty-n m))])
  27.  
  28. (struct l qty ()
  29.   #:transparent
  30.   #:methods gen:volume
  31.   [(define (in-ml v)
  32.      (* 1000 (qty-n v)))])
  33.  
  34. (struct ml qty ()
  35.   #:transparent
  36.   #:methods gen:volume
  37.   [(define (in-ml v)
  38.      (qty-n v))])
  39.  
  40. (struct dl qty ()
  41.   #:transparent
  42.   #:methods gen:volume
  43.   [(define (in-ml v)
  44.      (* 100 (qty-n v)))])
  45.  
  46. (define volume-ctor? (-> ep/c volume?))
  47. (define mass-ctor? (-> ep/c mass?))
  48.  
  49.  
  50. (define/contract (volume->volume v-val v-struct)
  51.   (-> volume? volume-ctor? volume?)
  52.   (define as-ml (in-ml v-val))
  53.   (define (from-ml x) (/ x (in-ml (v-struct 1))))
  54.   (v-struct (from-ml as-ml)))
  55.  
  56.  
  57. (define/contract (mass->mass m-val m-struct)
  58.   (-> mass? mass-ctor? mass?)
  59.   (define as-g (in-g m-val))
  60.   (define (from-g x) (/ x (in-g (m-struct 1))))
  61.   (m-struct (from-g as-g)))
  62.  
  63.  
  64. (struct/contract density ([m mass?] [v volume?]))
  65. (define/contract (to-g/ml d)
  66.   (-> density? ep/c)
  67.   (/ (in-g (density-m d)) (in-ml (density-v d))))
  68.  
  69.  
  70. (define/contract (mass->volume m-val v-struct density)
  71.   (-> mass? volume-ctor? density? volume?)
  72.   (define g/ml (to-g/ml density))
  73.   (define as-g (in-g m-val))
  74.   (define (from-ml x) (/ x (in-ml (v-struct 1))))
  75.   (define as-ml (/ as-g g/ml))
  76.   (v-struct (from-ml as-ml)))
  77.  
  78.  
  79. (define/contract (volume->mass v-val m-struct density)
  80.   (-> volume? mass-ctor? density? mass?)
  81.   (define g/ml (to-g/ml density))
  82.   (define as-ml (in-ml v-val))
  83.   (define (from-g x) (/ x (in-g (m-struct 1))))
  84.   (define as-g (* as-ml g/ml))
  85.   (m-struct (from-g as-g)))
  86.  
  87.  
  88.  
  89. (module+ test
  90.   (require rackunit)
  91.   (check-equal? (volume->volume (l 1) dl) (dl 10))
  92.   (check-equal? (volume->volume (dl 10) l) (l 1))
  93.   (check-equal? (mass->mass (kg 10) g) (g 10000))
  94.   (check-equal? (mass->volume (g 1) ml (density (g 1) (ml 1))) (ml 1))
  95.   (check-equal? (volume->mass (ml 1) g (density (g 1) (ml 1))) (g 1)))

=>