Дан шар радиуса R, центр которого находится в центре координат. Определить количество точек с целочисленными координатами, находящихся на его поверхности. Ваша программа должна
•запросить целое число R (0<r<1000)>1000 then end;
N:=0;
for x:=-R to R do
for y:=-R to R do
for z:=-R to R do
if sqrt(sqr(x)+sqr(y)+sqr(z))=R then N:=N+1;
writeln(N);
end.
но паскаль почему-то ругается, что "операнды имеют неприводимые типы" в условии отсеивания, и на подсчет 1000 тратит ГОРАЗДО большее время, чем 20 сек.. .
Другие языки программирования и технологии
Прошу помочь разобраться в задаче по программированию:
Классная задача! Помню бодался с ней.
k := 0;
for x:= 0 to R do begin
p := Trunc(Sqrt(r * r - x * x)); {возможная сумма Y^2 + Z^2}
for y:= 0 to p do begin
if r * r - x * x - y * y >= 0 then begin {Z возможно}
z := Trunc(Sqrt(r * r - x * x - y * y)); {значение Z}
if x * x + y * y + z * z = r * r then begin {точка на сфере}
n := Byte(x > 0) + Byte(y > 0) + Byte(z > 0); {1, 2 или 3 ненулевые координаты}
k := k + 1 shl n; {2, 4 или 8 точек на сфере}
end;
end;
end;
end;
Работает довольно быстро по сравнению с "лобовым" решением
k := 0;
for x:= 0 to R do begin
p := Trunc(Sqrt(r * r - x * x)); {возможная сумма Y^2 + Z^2}
for y:= 0 to p do begin
if r * r - x * x - y * y >= 0 then begin {Z возможно}
z := Trunc(Sqrt(r * r - x * x - y * y)); {значение Z}
if x * x + y * y + z * z = r * r then begin {точка на сфере}
n := Byte(x > 0) + Byte(y > 0) + Byte(z > 0); {1, 2 или 3 ненулевые координаты}
k := k + 1 shl n; {2, 4 или 8 точек на сфере}
end;
end;
end;
end;
Работает довольно быстро по сравнению с "лобовым" решением
Ну так ты ее решал "в лоб", поэтому и времени много уходит. Оптимизировать надо. Цикла достаточно двойного, третью координату надо вычислять и смотреть, целая ли она. Далее, достаточно считать только для одного квадранта.
у меня работает
program shar;
var x, y,z,r,n:integer;
begin
N:=0;
write('r=');readln(r);
for x:=-R to R do
for y:=-R to R do
for z:=-R to R do
if sqrt(sqr(x)+sqr(y)+sqr(z))=R then
begin writeln('x,y,z= ',x:4,y:4,z:4); N:=N+1; end;
writeln(N);
readln;
end.
program shar;
var x, y,z,r,n:integer;
begin
N:=0;
write('r=');readln(r);
for x:=-R to R do
for y:=-R to R do
for z:=-R to R do
if sqrt(sqr(x)+sqr(y)+sqr(z))=R then
begin writeln('x,y,z= ',x:4,y:4,z:4); N:=N+1; end;
writeln(N);
readln;
end.
Имхо, это - нерациональный алгоритм.
Во-первых, Вы зря извлекаете корень. Из-за погрешностей округления, он может и не дать целое число, и, кроме того, это накладная операция.
Во-вторых, совсем необязательно гонять переменные от минуса до плюса. Можно подсчитать количество точек в положительной части пространства и умножить на 8 (или на 4, или на 2 - в зависимости от того, попала ли проверяемая точка на координатные плоскости и оси) .
В третьих, лучше спускаться от R до 0, причем если точка (x, y, z) оказалась на расстоянии меньшем R, то переходить к следующему циклу.
Суммируя, навскидку алгоритм будет такой:
INT R2, x2, x2y2R2 :Integer;
R2 := R*R;
x := R;
WHILE(x >= 0)
DO BEGIN
x2 := x*x;
y := R;
WHILE (y >= 0)
DO BEGIN
x2y2R2 := R2 - (x2 + y*y);
z := R;
WHILE (z >= 0)
DO BEGIN
IF z*z = R2
THEN BEGIN
IF ((x = 0) AND (y = 0)) OR
((x = 0) AND (z = 0)) OR
((y = 0) AND (z = 0)) THEN N := N+2
ELSE
IF (x = 0) OR (y = 0) OR (z = 0) THEN N := N+4
ELSE N := N+8;
END;
ELSE BEGIN
if z2 < R2 THEN z2 := 0;
END;
dec(z);
END;
dec(y);
END;
dec(x);
END;
Во-первых, Вы зря извлекаете корень. Из-за погрешностей округления, он может и не дать целое число, и, кроме того, это накладная операция.
Во-вторых, совсем необязательно гонять переменные от минуса до плюса. Можно подсчитать количество точек в положительной части пространства и умножить на 8 (или на 4, или на 2 - в зависимости от того, попала ли проверяемая точка на координатные плоскости и оси) .
В третьих, лучше спускаться от R до 0, причем если точка (x, y, z) оказалась на расстоянии меньшем R, то переходить к следующему циклу.
Суммируя, навскидку алгоритм будет такой:
INT R2, x2, x2y2R2 :Integer;
R2 := R*R;
x := R;
WHILE(x >= 0)
DO BEGIN
x2 := x*x;
y := R;
WHILE (y >= 0)
DO BEGIN
x2y2R2 := R2 - (x2 + y*y);
z := R;
WHILE (z >= 0)
DO BEGIN
IF z*z = R2
THEN BEGIN
IF ((x = 0) AND (y = 0)) OR
((x = 0) AND (z = 0)) OR
((y = 0) AND (z = 0)) THEN N := N+2
ELSE
IF (x = 0) OR (y = 0) OR (z = 0) THEN N := N+4
ELSE N := N+8;
END;
ELSE BEGIN
if z2 < R2 THEN z2 := 0;
END;
dec(z);
END;
dec(y);
END;
dec(x);
END;
Площадь сферы равна 4*Пи*(R^2) так как вы задаете R количеством пикселей (целых точек) , то решение такое
const Pi:=3.1415926;
int N,R;
R:=1000;
N := trunc(4*Pi*R*R);
именно trunc(), а не round(). Trunc просто отбрасывает дробную часть. Round - округляет.
Если решение программы алгоритмическое, то последний автор Георгий Зотиков написал почти правильно, но правильней так (простите, Георгий, поправлю вас) :
program shar;
var x, y,z,r,n:integer;
begin
N:=0;
write('r=');readln(r);
for x:=-R to R do
for y:=-R to R do
for z:=-R to R do
if trunc(sqrt(sqr(x)+sqr(y)+sqr(z)))=R then
begin writeln('x,y,z= ',x:4,y:4,z:4); N:=N+1; end;
writeln(N);
readln;
end.
Потому что корни всегда будут вещественными и с целочисленным не совпадут в 50%, так что точек на самом деле будет в два раза больше....
const Pi:=3.1415926;
int N,R;
R:=1000;
N := trunc(4*Pi*R*R);
именно trunc(), а не round(). Trunc просто отбрасывает дробную часть. Round - округляет.
Если решение программы алгоритмическое, то последний автор Георгий Зотиков написал почти правильно, но правильней так (простите, Георгий, поправлю вас) :
program shar;
var x, y,z,r,n:integer;
begin
N:=0;
write('r=');readln(r);
for x:=-R to R do
for y:=-R to R do
for z:=-R to R do
if trunc(sqrt(sqr(x)+sqr(y)+sqr(z)))=R then
begin writeln('x,y,z= ',x:4,y:4,z:4); N:=N+1; end;
writeln(N);
readln;
end.
Потому что корни всегда будут вещественными и с целочисленным не совпадут в 50%, так что точек на самом деле будет в два раза больше....
Похожие вопросы
- Помогите пожалуйста решить задачу по программированию. В чем я ошибаюсь?
- Прошу помочь разобраться, пояснить некоторые пункты требования ТИПОГРАФИИ.
- Помогите пожалуйста решить задачу по программированию (язык программирования СИ)
- Помогите пожалуйста решить задачи по программированию. P.S: задачи по паскалю.
- Помогите разобраться с задачей по PASCAL
- Помогите разобраться в задаче
- Помогите, пожалуйста, с задачей по программированию(Pascal).
- Помогите пожалуйста решить задачу по программированию или напишите, как удалить подряд стоящие точки. (Си, Си++ Билдер)
- Скачала портативную версию Photoshop . Как узнать она реальная или демо - версия ???Очень прошу помогите разобраться !
- Помогите решить задачу на программирование!