Pascal строки

Тема в разделе "Другие языки", создана пользователем excel, 28 ноя 2013.

Модераторы: Цукер
  1. excel

    excel Постоялец

    Регистр.:
    13 май 2013
    Сообщения:
    137
    Симпатии:
    17
    Помогите пожалуйста сворганить след.прогу. Не очень толковый программист из меня, так что надеюсь на более сообразительных
     
  2. AZbest

    AZbest Писатель

    Регистр.:
    17 ноя 2013
    Сообщения:
    2
    Симпатии:
    1
    var
    s, subs, s_max: string;
    i, count_max, count_cur, d: Byte;
    begin
    count_max := 0;
    s_max := '';
    readln(s);
    i := 1;
    while (s[1]=' ')or(s[1]=',') do delete(s,1,1);
    while (s[length(s)]=' ')or(s[length(s)]=',') do delete(s,length(s),1);
    while(length(s)<>0) do
    begin
    i := 1;
    while (s<>',')and(s<>' ')and(i<=length(s)) do inc(i);
    count_cur := 0;
    subs := copy(s,1,i-1);
    d := Pos(subs,s);
    d := Pos(subs,s);
    d := Pos(subs,s)+length(subs)-1;

    while
    (Pos(subs,s)<>0)and(length(s)<>0)and
    ((s[Pos(subs,s)-1]=' ')or(s[Pos(subs,s)-1]=',')or(Pos(subs,s)=1))and
    ((Pos(subs,s)+length(subs)-1=length(s))or(s[Pos(subs,s)+length(subs)]=' ')or(s[Pos(subs,s)+length(subs)]=','))
    do begin
    delete(s,Pos(subs,s),length(subs));
    inc(count_cur);
    end;
    while (length(s)<>0)and((s[1]=' ')or(s[1]=',')) do delete(s,1,1);
    while (length(s)<>0)and((s[length(s)]=' ')or(s[length(s)]=',')) do delete(s,length(s),1);
    if count_cur > count_max then
    begin
    count_max := count_cur;
    s_max := subs;
    end;
    end;
    writeln(subs,' ~ ',count_max);
    readln;
    end.
     
    Последнее редактирование: 28 ноя 2013
    excel нравится это.
  3. yaski

    yaski

    Регистр.:
    21 фев 2010
    Сообщения:
    474
    Симпатии:
    277
    на делфи
    Код:
    type
      //Сведения о слове.
      TWord = record
        SWord : String; //Слово.
        Cnt : Integer; //Сколько раз слово встречается в тексте.
      end;
    //Возвращает строку, содержащую список слов, которые в исходном
    //тексте присутствуют наиболее часто.
    function ProcStr(const aStr : String) : String;
    const
      //Разделители слов.
      D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
      //Величина приращения длины динамического массива.
      Capacity = 10;
    var
      Arr : array of TWord; //Массив уникальных слов.
      SWord : String;
      i, j, Len, LenW, Cnt, CntMax : Integer;
    begin
      Result := '';
      //Извлекаем слова и добавляем их в массив.
      Len := Length(aStr); //Длина строки.
      LenW := 0; //Длина очередного слова.
      Cnt := 0; //Количество значимых элементов в массиве.
      CntMax := 0; //Наибольшее количество присутствий слова в массиве.
      for i := 1 to Len do begin
        //Пропускаем разделители.
        if aStr[i] in D then Continue;
        //Учитываем символ в длине слова.
        Inc(LenW);
        //Отслеживаем конец слова.
        if (i = Len) or (aStr[i + 1] in D) then begin
          //Получаем очередное слово из текста. Буквы слова делаем заглавными.
          SWord := AnsiUpperCase( Copy(aStr, i - LenW + 1, LenW) );
          //Ищем слово в массиве.
          j := 0;
          while j < Cnt do begin
            //Если слово обнаружено в массиве.
            if Arr[j].SWord = SWord then begin
              //Увеличиваем счётчик данного слова на 1.
              Inc(Arr[j].Cnt);
              Break;
            end;
            //Переход к следующему элементу массива.
            Inc(j);
          end;
          //Если j = Cnt, то слова нет в массиве. В этом случае добавляем слово в массив.
          if j = Cnt then begin
            //Количество значимых элементов массива теперь увеличилось на 1.
            Inc(Cnt);
            //Если требуется, увеличиваем длину массива.
            if Cnt > Length(Arr) then SetLength(Arr, Cnt + Capacity);
            //Добавляем сведения о слове в массив.
            Arr[j].SWord := SWord;
            Arr[j].Cnt := 1;
          end;
          //Уточняем сведения о наибольшем количестве присутствий слова.
          if Arr[j].Cnt > CntMax then CntMax := Arr[j].Cnt;
          //Сброс длины слова.
          LenW := 0;
        end;
      end;
      //Записываем в результирующую строку только те слова,
      //которые присутствуют в тексте наиболее часто.
      Result := '';
      for i := 0 to Cnt - 1 do
        if Arr[i].Cnt = CntMax then begin
          if Result <> '' then Result := Result + ', ';
          Result := Result + Arr[i].SWord;
        end;
    end;
    //Проверка.
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      Memo2.Text := ProcStr(Memo1.Text);
    end;
     
    excel нравится это.