Помогите написать програмку на паскале Опции

[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.

П.С. спасибо за помощь