Выполните задание, На бесконечном столе ссть горизонтальная и
вертикальная стены. Правый конец горизонталь-
ной стены соединен с нижним концом вертикаль-
ной стены. Длины стен неизвестны, в каждой
стене есть ровно один проход, точное место про-
хода и его ширина нагзвестны. Робот находится в
клетке, расположенной непосредственно слева от
вертикальной стены у её нижнего конца. На pot-
сунке указан один из возможных распо-
пожження стен и Робота (Робот обозначся буквой
«Р»).
Напишите для Робота алгоритм, закрашивающий псе клетки, распологатенныс непосредственно выше
и горизонтальной стены н левее вертикальной стены. Проходы должны остаться незакрашеннъом. Робот
доласен закрасить только клетки, удовлетворяющие данному условию. Например, для приведенного
выше рисунка Робот должен закрасить следующие клетки (ом, рисунок).
При исполнении алгоритма Робот не должҫн разрушиться, выполненне горитма должно
завершитьса. Конечное расположение Робота может быть произвольным. Алгоритм должен решать зада-
чу для любого допустимого расположения стен и любого расположения и размера проходов внутри стен.
Алгоритм может быть выполнен в среде формального інстиоттеля или записан в текстовом редакторе.
Сохраните алгоритм в текстовог фоайте.​

{неэффективный алгоритм}

const
 k = 100;

type
 maze = array [1..k, 1..k] of integer;
 var
 l : maze;
 n, m: integer;
 i, j: integer;
 c: char;
 t: text;
 w: integer;
 x0, y0: integer;
 x1, y1: integer;

procedure ways(a,b,r:integer);
begin
 if (w = 0) or (r < w) then {нет смысла идти дальше, если текущий путь уже превосходит найденный}
 if (l[a,b] <> -2) then
 if (r < l[a,b]) or (l[a,b] = -1) then {нет смысла идти, если текущая клетка уже была достигнута за меньшее число шагов}
   begin
   l[a,b] := r;
   if (a = x1) and (b = y1) then
     w := r
   else
     begin
     if a <> 1 then ways(a - 1, b, r + 1);
     if b <> 1 then ways(a, b - 1, r + 1);
     if a <> n then ways(a + 1, b, r + 1);
     if b <> m then ways(a, b + 1, r + 1);
     end
   end;
end; 
begin
 assign(t, 'input.txt');
 reset(t);
 w := 0;
 readln(t, n, m);
 readln(t, x0, y0);
 readln(t, x1, y1);
 for i := 1 to n do
   begin
   for j := 1 to m do
     begin
     read(t, c);
     case c of
       '.' : l[i,j] := -1; {будем считать, что если клетка отмечена как -1, то путь к ней еще не найден}
       'X' : l[i,j] := -2; {-2, если клетка непроходима}
       end;
     end;
   readln(t)
   end;
 close(t);
 if (l[x0,y0] <> -2) and (l[x1,y1] <> -2) then
   begin
   l[x0,y0] := 1; {просто трюк, чтобы пройти проверку на (r < l[x0,y0])}
     ways(x0, y0, 0);
   end
 else
  l[x1,y1] := -1;
 writeln(l[x1,y1])
end.

Var m : array[0..6] of Integer;
  i,k,N : Integer;
Begin
  For i:=0 to 6 do m[i]:=0;
  Readln(N);
  k:=6;
  While N>0 do
  Begin
    If N>=Power(2,k) then
    Begin
      N:=N-Trunc(Power(2,k));
      Inc(m[k]);
    end else Dec(k);
  end;
  For i:=0 to 6 do Writeln(Power(2,i),'  ',m[i],' шт.');
end.

Еще вариант:
Const
  NN = 7;
  money : array[1..7] of Integer = (1,2,4,8,16,32,64);
Var m : array[1..NN] of Integer;
  i,k,N : Integer;
Begin
  For i:=1 to NN do m[i]:=0;
  Readln(N);
  k:=NN;
  While N>0 do
  Begin
    If N>=money[k] then
    Begin
      N:=N-money[k];
      Inc(m[k]);
    end else Dec(k);
  end;
  For i:=1 to NN do Writeln(money[i],'  ',m[i],' шт.');
end.