В
Все
Б
Биология
Б
Беларуская мова
У
Українська мова
А
Алгебра
Р
Русский язык
О
ОБЖ
И
История
Ф
Физика
Қ
Қазақ тiлi
О
Окружающий мир
Э
Экономика
Н
Немецкий язык
Х
Химия
П
Право
П
Психология
Д
Другие предметы
Л
Литература
Г
География
Ф
Французский язык
М
Математика
М
Музыка
А
Английский язык
М
МХК
У
Українська література
И
Информатика
О
Обществознание
Г
Геометрия
icon21
icon21
06.11.2022 03:13 •  Информатика

Информатика( Lazarus )

​">

Показать ответ
Ответ:
гикат
гикат
26.03.2022 05:14
Пришлось написать рекурсивную процедуру. Надеюсь, это не вызовет вопросов.
Во вложениях даны тестовые файлы.

const
  n1 = 20;

type
  r5 = record
    value: byte; {Значение элемента}
    right: boolean; {Есть ли единица справа?}
    down: boolean; {Есть ли единица ниже?}
    left: boolean; {Есть ли единица слева?}
    viewed: boolean {Элемент просмотрен?}
  end;

var
  n, i, j, k: integer;
  m: array[1..n1, 1..n1] of r5;
  fin, fout: Text;

procedure Mark(i: integer; j: integer);
{рекурсивная процедура, отыскивающая весь островок и помечающая его}
begin
  if not m[i, j].viewed then
  begin
    m[i, j].viewed := true;
    if m[i, j].right then Mark(i, j + 1);
    if m[i, j].down then Mark(i + 1, j);
    if m[i, j].left then Mark(i, j - 1)
  end
end;

begin
  Assign(fin, 'Input.txt');
  Reset(fin);
  {Инициализация из файла}
  Readln(fin, n);
  for i := 1 to n do
    for j := 1 to n do
      Read(fin, m[i, j].value);
  Close(fin);
  {Определение соседей}
  for i := 1 to n do
    for j := 1 to n do
    begin
      if m[i, j].value = 1 then begin
        if j < n then m[i, j].right := (m[i, j + 1].value = 1) else m[i, j].right := false;
        if i < n then m[i, j].down := (m[i + 1, j].value = 1) else m[i, j].down := false;
        if j > 1 then m[i, j].left := (m[i, j - 1].value = 1) else m[i, j].left := false
      end;
      m[i, j].viewed := false
    end;
  {Подсчет "островков"}
  k := 0;
  for i := 1 to n do
    for j := 1 to n do
    begin
      with m[i, j] do
      begin
        if (m[i, j].value = 1) and (not m[i, j].viewed) then begin
          k := k + 1;
          Mark(i, j)
        end
      end
    end;
  Assign(fout, 'Output.txt');
  Rewrite(fout);
  Writeln(fout, k);
  Close(fout)
end.
0,0(0 оценок)
Ответ:
mariyasidorova1
mariyasidorova1
07.05.2023 07:15
Const
  m1 = 20;
  n1 = 20;

var
  x: array[1..m1, 1..n1] of integer;
  i, j, m, n, mx, mn: integer;

begin
  Write('Введите через пробел число строк и столбцов матрицы: ');
  Readln(m, n);
  Randomize;
  writeln(#13#10, 'Исходная матрица');
  for i := 1 to m do
  begin
    for j := 1 to n do
    begin
      x[i, j] := Random(100) - 50;
      Write(x[i, j]:5)
    end;
    Writeln
  end;
  for i := 1 to m do
  begin
    mx := x[i, 1]; mn := mx;
    for j := 2 to n do
      if mx < x[i, j] then mx := x[i, j]
      else if mn > x[i, j] then mn := x[i, j];
    Writeln('В строке ', i, ' мin=', mn, ', max=', mx)
  end
end.

Тестовое решение:

Введите через пробел число строк и столбцов матрицы: 5 8

Исходная матрица
   14   35    4   16   44  -14   47   36
  -23  -40   16   43   40   48   21   46
   23   30  -18   25  -43   -5   -3   37
   24  -26    9  -37   36   23  -33   36
   30   46   17  -18  -34  -35   36   28
В строке 1 мin=-14, max=47
В строке 2 мin=-40, max=48
В строке 3 мin=-43, max=37
В строке 4 мin=-37, max=36
В строке 5 мin=-35, max=46
0,0(0 оценок)
Популярные вопросы: Информатика
Полный доступ
Позволит учиться лучше и быстрее. Неограниченный доступ к базе и ответам от экспертов и ai-bota Оформи подписку
logo
Начни делиться знаниями
Вход Регистрация
Что ты хочешь узнать?
Спроси ai-бота