{uses Crt;} {Для древних сред Паскаль, работающих в DOS-режиме, снять комментарии в операторах uses, ClrScr, ReadKey } const n = 9; var x: array[1..n, 1..n] of real; y: array[1..n*(n-1) div 2] of real; i, j, k: integer; max, min, d: real;
begin Randomize; {ClrScr;} Writeln('Исходный массив'); for i := 1 to n do begin for j := 1 to n do begin x[i, j] := 100*Random - 50; Write(x[i, j]:4:0) end; Writeln end; { задание 1 } k:=0; for i:=2 to n do for j:=1 to i-1 do if x[i,j]<0 then begin Inc(k); y[k]:=x[i,j] end; Writeln('Сформированный одномерный массив'); for i:=1 to k do Write(y[i]:4:0); Writeln; { задание 2 } max:=y[1]; min:=max; for i:=2 to k do if y[i]>max then max:=y[i] else if y[i]<min then min:=y[i]; d:=max-min; i:=1; while (abs(y[i])<=d) and (i<=k) do Inc(i); if i<=k then begin d:=y[1]; y[1]:=y[i]; y[i]:=d end; Writeln('Результирующий одномерный массив'); for i:=1 to k do Write(y[i]:4:0); Writeln; {ReadKey} end.
Sub aaa() Dim i As Integer, j As Integer, d ReDim q(1 To 3, 1 To 2) For i = 1 To 3 For j = 1 To 2 q(i, j) = InputBox("Введите элемент (" + Str(i) + "," + Str(j) + ")") Next j Next i Cells(1, 1).Value = "Исходный массив" Range(Cells(2, 1), Cells(4, 2)).Value = q Cells(5, 1).Value = "Результирующий массив" For i = 1 To 3 If q(i, 1) > q(i, 2) Then d = q(i, 1): q(i, 1) = q(i, 2): q(i, 2) = d End If Next i Range(Cells(6, 1), Cells(8, 2)).Value = q End Sub
{Для древних сред Паскаль, работающих в DOS-режиме, снять комментарии
в операторах uses, ClrScr, ReadKey }
const
n = 9;
var
x: array[1..n, 1..n] of real;
y: array[1..n*(n-1) div 2] of real;
i, j, k: integer;
max, min, d: real;
begin
Randomize;
{ClrScr;}
Writeln('Исходный массив');
for i := 1 to n do
begin
for j := 1 to n do
begin
x[i, j] := 100*Random - 50;
Write(x[i, j]:4:0)
end;
Writeln
end;
{ задание 1 }
k:=0;
for i:=2 to n do
for j:=1 to i-1 do
if x[i,j]<0 then begin Inc(k); y[k]:=x[i,j] end;
Writeln('Сформированный одномерный массив');
for i:=1 to k do Write(y[i]:4:0);
Writeln;
{ задание 2 }
max:=y[1]; min:=max;
for i:=2 to k do
if y[i]>max then max:=y[i]
else
if y[i]<min then min:=y[i];
d:=max-min;
i:=1;
while (abs(y[i])<=d) and (i<=k) do Inc(i);
if i<=k then
begin d:=y[1]; y[1]:=y[i]; y[i]:=d end;
Writeln('Результирующий одномерный массив');
for i:=1 to k do Write(y[i]:4:0);
Writeln;
{ReadKey}
end.
Тестовое решение:
Исходный массив
37 -45 -17 -26 -6 -22 -1 -33 -3
-27 33 -15 -14 33 37 28 -12 -36
1 14 48 -2 -43 -1 17 34 -7
-11 45 -5 -16 32 -8 32 -1 -40
18 43 -13 -28 30 45 44 -38 -28
38 0 10 48 28 -43 -12 -29 -44
2 -11 48 33 7 10 35 -40 -28
-48 39 -49 42 5 -16 26 -40 -5
27 -21 34 -46 4 45 -22 29 -16
Сформированный одномерный массив
-27 -11 -5 -13 -28 0 -11 -48 -49 -16 -21 -46 -22
Результирующий одномерный массив
-49 -11 -5 -13 -28 0 -11 -48 -27 -16 -21 -46 -22
Dim i As Integer, j As Integer, d
ReDim q(1 To 3, 1 To 2)
For i = 1 To 3
For j = 1 To 2
q(i, j) = InputBox("Введите элемент (" + Str(i) + "," + Str(j) + ")")
Next j
Next i
Cells(1, 1).Value = "Исходный массив"
Range(Cells(2, 1), Cells(4, 2)).Value = q
Cells(5, 1).Value = "Результирующий массив"
For i = 1 To 3
If q(i, 1) > q(i, 2) Then
d = q(i, 1): q(i, 1) = q(i, 2): q(i, 2) = d
End If
Next i
Range(Cells(6, 1), Cells(8, 2)).Value = q
End Sub