Задача в Pascale по множествам,помогите решить

[Student35]

Всем здравствуйте, у меня большая беда, мне нужно сдать задачу по множествам в понедельник, если не здам, меня не допустят к экзамену, помогите пожалуйста, решите если сможете.
Вот собственно задача:
Известны сорта роз, выращиваемых тремя цветоводами: "Анджелика", "Виктория", "Галатин", "Ave Maria", "Катарина", "Юбилейная". Определить те сорта, которые имеются у каждого из цветоводов; которые есть хотя бы у одного из цветоводов; которых нет ни у одного из цветоводов.
Пожалуйста помогите мне...

[KORT]

Вот и тогово:

Uses crt;
Type Rozy=(Andjelika,Viktoriya,Galatin,Ave_Maria,Katarina,Ubileinaya);
     Mn=set of Predmet;
Const A:Mn=[Andjelika,Viktoriya];
      B:Mn=[Andjelika,Galatin];
      C:Mn=[Andjelika,Ave_Maria];
      D:Mn=[Andjelika];
      E:Mn=[Andjelika,Ubileinaya];
      F:Mn=[ Andjelika,Viktoriya,Galatin,Ave_Maria,Katarina,Ubileinaya];
Var Vse,Net,Mn123:Mn;

Procedure Vivod(Var mnog:Mn);
Var i:integer;
    mas:array[1..6] of Rozy;
    ms:array[1..6] of string;
begin
mas[1]:=Andjelika;
mas[2]:=Viktoriya;
mas[3]:=Galatin;
mas[4]:=Ave_Maria;
mas[5]:=Katarina;
mas[6]:=Ubileinaya; 

ms[1]:='Andjelika';
ms[2]:='Viktoriya';
ms[3]:='Galatin';
ms[4]:='Ave_Maria';
ms[5]:='Katarina';
ms[6]:='Ubileinaya'; 
For i:=1 to 6 do begin
If mas[i] in mnog then write(ms[i],'  ');
end;
end;

BEGIN
 CLRSCR;
 
Vse:=A*B*C*D*E;
Net:=F-(A+B+C+D+E);
Mn123:=A*B*C;
Textcolor(15);
Writeln('Sadovod A:');
Textcolor(10);
Vivod(A);
Writeln;
Textcolor(15);
Writeln(' Sadovod B:');
Textcolor(10);
Vivod(B);
Writeln;
Textcolor(15);
Writeln(' Sadovod C:');
Textcolor(10);
Vivod(C);
Writeln;
Textcolor(15);
Writeln(' Sadovod D:');
Textcolor(10);
Vivod(D);
Writeln;
Textcolor(15);
Writeln(' Sadovod E:');
Textcolor(10);
Vivod(E);
Writeln;
Textcolor(15);
Writeln('Odinakovye sorta roz u v sadovodov:');
Textcolor(10);
Vivod(Vse);
Writeln;
Textcolor(15);
Writeln('Sort roz, kotorye ne vyratscivaut');
Textcolor(10);
Vivod(Net);
Writeln;
Readkey;
END.

[puporev]

Наворочено круто, хотя и с небольшими ошибками.
Чтобы не шокировать преподавателя, посмотри этот код. Все работает, проверено.

program sort_roz;
uses crt;                        //создаем тип сортов роз(русские буквы нельзя, поэтому
type roz=set of (a,v,g,av,k,yu);  //сокращенно англиискими)         
var m,m1,m2,m3:roz;                //три цветовода
    s:array[1..6]of roz;           //массив сортов
    s1:array[1..6]of string;       //массив названий сортов
    i:integer;
begin
clrscr;
m1:=[a,v,g];   //первый цветовод, можно любой набор сортов
m2:=[a,v,av];   //второй
m3:=[a,v,av,k];  //третий
s[1]:=[a];s[2]:=[v];s[3]:=[g];s[4]:=[av];s[5]:=[k];s[6]:=[yu];
s1[1]:='"Анджелика"';s1[2]:='"Виктория"';s1[3]:='"Галатин*"';s1[4]:='"Ave Maria"';s1[5]:='"Катарина"';s1[6]:='"Юбилейная"';
for i:=1 to 6 do
   begin
     if (s[i]*m1=s[i])and(s[i]*m2=s[i])and(s[i]*m3=s[i])then
     writeln(s1[i],' у всех цветоводов')
     else if (s[i]*m1=s[i])or(s[i]*m2=s[i])or(s[i]*m3=s[i])then
     writeln(s1[i],'хотя бы у одного цветовода')
     else writeln(s1[i],'нет ни у одного цветовода');
   end;
readln
end.

[Student35]

Спасибо огромное, но есть один вопрос!
У меня в паскале в 14 строке (s1[1]:='"Анджелика"';s1[2]:='"Виктория"';s1[3]:='"Галатин*"';s1[4]:='"Ave Maria"';s1[5]:='"Катарина"';s1[6]:='"Юбилейная"' при компиляции, комп подчеркивает ";" точку с запятой, и пишет "Error 26:Type mismatch"...Обьясните пожалуйста почему? Я мучался, мучался так и не понял...

[Карась]

скомпилил. Всё работает.

Возможно строка криво перенеслась...

.........
s1[1] := '"Анджелика"'; s1[2] := '"Виктория"'; s1[3] := '"Галатин*"';
s1[4] := '"Ave Maria"'; s1[5] := '"Катарина"'; s1[6] := '"Юбилейная"';
...........

Сделай длиную строку в две оротких...

[puporev]

Правильно расставь везде знаки, например ' "Анджелика" '; здесь сначала апостроф, потом открывающие кавычки, как у тебя в условии, потом закрывающие кавычки и снова апостроф.
И если ты списал код один к одному, то прав Карась, в Паскале переносить стороку нельзя.

[Student35]

Да да да, спасибо, я ее сдал...
Но есть еще одна просьба...простите меня пожалуйста, наглость моя не имеет границ...
Помогите пожалуйста решить вот эти 2 задачи, они вроде простые, но я непонимаю их.

1. Треугольник задан координатами своих вершин. Составить программу вычисления его площади.
2. Составить программу определяющую в каком из данных двух чисел больше цифр.
Их обе нужно решить с помощью процедур и функций (ну по этой теме задачи задали), и только с помощью процедур и функций, я по другому решил, у меня учительница не приняла.
Решите пожалуйста!!! Если я их сдам, то мне не нужно будет экзамен сдавать, спасибо огромное заранее. (просто экзамен я сам вряд ли сдам.

[puporev]

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

program Treugolnik;
uses crt;
var x1,x2,x3,y1,y2,y3,a,b,c,p,S:real;
function DLst(x1,x2,y1,y2:real):real;//длина стороны
begin
DLst:=sqrt(sqr(x2-x1)+sqr(y2-y1));
end;
function Pp(a,b,c:real):real;//полупериметр
begin
Pp:=(a+b+c)/2;
end;
function Str(p,a,b,c:real):real;//площадь
begin
Str:=sqrt(p*(p-a)*(p-b)*(p-c));
end;
begin
clrscr;
write('x1=');readln(x1);write('x2=');readln(x2);write('x3=');readln(x3);
write('y1=');readln(y1);write('y2=');readln(y2);write('y3=');readln(x3);
a:=DLst(x1,x2,y1,y2);
b:=DLst(x1,x3,y1,y3);
c:=DLst(x2,x3,y2,y3);
p:=Pp(a,b,c);
S:=Str(p,a,b,c);
write('S=',S:4:2);
readln
end.

По второй задаче. Ее можно решить по разному. Приведи свой код, как ты ее решил без функций, помогу сделать функции.

[Student35]

Спасибо большое, а вот решение моей второй задачи:
program z2;
var a,b : Integer;
str1, str2 : String;
begin
write('N1: ');
readln(a);
write('N2: ');
readln(b);
str(a,str1);
str(b,str2);
if length(str1)=length(str2) then writeln('=')
else if length(str1)>length(str2) then writeln('n1')
else writeln('n2');

end.

[puporev]

Вот. Так и думал, что решил через строки. Это пожалуй самый оптимальный вариант решения, но учителя его не любят, им подавай разложение числа на цифры. Вот как это выглядит с функцией:

program cifry;
uses crt;
var A,B:longint;
function Cifr(n:longint):integer;//функция, определяющая кол-во цифр в числе
var k:integer;
begin
   k:=0;
   while n>0 do
     begin
       n:=n div 10;
       k:=k+1;
     end;
   Cifr:=k;
end;
begin               //начало основной программы
   clrscr;
   write('A=');readln(A);
   write('B=');readln(B);
   if Cifr(A)>Cifr(B) then
   writeln('bolshe cifr v chisle A')
   else if Cifr(A)<Cifr(B) then
   writeln('bolshe cifr v chisle B')
   else writeln('Kolichestvo cifr ravno');
readln;
end.