Задача по Turbo Pascal

[airyashov]

Код: Выделить всё

program zad;

var i,j,code:integer;
    s,s1:string;
begin
readln(i);
str(i,s);
j:=1;
s1:='';
while (j<=Length(s)) do
begin
     s1:=s[j]+s1;
     inc(j);
end;
val(s1,i,code);
writeln(i);

end.

[assis2007]

Хыиуду
А как тогда??

[MOTOCoder]

Зписывать введенные строки текста нужно не в массив words, а в другой массив.
Потом обработать каждую строку полученного массива функцией ParceText, кторая разместит все слова в массиве words.

[assis2007]

const
N=100;
var
words:array[1..N]of string;
w:array[1..N]of string;
cn,k:integer;
s:string;
wd:string;
i,j:integer;
isk_slovo:integer;
kolislov:integer;
kolpovt:integer;
max,m,c:integer;
wc:integer;
a,b:boolean;
function Kolslov(txt:string):integer;
var
l,c:integer;
begin
l:=length(txt);
for i:=1 to l+1 do
begin
if ((txt<>' ')and(i<>l+1)) then
wd:=wd+txt
else
begin
c:=c+1;
words[c]:=wd;
wd:='';
end;
end;
if c>10 then
begin
writeln('Obrabativaetsa tolko 10 slov');
Kolslov:=10;
end
else
Kolslov:=c;
end;
begin
writeln('Vvedite tekst');
m:=0;
repeat
readln(s);
if s<>'$' then
begin
inc(m);
words[m]:=S;
end;
until s='$';
kolislov:=kolslov(s);
a:=false;
if kolislov>=2 then
begin
for i:=1 to kolislov do
begin
kolpovt:=0;
for j:=1 to kolislov do
if words[j]=words then
kolpovt:=kolpovt+1;;
if kolpovt>1 then
begin
isk_slovo:=i;
a:=true;
end;
end;
writeln;
if a then
begin
writeln('Clova vstrechayshiesa bolee odnogo raza:');
for i:=1 to kolislov do
begin
wc:=0;
for j:=1 to kolislov do
if words=words[j] then
inc(wc);
if wc>1 then
begin
b:=true;
for k:=1 to cn do
if w[k]=words then
b:=false;
if b then
begin
writeln(words);
inc(cn);
w[cn]:=words;
end;
end;
end;
end
else
writeln('V texte net slov povtorayshihsa bolee odnogo raza');
end
else
writeln('Text otsytstvyet');
readln;
end.
Теперь выводит что в тексте нет слов повторяющихся более одного раза

[assis2007]

Код: Выделить всё

const
  N=100;
var
 words:array[1..N]of string;
 w:array[1..N]of string;
 cn,k:integer;
 s:string;
 wd:string;
 i,j:integer;
 index:integer;
 count,co,col:integer;
 cnt:integer;
 wc:integer;
 b,a,pr:boolean;
 function ParceText(txt:string):integer;
var l,c:integer;
begin
 c:=0;
 pr:=false;
 l:=length(txt);
 for i:=1 to l+1 do
 begin
  if ((txt[i]<>' ')and(i<>l+1)) then
   begin
    wd:=wd+txt[i];
    pr:=true;
   end
  else
   begin
    inc(c);
    words[c]:=wd;
    wd:='';
   end;
 end;
 ParceText:=c;
end;
begin
 writeln('Vvedite text:');
 repeat
  readln(s);
  if s<>'$' then
   begin
    count:=ParceText(s);
    co:=co+count;
   end;
 until s='$';
    for i:=1 to co do
     begin
      cnt:=0;
      for j:=1 to co do
       if words[i]=words[j] then
        inc(cnt);
        if cnt>1 then
          begin
           index:=i;
          end;
     end;
    for i:=1 to co do
      begin
       wc:=0;
       for j:=1 to co do
        if words[i]=words[j] then
         inc(wc);
         if wc>1 then
          begin
           b:=true;
           for k:=1 to cn do
            if w[k]=words[i] then
             b:=false;
             if b then
              begin
               inc(cn);
               w[cn]:=words[i];
              end;
          end;
      end;


 if pr then
  begin
   if co<=10 then
    begin
     writeln('slova povtor bolee odnogo raza:');
     for k:=1 to cn do
      writeln(w[k]);
    end
   else
    begin
     writeln('obrabat 10 slov');
     writeln('slova povtor bolee odnogo raza:');
      for k:=1 to cn do
       writeln(w[k]);
    end;
  end
 else
  writeln('text otsytstvyet');
end.

Почему то при введении двух строквыводит только то что находится на вротой строке. что не так?

[MOTOCoder]

Во-первых вынести c из ParceText в глобальный var и убрать c:=0 в начале функции.

[assis2007]

спасибо большое заработало

[assis2007]

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

[MOTOCoder]

Поставить счетчик и проверять, сколько слов.

[assis2007]

а где его ставить я всё просто перепробовал