Помощь - Поиск - Пользователи - Календарь
Полная версия: Помогите написать програмку на паскале
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
sergey121212
Дан текст. Составить программу удалив из него повторное вхождение слов.

Вот что я попытался сделать но все равно не получается

1. Сделал массив из 8 слов и удалил из него одиннаковые

uses crt;
const n = 8;
type M_st=array[1..n] of string[20];
var
a:M_st;
s:M_st;
i,j,l: integer;
flag: boolean;
begin
writeln('Vvedite 8 slov');
for i := 1 to n do
readln(a[i]);
writeln;
j := 1;
for i := 1 to n do
begin
flag := true;
for l := 1 to j do
if s[l] = a[i] then
flag := false;
if flag = true then begin
s[j] := a[i];
j := j+1
end;
end;
for i := 1 to j-1 do
write (s[i],' ');
writeln;
readln;
writeln;
end.



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

2. Написал часть программы которая копирует каждое слово текста в массив а вот тальше впал в ступор.

program lab10;
uses crt;
Var C: String;
I,Pb,j,l,n,k:integer; x: array [1..1000] of string; s: array [1..1000] of string;

flag: boolean;
Begin
Write('Введите текст: ');
ReadLn©;
C:=C+' '; n:=Length©;
K:=0;
While pos(' ',C) <> 0 Do
Begin
Pb := pos(' ',C);
for i:=1 to pb do
x[i]:=Copy(C,1,Pb-1);
if x[i]=Copy(C,1,Pb-1) then K:=k+1;
Delete(C,1,Pb);
end;
writeln;
Lapp
Ты в принципе на верном пути. Но ты зря так сильно разделил эти две части: разбиение на слова и поиск одинаковых. Надо просматривать массив (словарь) по мере его набора, и, если слова еще нет там - добавлять, а если оно уже есть в массиве - не добавлять его, а просто удалять из текста.

И еще один совет. Почему-то все новички при разбиении на слова ищут разделители, хотя их множество обычно очень сильно неопределено. Рекомендую использовать набор букв (алфавит) - их множество гораздо легче поддается определению.

Вот, смотри:
const
m= 100;
Alphabet= ['A'..'Z']+['a'..'z'];

var
s,w: string;
dict: array[1..m] of string;
i,j,n: integer;

begin
readln(s); // читаем текст
n:= 0; // словарь сначала пуст
i:= 1; // встаем в начало текста
w:= ''; // очищаем слово
while i<=Length(s) do begin // цикл по всему тексту
if s[i] in Alphabet then w:= w+s[i] // если буква, прибавляем к слову
else // если не буква
if w<>'' then begin // если слово уже накоплено
j:= 1;
while (j<=n) and (w<>dict[j]) do inc(j); // проходим по словарю
if j>n then begin // слово не найдено
inc(n); // добавляем его к словарю
dict[n]:= w
end
else Delete(s,i-Length(w),Length(w)); // слово найдено, удаляем его из текста
w:= '' // и снова очищаем
end
inc(i)
end;
writeln(s);
readln
end.

Обрати также внимание на правильное форматирование кода.
sergey121212
А я вот еле сделал такое

Код

program lab10;
Var C: String;
I,Pb,j,f,n,k:integer;
x: array [1..1000] of string;
s: array [1..1000] of string;
Begin
Write('Введите текст: ');
ReadLn(C);
C:=C+' '; n:=Length(C);
K:=0;

While pos(' ',C) <> 0 Do
begin
Pb := pos(' ',C);
if Pb=pos(' ',C) then
begin
k:=k+1;
i:=k;
x[i]:=Copy(C,1,Pb-1);
end;
Delete(C,1,Pb);
end;


for j:=1 to k do
begin
i:=j;
s[j]:=x[i];
end;

for j:=1 to k do
begin
for i:=1 to k do
if s[j]=x[i] then f:=f+1;
if f<2 then write(s[j],' ');
f:=0;
end;

End.


П.С. спасибо за помощь
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.