Технический форум - Какие из рейсов на каждом маршруте надо исключить из расписания, чтобы маршруты стали

Да... думал — раз, и квас, ан нет: задачка заковыристая. И весьма. Ну вот что получилось. Должен, правда, предупредить, что программа написана, отлажена и оттестрована на DOS Free Pascal, а если у Вас, к примеру, этот грёбаный ABC, который начнёт верещать, то я за это не отвечаю. Впрочем, напишите, разберёмся.

Код:

Const

 K=20; {Количество посадочных мест в автобусе}



Var

 A:Array[1..5,1..7] of Byte; {Число проданных билетов на маршрут, рейс}

 W:Array[1..5,1..7] of Byte; {Номера исключаемых рейсов}

 i,j:Byte;



Function Rent(M1:Byte {Маршрут}):Boolean; {Рентабельность}

var i1,Num_of_R,Num_of_B:Byte;

begin

 Num_of_R:=0; {Количество неотмененных рейсов}

 Num_of_B:=0; {Количество проданных билетов}

 for i1:=1 to 7 do

  if W[M1,i1]=1 then

   begin

    Inc(Num_of_R);

    Inc(Num_of_B,A[M1,i1]);

   end;

 Rent:=(1.0*Num_of_B>0.75*Num_of_R*K);

end;



Function Min_R(M:Byte):Byte; {номер рейса маршрута M с минимальной загрузкой}

var

 Mnt,MnR,q,Rm:Byte;

begin

 Mnt:=K;

 for q:=1 to 7 do

  if (W[M,q]=1) and (A[M,q]<Mnt) then

   begin

    MnR:=q;

    Mnt:=A[M,q];

   end;

 Min_R:=MnR;

end;



Procedure Crash; {Заполнение массива исключаемых рейсов}

var

 m1,r1,t1,i1,j1,Sum:Byte;

begin

 for i1:=1 to 5 do

  if Rent(i1)=FALSE then

   repeat

    W[i1,Min_R(i1)]:=0;

    Sum:=0;

    for j1:=1 to 7 do Inc(Sum,W[i1,j1]);

   until Rent(i1) or (Sum=0);

end;



Begin

 for i:=1 to 5 do

  for j:=1 to 7 do

   W[i,j]:=1;

 for i:=1 to 5 do

  begin

   for j:=1 to 7 do

    repeat

     Write(' Маршрут ',i,' Рейс ',j, ' Продано билетов ');

     Readln(A[i,j]);

     if A[i,j]>K then Writeln(' Число билетов не может превышать ',K,'!');

    until A[i,j]<=K;

   Writeln;

  end;

 Crash;

 Writeln(' Отменяются: ');

 for i:=1 to 5 do

  for j:=1 to 7 do

   if W[i,j]=0 then

    Writeln(' Маршрут ',i,' Рейс ',j);

 Readln;

End.