fork download
copy 
  1. ; powers of 3
  2.  
  3. (define (ilog b n)
  4.   (let loop1 ((lo 0) (b^lo 1) (hi 1) (b^hi b))
  5.     (if (< b^hi n) (loop1 hi b^hi (* hi 2) (* b^hi b^hi))
  6.       (let loop2 ((lo lo) (b^lo b^lo) (hi hi) (b^hi b^hi))
  7.         (if (<= (- hi lo) 1) (if (= b^hi n) hi lo)
  8.           (let* ((mid (quotient (+ lo hi) 2))
  9.                  (b^mid (* b^lo (expt b (- mid lo)))))
  10.             (cond ((< n b^mid) (loop2 lo b^lo mid b^mid))
  11.                   ((< b^mid n) (loop2 mid b^mid hi b^hi))
  12.                   (else mid))))))))
  13.  
  14. (define-syntax while
  15.   (syntax-rules ()
  16.     ((while pred? body ...)
  17.       (do () ((not pred?)) body ...))))
  18.  
  19. (define-syntax assert
  20.   (syntax-rules ()
  21.     ((assert expr result)
  22.       (if (not (equal? expr result))
  23.           (for-each display `(
  24.             #\newline "failed assertion:" #\newline
  25.             expr #\newline "expected: " ,result
  26.             #\newline "returned: " ,expr #\newline))))))
  27.  
  28. (define (test)
  29.   (assert (power3? 1) #t)
  30.   (assert (power3? 80) #f)
  31.   (assert (power3? 81) #t)
  32.   (assert (power3? 82) #f)
  33.   (assert (power3? 242) #f)
  34.   (assert (power3? 243) #t)
  35.   (assert (power3? 244) #f))
  36.  
  37. (define (power3? n)
  38.   (cond ((= n 1) #t)
  39.         ((positive? (modulo n 3)) #f)
  40.         (else (power3? (/ n 3)))))
  41.  
  42. (test)
  43.  
  44. (define (power3? n)
  45.   (cond ((or (= n 1) (= n 3)) #t)
  46.         ((positive? (modulo n 3)) #f)
  47.         (else (power3? (/ n 9)))))
  48.  
  49. (test)
  50.  
  51. (define (divrem n d)
  52.   (let ((q (quotient n d)))
  53.     (values q (- n (* d q)))))
  54.  
  55. (define (power3? n)
  56.   (if (= n 1) #t
  57.     (call-with-values
  58.       (lambda () (divrem n 3))
  59.       (lambda (q r)
  60.         (if (positive? r) #f
  61.           (power3? q))))))
  62.  
  63. (test)
  64.  
  65. (define (power3? n)
  66.   (or (= n (expt 3  0))   ; 1
  67.       (= n (expt 3  1))   ; 3
  68.       (= n (expt 3  2))   ; 9
  69.       (= n (expt 3  3))   ; 27
  70.       (= n (expt 3  4))   ; 81
  71.       (= n (expt 3  5))   ; 243
  72.       (= n (expt 3  6))   ; 729
  73.       (= n (expt 3  7))   ; 2187
  74.       (= n (expt 3  8))   ; 6561
  75.       (= n (expt 3  9))   ; 19683
  76.       (= n (expt 3 10)))) ; 59049
  77.  
  78. (test)
  79.  
  80. (define threes
  81.   (let loop ((t 1) (ts (list)))
  82.     (if (< (expt 2 64) t)
  83.         (list->vector (reverse ts))
  84.         (loop (* t 3) (cons t ts)))))
  85.  
  86. (define (power3? n)
  87.   (let ((hi (- (vector-length threes) 1)))
  88.     (if (or (< n 1) (< (vector-ref threes hi) n)) #f
  89.       (let loop ((lo 0) (hi hi))
  90.         (let ((mid (quotient (+ lo hi) 2)))
  91.           (cond ((< hi lo) #f)
  92.                 ((< (vector-ref threes mid) n)
  93.                   (loop (+ mid 1) hi))
  94.                 ((< n (vector-ref threes mid))
  95.                   (loop lo (- mid 1)))
  96.                 (else #t)))))))
  97.  
  98. (test)
  99.  
  100. (define (power3? n)
  101.   (zero? (modulo 59049 n)))
  102.  
  103. (test)
  104.  
  105. (define (power3? n)
  106.   (= (expt 3 (ilog 3 n)) n))
  107.  
  108. (test)
  109.  
  110. (define (power? n b)
  111.   (when (< 1 n)
  112.     (while (zero? (modulo n b))
  113.       (set! n (quotient n b))))
  114.   (= n 1))
  115.  
  116. (display (power? 243 3)) (newline)
Success #stdin #stdout 0.08s 8896KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
#t
https://ideone.com/FkrqlG
language:
Scheme (guile 2.2.4)
created:
8 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!