Kurs2011

Приложение 3 (продолжение)

31

Приложение 3 (продолжение)

32

Приложение 3 (продолжение)

33

Приложение 3 (продолжение)

34

Приложение 3 (продолжение)

35

Приложение 3 (продолжение)

36

Приложение 4

Граф передачи управления процедуры ОБРАБ(А, N)

1

2

3

7

8

9

10

37

Приложение 5

Program Lab_11;

Const Nmax=20; {максимальное количество элементов в массиве} Type Mas=array[1..Nmax] of Shortint;

var n: Byte;

a:Mas;

{======= INPUT ======= }

Procedure Input(var Mi: Mas; var Ni: Byte); var f: Text;

Begin { of Input } Assign(F, 'f1.txt'); Reset(F);

Ni:=0;

While not EoF(F) do begin

Inc(Ni); Read(F, Mi[Ni]);

end;

Close(F);

End; { of Input }

{ ======= TRANSFORM ======= }

Procedure Transform(var Mt: Mas; Nt: Byte); Type SumType=0..9;

var IncreaseFlag, PositiveFlag: Boolean; b: Mas;

n1: Byte; Sum: SumType;

{-----Analysis-----}

Procedure Analysis(Ar:Mas; N:Byte; var Sum: SumType; var PositiveFlag: Boolean);

var NOdd:Byte;

Function FSum(n:Word):SumType; var s, d:Word;

Begin {of FSum} s:=0; d:=n; Repeat

Repeat

s:=s+(d mod 10); d:=d div 10;

Until (d=0); d:=s; s:=0;

Until (d<10);

38

FSum:=d;

End; {of FSum}

Function QuantityOdd(ArQ:Mas; Nq:Byte):Byte; var i, q:Byte;

Begin {of QuantityOdd} q:=0;

For i:=1 to Nq do If Odd(ArQ[i]) Then Inc(q); QuantityOdd:=q;

end; {of QuantityOdd}

Begin { of Analysis } Sum:=FSum(N);

NOdd:=N-QuantityOdd(Ar,N); {Находим количество четных эле-

ментов}

if (NOdd>=(N-NOdd)) Then PositiveFlag:=True Else PositiveFlag:=False;

End; { of Analysis }

{-----Choice-----}

Procedure Choice(ArA:Mas; var ArB:Mas; N:Byte; var N1:Byte; PositiveFlag: Boolean);

var j:Byte;

Begin { of Choice } N1:=0;

For j:=1 to N do

If (((ArA[j]>=0) and PositiveFlag) or ((ArA[j]<0) and (not PositiveFlag))) Then

Begin Inc(N1);

ArB[N1]:=ArA[j]

End; End; { of Choice }

{-----Sort-----}

Procedure Sort(var ArB:Mas; Ns:Byte; IncreaseFlag: Boolean);

Procedure SortInc(var a:Mas; Ni:Byte); var i,j,min: Byte;

tmp: Shortint; Begin { of SortInc }

for i:=1 to Ni-1 do Begin

min:=i;

39

for j:=i+1 to Ni do if (a[j]<a[min]) Then

min:=j;

tmp:=a[min];

a[min]:=a[i];

a[i]:=tmp;

End;

End; { of SortInc }

Procedure SortDec(var a:Mas; Nd:Byte); var i,j,min: Byte;

Procedure Ret(var ArA:Mas; ArB:Mas; N:Byte; PositiveFlag: Boolean);

var j,k:Byte;

Begin { of Transform }

Analysis(Mt, Nt, Sum, PositiveFlag);

40