помогите доработать программу

Модераторы: Duncon, Naeel Maqsudov, Игорь Акопян, Хыиуду

Ответить
повстанец
Сообщения: 18
Зарегистрирован: 13 мар 2008, 19:50

Когда-то мною была написана программка:
"сортировать массив в порядке возрастания, если среднее арифметическое элементов с четными значениями больше среднего арифметического с нечетными и убывания если наоборот"
Сейчас потребовалось дополнить ее следующим:

-реализовать поиск элементов массива.
-посчитать и вывести на экран число перестановок эл-в при перестановке.

Для поиска элементов написал такой код:
program poisk;
var Rand: array [1..20] of integer;
i, X, numberx: integer;
begin
randomize;
writeln ('massiv slych');
for i:=1 to 20 do
begin
Rand:=random(50);
write (rand:4);
end;
writeln;write ('vvedite x',' '); readln (x);
numberx:=0;
for i:= 1 to 20 do
if Rand=x then numberx:=numberx+1;
if numberx=0
then writeln ('net ego')
else writeln ('ono', ' ',x,' ','prisytstvyet',' ', numberx, ' ','raz');
end.

Но мой исходный код работает с файлами, тоесть вввод и вывод элементов происходит в файлы. :( .
Не могу понять как посчитать и вывести на экран число перестановок эл-в при перестановке.
Заранее благодарю за помощь.
Код исходной программы ниже:

Program SortArray;
Const MaxN=100;
Type Mas=Array[1..MaxN] Of Integer;
var
A:Mas;
n:byte;


procedure Input(var A:Mas;var n:byte);
var
f:text;
begin
Assign(f,'f1.txt');
Reset(f);
n:=0;
while not eof(f) do
begin
Inc(n);
Read(f,A[n]);
end;
Close(f);
end;

procedure Output(A:Mas;n:byte);
var
f:text;
i:byte;
begin
Assign(f,'f2.txt');
Rewrite(f);
for i:=1 to n do
Write(f,A:4);
Close(f);
end;

Procedure Transform(var A:Mas;n:byte); { obrabotka}
var IncreaseFlag:Boolean;
var Sum:real;
procedure Analiz(A:Mas;n:byte;var IncreaseFlag:Boolean; var Sum:real); { analiz }

Function CountOdd(var A:Mas;n:byte; var Sum:real):real; {srednee arifm nechetnuh}
var i:byte;

Begin
Sum:=0;

for i:=1 to n do
If (A Mod 2)<>0 Then
Begin
Sum:=Sum+A;
CountOdd:=Sum/n
End;
End;

Function CountEven(var A:Mas;n:byte; var Sum:real):real; {srednee arifm chetnuh}
var i:byte;
Begin
Sum:=0;

for i:=1 to n do
If (A Mod 2)=0 Then
Begin
Sum:=Sum+A;
CountEven:=Sum/n
End;
End;


begin {of analiz}
if (CountEven(A,n,Sum) > CountOdd(A,n,Sum))
then { formirovanie flaga }
IncreaseFlag:=True
else
IncreaseFlag:=False
End;



Procedure Sortirovka(var A:Mas;n:byte;var IncreaseFlag:Boolean); { sortirovka}


Procedure SortInc(var A:Mas;n:byte); {sortirovka po vozrastaniy}
var
i,j:byte;
tmp:integer;
begin
for i:=1 to n-1 do
for j:=1 to n-i do
if A[j]>A[j+1] then
begin
tmp:=A[j];
A[j]:=A[j+1];
A[j+1]:=tmp;
end;
end;

Procedure SortDec(var A:Mas;n:byte); {sortirovka po ybuvaniy}
var
i,j:byte;
tmp:integer;
begin
for i:=1 to n-1 do
for j:=1 to n-i do
if A[j]<A[j+1] then
begin
tmp:=A[j];
A[j]:=A[j+1];
A[j+1]:=tmp;
end;
end;

begin {of sortirovka}
if IncreaseFlag=True then
SortInc(A,n)
else SortDec(A,n);
End;

Begin {of transform}
Analiz(A,n,IncreaseFlag,Sum);
Sortirovka(A,n,IncreaseFlag);
end;

begin {programma}
Input(A,n);
Transform(A,n);
Output(A,n);
end.
Хыиуду
Сообщения: 2442
Зарегистрирован: 06 мар 2005, 21:03
Откуда: Москва
Контактная информация:

В SortInc и SortDec после
tmp:=A[j];
A[j]:=A[j+1];
A[j+1]:=tmp;
дописать что-то вроде inc(ChisloPerestanovok), естественно, эту переменную перед циклами обнулять, а после выводить.
Работа в исходной программе идет с файлами, но потом все переписывается в массив А, и с ним идет работа. Замените в своей процедуре Rand на А
Искусство программирования - заставить компьютер делать все то, что вам делать лень.
Для "спасибо" есть кнопка "Спасибо" в виде звездочки внизу под ником автора поста.
Ответить