freepascal.ru

Здравствуйте,не могу понять задание под буквой г)Садовая ограда.

Затем найдите левый верхний и правый нижний углы для
ограды и постройте её символом решетки. Ограда должна охватывать деревья, но
не выходить за пределы поля (то, что выходит за пределы, не строить

Особенно то,что написано в скобках.Да и какая ограда за пределами массива?
Что значит найти углы?Углы матрицы?
Или массив больше поля и надо засадить деревьями только определённое пространство,но не весь массив?

Это задача 49-Г.
При случайной "посадке деревьев" могут быть разные случаи. Если ни одно дерево не попадает в крайние ряды матрицы (верхний, нижний, левый, правый), то ограда будет иметь 4 стороны. А если попадает, то соответствующие стороны ограды не строятся.
Пример:

Код: Выделить всё

. - пусто
* - дерево
# - ограда

...#.....*
...#*.....
...#......
...#...*..
...#######
..........
..........
..........
..........
..........


Видать такой способ для посадки деревьев не пойдёт:

Код: Выделить всё

const
  row=20;
  col=40;

type
  tmatrix=array [1..row,1..col] of char;

procedure creatematrix(var arg:tmatrix);
const
  sym='.*';
var
  i,j:byte;
begin
  for i:=1 to row do begin
    for j:=1 to col do begin
      arg[i,j]:=sym[random(2)+1];
      write(arg[i,j]);
    end;
    writeln;
  end;
end;

var
  ar:tmatrix;

begin
  randomize;
  creatematrix(ar);
  readln
end.

Paster Fob писал(а):     arg[i,j]:=sym[random(2)+1];
Видать такой способ для посадки деревьев не пойдёт

Да, густовато будет, словно бурьян.
Попробуйте так (сам по другому делал):

Код: Выделить всё

arg[i,j]:=sym[Ord(random(10)=0)+1];

Oleg_D писал(а):Да, густовато будет, словно бурьян.
Попробуйте так (сам по другому делал):

Код: Выделить всё

arg[i,j]:=sym[Ord(random(10)=0)+1];

я кстати вот как решил эту задачу:

Код: Выделить всё

const
  row=20;
  col=40;

type
  tfield=array [1..row,1..col] of char;

var
  arr:tfield;

procedure plantfield;
const
  s:string[2]='.*';
var
  i,j:byte;
begin
  for i:=1 to row do
    for j:=1 to col do
      arr[i,j]:=s[Ord(random(50)=0)+1];
end;

procedure fencefield;
const
  c='#';
var
  i,j,ai,aj,bi,bj:byte;
  bl:boolean;
begin
  bl:=false;
  for i:=1 to row do
    for j:=1 to col do
      if arr[i,j]='*' then begin
        if not bl then begin
          ai:=i;
          aj:=j;
          bl:=true;
        end;
        if aj>j then aj:=j;
      end;
  bl:=false;
  for i:=row downto 1 do
    for j:=col downto 1 do
      if arr[i,j]='*' then begin
        if not bl then begin
          bi:=i;
          bj:=j;
          bl:=true;
        end;
        if bj<j then bj:=j;
      end;
  for i:=aj to bj do
    arr[ai,i]:=c;
  for i:=ai to bi do begin
    arr[i,aj]:=c;
    arr[i,bj]:=c;
  end;
  for i:=aj to bj do
    arr[bi,i]:=c;
end;

procedure writefield;
var
  i,j:byte;
begin
  for i:=1 to row do begin
    for j:=1 to col do
      write(arr[i,j]);
    writeln;
  end;
  writeln
end;

begin
  randomize;
  plantfield;
  writefield;
  fencefield;
  writefield;
  readln
end.

Paster Fob писал(а):я кстати вот как решил эту задачу:

Прилагаю результат первого запуска вашей программы.
Если немного переиначить условие и разрешить строить ограду по крайним деревьям, то похоже.
А моё решение найдёте в файле ответов.
Ещё хотелось бы более внятных идентификаторов, например: Xmin, Xmax, Ymin, Ymax.

Oleg_D писал(а):Если немного переиначить условие и разрешить строить ограду по крайним деревьям, то похоже.

Смутила вот это строчка

Ограда должна охватывать деревья, но не выходить за пределы поля

я понял так,что ограду надо строить по крайним деревьям.
Переделал я программу и вот он результат.

Код: Выделить всё

const
  row=20;
  col=40;

type
  tfield=array [1..row,1..col] of char;

var
  arr:tfield;

procedure plantfield;
var
  i,j,k,n:byte;
begin
  fillchar(arr,sizeof(arr),'.');
  n:=random(20)+1;
  for k:=1 to n do begin
    i:=random(row)+1;
    j:=random(col)+1;
    arr[i,j]:='*';
  end;
end;

procedure findangles(var ai,bi,aj,bj:byte);
var
  bl:boolean;
  i,j:byte;
begin
  bl:=false;
  for i:=1 to row do
    for j:=1 to col do
      if arr[i,j]='*' then begin
        if not bl then begin
          ai:=i;aj:=j;
          bi:=i;bj:=j;
          bl:=true;
        end;
        if j<aj then aj:=j;
        if j>bj then bj:=j;
        if i>bi then bi:=i
      end;
end;

function anglemin(var min:byte):boolean;
begin
  if min=1 then anglemin:=true
  else begin
    min:=min-1;
    anglemin:=false
  end;
end;

function anglemax(var max:byte;const amax:byte):boolean ;
begin
  if max=amax then anglemax:=true
  else begin
    max:=max+1;
    anglemax:=false;
  end;
end;

procedure fencefield;
const
  c='#';
var
  imin,imax,jmin,jmax,i:byte;
  bl,bn,bol,bon:boolean;
begin
  findangles(imin,imax,jmin,jmax);
  bl:=anglemin(jmin);
  bn:=anglemax(jmax,col);
  bon:=anglemin(imin);
  bol:=anglemax(imax,row);
  if (imin>=1) and not bon then
    for i:=jmin to jmax do
      arr[imin,i]:=c;
  if (imax<=row) and not bol then
    for i:=jmin to jmax do
      arr[imax,i]:=c;
  if (jmin>=1) and not bl then
    for i:=imin to imax do
      arr[i,jmin]:=c;
  if (jmax<=col) and not bn then
    for i:=imin to imax do
      arr[i,jmax]:=c;
end;

procedure writefield;
var
  i,j:byte;
begin
  for i:=1 to row do begin
    for j:=1 to col do
      write(arr[i,j]);
    writeln;
  end;
  writeln
end;

begin
  randomize;
  plantfield;
  writefield;
  fencefield;
  writefield;
  readln
end.

Зацените.В ответы заглянул уже после того как написал выше указанный код.Сравнил,в вашем варианте мне не нравится то,что углы ограды пустые.

Paster Fob писал(а):Зацените.

В целом неплохо, по крайней мере, работает Несколько замечаний и советов по мелочи.
1. Мне больше нравится, когда глобальные имена (процедуры, переменные) начинаются с большой буквы. А то, что составлено из нескольких слов, тоже выделяется: "AngleMax" вместо "anglemax". Компилятору всё равно, но так легче читается.
2. Это объявление:
function anglemax(var max:byte; const amax:byte):boolean ;
можно заменить таким:
function anglemax(var max:byte; amax:byte):boolean ;
Дело в том, что параметры по ссылкам VAR и CONST -- это на самом деле указатели, хоть и неявные. Доступ к параметрам через указатели всегда немного медленней, чем напрямую. И код немного длиннее. Мелочь, но на будущее знайте.

Paster Fob писал(а):Сравнил,в вашем варианте мне не нравится то,что углы ограды пустые.

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

Код: Выделить всё

{ Задача 49-Г -- Садовая ограда }

const CX=60;   CY=20;  { ширина и высота поля }

type  TField = array [1..CX, 1..CY] of Char;

var Field : TField;

{ Посадка деревьев }
procedure MakeGarden(N: integer);
var i, x, y: integer;
begin
  FillChar(Field, SizeOf(Field),'.');
  for i:=1 to N do begin
    x:= 1 + Random(CX);
    y:= 1 + Random(CY);
    Field[x,y]:= '*';
  end;
end;

{ Показ поля }
procedure ExpoGarden;
var x, y: integer;
begin
  for y:=1 to CY do begin
    for x:=1 to CX do Write(Field[x,y]);
    Writeln;
  end;
end;

{ Исследование сада }
procedure ScanGarden(var Xmin, Ymin, Xmax, Ymax : integer);
var x, y: integer;
begin
  Xmin:= CX+1;  Ymin:= CY+1;
  Xmax:= 0;     Ymax:= 0;
  for x:=1 to CX do
    for y:=1 to CY do
      if Field[x,y]='*' then begin
         if XMin>x then XMin:=x;
         if YMin>y then YMin:=y;
         if XMax<x then XMax:=x;
         if YMax<y then YMax:=y;
      end;
end;

{ Постройка ограды }
procedure MakeRail(Xmin, Ymin, Xmax, Ymax : integer);
const CRail='#';
var x, y: integer;
begin
  { сверху }
  if YMin>1  then for x:=XMin-Ord(XMin>1) to XMax+Ord(XMax<CX)
    do Field[x,Ymin-1]:= CRail;
  { снизу }
  if YMax<CY then for x:=XMin-Ord(XMin>1) to XMax+Ord(XMax<CX)
    do Field[x,Ymax+1]:= CRail;
  { слева }
  if XMin>1  then for y:=YMin to YMax
    do Field[XMin-1,y]:= CRail;
  { справа }
  if XMax<CX then for y:=YMin to YMax
    do Field[XMax+1,y]:= CRail;
end;

var Xmin, Ymin, Xmax, Ymax : integer;  { координаты углов ограды }

begin
  Randomize;
  MakeGarden(8);
  ScanGarden(Xmin, Ymin, Xmax, Ymax);
  ExpoGarden;
  Readln;
  MakeRail(Xmin, Ymin, Xmax, Ymax);
  ExpoGarden;
  Readln;
end.


);

Спасибо за оценку,буду исправляться.

параметры по ссылкам VAR и CONST -- это на самом деле указатели, хоть и неявные

А вот это в FPC не так. Если параметр, помеченный как const имеет размер меньше или равный размеру указателя, то указатель не создается. Для того, чтобы он создавался всегда, следует использовать constref.

Спасибо за это уточнение, будем знать.
Вообще, современные умные компиляторы могут так или иначе оптимизировать код, устраняя мелкие несуразности "писателей". Но это зависит от конкретного компилятора и его настроек.
А начинающим надо привыкать к правильному применению ссылок: они уместны либо для возврата результатов (VAR), либо для передачи сложных типов данных: массивов, записей, множеств и файловых переменных. А простые типы передают по значению.