Задачи по строкам , практикум

[filh]

Задача:

Даны две строки, найти наибольшую общую подстроку в этих строках.


Описание:

function findSubStr(Str1, Str2: string): string;

Str1 - первая строка;
Str2 - вторая строка;
Функция возвращает наибольшую общую подстроку в Str1 и Str2.
Реализация:

function findSubStr(Str1, Str2: string): string;
var
  Sout: string;
   i,j, len: integer;
begin
  len := 0;
  for j := 1 to length (Str1) do
   for i := 1 to length (Str1) - j + 1 do
    begin
      Sout := copy (Str2, i, j);
      if (pos (Sout, Str1) > 0) and (length (Sout) > len) then
       begin
         findSubStr := copy(Str1, pos (Sout, Str1), j);
         len := j;
       end;
    end;
end;

Использование:

 
...
  s1 := 'The power of Turbo Pascal';
  s2 := 'Pascal is a powerful programming language';
  writeln ('Substr = ' + findSubStr (s1, s2));       { Substr='Pascal' }
...

Сообщение отредактировано: Romtek - 03.08.04, 20:49

[Romtek]

Задача:

Вывести слова в предложении, разделённые пробелом, запятой или точкой.

program Parsing;
 
procedure ParseWords(s: string);
const Delimiters : set of char = [' ', '.' , ',']; { Разделители слов в предложении. Можно добавить другие }
var i, op: word;
 
procedure CutWord;
var _word: string;
begin
     _word:=copy(s,op,i-op);
     writeln('"',_word,'"'); { вывод слова }
end;
 
begin
     i:=0;
     op:=1;
     while i<=length(s) do
     begin
          inc(i);
 
          if s[i] in Delimiters then { если найден разделитель, то "вырезать" слово }
          begin
               CutWord;
               op:=i+1; { Запомнить начало предыдущего слова. Т.е. следующий индекс после разделителя }
          end;
     end;
     if op<>i then CutWord; { Осталось нетронутое слово. Его тоже не забудем :) }
end;
 
begin
     ParseWords('tester.1 23'); { Вывод слов из предложения, разделённых знаками }
     readln;
end.

Сообщение отредактировано: Romtek - 03.08.04, 20:53

[Romtek]

Задание:

Вывести на экран слова (последовательность букв алфавита) в строке.

procedure FindWords(s: string);
Const Letters: Set Of Char = ['A'..'Z','a'..'z','А'..'Я','а'..'п','р'..'я'];
var p,q: byte;
    sc : string;
begin
  p := 1; { Проверять с 1-го символа в строке }
 
  while p <= length (s) do { Поиск по строке}
  begin
    q := p; { Запомнить позицию p }
 
    while (p <= length (s)) and (s[p] in Letters) do
      inc(p);  { Пока не конец строки и очередной символ является буквой, увеличивать позицию p}
 
    if q <> p then { Если позиция p сдвинута относительно q, значит найдено слово }
    begin
      sc := copy (s, q, p - q); { Вырезать слово }
      writeln (sc); { и вывести его на экран }
    end;
 
    inc (p); { передвинув позицию p продолжить поиск по строке }
  end;
 
end;
 
begin
  FindWords ('abc 1a333 где34слово?')
end.

Сообщение отредактировано: Romtek - 03.08.04, 21:00

[tserega]

Задание:

Написать функцию заменяющую в заданной строке типа 1 на выражение типа 2. (Задача о замене одной подстрокм другой)

Function Replace(Source : String; What, Repl : String) : String;
Var P : Integer;
Begin
 While Pos(What, Source) > 0 Do
  Begin
   P:=Pos(What, Source);
   Delete(Source, P, Length(What));
   Insert(Repl, Source, P);
  End;
 Replace:=Source;
End;
 
Begin
 Writeln(Replace('I love cheese', 've', 'EEEE'));
End.

Сообщение отредактировано: Romtek - 03.08.04, 21:03

[tserega]

В функции Replace найден небольшой глюк: вызов, например Replace('I love cheese', 'e', 'ee') приведет или к зависанию, или к ошибке. Это вызвано тем, что заменяя отно "е" на два, длина строки увеличивается, причем подстрока "е" будет встречаться снова и снова.
Поэтому будет разбивать строку на две части: head (где все необходимые подстроки заменены) и tail (где замену еще предстоит сделать), к которой применим функцию Replace рекурсивно.

Function Replace(Source : String; What, Repl : String) : String;
Var P : Integer;
    Head, Tail : String;
Begin
 If (Length(Source) <= 0) Then Exit; {В пустой строке нечего менять. Это и есть "якорь" рекурсии}
 If Pos(What, Source) > 0 Then {Если нашли что менять}
  Begin
   P:=Pos(What, Source);
   Delete(Source, P, Length(What));
   Insert(Repl, Source, P); {Удаляем и вставляем нужную строку (замена первой похожей подстроки)}
   Head:=Copy(Source, 1, P + Length(Repl) - Length(What)); {В этой подстроке замен больше делать не надо}
   Tail:=Copy(Source, Length(Head) + 1, Length(Source) - Length(Head)); {А здесь надо!}
   Source:=Head + Replace(Tail, What, Repl); {Рекурсивный вызов}
  End;
 Replace:=Source;
End;
 
Begin
 Writeln(Replace('I love cheese', 'e', 'ee'));
End.

[e-moe]

Удаление незначащих нулей в числе.
Например: NormalizeNumber(-00010.20000) вернет '-10.2'
а NormalizeNumber(0.0) вернет просто '0'.

 
function NormalizeNumber(x:real): string;
var
  l : integer;
  s : string;
begin
 
  s:='';
  str(x:0:99,s);
  l:=Length(s);
  while s[l] in ['0','.'] do
    begin
      dec(l);
      if s[l]='.' then
        begin
          dec(l);
          break
        end;
    end;
 
  NormalizeNumber:=copy(s,1,l)
end;

[Romtek]

Проверка, является ли слово палиндромом (симметричным с обоих концов)

function IsPalindrom(S: string): boolean;
var i,len: integer;
    pal: boolean;
begin
     pal:=true; {считаем, что в начале у нас палиндром}
 
     len:=length(S);
     for i:=1 to (len div 2) do {проверяем до половины строки}
         if S[i]<>S[len-i+1] then {одинаковы ли парные символы, начиная с обоих концов строки}
         begin
              pal:=false; {мы былы не правы}
              break; {выходим из цикла, не проверяя остальные символы}
         end;
 
     IsPalindrom:=pal
end;
 
var Str: string;
begin
     write('Enter string: ');
     readln(str);
     writeln('Palindrom: ',IsPalindrom(str));
     readln;
end.