Обработка множеств

[Oksana777]

Обработка множеств

Пусть дан текст, заканчивающийся точкой. Текст состоит из слов, разделённых пробелами.Слово представляет собой последовательность латинских букв. Напечатайте те слова, в которые не входит ни одна из букв первого слова.(Попробовала написать программу, но она работает неправильно..исправьте, если что не так)


uses
SysUtils, Windows;

var a:array[1..200]of string;
c:char;
k,i,j,n:integer;
t:boolean;
begin
setconsolecp(1251);
setconsoleoutputcp(1251);
i:=1;
read(c);
while c<>'.' do
begin
if c=' ' then
inc(i)
else
a:=a+c;
read(c);
end;
n:=i;
i:=2;
while i<n do
begin
t:=false;
for j:=1 to length(a[1]) do
begin
for k:=1 to length(a)do
if a[k]=a[1][j] then
t:=true;
end;
if t=false then
writeln('Cлова, в которые не входит ни одна из букв первого слова: ', a);
readln;
inc(i);
end;
readln
end.

 

[Vladimir_S]

Ну во-первых, Вы же сами определяете тип задания, как работа с множествами, а где у Вас в программе множества? В упор не вижу. Во-вторых, я работаю только с DOS-Паскалем, а потому правильность установки виндовских модулей-кодировщиков и возня с кириллицей - Ваша забота. В-третьих, вводить текст побуквенно - тоска смертная, а потому я ввожу и обрабатываю строку целиком. Вот что получилось:

var
 a:array[1..200] of string;
 i,j,n:integer;
 r:set of char;
 t:boolean;
 s:string;
begin
 for i:=1 to 200 do a[i]:='';
 r:=[];
 writeln('Enter the string:');
 readln(s);
 i:=1;
 j:=0;
 while s[j]<>'.' do
  begin
   inc(j);
   if s[j]=' ' then
    inc(i)
   else
    a[i]:=a[i]+s[j];
  end;
 n:=i;
 for i:=1 to length(a[1]) do
  if not(a[1][i] in r) then r:=r+[a[1][i]];
 writeln('Words containing no letters of the first word:');
 for i:=2 to n do
  begin
   t:=true;
   j:=0;
   repeat
    Inc(j);
    if a[i][j] in r then t:=false;
   until not(t) or (j=length(a[i]));
   if t then write(a[i]+' ');
  end;
 readln
end.

 

[Oksana777]

спасибо...tcelobitnaja

 

[Oksana777]

Ну во-первых, Вы же сами определяете тип задания, как работа с множествами, а где у Вас в программе множества? В упор не вижу. Во-вторых, я работаю только с DOS-Паскалем, а потому правильность установки виндовских модулей-кодировщиков и возня с кириллицей - Ваша забота. В-третьих, вводить текст побуквенно - тоска смертная, а потому я ввожу и обрабатываю строку целиком. Вот что получилось:

var
 a:array[1..200] of string;
 i,j,n:integer;
 r:set of char;
 t:boolean;
 s:string;
begin
 for i:=1 to 200 do a[i]:='';
 r:=[];
 writeln('Enter the string:');
 readln(s);
 i:=1;
 j:=0;
 while s[j]<>'.' do
  begin
   inc(j);
   if s[j]=' ' then
    inc(i)
   else
    a[i]:=a[i]+s[j];
  end;
 n:=i;
 for i:=1 to length(a[1]) do
  if not(a[1][i] in r) then r:=r+[a[1][i]];
 writeln('Words containing no letters of the first word:');
 for i:=2 to n do
  begin
   t:=true;
   j:=0;
   repeat
    Inc(j);
    if a[i][j] in r then t:=false;
   until not(t) or (j=length(a[i]));
   if t then write(a[i]+' ');
  end;
 readln
end.

а если у меня случай, что слов, в которых нету букв из первого слова, нет, как вывести сообщение "Таких слов не найдено"?

 

[Vladimir_S]

а если у меня случай, что слов, в которых нету букв из первого слова, нет, как вывести сообщение "Таких слов не найдено"?

Легко. Например, так:
1. Вводим еще одну булевскую переменную, например, t1. Соответсвенно, вместо

  t:boolean;

пишем

 t[COLOR=Red],t1[/COLOR]:boolean;

2. Конец программы заменяем на

 writeln('Words containing no letters of the first word:');
[COLOR=Red] t1:=true;[/COLOR]
 for i:=2 to n do
  begin
   t:=true;
   j:=0;
   repeat
    Inc(j);
    if a[i][j] in r then t:=false;
   until not(t) or (j=length(a[i]));
   if t then
[COLOR=Red]    begin
     write(a[i]+' ');
     t1:=false;
    end;[/COLOR]
  end;
[COLOR=Red] If t1 then writeln('No such words!');[/COLOR]
 readln
end.

 

[Oksana777]

Спасибо вам огромное, Владимир!