Помощь - Поиск - Пользователи - Календарь
Полная версия: Извлечения корня квадратного
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
barlog
Нужно было составить программу демонстрирующая извлечения корня квадратного.
Дошёл до такого вот момента
Uses Crt;
Var x,b,z,l,c,r,d,i,u,um:Longint;
k:byte; s:string;
Begin
ClrScr;
{------------------------------------------------------}
TextColor(white);
GotoXY(15,1); WriteLn('Izvlechenia korna kvadratnogo');
WriteLn('Vvedite chislo');
WriteLn(' ЪДДДДДДДД');
Write(' \і'); ReadLn(x);
GotoXY(15,4);Write('=');
{------------------------------------------------------}
for k:=2 to 5 do
begin
GotoXY(6,3*k);Write('ДДДДДДДДДДД');
end;
{------------------------------------------------------}
str(x,s);
l:=round(length(s)/2)-1;
b:=x; z:=1; r:=0;
{------------------------------------------------------}
while b>=100 do
begin
b:=b div 100;
z:=z*100
end;
{------------------------------------------------------}
c:=9;
while c*c>b do c:=c-1;
r:=r*10+c;
d:=c*c;
x:=x-d*z; {x=3654321}
ReadKey; GotoXY(8,5); Write(d);
ReadKey; GotoXY(16,4); Write©;
{------------------------------------------------------}
l:=l-1; {l=2}
z:=z div 100; {z=10000}
b:=x; {b=3654321}
for i:=1 to l do b:=b div 100; {b=365}
ReadKey; GotoXY(8,7); Write(b);
c:=9;
while (20*r+c)*c>b do c:=c-1; {c=7}
r:=r*10+c; {r=27}
u:=r*2-c; {u=47}
um:=u*c; {um=47*7=329}
ReadKey; GotoXY(3,7); Write(u);
ReadKey; GotoXY(4,8); Write©;
ReadKey; GotoXY(8,8); Write(um);
ReadKey; GotoXY(17,4); Write©;
{------------------------------------------------------}
l:=l-1; {l=1}
b:=x; {b=3654321}
b:=b-um*z; {b=364321}
z:=z div 100; {z=100}
for i:=1 to l do b:=b div 100;
ReadKey; GotoXY(9,10); Write(b); {b=3643}
c:=9;
while (20*r+c)*c>b do c:=c-1;
r:=r*10+c;
u:=r*2-c;
um:=u*c;
ReadKey; GotoXY(3,10); Write(u);
ReadKey; GotoXY(5,11); Write©;
ReadKey; GotoXY(9,11); Write(um); {3276}
ReadKey; GotoXY(18,4); Write©;
{------------------------------------------------------}
l:=l-1; {l=0}
b:=b*z+x mod 100;
b:=b-um*z;
z:= z div 100;
for i:=1 to l do b:=b div 100;
ReadKey; GotoXY(10,13); Write(b);
c:=9;
while (20*r+c)*c>b do c:=c-1;
r:=r*10+c;
u:=r*2-c;
um:=u*c;
ReadKey; GotoXY(3,13); Write(u);
ReadKey; GotoXY(6,14); Write©;
ReadKey; GotoXY(10,14); Write(um);
ReadKey; GotoXY(19,4); Write©;
{------------------------------------------------------}
b:=b-um;
ReadKey; GotoXY(11,16); Write(b);
ReadLn;
End.

Немогу загнать всё это в цикл. Ввожу семизначное число 7654321 и над ним эксперементирую.
Другие семи и восьми значные тоже считает, до запятой.
Надо чтобы и по короче числа брал, вместо того чтобы нули писал в конце.
Может где-то перемудрил. Помогите довести до ума пожалуйста!
klem4
Ты бы убрал свои бирюльки GotoXY, и так не понятно что твоя программа должна делать и в чем ошибка + телепат штатный в отпуске по этому со следующими строчками возникают неразрешимые проблемы :

 WriteLn('      ЪДДДДДДДД');
Write('ДДДДДДДДДДД');


Если хочешь получить какой-либо результат, приведи полностью свое задание, разбириться среди понятных только тебе вычислений желания нету ни малейшего.

М
Зачем опять PASCОDE ? Я же просил пользоваться CODE=...
volvo

barlog
Задачи вычисляет корень квадратный из числа до запятой.
В данном случае реализована для частного случая-семизначного числа.
Эта прогамма - демонстрация `старого способа извлечения корня`.Всё делаеться по шагово, т.е после каждого нажатия Enter появляеться следующее значение.
Нужно как то зациклить повторяющееся действия.
volvo
А ты не можешь зациклить одно, и НЕ зациклить другое... У тебя часть действий повторяется, а вот кое-что каждый раз новое:

Первый проход:
 z:=z div 100;   {z=10000}
b:=x; {b=3654321}
Второй проход:
 b:=x;                           {b=3654321}
b:=b-um*z; {b=364321}
z:=z div 100; {z=100}
Третий проход:
 b:=b*z+x mod 100;
b:=b-um*z;
z:= z div 100;
Как ты ЭТО хочешь зациклить? Сначала приведи это к виду, когда все переменные на каждой итерации изменяются одинаково, потом зацикливать будешь...
barlog
Попробую, тока не забывайте про эту тему пока, хорошо?! Как получиться выложу.
Archon
Попробуй посмотреть DEMO.DESIGN FAQ
volvo
Archon, ссылка на алгоритм - здесь:
Точное вычисление квадратного корня

Автору нужно именно пошаговое его выполнение, а не те ассемблерные процедуры, которые ты предлагаешь...
volvo
barlog,
вот что получилось у меня (только без всех этих GotoXY, их сам добавь, если нужно... Моя программа просто иллюстрирует процесс получения результата):

{ Эти 2 функции - для удобства, чтобы не вызывать Str/Val напрямую }
function int_to_str(i: longint): string;
var s: string;
begin
str(i, s);
int_to_str := s;
end;
function str_to_int(s: string): longint;
var
i: longint;
err: integer;
begin
val(s, i, err);
str_to_int := i;
end;

var
s_num, n: longint;
err: integer;
before_s, cs, s, ns, res: string;
p, c: byte;

begin
write('n = '); readln(n);
{ n := 54321; }
writeln(n:20);
str(n, ns);

res := '';

p := 1 + byte(not odd(length(ns)));
s := copy(ns, 1, p);
delete(ns, 1, p);

s_num := str_to_int(s);
c := 1;
while sqr( c ) <= s_num do inc( c );
dec( c );
writeln(s:(20 - length(ns)), c:10);

res := res + int_to_str( c );
writeln(sqr( c ):(20 - length(ns)));

s_num := s_num - sqr( c );
str(s_num, s);

repeat
s := s + copy(ns, 1, 2);
delete(ns, 1, 2);

before_s := int_to_str(2 * str_to_int(res));
c := 0;
while str_to_int(s) - (10 * str_to_int(before_s) + c) * c >= 0 do inc( c );
dec( c );

writeln(before_s:9, c:1, s:(10 - length(ns)), c:10);
writeln((10 * str_to_int(before_s) + c) * c:(20-length(ns)));

res := res + int_to_str( c );
s := int_to_str(str_to_int(s) - (10 * str_to_int(before_s) + c) * c);
until length(ns) = 0;

writeln('res = ', res);
end.
Проверялось на 5-ти и 7-ми значных числах... Вроде не сбоит...
barlog
Спасибо тебе volvo! Наконец то кто то понял что мне надо. Твоя программа работает при всех возможных числах. Просто задание у нас это было по целым числам, а не по строкам. Вот я тут доделал свою.
В принцепе всё нормально работает, если сможете посмотрите, помоему можно сдавать?!
Код

Uses Crt;
Var x,b,z,l,c,r,d,i,u,um:Longint;
    k:byte; s:string;
Begin
ClrScr;
{------------------------------------------------------}
TextColor(white);
GotoXY(15,1); WriteLn('Izvlechenia korna kvadratnogo');
WriteLn('Vvedite chislo');
WriteLn('        ЪДДДДДДДДД');
Write('       \і'); ReadLn(x);
GotoXY(19,4);Write('=');
{------------------------------------------------------}
str(x,s);
l:=round(length(s)/2)-1;
b:=x; z:=1; r:=0;
{------------------------------------------------------}
for k:=2 to l+2 do
  begin
   GotoXY(8,3*k);Write('ДДДДДДДДДДД');
  end;
{------------------------------------------------------}
while b>=100 do
  begin
   b:=b div 100;
   z:=z*100
  end;
{------------------------------------------------------}
c:=9;
while c*c>b do c:=c-1;
r:=r*10+c;
d:=c*c;
x:=x-d*z;
ReadKey; GotoXY(10,5); Write(d);
ReadKey; GotoXY(20,4); Write(c);
{------------------------------------------------------}
for k:=0 to l-1 do
begin
  l:=l-1;
  z:=z div 100;
  b:=x;
  for i:=1 to l do b:=b div 100;
  ReadKey; GotoXY(10+k,7+3*k); Write(b);
  c:=9;
  while (20*r+c)*c>b do c:=c-1;
  d:=(20*r+c)*c;
  x:=x-d*z;
  r:=r*10+c;
  u:=r*2-c;
  um:=u*c;
  ReadKey; GotoXY(5,7+3*k); Write(u);
  ReadKey; GotoXY(6+k,8+3*k); Write(c);
  ReadKey; GotoXY(10+k,8+3*k); Write(um);
  ReadKey; GotoXY(21+k,4); Write(c);
end;
b:=b-um;
ReadKey; GotoXY(11+k,10+3*k); Write(b);
ReadLn;
End.

Если ничего исправлять не нужно по вашему усмотрению, то тему можно закрыть. Спасибо volvo ещё раз огромное за всё! smile.gif
volvo
Цитата
В принцепе всё нормально работает
Не совсем... При вводе числа 54321, например, (да и любого пятизначного числа) с программой начинает твориться что-то непонятное...

А попробуй ввести двухзначное число blink.gif blink.gif

Все-таки, доработай программу... Осталось, скорее всего, совсем чуть-чуть...
barlog
Действительно с двухзначными числами глюк!?
А с пяти значными всё считает просто он последнее число после вычитания выводит на одну позицию левее или правее. Я просто не смог разобраться с полседним GotoXY.
Код

GotoXY(11+k,10+3*k); Write(b);

Надо подумать над этим. Спасибо за подсказку!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.