Advertisement
Ethangx8

zz

Oct 30th, 2019
833
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Scheme 1.61 KB | None | 0 0
  1.  
  2. (define get-sign
  3.   (lambda(b)
  4.     (if(char=? (string-ref b 0) #\-) -1 1)
  5.     )
  6.   )
  7.  
  8.  
  9. (define find-point
  10.   (lambda(s)
  11.     (let((n (- (string-length s) 1)))
  12.       (if(char=? (string-ref s  n) #\.)  n
  13.          (if (= n 0)
  14.              -1
  15.              (find-point(substring s 0 n))
  16.              )
  17.          )
  18.       )
  19.     )
  20.   )
  21. (define rep->whole
  22.   (lambda(s1 s2 b)
  23.     (let((k (- (string-length s2) 1)))
  24.          (let((pre (substring s2 0 k)) (lsb (string-ref s2 k)))
  25.            (if (= k 0)
  26.                (rep->get-v s1 lsb)
  27.                 (+ (* b (rep->whole s1 pre b)) (rep->get-v s1 lsb))
  28.                )
  29.            )
  30.       )
  31.     )
  32.   )
  33. (define rep->frac
  34.   (lambda (s1 s2 b)
  35.     (let((k (- (string-length s2) 1)))
  36.          (let((pre (substring s2 0 k)) (lsb (string-ref s2 k)))
  37.            (if (= k 0)
  38.                (*(rep->get-v s1 lsb) (expt b (* -1 (+ k 1))))
  39.                (+ (* (rep->get-v s1 lsb) (expt b (* -1 (+ k 1)))) (rep->frac s1 pre b))
  40.                )
  41.            )
  42.       )
  43.     )
  44.   )
  45. (define rep->get-v
  46.   (lambda(s c)
  47.     (let((k (- (string-length s) 1)))
  48.       (if(= k -1)
  49.           0
  50.          (if(char=? (string-ref s k) c)
  51.             k
  52.             (rep->get-v (substring s 0 k) c)
  53.             )
  54.          )
  55.       )
  56.     )
  57.   )
  58. (define rep->number
  59.   (lambda (s1 s2)
  60.     (let((base (string-length s1)))
  61.       (let((p (find-point s2)))
  62.         (if(= p -1)
  63.            (* (get-sign s2) (rep->whole s1 s2 base))
  64.            (* (get-sign s2) (+ (rep->whole s1 (substring s2 0 p) base) (rep->frac s1 (substring s2 (+ p 1 )) base)))
  65.            )
  66.       )
  67.       )
  68.     )
  69.   )
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement