平方根的 Scheme Lisp 连分数

Question

我需要创建一个连分数函数来求一个数的平方根，并将其用在平方根函数中。我正在使用的系列和代码的重新排列版本如上所示。

(define (contfrac x)
   (cond
     ((= x 0) 1)
     (contfrac (/ (- x 1) (+ 2 (- x 1))))))

这是我的连分数函数，它似乎正在检查初始分数，但我无法让它继续超过第二个分数并在 (newsquareroot x y) 函数 x 变量中实现它以确定 x 的平方根和y 是连续分数被递归调用的次数。我不确定我是否应该更改 contfract 函数以调用自身一定次数或在 newsquareroot 函数中执行它。 continued fraction series

Answer 1

可能最好的方法是通过矩阵乘法，因为正数的平方根很容易表示。如果 a 是 N 的整数平方根并且 b = N-a^2 则连分数是 a+b/(2a+b/(2a+b ...))。这可以用无限矩阵乘积 ((a b)(1 0)) 乘以无限乘积 ((2a b)(1 0)) 来表示，精度随心所欲。当您有任意多的项时，只需将有理数作为第一列即可。

这是一个应该易于扩展的示例。

#lang racket/base
(require math/number-theory)

(define (times left right)
  (define (transpose m)
    (apply map list m))
  (define r (transpose right))
  (for/list ((row left))
    (for/list ((col r))
      (apply + (map * row col)))))

(define iterations (make-parameter 50))

(define (square-root N)
  (define a (integer-root N 2))
  (define b (- N (* a a)))
  (if (zero? b)
      a
      (let* ((first-matrix (list (list a b) (list 1 0)))
             (2a (* 2 a))
             (rest-matrix (list (list 2a b) (list 1 0))))
        (let ((result-matrix
               (for/fold ((accum first-matrix))
                         ((i (in-range (iterations))))
                 (times accum rest-matrix))))
          (apply / (map car result-matrix))))))
 ;;;;;;
Welcome to DrRacket, version 6.12 [3m].
Language: racket/base [custom]; memory limit: 16384 MB.
> (square-root 2)
1 4866752642924153522/11749380235262596085
> (- (sqrt 2) (square-root 2))
0.0
> (square-root 23)
;;;4 and a huge fraction that breaks formatting here
> (- (sqrt 23) (square-root 23))
0.0
> 

顺便说一句continued fraction package可用，但它比这稍微复杂一点，并且是建立在序列上的。

编辑 因为它被标记为 r5rs，所以我应该这样写。我不是 100% 确定 racket/r5rs 合规性，但这运行。

#lang r5rs

(define (transpose m)
  (apply map list m))

(define (row*col r c)
  (apply + (map * r c)))

(define (make-row* r)
  (lambda(c) (row*col r c)))

(define (times left right)
  (let ((r (transpose right)))
    (let loop ((rows left))
      (if (null? rows)
          '()
          (cons (map (make-row* (car rows))
                     r)
                (loop (cdr rows)))))))

(define (matrix-expt m e)
  (cond ((= 1 e) m)
        ((even? e) (matrix-expt (times m m)
                                (/ e 2)))
        (else (times m (matrix-expt (times m m)
                                    (/ (- e 1) 2))))))

(define (integer-root N exp)
  (letrec ((recur (lambda(i)
                    (let ((next (+ 1 i)))
                      (if (< N (expt next exp))
                          i
                          (recur next))))))
    (recur 1)))

(define (square-root N iters)
  (let* ((a (integer-root N 2))
         (b (- N (* a a))))
    (if (zero? b)
        a
        (let* ((first-matrix (list (list a b)
                                   (list 1 0)))
               (2a (* 2 a))
               (rest-matrix (list (list 2a b)
                                  (list 1 0)))
               (result-matrix
                (times first-matrix
                       (matrix-expt rest-matrix
                                    iters))))
          (apply / (map car result-matrix))))))