ПРИЛОЖЕНИЕ 2.
Текст программы расчёта 20 лучших вариантов заправки машин разрыхлительно-очистительного агрегата (выборка из 216).
Язык программирования – Turbo Pascal.
Program Calc_and_Sort;
{$R-,S-}
Uses CRT;
type
Drive_OutPut = (con, prn, filed) ;
dim = array [1..5,1..216] of real;
Alt_dim = array [1..216] of real;
Alt_num = array [1..6,1..216] of integer;
const
N : array [1..3,1..6] of word =
((450,450,500,500,600,600),
(400,400,500,500,600,600),(445,445,560,560,700,700));
var
abv : Drive_OutPut ;
number,
i, j,k, a1,f1,f2,f3 : byte ;
ch : char ;
N_r : Alt_num;
Nn_r : array [1..6,1..20] of Integer;
Nn_e : array [1..5,1..20] of Real;
nn : array[1..20] of Integer;
c,
alt_tab : Alt_dim;
tab : dim ;
s0,sv0,s1,sv1,s2,sv2,s3,sv3,
s4,e1,e2,e3,e4,E : real ;
r1,r2,r3 : byte ;
Procedure OutPut_Data (VR : Drive_OutPut) ;
var
fg : text ;
Begin
case VR of
CON : assign (fg,'CON') ;
PRN : assign (fg,'PRN') ;
Filed : assign (fg,'cl_20.rez') ;
end;
{$I-}
Rewrite (fg) ;
{$I+}
if IOResult <> 0 then
begin
writeln (' Ошибка вывода') ;
halt(0) ;
end;
textcolor (15);
writeln(fg,' Данные: засоренность в исходном
материале Зо =',s0:2:1,' %');
writeln(fg,' ');
writeln(fg,
' 20 ЛУЧШИХ ПАРАМЕТРОВ РАСЧЕТА ОТНОСИТЕЛЬНОГО ЭФФЕКТА ОЧИСТКИ');
writeln(fg,
'╔═══╤═════╤═══╤═════╤═══╤═════╤═══╤══════╤═════╤═════╤═════╤══════╗');
writeln(fg,'║ N │ n1, │R1,│ n2, │R2,│ n3, │R3,│ Э1,
│ Э2, │ Э3, │ Э4, │ Эобщ,║');
writeln(fg,'║п/п│мин-1│мм.│мин-1│мм.│мин-1│мм.│ %
│ % │ % │ % │ % ║');
writeln(fg,
'╟───┼─────┼───┼─────┼───┼─────┼───┼─────┼─────┼─────┼─────┼──────╢');
a1 := 1 ;
for a1 := 1 to 20 do
begin
writeln(fg,' ║',nn[a1]:3,'│ ',Nn_r[1,a1]:3,' │ ',
Nn_r[2,a1]:1,' │ ',Nn_r[3,a1]:3,
' │ ',Nn_r[4,a1]:1,' │ ',Nn_r[5,a1]:3,' │ ',
Nn_r[6,a1]:1,' │',
Nn_e[1,a1]:5:1,'│',Nn_e[2,a1]:5:1,'│',
Nn_e[3,a1]:5:1,'│',
Nn_e[4,a1]:5:1,'│',Nn_e[5,a1]:6:2,' ║');
end;
writeln(fg,
'╚═══╧═════╧═══╧═════╧═══╧═════╧═══╧══════╧═════╧═════╧═════╧══════╝');
writeln(fg,' © John Kife, МГТА 1996');
writeln(fg,' ');
Close (fg);
end;
procedure quicksort(var a: Alt_dim; Lo, Hi: integer);
var
xy : integer;
procedure sort(l, r: integer);
var
i, j : Integer;
x, y : Real;
begin
i:=l; j:=r; x:=a[(l+r) DIV 2];
repeat
while a[i] > x do i:=i+1;
while x > a[j] do j:=j-1;
if i<=j then
begin
y:=a[i]; a[i]:=a[j]; a[j]:=y;
i:=i+1; j:=j-1;
end;
until i>j;
if l<j then sort(l, j);
if i<r then sort(i, r);
end;
begin {quicksort};
sort(Lo, Hi);
for i:=1 to 20 do
begin
xy := 1;
while c[i] <> tab[5,xy] do Inc(xy);
nn[i] := xy;
end;
a1 := 1 ;
for i := 1 to 6 do
for j := 1 to 6 do
for k := 1 to 6 do
begin
if odd(i) then r1 := 4 else r1 := 6 ;
if odd(j) then r2 := 4 else r2 := 6 ;
if odd(k) then r3 := 4 else r3 := 6;
N_r[1,a1] := n[1,i]; n_r[2,a1] := r1;
N_r[3,a1] := n[2,j]; n_r[4,a1] := r2;
N_r[5,a1] := n[2,k]; n_r[6,a1] := r3;
Inc(a1);
end;
For i := 1 to 20 do
begin
Nn_r[1,i] := N_r[1,nn[i]]; Nn_r[2,i] := N_r[2,nn[i]];
Nn_r[3,i] := N_r[3,nn[i]]; Nn_r[4,i] := N_r[4,nn[i]];
Nn_r[5,i] := N_r[5,nn[i]]; Nn_r[6,i] := N_r[6,nn[i]];
Nn_e[1,i] := tab[1,nn[i]]; Nn_e[2,i] := tab[2,nn[i]];
Nn_e[3,i] := tab[3,nn[i]]; Nn_e[4,i] := tab[4,nn[i]];
Nn_e[5,i] := tab[5,nn[i]];
end;
end;
BEGIN
TextBackGround (0);
ClrScr;
textcolor (10);
writeln(' Written by Smolin Dmitry ( Kife ) ,
Latishev Anatoly (Toll), МГТА 1996');
textcolor (15);
writeln;
writeln(' РАСЧЕТ ОТНОСИТЕЛЬНОГО ЭФФЕКТА ОЧИСТКИ
И ОПТИМАЛЬНЫХ ');
writeln(' ПАРАМЕТРОВ ЗАПРАВКИ МАШИН РОА ');
textcolor (14);
writeln;
writeln('Введите исходную засоренность');
write('(сумму пороков в исходном
материале), % :');
textcolor (15);
readln (s0);
{** Расчеты *****}
sv0 := 0.9*s0;
a1 := 1;
for i := 1 to 6 do
begin
for j := 1 to 6 do
begin
for k := 1 to 6 do
begin
f1 := i ;
case f1 of
1 : s1 := 0.212963*sv;
2 : s1 := 0.21728*sv;
3 : s1 := 0.25833*sv;
4 : s1 := 0.303395*sv;
5 : s1 := 0.27685*sv;
6 : s1 := 0.29753*sv;
end ;
e1 := 100*s1/sv0 ;
sv1 := sv0*(1-(e1/100)) ;
f2 := j ;
case f2 of
1 : s2 := 0.1961*sv;
2 : s2 := 0.26378*sv;
3 : s2 := 0.29125*sv;
4 : s2 := 0.36211*sv;
5 : s2 := 0.30045*sv;
6 : s2 := 0.36262*sv;
end ;
e2 := 100*s2/sv1 ;
sv2 := sv1*(1-(e2/100)) ;
f3 := k ;
case f3 of
1 : s3 := 0.04709*sv;
2 : s3 := 0.08351*sv;
3 : s3 := 0.114035*sv;
4 : s3 := 0.108333*sv;
5 : s3 := 0.08824*sv;
6 : s3 := 0.14015*sv;
end ;
e3 := 100*s3/sv2 ;
sv3 := sv2*(1-(e3/100)) ;
s4 := 0.1856*sv;
e4 := 100*s4/sv3 ;
E := e1+e2+e3+e4 ;
tab [1,a1] := e1 ;
tab [2,a1] := e2 ;
tab [3,a1] := e3 ;
tab [4,a1] := e4 ;
tab [5,a1] := E ;
Inc(a1);
end ;
end ;
end ;
for i := 1 to 216 do
c[i] := tab[5,i];
QuickSort(c,1,216);
abv := con ;
OutPut_Data (abv) ;
writeln(' Куда выводить?
[ 1 - printer, 2 - file ]: ') ;
ch := ReadKey ;
case ch of
'1' : abv := prn ;
'2' : abv := filed ;
end ;
OutPut_Data (abv) ;
if abv = filed then
begin
textcolor (10) ;
write('Записано на диск в файл ''clean. rez''.');
end ;
textcolor (15) ;
END.
{
program qsort;
Uses Crt;
max = 1000;
type
list = array[1..max] of integer;
var
data: list;
i: integer;
Randomize;
for i:=1 to max do data[i]:=Random(30000);
Writeln;
Write('Now sorting random numbers...');
quicksort(data,1,max);
Writeln;
for i:=1 to 1000 do Write(data[i]:8);
end.
}
