Здравствуйте!
Я следил за вашим диалогом с pashasnuff. Так как у меня похожая задача. Мне помогли сделать ее. Но она сделана с помощью массива, а задание состоит сделать ее с помощью множеств. Не могли мне помочь выполнить это задание с помощью множеств. Я понимаю, что с помощью массивов сделать ее намного легче. Но преподаватель требует что бы сделали ее с помощью множеств.
Задание:
Вводится непустая строка из строчных букв(не более 79 символов). Отдельные слова в ней разделены запятыми(слева и справа от запятой могут быть пробелы). Вывести на печать в алфавитном порядке. Гласные, которые не входят более, чем в одно слово.
Вот код:
program stroki;
{uses crt;{Подключение модуля работы с экраном. Есть о обычном Паскале}
label 3;
procedure vvod(var sp:string; var lp:integer);
begin
writeln('Введите строку слов, разделенных запятыми:');
readln(sp);
sp:=sp+'.';
lp:=length(sp);
writeln;
end;
procedure tek_slovo(sp:string;lp:integer;var ip:integer;var s1p:string;var l1p:integer);
begin
s1p:='';
while (sp[ip]<>',')and (sp[ip]<>'.')and (sp[ip]<>' ')do
begin
s1p:=s1p+sp[ip];
l1p:=length(s1p);
inc(ip);
end;
end;
var s,s1,s2,s3:string;
l,l1,i,j,k,b:integer;
a: array[1..20] of string [20];
begin
3: {clrscr;{очистка экрана. Есть в обычном Паскале}
writeln('Меню:');
writeln('Слова в алфавитном порядке - 1');
writeln('Уникальные символы строки - 2');
writeln('Выход из программы - 0');
writeln('Выберите номер пункта меню:');
readln(k);
case k of
1:begin
vvod(s,l);
i:=0;
b:=0;
writeln('Cлова в алфавитном порядке');
while i<=l-1 do
begin
inc(i);
{Выделение текущего слова}
if (s[i]<>' ')then
begin
{в s1 - текущее слово}
tek_slovo(s,l,i,s1,l1);
inc(b); {b:=b+1}
a[b]:=s1;
end;
end;
{сортировка массива слов (массив А)методом "пузырька"}
for i:=1 to b-1 do
for j:=i+1 to b do
if a[i]>a[j] then
begin
s2:=a[i]; a[i]:=a[j]; a[j]:=s2;
end;
s3:='';
{слова в алфавитном порядке}
for j:=1 to b do
s3:=s3+a[j]+', ';
writeln (s3);
goto 3;
end;
2:begin
vvod(s,l);
i:=0;
s3:='';
writeln('Гласные, которые не входят более, чем в одно слово');
while i<=l-1 do
begin
inc(i);
{Выделение текущего слова}
if (s[i]<>' ')then
begin
tek_slovo(s,l,i,s1,l1);
s2:=s; {Вспомогательная строка}
{Удаление текущего выделенного слова из вспомогательной строки}
delete(s2,i-l1,l1);
{Если очередная буква выделенного текущего слова ни разу не входит во
вспомогательную строку без него и не входит в результирующую строку,
содержащую уникальные символы, то она заносится в результирующую строку s3}
for j:=1 to l1 do
if (pos(s1[j],s2)=0) and (pos(s1[j],s3)=0)then s3:=s3+' ' +s1[j];
end;
end;
{Уникальные символы}
writeln (s3);
goto 3;
end; {1}
0:exit;
end;{case}
end.