Задача 4 Урок 18

Primary tabs

Submitted by NewDeveloper on Wed, 08/18/2021 - 01:42

Forums:

Задача 4 Урок 18:

Дан текстовый файл, в котором с в ASCII-стиле нарисованы цепочки из цифр, которые связаны по горизонтали и вертикали.
Все цепочки составляют одно дерево, которое устроено так:

  • всегда есть общий корень и это цифра
  • по горизонтали цепочка не разрывается пробелами, соединяется же с помощью последовательностей знака - (тире).
  • по вертикали цепочка не разрывается переносом строк, соединяется же с помощью вертикальных последовательностей символа | (вертикального разделителя).

Размер схемы не более чем 100 на 100 символов.

Примеры:

  1. ?
    1
    2
    3
    4
    5
    1------4--------------5-------6--------7
           |              |
           |              |-------5---------8
           |
           |-------6--------7--7-------9------8---1----5---3

    Ответ: 10

  2. ?
    1
    2
    3
    4
    5
    6
    7
    8
    1------4------8--------5-------6--------7
           |      |        |
           |      |        |-------5---------8
           |      |               
           |      |--------8-8-8---8----8
           |    
           |-------6--------7--7
           |--------------5-5--5--5 

    Ответ: 8

ПРИМЕЧАНИЕ: задача взята из списка соревнования IFF 2020

Задача: вывести длина самой длинной цепочки.

var f1: text;
    filename, s: string;
    i, j, c, idx, int, o, max, smax: integer;
    a: array [1..100] of string;
begin
  filename := 'F:\Pascal\урок 18\i.txt';
  assign(f1, filename);
  reset(f1);
  while not eof(f1) do
    begin
      readln(f1, s);
      for i := length(s) downto 1 do
       if s[i] = '-' then
        begin
         c += 1;
         a[c] := s;
         break;
        end;
    end;
  idx := 1;
  for i := 1 to c do writeln(a[i]);
  for i := c downto 2 do
   begin
    for j := length(a[i]) downto idx do
     begin
      if a[i][j] = '|' then
       begin
        idx := j;
        break;
       end;
      val(a[i][j], int, o);
      if o = 0 then max += 1;
     end;
    for j := idx downto 1 do
     if a[1][j] <> '-' then max += 1;
    if smax < max then smax := max;
    max := 0;
   end;
  for j := 1 to length(a[1]) do
   begin
    val(a[1][j], int, o);
    if o = 0 then max += 1;
   end;
  if smax < max then smax := max;
  writeln();
  writeln('Максимальная длина: ', smax);
  readln();
end.
  • Log in to post comments
  • 2248 reads
vedro-compota's picture

vedro-compota

Wed, 08/18/2021 - 12:51

желательно разбить код на процедуры и функции

_____________
матфак вгу и остальная классика =)

NewDeveloper

Wed, 08/18/2021 - 17:17 

type arrstr = array [1..100] of string;

procedure toarr(var f1s: text; st: string; var ast: arrstr; var cs: integer);
var iv: integer;
begin
 while not eof(f1s) do
   begin
     readln(f1s, st);
     for iv := length(st) downto 1 do
      if st[iv] = '-' then
       begin
        cs += 1;
        ast[cs] := st;
        break;
       end;
   end;
end;

function withoutfirst(aw: arrstr; var iw, idxw, maxw: integer): integer;
var jw, intw, ow: integer;
begin
   for jw := length(aw[iw]) downto idxw do
    begin
     if aw[iw][jw] = '|' then
      begin
       idxw := jw;
       break;
      end;
     val(aw[iw][jw], intw, ow);
     if ow = 0 then maxw += 1;
    end;
   result := maxw;
end;

procedure addfirst(aa: arrstr; var idxa, smaxa, maxa: integer);
var ja: integer;
begin
   for ja := idxa downto 1 do
    if aa[1][ja] <> '-' then maxa += 1;
   if smaxa < maxa then smaxa := maxa;
   maxa := 0;
end;

function onlyfirst(ao: arrstr; var smaxo, maxo: integer): integer;
var jo, into, oo: integer;
begin
   for jo := 1 to length(ao[1]) do
    begin
     val(ao[1][jo], into, oo);
     if oo = 0 then maxo += 1;
    end;
   if smaxo < maxo then smaxo := maxo;
   result := smaxo;
end;

var f1: text;
   filename, s: string;
   i, c, idx, max, smax, il: integer;
   a: arrstr;
begin
 filename := 'F:\Pascal\урок 18\i.txt';
 assign(f1, filename);
 reset(f1);
 toarr(f1, s, a, c);
 idx := 1;
 for i := 1 to c do writeln(a[i]);
 for i := c downto 2 do
  begin
   il := i;
   withoutfirst(a, il, idx, max);
   addfirst(a, idx, smax, max);
  end;
 onlyfirst(a, smax, max);
 writeln();
 writeln('Максимальная длина: ', smax);
 readln();
end.