Помощь - Поиск - Пользователи - Календарь
Полная версия: "прозрачные и непрозрачные кубики"
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
-azi-
Помогите с алгоритмом решения:
1.Куб состоит из n3 прозрачных и непрозрачных элементарных кубиков. Построить полностью непрозрачный куб, используя ровно n2 непрозрачных элементарных кубиков.
2.Поле размером m×n заполнено прозрачными и непрозрачными кубиками. Найти все столбцы поля, все непрозрачные кубики которых невидимы для наблюдателя, расположен-ного слева.
hiv
Вот простой и тупой перебор всех вариантов (сочетаний n*n из n*n*n элементарных кубиков)
program KUB;

var soch : array [1..100] of longint;
n,i,j,n2,n3 :longint;

procedure write_soch; {выводим решение на экран}
var i,x,y,z,l :longint;
begin
writeln('Решение:');
writeln(' X Y Z');
for i:=1 to n2 do
begin
l:=soch[i]-1;
z:=l div n2;
l:=l mod n2;
y:=l div n;
x:=l mod n;
writeln((x+1):6,(y+1):6,(z+1):6);
end;
end;

{переводим трехмерные координаты в одномерные}
function translate(x,y,z:longint):longint;
begin
translate:=(z-1)*n2+(y-1)*n+(x-1)+1;
end;

{определяем есть ли такая координата в сочетании}
function inside(i:longint):boolean;
var j :longint;
res :boolean;
begin
j:=0;
repeat
inc(j);
res:=(i=soch[j]);
until (j>=n2)or res;
inside:=res;
end;

{проверяем куб на непрозрачность}
function Test:boolean;
var x,y,z :longint;
res,boy :boolean;
begin
res:=true;

z:=1;
while (z<=n)and res do
begin
y:=1;
while (y<=n)and res do
begin
boy:=false;
for x:=1 to n do boy:=boy or inside(translate(x,y,z));
res:=boy;
inc(y);
end;
inc(z);
end;

z:=1;
while (z<=n)and res do
begin
x:=1;
while (x<=n)and res do
begin
boy:=false;
for y:=1 to n do boy:=boy or inside(translate(x,y,z));
res:=boy;
inc(x);
end;
inc(z);
end;

x:=1;
while (x<=n)and res do
begin
y:=1;
while (y<=n)and res do
begin
boy:=false;
for z:=1 to n do boy:=boy or inside(translate(x,y,z));
res:=boy;
inc(y);
end;
inc(x);
end;
Test:=res;
end;

begin
write('N='); readln(n);
n2:=n*n;
n3:=n2*n;
for i:=1 to n2 do soch[i]:=i; {задаем первое сочетание}
if Test then write_soch; {проверяем его}

i:=n2;
while i>0 do
begin
i:=n2;
while (i>0)and(soch[i]=(n3-n2+i)) do dec(i);
if i>0 then
begin
inc(soch[i]);
for j:=i+1 To n2 Do soch[j]:=soch[j - 1] + 1;
{проверяем следующее сочетание}
if Test then write_soch;
end;
end;

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