"прозрачные и непрозрачные кубики" Опции

[-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]

Спасибо огромное