Paskal_ucheb_posob_ch1_21_11_2011

71

Var

V : array[1..100] of real; I,J,N : integer;

K : real; Begin

write (' N-? '); readln ( N );

for I:=1 to N do begin write (' V[‘,I,’]-> '); readln ( V[I] );

end;

for I:=N downto 2 do

for J:=1 to ( I-1 ) do

if ( V[J]>V[J+1] )then begin

K:=V[J];

V[J]:=V[J+1];

V[J+1]:=K;

end;

for I:=1 to N do writeln('I',I,'V[I]=',V[I] );

End.

_7 5 8 11 3 12 6 5 9 10 5 7 8 11 3

3 11 12 6

6 12 5

5 12 9

9 12 10

10 12 _5 7 8 3 11 6 5 9 10 12

5 7 8 3

3 8 11 6

6 11 5

5 11 9

9 11 10

10 11 12 _5 7 3 8 6 5 9 10 11 12

72

................

Сравниваются пары стоящих друг за другом элементов. Метод используется для небольших массивов.

Упражнение 33.

Дан массив вещественных чисел, содержащий 20 элементов. Записать в этот же массив сначала все положительные числа, а затем все отрицательные числа, сохраняя порядок их следования.

5 6 -7 4 -9 -2 3 0 2 0 5 -12 -56 89 5 6 4 3 0 2 0 5 89 -7 -9 -2 -12 -56

5 6 4 3 0 2 0 5 89 -7 -9 -2 -12 -56

Type

x=array[1..20] of real;

Var

a,b,c : x;

j,i,k,l : integer; Begin

for i:=1 to 20 do begin write (‘a[‘,I,’]=’); read(a[i]);

end;

k:=0;

l:=0;

for i:=1 to 20 do Begin

if a[i]>=0 then Begin

k:=k+1;

b[k]:=a[i];

End

else

Begin l:=l+1;

c[l]:=a[i];

End;

End;

for i:=1 to k do a[i]:=b[i];

73

j:=k;

for i:=1 to 20-k do Begin

j:=j+1;

a[j]:=c[i];

End;

for i:=1 to 20 do writeln(a[i]:3:2);

End.

Упражнение 34.

Дан текст из 80 символов. Напечатать сначала все цифры входящие в него , а за тем все остальные литеры, сохраняя взаимное расположение символов в каждом из двух групп множеств .

Program SEM ;

Const N=80;

Var X : packed array[1..N] of char; C : char;

I,K : integer; Begin

K:=0; (* количество не цифр *) for I:=1 to n do

begin

read(C); (* цифру печатать, не цифру в массив Х *) if ( C>='0' )and( C<='9' )

then write(C) else

begin K:=K+1; X[K]:=C; end; end;

for I:=1 to K do write(X[I]); (* печать литеры из Х *) End.

Упражнение 35.

Даны массивы X и Y . Элементы каждого из массивов упорядочены по неубыванию . Объединить Х и У в массив Z так , чтобы они снова оказались упорядочены по неубыванию.

Program XYZ;

Const K=50; M=20; N=70;

Var X:array[1..K] of real;

74

Y:array[1..M] of real;

Z:array[1..N] of real;

I,J,P,L:integer;

Begin

for I:=1 to 50 do readln ( X[I] ); for J:=1 to 20 do readln ( Y[J] );

P:=1; I:=1; J:=1; (* индексы очередного элемента из Z,X,Y *) repeat

if X[I]<Y[J] then

begin Z[P]:=X[I]; I:=I+1; end

else

begin Z[P]:=Y[J]; J:=J+1; end;

P:=P+1;

until (I>K) or (J>M);

(* один из массивов Х или У исчерпан*)

if I>K then repeat

Z[P]:=Y[J]; J:=J+1; P:=P+1; until J>M

else repeat

Z[P]:=X[I]; I:=I+1; P:=P+1; until I>K;

for L:=1 to P do write ( Z[L] ); End.

Упражнение 36.

Упорядочить массив N<=20 по убыванию. Из полученной последовательности удалить все повторяющиеся элементы, кроме одного.

Program VIJJ;

Const N1=20;

Var a:array[1..21] of real; k,i,j,n,k1,nmax,s,up,down:integer;

amax,k2:real;

Begin

readln(n); for i:=1 to n do readln(a[i]);

75

for k:=1 to n-1 do Begin

amax:=a[k]; nmax:=k; k1:=k+1;

for i:=k1 to n do

if a[i]>amax then Begin amax:=a[i]; nmax:=i; end;

a[nmax]:=a[k];

a[k]:=amax;

end;

writeln('OTCOPТИPOBAHHЫЙ ПО УБЫВАНИЮ МАССИВ'); for j:=1 to n do write(a[j]:6:2);

s:=0;

for i:=1 to n-1 do if a[i]=a[i+1] then s:=s+1;

write('КОЛИЧЕСТВО ПОВТОРНЫХ ЭЛЕМЕНТОВ '); writeln(s); down:=1; up:=2;

while up<=n do

Begin if a[up]=a[down] then up:=up+1 else

Begin

down:=down+1; a[down]:=a[up]; up:=up+1;

End; End;

writeln; writeln('OTCOPTИРОВАННЫЙ ПО УБЫВАНИЮ МАССИВ'); writeln('С УДАЛЕННЫМИ ОДИНАКОВЫМИ ЭЛЕМЕНТАМИ +

DOWN');

for J:=1 to DOWN do write(a[j]:6:4);

writeln; writeln('ОТСОРТИРОВАННЫЙ ПО УБЫВАНИЮ МАССИВ'); writeln('С УДАЛЕННЫМИ ОДИНАКОВЫМИ ЭЛЕМЕНТАМИ + S'); forJ:=1 to N-S do write(a[j]:6:4);

End.

Если Adown = Aup, то берем следующий , т.е. up сдвигается на 1 вправо. Если Adown <> Aup, то down сдвигается на 1 вправо, его значение из up записывается в down; up также сдвигается на позицию.

Практический пример (после сортировки массива по убыванию)

5 5 5 4 4 3 2 1 1

76

77

ЛЕКЦИЯ 11 и СЕМИНАРЫ ЧАСТЬ V

ДВУМЕРНЫЕ МАССИВЫ

Упражнение 37.

Ввод матрицы, состоящей из M строк и N столбцов.

for i:=1 to M do Begin for j:=1 to N do begin

write(‘Input a[‘,I,’.’,j,’]=’); readln(a[i,j]);

end;

readln;

End;

Упражнение 38.

readln ( N );

for I:=1 to N do

for J:=1 to N do begin if I<>J then A[I,J]:=0

else read ( A[I,J] ) end;

Упражнение 39.

Умножение матрицы на число.

readln( N,C ) for I:=1 to N do for J:=1 to N do begin

78

write (' A[I,J]-? '); readln (' A[I,J]-? ');

A[I,J]:=C*A[I,J];

End;

Упражнение 40.

Транспонирование матрицы.

readln ( N ); for I:=1 to N do

for J:=(1+I) to N do begin

C:=A[I,J]; A[I,J]:=A[J,I]; A[J,I]:=C; End;

Упражнение 41.

Подсчет определителя матрицы.

Определители матриц N*N вычисляются по методу Гаусса. Он сводится к преобразованию матриц к треугольному виду с помощью формул преобразования элементов матрицы. Преобразование массива A[n*n] производится в направлении расположения столбцов слева на право. Определитель вычисляется как произведение всех диагональных элементов преобразованной матрицы.

for I:=1 to N-1 do begin for J:=(1+I) to N do begin

A[J,I]:=A[J,I]/A[I,I]; for K:=(I+1) to N do

A[J,K]:=A[J,K]-A[J,I]*A[I,K];end; D=D*A[I,I];

end; d:=d*A[n,n]; OPR:=D;

80

for I:=1 to N do S:=S+A[ K,I ] * B[ I,J]; C[ K,J ]:= S;

end;

for k:= 1 to m do begin

for j:= 1 to l do write(c[k,j]): writeln;end;

End.

Упражнение 44.

Упорядочить квадратную матрицу A[8x8] таким образом, чтобы максимальные по абсолютной величине элементы в строке были в диагонали.

Program MAXDIAG ; Const K=8;

Type MATRIX = array[1..K,1..K] of real; Var A : MATRIX; MAX : real;

L, I, J : integer; Begin

for I:=1 to K do

for J:=1 to K do readln ( A[I,J] ); j:=1;

for I:=1 to K do (*перебор строк*) begin

L:=1;

MAX:=A[I,1]; (*начальное значение максимального эл-та в стро-

ке*)

for J:=2 to K do (*перебор элементов в строке*) if abs( MAX ) <abs( A[I,J] )

then begin (*запоминание нового максимальн. эл-та в строке и его номера*)

MAX:=A[I,J]; L:=J; end;

if ( L <> I ) (* если максимальн. эл-нт не диагональн., то переставить его с диагональным*)

then begin A[I,L]:=A[I,I]; A[I,I]:=MAX; end; end;

for I:=1 to K do begin (*перебор строк*)

writeln (' '); for j:=1 to K do write ( A[I,J]:3:3 ); end; End.