В строке малыми латинскими буквами записаны слова, разделяющиеся запятыми. Первые буквы некоторых слов могут совпадать. Указать минимальное количество первых букв, по которым можно различить слова из заданного списка — Pascal(Паскаль)

program Project1;
 
const
  (*Множество разделителей слов.*)
  D = [' ', '.', ',', ':', ';', '!', '?', Char(9), Char(10), Char(13)];
 
var
  (*Исходная строка, очередное слово строки.*)
  StrSrc, StrWord : String;
  (*Массив выделенных из строки слов.*)
  ArrWords : array[1..100] of String;
  (*i, j, k - Индексы элементов,
  Pos2 - флаг конца слова,
  Cnt - количество выделенных из строки слов.
  CntS - счётчик совпадающих букв.
  CntRes - минимальная неповторяющаяся часть.*)
  i, j, k, Pos2, Cnt, CntS, CntRes: Integer;
 
function Min(const aV1, aV2 : Integer) : Integer;
begin
  if aV1 <= aV2 then Min := aV1
  else Min := aV2;
end;
 
begin
  repeat
    Writeln('Введите строку:');
    Readln(StrSrc);
 
    (*Выделяем слова и помещаем их в массив ArrWords.*)
 
    Pos2 := 0;
    Cnt := 0;
    StrWord := '';
    for i := 1 to Length(StrSrc) do begin
      (*Пропускаем разделители.*)
      if StrSrc[i] in D then Continue;
      (*Добавляем к очередному слову символы, которые не являются разделителями.*)
      StrWord := StrWord + StrSrc[i];
      (*Отслеживаем конец очередного слова.*)
      if i = Length(StrSrc) then
        Pos2 := i
      else if StrSrc[i + 1] in D then
        Pos2 := i
      ;
      (*Если конец слова найден.*)
      if Pos2 > 0 then begin
        Inc(Cnt);
        ArrWords[Cnt] := StrWord;
        (*Обнуляем сведения по слову.*)
        StrWord := '';
        (*Обнуляем флаг конца слова.*)
        Pos2 := 0;
      end;
    end;
 
    (*Определяем минимальную неповторяющуюся часть.*)
    CntRes := 0;
    for i := 1 to Cnt - 1 do begin
      for j := i + 1 to Cnt do begin
        CntS := 0;
        for k := 1 to Min( Length(ArrWords[i]), Length(ArrWords[j]) ) do begin
          (*
          Если требуется сверять буквы независимо от регистра, тогда так:
          if UpCase(ArrWords[i][k]) = UpCase(ArrWords[j][k]) then
          *)
          if ArrWords[i][k] = ArrWords[j][k] then
            Inc(CntS)
          else
            Break
          ;
        end;
        if CntS > CntRes then CntRes := CntS;
      end;
    end;
 
    CntRes := CntRes + 1;
 
    Writeln('Длина минимальной неповторяющейся части = ', CntRes);
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(StrSrc);
  until StrSrc <> '';
end.

Leave a Comment

19 − 12 =