Глава 38, задача Б
Добавлено: 05.05.2013 06:50:01
Решил эту задачу, затем посмотрел решение автора, оказалось, что мой код длиннее практически в два раза.
Оцените пожалуйста решение, укажите на ошибки. Мне не совсем нравится частое использование case of end
Оцените пожалуйста решение, укажите на ошибки. Мне не совсем нравится частое использование case of end
- Код: Выделить всё
type
TSet = set of byte;
var
i:byte;
Bus, Truck, Car, Red, Yellow, White, Black, Sets:TSet;
function ReadType(aI:byte):TSet;
var
n:byte;
begin
ReadType:=[];
for n:=0 to 255 do
if n mod aI=0 then ReadType:=ReadType+[n];
end;
procedure SetOfType(var aBus, aTruck, aCar:TSet);
var
i, j:byte;
begin
i:=7;
repeat
case i of
7:aBus:=ReadType(i);
5:aTruck:=ReadType(i)-aBus;
else for j:=0 to 255 do
if not (j in aBus+aTruck) then aCar:=aCar+[j];
end;
i:=i-2;
until i<3;
end;
function ReadColor(aI:byte):TSet;
var
n:byte;
begin
ReadColor:=[];
for n:=0 to 255 do
if n mod aI=0 then ReadColor:=ReadColor+[n];
end;
procedure SetOfColor(var aRed, aYellow, aWhite, aBlack:TSet);
var
i, j:byte;
begin
i:=4;
repeat
case i of
4:aRed:=ReadColor(i);
3:aYellow:=ReadColor(i)-aRed;
2:aWhite:=ReadColor(i)-(aRed+aYellow);
else for j:=0 to 255 do
if not (j in aRed+aYellow+aWhite) then aBlack:=aBlack+[j];
end;
dec(i);
until i=0;
end;
procedure WriteSets(aSet:TSet);
var
j, k:byte;
begin
k:=0;
for j:=0 to 255 do begin
if j in aSet then inc(k);
end;
write(k, ' ');
end;
begin
//Множества типов автомобилей
Bus:=[]; Truck:=[]; Car:=[];
//Множество цветов
Red:=[]; Yellow:=[]; White:=[]; Black:=[];
SetOfType(Bus, Truck, Car);
SetOfColor(Red, Yellow, White, Black);
for i:=1 to 7 do begin
case i of
1:Sets:=Bus;
2:Sets:=Truck;
3:Sets:=Car;
4:Sets:=Red;
5:Sets:=Yellow;
6:Sets:=White;
7:Sets:=Black;
end;
WriteSets(Sets);
if (i=3) or (i=7) then writeln;
end;
Sets:=(Red*Car)+(White*Truck)+Bus;
WriteSets(Sets);
readln;
end.