Версия для печати темы

Автор: shizik 9.06.2007 5:49

Условие:Найти в тексте слова, содержащие не более одной буквы, не входящей ни в последующее, ни в предыдущее слово, записать их заглавными буквами и указать после каждого такого слова в скобках найденную букву.
по большому счету нужна вот эта часть: Найти в тексте слова, содержащие не более одной буквы, не входящей ни в последующее, ни в предыдущее слово, -

Автор: Lapp 9.06.2007 12:13

Нарушая протокол и регламент этого раздела, публикую решение открыто. Считаю, что скрывать нет смысла, поскольку тема есть и в Задачах.
Shizik, пожалуйста, заплати на счет форума (см. http://forum.pascal.net.ru/index.php?showtopic=9779 ) 3 WMZ или 80 WMR. Рассчитываю на твою порядочность. Если будут дальнейшие вопросы по решению - задавай их в той теме, которая в Задачах. Спасибо.

type
  Chars=set of char;

var
  s1,s2,s3,m:Chars;
  w2,w3:string;
  s:string;
  i:integer;

const
  Delimeters:Chars=[' '];
  Letters:Chars=['A'..'Z','a'..'z'];

function GetWord(s:string; var i:integer):string;
var
  j:integer;
begin
  while i<Length(s) do if s[i] in Delimeters then Inc(i) else break;
  j:=i;
  while j<=Length(s) do if not (s[j] in Delimeters) then Inc(j) else break;
  GetWord:=Copy(s,i,j-i);
  i:=j
end;

function GetChars(s:string):Chars;
var
  Se:Chars;
  i:integer;
begin
  Se:=[];
  for i:=1 to Length(s) do Include(Se,s[i]);
  GetChars:=Se
end;

function Quantity(s:Chars):integer;
var
  i:integer;
  c:char;
begin
  i:=0;
  for c:=#0 to #255 do if c in s then Inc(i);
  Quantity:=i
end;

function UpStr(s:string):string;
var
  i:integer;
begin
  for i:=1 to Length(s) do s[i]:=UpCase(s[i]);
  UpStr:=s
end;

function GetChar(s:Chars):char;
var
  c:char;
begin
  if s=[] then GetChar:=' '
  else for c:=#0 to #255 do if c in s then begin
    GetChar:=c;
    Break
  end
end;

begin
  Write('Type in a sting: ');
  ReadLn(s);
    i:=1;
  s1:=GetChars(GetWord(s,i));
  w2:=GetWord(s,i);
  s2:=GetChars(w2);
  w3:=GetWord(s,i);
  s3:=GetChars(w3);
  repeat
    m:=(Letters-s1-s3)*s2;
    if Quantity(m)<=1 then
      WriteLn(UpStr(w2),' (',GetChar(m),')');
    s1:=s2;
    s2:=s3;
    w2:=w3;
    w3:=GetWord(s,i);
    s3:=GetChars(w3)
  until w2='';
end.

Желаю успехов

Автор: shizik 9.06.2007 12:49

Пасибо большое - ближе к вечеру деньги пришлю )

Автор: Lapp 9.06.2007 13:49

Хорошо, и не забудь отметить это здесь - ок?

Автор: shizik 17.06.2007 15:45

Деньги переведены )