Держи студент. 
Надеюсь ты не ПОВТАС-овец, а то должно быть стыдно!
| Код |
const
N= 10;
type
TArray= array [1..N] of real;
{------------------------------------------------}
{Задаём случайным образом значения элементов массива}
procedure Rand (var arr: TArray);
var
i: integer;
begin
randomize;
for i:= 1 to N do
arr[i]:= (random (10000) - 5000) / 100;
end;
{------------------------------------------------}
{Вывод массива на экран. Второй параметр: подпись}
procedure Print (arr: TArray; caption: string);
var
i: integer;
begin
writeln (caption);
for i:= 1 to N do
write (arr[i]:2:2, ' ');
writeln;
end;
{------------------------------------------------}
{Нахождение позиций первых положительных чисел с начала и конца}
procedure LRPos (arr: TArray; var L, R: integer);
var
i: integer;
begin
L:= 0;
R:= N;
for i:= 1 to N do
if (arr[i] >= 0) then
begin
L:= i;
break;
end;
for i:= N downto 1 do
if (arr[i] >= 0) then
begin
R:= i;
break;
end;
end;
{------------------------------------------------}
{Нахождение количества отрицательных чисел между крайтними положительными}
function ColMinus (arr: TArray): integer;
var
l, r: integer;
i: integer;
ret: integer;
begin
LRPos (arr, l, r);
ret:= 0;
for i:= l to r do
if (arr[i] < 0) then
inc (ret);
ColMinus:= ret;
end;
{------------------------------------------------}
{Нахождение минимального по модулю элемента (позиция)}
function PosMin (arr: TArray): integer;
var
i: integer;
min: real;
pos: integer;
begin
min:= abs(arr[1]);
pos:= 1;
for i:= 2 to N do
if (min > abs(arr[i])) then
begin
min:= abs(arr[i]);
pos:= i;
end;
PosMin:= pos;
end;
{------------------------------------------------}
{Нахождение суммы элементов по модулю, расположенных после мин. по модулю}
function Summ (arr: TArray): real;
var
i: integer;
ret: real;
begin
ret:= 0;
for i:= PosMin(arr) to N do
ret:= ret + abs(arr[i]);
Summ:= ret;
end;
{------------------------------------------------}
{Возведение отрицательных значений элементов массива в степень}
procedure Pow2 (var arr: TArray);
var
i: integer;
begin
for i:= 1 to N do
if (arr[i] < 0) then
arr[i]:= sqr (arr[i]);
end;
{------------------------------------------------}
{Процедура меняющая два значения местами. Нужна для сортировки}
procedure Swap (var a, b: real);
var
buff: real;
begin
buff:= a;
a:= b;
b:= buff;
end;
{------------------------------------------------}
{Соответственно сама сортировка}
procedure Sort (var arr: TArray);
var
i, j: integer;
min: real;
begin
for i:= 1 to N - 1 do
for j:= i + 1 to N do
if (arr[i] > arr[j]) then
Swap (arr[i], arr[j]);
end;
{------------------------------------------------}
var
arr: TArray;
begin
Rand (arr);
Print (arr, 'Original');
writeln;
writeln ('1) col= ', ColMinus(arr));
writeln ('2) min= ', PosMin(arr));
writeln ('2) sum= ', Summ(arr):3:2);
Pow2 (arr);
Sort (arr);
Print (arr, '3) Sorted');
end.
|
|
