VPF::[Delphi] Одномерные массивы - Форум программистов

takewu

Дата 28.2.2009, 17:37 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 28.2.2009

Репутация: нет
Всего: нет

прошу помощи! smile

В одномерном массиве, состоящем из n  вещественных элементов, вычислить:

1.      количество отрицательных элементов массива между первым положительным и последним положительным элементом массива;

2.      сумму модулей элементов массива, расположенных после минимального по модулю элемента.

3.      Заменить все отрицательные элементы массива их квадратами и упорядочить элементы массива по возрастанию.

t_gran

Дата 3.3.2009, 08:16 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 621
Регистрация: 13.11.2007
Где: г.Усть-Илимск

Репутация: 33
Всего: 37

Держи студент. smile

Надеюсь ты не ПОВТАС-овец, а то должно быть стыдно!

Код


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.

Это сообщение отредактировал(а) Rodman - 15.4.2009, 18:55

--------------------

Я знаю, что ничего не знаю© Сократ
user posted image

Stasya16

Дата 14.4.2009, 19:42 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 14.4.2009

Репутация: нет
Всего: нет

Модератор: Сообщение скрыто.

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »