В вводимой строке заменить самое часто встречаемое слово на обратное. Pascal abc

[yulka6464]

как заменить слово на обратное я знаю, а вот как найти самое часто встречаемое слово не получается..подскажите пожалуйста

var
    s: string;
    i,n: byte;
    c: char;
begin
    write('Введите строку: ');
    readln(s);
    n := length(s) div 2;
    for i := 1 to n do begin
        c := s[i];
        s[i] := s[length(s)-i+1];
        s[length(s)-i+1] := c;
    end;
    writeln(s);
readln
end.

[temaps]

slovo,maxslovo:string;
k,maxk:integer;
....
s1:=s;
maxk:=0;
maxslovo:='';
repeat
ищем в s1 первое слово и записываем его в slovo, далее:
k:=0;
while pos(slovo,s1)>0 do
  begin
  inc(k);
  delete(s1,pos(slovo,s1),length(slovo));
  end;
if k>maxk then
  begin
  maxslovo:=slovo;
  maxk:=k;
  end;
until в строке s1 не осталось слов
дальше ищем максимальное слово в s - pos(maxslovo,s) и обращаем его
....

По repeat - until прокомментирую. Я бы написал функцию, возвращающую true, если в строке есть слова и записывающую первое слово в какую-нибудь переменную и тогда можно использовать её в условии цикла. Например, я называю функцию fw(s:string;var w:string):boolean;
Тогда вместо repeat:

....
maxslovo:='';

while fw(s1,slovo) do
begin

k:=0;
while pos(slovo,s1)>0 do
......

[yulka6464]

а можно готовую программу, у меня чтото не получается

[temaps]

Я не вижу сложностей. Ну, пожалуйста, вот готовая:

function fw(s:string;var w:string):boolean;
const
c=['a'..'z','A'..'Z'];
var
i:integer;
begin
  while (not (s[1] in c)) and (length(s)>0) do delete(s,1,1);
  if length(s)>0 then
  begin
    s:=s+' ';
    i:=1;
    while (s[i] in c) do inc(i);
    w:=copy(s,1,i-1);
    fw:=true;
  end
  else
  begin
    w:='';
    fw:=false;
  end;
end;

[yulka6464]

спасибо за готовое задание..только оно не хочет у меня работать..у меня англоязычная винда и комменты в строке состояния пишутся непонятными сиволами..ниже прикреплю картинку..посмотрите в чем у меня ошибка?

[temaps]

Сообщение от yulka6464

...посмотрите в чем у меня ошибка?

Вроде очевидно же, что в прокладке между монитором и креслом.
Я догадался, что ты хочешь целиком всю программу, но надеялся, что включатся мозги после того как я указанную мной функцию полностью напишу.
Ладно, пофиг. Скомпоную то что есть:

var
 s: string;
 i,n: byte;
 c: char;
slovo,maxslovo:string;
k,maxk:integer;

function fw(s:string;var w:string):boolean;
const
c=['a'..'z','A'..'Z'];
var
i:integer;
begin
  while (not (s[1] in c)) and (length(s)>0) do delete(s,1,1);
  if length(s)>0 then
  begin
    s:=s+' ';
    i:=1;
    while (s[i] in c) do inc(i);
    w:=copy(s,1,i-1);
    fw:=true;
  end
  else
  begin
    w:='';
    fw:=false;
  end;
end;

 begin
 write('Введите строку: ');
 readln(s);

s1:=s;
maxk:=0;
maxslovo:='';
while fw(s1,slovo) do
begin
k:=0;
while pos(slovo,s1)>0 do
  begin
  inc(k);
  delete(s1,pos(slovo,s1),length(slovo));
  end;
if k>maxk then
  begin
  maxslovo:=slovo;
  maxk:=k;
  end;
end;

{изменять в твоём коде не хочу, поэтому использую твою переменную}
s1:=s;
s:=maxslovo; 

 n := length(s) div 2;
 for i := 1 to n do begin
 c := s[i];
 s[i] := s[length(s)-i+1];
 s[length(s)-i+1] := c;
 end;

repeat
  i:=pos(maxslovo,s1);
  delete(s1,i,length(maxslovo));
  insert(s1,s,i);
until pos(maxslovo,s1)=0;
s:=s1;{изменять в твоём коде не хочу, поэтому использую твою переменную}

 writeln(s);
 readln
 end.

[TinMan]

Сообщение от temaps

Вроде очевидно же, что в прокладке между монитором и креслом.

Улыбнуло, согласен, temaps +1 ))

Юлка6464 сделай вот так:

Start -> Control Panel -> Region and Language -> Administrative -> Change System Locale -> Select Russian -> Okay ...

Хотя, темапс, не все у тебя так гладко в ответе..

[yulka6464]

спасибо большущее, все работает)))
а как сделать так чтобы все не часто повторяющиеся слова не удалялись а записывались в строке вместе с перевернутым?

[temaps]

Сообщение от TinMan

.....

Хотя, темапс, не все у тебя так гладко в ответе..

Я же сказал, что буду просто компоновать то что есть в теме. Добавил только пару строк кода.

Сообщение от yulka6464

а как сделать так чтобы все не часто повторяющиеся слова не удалялись а записывались в строке вместе с перевернутым?

Ну просто добавь сюда:

repeat
  i:=pos(maxslovo,s1);
  delete(s1,i,length(maxslovo));
  insert(s1,s,i);
until pos(maxslovo,s1)=0;

копирование в другую строку от начала и до i+length(maxslovo) и удаление до этого же места, а при копировании добавляй перевёрнутое слово.