; powers of 3

(define (ilog b n)
  (let loop1 ((lo 0) (b^lo 1) (hi 1) (b^hi b))
    (if (< b^hi n) (loop1 hi b^hi (* hi 2) (* b^hi b^hi))
      (let loop2 ((lo lo) (b^lo b^lo) (hi hi) (b^hi b^hi))
        (if (<= (- hi lo) 1) (if (= b^hi n) hi lo)
          (let* ((mid (quotient (+ lo hi) 2))
                 (b^mid (* b^lo (expt b (- mid lo)))))
            (cond ((< n b^mid) (loop2 lo b^lo mid b^mid))
                  ((< b^mid n) (loop2 mid b^mid hi b^hi))
                  (else mid))))))))

(define-syntax while
  (syntax-rules ()
    ((while pred? body ...)
      (do () ((not pred?)) body ...))))

(define-syntax assert
  (syntax-rules ()
    ((assert expr result)
      (if (not (equal? expr result))
          (for-each display `(
            #\newline "failed assertion:" #\newline
            expr #\newline "expected: " ,result
            #\newline "returned: " ,expr #\newline))))))

(define (test)
  (assert (power3? 1) #t)
  (assert (power3? 80) #f)
  (assert (power3? 81) #t)
  (assert (power3? 82) #f)
  (assert (power3? 242) #f)
  (assert (power3? 243) #t)
  (assert (power3? 244) #f))

(define (power3? n)
  (cond ((= n 1) #t)
        ((positive? (modulo n 3)) #f)
        (else (power3? (/ n 3)))))

(test)

(define (power3? n)
  (cond ((or (= n 1) (= n 3)) #t)
        ((positive? (modulo n 3)) #f)
        (else (power3? (/ n 9)))))

(test)

(define (divrem n d)
  (let ((q (quotient n d)))
    (values q (- n (* d q)))))

(define (power3? n)
  (if (= n 1) #t
    (call-with-values
      (lambda () (divrem n 3))
      (lambda (q r)
        (if (positive? r) #f
          (power3? q))))))

(test)

(define (power3? n)
  (or (= n (expt 3  0))   ; 1
      (= n (expt 3  1))   ; 3
      (= n (expt 3  2))   ; 9
      (= n (expt 3  3))   ; 27
      (= n (expt 3  4))   ; 81
      (= n (expt 3  5))   ; 243
      (= n (expt 3  6))   ; 729
      (= n (expt 3  7))   ; 2187
      (= n (expt 3  8))   ; 6561
      (= n (expt 3  9))   ; 19683
      (= n (expt 3 10)))) ; 59049

(test)

(define threes
  (let loop ((t 1) (ts (list)))
    (if (< (expt 2 64) t)
        (list->vector (reverse ts))
        (loop (* t 3) (cons t ts)))))

(define (power3? n)
  (let ((hi (- (vector-length threes) 1)))
    (if (or (< n 1) (< (vector-ref threes hi) n)) #f
      (let loop ((lo 0) (hi hi))
        (let ((mid (quotient (+ lo hi) 2)))
          (cond ((< hi lo) #f)
                ((< (vector-ref threes mid) n)
                  (loop (+ mid 1) hi))
                ((< n (vector-ref threes mid))
                  (loop lo (- mid 1)))
                (else #t)))))))

(test)

(define (power3? n)
  (zero? (modulo 59049 n)))

(test)

(define (power3? n)
  (= (expt 3 (ilog 3 n)) n))

(test)

(define (power? n b)
  (when (< 1 n)
    (while (zero? (modulo n b))
      (set! n (quotient n b))))
  (= n 1))

(display (power? 243 3)) (newline)