ru.algorithms

 
 - RU.ALGORITHMS ----------------------------------------------------------------
 From : Sergey Voloshchuk                    2:5020/400     30 Nov 2001  17:06:10
 To : Victor Petrov
 Subject : Re: кв. корень
 -------------------------------------------------------------------------------- 
 

 К чему такие сложности? Квадратный корень легко находится по итерационной
 формуле
 sqrt(x) = 1/2 * (a + x/a)
 где а - начальное значение корня, можно принять а = х/2. Сходится очень
 быстро, причем каждый шаг дает примерно в 2 раза больше десятичных знаков
 чем предыдущий.
 > ДДД Вставка файла sqrt.pas ДДД
 > const MaxN = 10100;
 > type Long = array [0..MaxN] of Integer;
 > procedure Pack (var x : Long);
 > begin
 >   while (x [0] > 0) and (x [x [0]] = 0) do dec (x [0]);
 > end;
 > function IsGE (var x, y : Long) : Boolean;
 > var i : Integer;
 > begin
 >   if x [0] > y [0] then begin IsGE := true; exit; end;
 >   if x [0] < y [0] then begin IsGE := false; exit; end;
 >   i := x [0];
 >   while (i > 0) and (x [i] = y [i]) do dec (i);
 >   IsGE := (i = 0) or (x [i] > y [i]);
 > end;
 > procedure Sub (var x, y : Long);
 > var i : Integer; tmp, cf : Integer;
 > begin
 >   cf := 0;
 >   for i := 1 to x [0] do begin
 >     tmp := x [i] - cf;
 >     if i <= y [0] then dec (tmp, y [i]);
 >     if tmp >= 0 then begin x [i] := tmp; cf := 0; end
 >     else begin x [i] := tmp + 10; cf := 1; end;
 >   end;
 >   Pack (x);
 > end;
 > procedure DecL (var x : Long; y : Integer);
 > var i : Integer; tmp, cf : Integer;
 > begin
 >   cf := y;
 >   for i := 1 to x [0] do begin
 >     tmp := x [i] - cf;
 >     if tmp >= 0 then begin x [i] := tmp; cf := 0; end
 >     else begin x [i] := tmp + 10; cf := 1; end;
 >   end;
 >   Pack (x);
 > end;
 > procedure IncL (var x : Long; y : Integer);
 > var i : Integer; tmp, cf : Integer;
 > begin
 >   cf := y;
 >   for i := 1 to x [0] do begin
 >     tmp := x [i] + cf;
 >     if tmp < 10 then begin x [i] := tmp; cf := 0; end
 >     else begin x [i] := tmp - 10; cf := 1; end;
 >   end;
 >   if cf > 0 then begin inc (x [0]); x [x [0]] := cf; end;
 > end;
 > procedure ShiftL (var x : Long; y : Integer);
 > var i : Integer;
 > begin
 >   if x [0] = 0 then exit;
 >   for i := x [0] downto 1 do x [i + y] := x [i];
 >   for i := y downto 1 do x [i] := 0;
 >   inc (x [0], y);
 > end;
 > procedure Half (var x : Long);
 > var i : Integer; tmp, cf : Integer;
 > begin
 >   cf := 0;
 >   for i := x [0] downto 1 do begin
 >     tmp := cf * 10 + x [i];
 >     x [i] := tmp shr 1;
 >     cf := tmp and 1;
 >   end;
 >   Pack (x);
 > end;
 > procedure WrLong (var x : Long);
 > var i : Integer;
 > begin
 >   if x [0] = 0 then write ('0');
 >   for i := x [0] downto 1 do write (x [i]);
 >   writeln;
 > end;
 > var x, y, z : Long;
 >     tmp : Integer;
 >     i : Integer;
 >     ch : Char;
 > begin
 >   assign (input, 'in.txt'); reset (input);
 >   assign (output, 'out.txt'); rewrite (output);
 >   repeat
 >     repeat read (ch) until ch in ['0'..'9'];
 >     inc (x [0]); x [x [0]] := Ord (ch) - Ord ('0');
 >   until SeekEOF;
 >   for i := 1 to x [0] shr 1 do begin
 >     tmp := x [i]; x [i] := x [x [0] - i + 1];
 >     x [x [0] - i + 1] := tmp;
 >   end;
 >   Pack (x);
 >   if Odd (x [0]) then inc (x [0]);
 >   i := x [0];
 >   z [0] := 1; z [1] := 1;
 >   y [0] := 0;
 >   repeat
 >     ShiftL (y, 2); if y [0] < 2 then y [0] := 2;
 >     y [1] := x [i - 1]; y [2] := x [i]; dec (i, 2);
 >     Pack (y);
 >     DecL (z, 1); ShiftL (z, 1); IncL (z, 1);
 >     while IsGE (y, z) do begin
 >       Sub (y, z); IncL (z, 2);
 >     end;
 >   until i = 0;
 >   Half (z);
 >   WrLong (z);
 >   WrLong (y);
 > end. ДДД Конец вставки файла sqrt.pas ДДД
 >
 >                                         Victor
 --- ifmail v.2.15dev5
  * Origin: Geophysmash (2:5020/400)
 
 

Вернуться к списку тем, сортированных по: возрастание даты  уменьшение даты  тема  автор 

Тема:    Автор:    Дата:    кв. корень   Alexander Lunkov   27 Nov 2001 17:42:08   кв. корень   Ilya Malanyin   29 Nov 2001 17:21:00   кв. корень   Victor Petrov   29 Nov 2001 20:23:37   Re: кв. корень   Sergey Voloshchuk   30 Nov 2001 17:06:10   кв. корень   Victor Petrov   01 Dec 2001 17:27:31   кв. корень   Stanislav Shwartsman   01 Dec 2001 17:53:06   кв. корень   Victor Petrov   02 Dec 2001 16:46:31   кв. корень   Ђ­¤аҐ©   29 Nov 2001 21:20:04   кв. корень   Alexander Lunkov   03 Dec 2001 07:03:57   кв. корень   Alexey Gradovtsev   30 Nov 2001 13:28:10