freepascal.ru

Решил эту задачу, затем посмотрел решение автора, оказалось, что мой код длиннее практически в два раза.
Оцените пожалуйста решение, укажите на ошибки. Мне не совсем нравится частое использование 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.

Каждый решает по своему.Вот мой вариант:

Код: Выделить всё

type tset=set of byte;

function CountCars(var aset:tset):byte;
var k,n:byte;
begin
  n:=0;
  for k:=0 to 255 do
    if k in aset then inc(n);
  CountCars:=n;
end;

procedure WriteSet(var aset:tset);
var k,n:byte;
begin
  n:=0;
  for k:=0 to 255 do
    if k in aset then write(k:4);
  writeln; writeln;
end;

var bus,truck,car,red,yellow,white,black,sn:tset;
    k:byte;
begin
  bus:=[];truck:=[];car:=[];red:=[];
  yellow:=[];white:=[];black:=[];
  for k:=0 to 255 do begin
    if k mod 7=0 then bus:=bus+[k]
    else if k mod 5=0 then truck:=truck+[k]
    else car:=car+[k];
  end;
  writeln('Количество автомобилей');
  writeln('Автобусы ',CountCars(bus)); WriteSet(bus);
  writeln('Грузовые ',CountCars(truck)); WriteSet(truck);
  writeln('Легковые ',CountCars(car)); WriteSet(car);
  for k:=0 to 255 do begin
    if k mod 4=0 then red:=red+[k]
    else if k mod 3=0 then yellow:=yellow+[k]
    else if k mod 2=0 then white:=white+[k]
    else black:=black+[k];
  end;
  writeln('Количество автомобилей по цвету');
  writeln('Красные ',CountCars(red)); WriteSet(red);
  writeln('Жёлтые ',CountCars(yellow)); WriteSet(yellow);
  writeln('Белые ',CountCars(white)); WriteSet(white);
  writeln('Чёрные ',CountCars(black)); WriteSet(black);
  sn:=(red*car)+(white*truck)+bus;
  writeln('В тот день в столицу въехалo ',CountCars(sn),' автомобилей:');
  WriteSet(sn);
  readln;
end.

TiPo писал(а):Решил эту задачу...

Не тестировал, но по решению вижу, что с множествами вы разобрались, тему освоили.
И с процедурами-функциями тоже. Это главное, а опыт - дело наживное.
Первые редакции никогда не будут идеальными, но старайтесь потом доводить свои программы так, чтобы они становились простыми и ясными.
Удачи!

Oleg_D писал(а):

TiPo писал(а):Решил эту задачу...

Не тестировал, но по решению вижу, что с множествами вы разобрались, тему освоили.
И с процедурами-функциями тоже. Это главное, а опыт - дело наживное.
Первые редакции никогда не будут идеальными, но старайтесь потом доводить свои программы так, чтобы они становились простыми и ясными.
Удачи!

Большое спасибо!