sw/src/pascal/WEXAKT.PS

   1 PROGRAM WURZEL2EXAKT(INPUT,OUTPUT);
   2
   3
   4 (*)
   5 (   QUADRATWURZEL AUS 2  AUF BIS ZU 1000 STELLEN GENAU
   6 (   BERECHNET MITTELS DER
   7 (
   8 (   BINOMIALREIHE  SQRT(1+X) =
   9 (
  10 (            (1/2)         (1/2)                 (1/2)
  11 (   =  1  +  (   ) * X  +  (   ) * X^2  + ... +  (   ) * X^K  + ...
  12 (            ( 1 )         ( 2 )                 ( K )
  13 (
  14 (
  15 (   KONVERGENZBESCHLEUNIGUNG WIRD DURCH
  16 (
  17 (   SQRT(2)  =  10/7 * SQRT(2 * 49/100)  =  10/7 * SQRT(1 - 2/100)
  18 (
  19 (   ERREICHT, DAMIT IST  X = -0.02  UND ALLE GLIEDER
  20 (   DER REIHE (BIS AUF 1) SIND NEGATIV.
  21 (
  22 (   SOMIT ERGIBT SICH:
  23 (
  24 (       S Q R T ( 2 )  =  ( 1 - REIHENSUMME ) * 10 / 7
  25 (
  26 (*)
  27
  28 CONST   BASE (*OF ARITHMETIC*) = 100000 (*DON'T CHANGE THIS!*);
  29
  30 TYPE    LONGNUMBER = ARRAY[0..205] OF INTEGER;
  31
  32 VAR     NUMBEROFDIGITS, FIRST, LAST, I, K, M, D,
  33         DIGIT, CARRY, POWER: INTEGER;
  34         A (*GLIED*),
  35         S (*SUMME*): LONGNUMBER;
  36
  37
  38 BEGIN
  39     READ(NUMBEROFDIGITS);
  40     FIRST := 1;  LAST := NUMBEROFDIGITS DIV 5  +  4;
  41
  42 (*)
  43 (   AUFSTELLEN DES ANFANGSGLIEDES DER REIHE ( = 0.01 )
  44 (   UND DES ANFANGSWERTES DER SUMME
  45 (*)
  46
  47     K := 1;
  48     FOR I := 0 TO LAST DO
  49         BEGIN  A[I] := 0;  S[I] := 0  END;
  50     A[1] := 10000;  S[1] := 10000;
  51     A[LAST+1] := BASE  (* GUARD *);
  52
  53
  54 REPEAT  K := K + 1;
  55
  56     (*)
  57     (   REKURSIVE BERECHNUNG DES NAECHSTEN GLIEDES DER REIHE:
  58     (
  59     (         A  <===  A * (2*K - 3) / 100 / K
  60     (
  61     (*)
  62
  63     M := K+K - 3;
  64     I := LAST+1;  CARRY := 0;
  65     WHILE (FIRST<I) OR (CARRY<>0) DO
  66       BEGIN
  67         I := I - 1;
  68         DIGIT  := M*A[I] + CARRY;
  69         A[I]   := DIGIT MOD BASE;
  70         CARRY  := DIGIT DIV BASE;
  71       END;
  72     FIRST := I;
  73
  74     D := 100*K;
  75     CARRY := 0;
  76     FOR I := FIRST TO LAST DO
  77       BEGIN
  78         DIGIT := CARRY*BASE + A[I];
  79         A[I]  := DIGIT DIV D;
  80         CARRY := DIGIT MOD D
  81       END;
  82
  83     WHILE A[FIRST]=0 DO FIRST := FIRST + 1;
  84
  85     (*)
  86     (   AUFSUMMIERUNG   SUMME  <===  SUMME + GLIED
  87     (*)
  88
  89     I := LAST;  CARRY := 0;
  90     WHILE (FIRST<=I) OR (CARRY<>0) DO
  91       BEGIN
  92         DIGIT := S[I] + A[I] + CARRY;  CARRY := 0;
  93         IF DIGIT >= BASE THEN BEGIN
  94                                 DIGIT := DIGIT - BASE;
  95                                 CARRY := 1
  96                               END;
  97         S[I] := DIGIT;
  98         I := I - 1
  99       END
 100
 101 UNTIL FIRST>LAST;
 102
 103 (*)
 104 (   SUBTRAHIERE SUMME DER REIHE VON  1
 105 (*)
 106
 107     I := LAST;
 108     WHILE S[I]=0 DO I := I-1;
 109     S[I] := BASE - S[I];
 110     FOR I := I-1 DOWNTO 1 DO S[I] := BASE-1 - S[I];
 111     S[0] := 9;
 112
 113 (*)
 114 (   DIVISION DURCH  7
 115 (*)
 116
 117     CARRY := 0;
 118     FOR I := 0 TO LAST DO
 119       BEGIN
 120         DIGIT := CARRY*BASE + S[I];
 121         S[I]  := DIGIT DIV 7;
 122         CARRY := DIGIT MOD 7
 123       END;
 124
 125 (*)
 126 (   A U S G A B E :
 127 (*)
 128
 129     WRITELN; WRITE("SQRT(2) = 1.");
 130     FOR I := 1 TO LAST-4 DO
 131       BEGIN
 132         DIGIT := S[I];  POWER := BASE;
 133         REPEAT POWER := POWER DIV 10;
 134             WRITE(DIGIT DIV POWER:1);
 135             DIGIT := DIGIT MOD POWER
 136         UNTIL POWER=1;
 137         IF I MOD 10 = 0 THEN BEGIN WRITELN; WRITE(" ":12) END
 138       END;
 139     WRITELN
 140 END.