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

Oksana777 · 24.05.2012, 07:47

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

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[i]:=a[i]+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[i])do
if a[i][k]=a[1][j] then
t:=true;
end;
if t=false then
writeln('Cлова, в которые не входит ни одна из букв первого слова: ', a[i]);
readln;
inc(i);
end;
readln
end.

Vladimir_S · 24.05.2012, 20:34

Ну во-первых, Вы же сами определяете тип задания, как работа с множествами, а где у Вас в программе множества? В упор не вижу. Во-вторых, я работаю только с 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 · 24.05.2012, 22:06

спасибо...

Oksana777 · 26.05.2012, 04:36

Цитата:

Сообщение от 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.

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

Vladimir_S · 26.05.2012, 09:50

Цитата:

Сообщение от Oksana777

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

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

Код:

  t:boolean;

пишем

Код:

 t,t1:boolean;

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

Код:

 writeln('Words containing no letters of the first word:');
 t1:=true;
 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
    begin
     write(a[i]+' ');
     t1:=false;
    end;
  end;
 If t1 then writeln('No such words!');
 readln
end.

Oksana777 · 26.05.2012, 22:57

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

24.05.2012, 07:47	#1 (permalink)
Oksana777 Member Регистрация: 08.05.2012 Сообщений: 16 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Обработка множеств Пусть дан текст, заканчивающийся точкой. Текст состоит из слов, разделённых пробелами.Слово представляет собой последовательность латинских букв. Напечатайте те слова, в которые не входит ни одна из букв первого слова.(Попробовала написать программу, но она работает неправильно..исправьте, если что не так) 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[i]:=a[i]+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[i])do if a[i][k]=a[1][j] then t:=true; end; if t=false then writeln('Cлова, в которые не входит ни одна из букв первого слова: ', a[i]); readln; inc(i); end; readln end.

24.05.2012, 20:34	#2 (permalink)
Vladimir_S Специалист Регистрация: 27.08.2008 Адрес: Санкт-Петербург Сообщений: 27,807 Сказал(а) спасибо: 340 Поблагодарили 583 раз(а) в 208 сообщениях Репутация: 113184	Ну во-первых, Вы же сами определяете тип задания, как работа с множествами, а где у Вас в программе множества? В упор не вижу. Во-вторых, я работаю только с 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.

24.05.2012, 07:47
Helpmaster Member Регистрация: 08.03.2016 Сообщений: 0	Так же решение проблемы можно попробовать найти в одной из похожих тем Обработка текста Обработка массивов Обработка файлов Обработка txt Обработка алюминия

24.05.2012, 22:06	#3 (permalink)
Oksana777 Member Регистрация: 08.05.2012 Сообщений: 16 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	спасибо...

Ads
Яндекс Member Регистрация: 31.10.2006 Сообщений: 40200 Записей в дневнике: 0 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 55070

26.05.2012, 22:57	#6 (permalink)
Oksana777 Member Регистрация: 08.05.2012 Сообщений: 16 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	*Спасибо вам огромное, Владимир!*