Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 21.05.2007, 13:45   #1
Acid
 
Регистрация: 27.04.2007
Сообщений: 3
Восклицание надо немного дописать...

сел писать..... пописал.. а потом мозг перегрелся.... может поможет кто-нибудь?
Задание: отсортировать первые две трети массива в порядке возрастания если средноее арифметическое всех элементов больше нуля;
иначе - лишь первую треть. остальную часть массива не сортировать а расположить в обратном порядке
Код:
 
{************начало программы************}
Program 01;
const Nmax=20; {максимальное количество элементов в массиве}
Type mas=array[1..Nmax] of shortint;
var n: byte; a: Mas;
{****####********будущая процедура анализа********####****}
{************сумма элементов массива(для среднего арифметического)************}
Function Sum (n:Integer;SumMass:Mas): Real;
Var
   I, J: Integer;
   S:Real;
Begin
     S:=0;
     For I:=1 To n Do
     Begin
          S:=S+SumMass[i];
     End;
     Sum:=S;
End;
{************среднее арифметическое************}
Procedure Example5 (n:Integer; a:Mas);
Var
   Sredn: Real;
Begin
     Sredn:=Sum (ExCol,ExMass)/Col;
     WriteLn('Среднее арифметическое значение элементов массива: ',Sredn:4:4);
End;
{************сортировка по возрастанию************}
Procedure sort_vozrast (n:Integer; a:Massiv);
Var
   MasAZ: Mas;
   Buffer: Real;
   I, J: Integer;
Begin
     For I:=1 To n Do MasAZ[i]:=a[i];
     For I:=1 To n Do
         For J:=I To n Do
             Begin
                  If MassAZ[i]>MassAZ[J] Then
                  Begin
                       Buffer:=MasAZ[J];
                       MasAZ[J]:=MasAZ[i];
                       MasAZ[i]:=Buffer;
                  End;
             End;
     WriteLn ('Упорядоченный по возрастанию массив:');
     For I:=1 To n Do
     Begin
          Write (MasAZ[i]:4:4,' ');
     End;
     WriteLn;
End;
 
begin {of program}
Writeln('Введите число элементов массива (не более 20) : ');
     ReadLn (n);
 if n>6 then 
 begin
     For I:=1 To Col Do
     Begin
          Write ('Введите ',I,' элемент массива: ');
          ReadLn (Mas[i]);
     End;
 
 
Input(a, n); transform(a, n); output(a, n) end;
else writeln('недостаточное количество элементов в массиве');
readln
end.
буду очень признателен, необходимо дописать процедуру анализа(которая зависит от среднего -арифметического) и модуль сортировки массива в обратном порядке......
Acid вне форума Ответить с цитированием
Старый 21.05.2007, 17:32   #2
VoRTeX
Пользователь
 
Аватар для VoRTeX
 
Регистрация: 07.02.2007
Сообщений: 21
По умолчанию

Вроде так:
type
mas=array[1..20] of shortint;
var
a:mas;
temp, i, j:shortint;
begin
for i:=1 to 20 do
begin
Writeln('vvedite ', i, ' element massiva');
Readln(a[i]);
end;
for i:=1 to 20 do
temp:=temp + a[i];
if temp>0 then
begin
for i:=1 to 2*(20 div 3) do
begin
if a[i]<a[i+1] do
begin
Temp:=a[i]; a[i]:=a[i+1]; a[i+1]:=Temp;
end;
end;
end;
else do
begin
for i:=1 to 20 div 3 do
begin
if a[i]<a[i+1]
begin
Temp:=a[i]; a[i]:=a[i+1]; a[i+1]:=Temp;
end;
end;
end;
VoRTeX вне форума Ответить с цитированием
Старый 21.05.2007, 17:32   #3
VoRTeX
Пользователь
 
Аватар для VoRTeX
 
Регистрация: 07.02.2007
Сообщений: 21
По умолчанию

Вроде так:
type
mas=array[1..20] of shortint;
var
a:mas;
temp, i, j:shortint;
begin
for i:=1 to 20 do
begin
Writeln('vvedite ', i, ' element massiva');
Readln(a[i]);
end;
for i:=1 to 20 do
temp:=temp + a[i];
if temp>0 then
begin
for i:=1 to 2*(20 div 3) do
begin
if a[i]<a[i+1] do
begin
Temp:=a[i]; a[i]:=a[i+1]; a[i+1]:=Temp;
end;
end;
end;
else do
begin
for i:=1 to 20 div 3 do
begin
if a[i]<a[i+1]
begin
Temp:=a[i]; a[i]:=a[i+1]; a[i+1]:=Temp;
end;
end;
end;
VoRTeX вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Ловушка на клаву(нужно немного улутшить ее) xshStasX Win Api 2 11.08.2008 15:50
Помогите немного если не сложно,оч надо(Pascal) Bremen Помощь студентам 7 27.07.2008 12:52
немного переделать задание braza Паскаль, Turbo Pascal, PascalABC.NET 1 09.05.2008 21:23
Deep Purple - немного о группе. Alar Свободное общение 1 20.09.2007 21:53
Немного математики Socol Помощь студентам 3 18.02.2007 02:01