Помогите, пожалуйста, написать программу с символьными данными

[kris_kaif]

Помогите, пожалуйста, написать программу с символьными данными

Вводится текст в виде списка слов, разделенных запятыми, и заканчивающийся точкой (в слове не более 10 литер, в тексте не более 20 слов). Напишите про-грамму, выводящую упорядоченный в алфавитном порядке перечень слов (без по-вторений) с указанием, сколько раз такое слово встречалось в тексте.

 

[Евгений]

Так как не написали на чём писать, сделал в Pascal.

const n=20;
type Z= array[1..n] of string;
var f,f1: Text;
s,s1: string;
c: char;
j,i,t: byte;
A: Z;
begin
Readln(s);
Assign(f,'Text_in.txt'); Rewrite(f);
Writeln(f,s);
Reset(f);
s1:=''; t:=1;
While not Eof(f) do
Readln(f,s);
for i:=1 to Length(s) do begin
c:= s;
if (c<>',') and (c<>'.') then
s1:= s1+c
else begin
A[t]:= s1;
Inc(t);
s1:='';
if (t>n) then Break;
end;
end;
for i:=1 to n-1 do
for j:=1 to n-i do
if A[j]>A[j+1] then begin
s:= A[j];
A[j]:= A[j+1];
A[j+1]:= s
end;
Assign(f1,'Text_out.txt');
Rewrite(f1);
i:=1;t:=1;
repeat
if A=A[i+1] then begin
Inc(t);
Inc(i)
end else begin
Writeln(f1,A,'-',t);
t:=1;
Inc(i)
end;
until i>n;
Close(f);
Close(f1);
end.

 

[kris_kaif]

да, мне нужно было в Pascal! спасибо за помощь, а не подскажите ещё, что мне нужно ввести после того как внизу экрана у меня появляется поле "ввод данных" ?

 

[Евгений]

Вводите строку из слов через запятую, а в конце ставите точку. В условии про пробелы ничего не сказано и их использовать не стоит.

 

[kris_kaif]

он мне уже в который раз ошибку выдаёт(

 

[poiu]

а это все глючный ABC. вроде ранее советовали изменить описание массива. на что то вроде type Z= array[1..n] of string[10];

 

[kris_kaif]

всё рввно не получается( tehno015

 

[Евгений]

У меня Free Pascal и всё работает.
Немрого подправил( на случай если слов меньше 20):

const n=20;
type Z= array[1..n] of string;
var f,f1: Text;
s,s1: string;
c: char;
j,i,t: byte;
A: Z;
begin
Readln(s);
Assign(f,'Text_in.txt'); Rewrite(f);
Writeln(f,s);
Reset(f);
s1:=''; t:=1;
While not Eof(f) do
Readln(f,s);
for i:=1 to Length(s) do begin
c:= s;
if (c<>',') and (c<>'.') then
s1:= s1+c
else begin
A[t]:= s1;
Inc(t);
s1:='';
if (t>n) then Break;
end;
end;
for i:=1 to n-1 do
for j:=1 to n-i do
if A[j]>A[j+1] then begin
s:= A[j];
A[j]:= A[j+1];
A[j+1]:= s
end;
Assign(f1,'Text_out.txt');
Rewrite(f1);
i:=1;t:=1; s1:='';
repeat
if A=s1 then Inc(i)
else
if A=A[i+1] then begin
Inc(t);
Inc(i)
end else begin
Writeln(f1,A,'-',t);
t:=1;
Inc(i)
end;
until i>n;
Close(f);
Close(f1);
end.

 

[kris_kaif]

всё равно ошибку выдаёт(

 

[Vladimir_S]

У меня Free Pascal и всё работает.

Странно. Не должно работать: ошибка видна сразу.
Вот Вы ставите цикл с постусловием:

repeat
if A=s1 then Inc(i)
else
if A=A[i+1] then begin
Inc(t);
Inc(i)
end else begin
Writeln(f1,A,'-',t);
t:=1;
Inc(i)
end;
until i>n;

причем в теле цикла мало того, что допускается это самое i>n, так еще и делается обращение к элементу массива A[i+1]! Тут явный выход за границу массива, о чем транслятор у kris_kaif и верещит. Вероятно, а Вас, Женя, эта проверка (выход индекса массива за пределы диапазона) по умолчанию отключена - вот и создается впечатление, что всё тип-топ. Но ошибку отсутствие проверки не снимает. Поправьте, пожалуйста.

 

[Vladimir_S]

Вообще-то я не считаю этичным влезать в творчество коллеги и потому прошу меня извинить, но поскольку Евгений исчез, а оставлять задачу незавершенной не годится, выложу свой вариант решения. У меня без файлов и можно ставить пробелы (даже несколько подряд) в начале строки и между запятой и первой буквой следующего слова. А можно и не ставить. Отработает.

Var
 W:Array[1..20] of String[10];
 Rep:Array[1..20] of Integer;
 S,C:String[200];
 i,j,k,N,L:integer;

Begin
 Writeln('Enter the string');
 Readln(S);
 L:=Length(S);
 Writeln;
 j:=1;
 i:=0;
 Repeat
  W[j]:='';
  repeat
   Inc(i);
  until S[i]<>' ';
  if i<L then
   begin
    while (S[i]<>',') and (S[i]<>'.') do
     begin
      W[j]:=W[j]+S[i];
      Inc(i);
     end;
   end;
  if i<L then Inc(j);
 Until i>=L;
 N:=j;

 for i:=1 to N do Rep[i]:=1;

 for i:=1 to N-1 do
  for j:=i+1 to N do
   if W[i]=W[j] then
    begin
     Inc(Rep[i]);
     for k:=j+1 to N do W[k-1]:=W[k];
     Dec(N);
    end;

 for i:=1 to N-1 do
  for j:=1 to N-i do
   if W[j]>W[j+1] then
    begin
     C:=W[j+1];
     W[j+1]:=W[j];
     W[j]:=C;
    end;

 for i:=1 to N do
  writeln(W[i]+' (',Rep[i],')');

 Readln
End.

 

[Евгений]

Поправил:
const n=20;
type Z= array[1..n] of string;
var f,f1: Text;
s,s1: string;
c: char;
j,i,t: byte;
A: Z;
begin
Readln(s);
Assign(f,'Text_in.txt'); Rewrite(f);
Writeln(f,s);
Reset(f);
s1:=''; t:=1;
While not Eof(f) do
Readln(f,s);
for i:=1 to Length(s) do begin
c:= s;
if (c<>',') and (c<>'.') then
s1:= s1+c
else begin
A[t]:= s1;
Inc(t);
s1:='';
if (t>n) then Break;
end;
end;
for i:=1 to n-1 do
for j:=1 to n-i do
if A[j]>A[j+1] then begin
s:= A[j];
A[j]:= A[j+1];
A[j+1]:= s
end;
Assign(f1,'Text_out.txt');
Rewrite(f1);
i:=1;t:=1; s1:='';
repeat
if A=s1 then Inc(i)
else
if A=A[i+1] then begin
Inc(t);
if i= n-1 then
Writeln(f1,A,'-',t);
Inc(i)
end else begin
Writeln(f1,A,'-',t);
t:=1;
Inc(i)
end;
until i=n;
if (i=n) and (A<>A[i-1]) then
Writeln(f1,A,'-1');
Close(f);
Close(f1);
end.