IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> помогите доработать код
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 2
Пол: Мужской

Репутация: -  0  +


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

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

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



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[i]: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[i] Mod 2)<>0 Then
Begin
Sum:=Sum+A[i];
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[i] Mod 2)=0 Then
Begin
Sum:=Sum+A[i];
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.


 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(светлое_небо @ 24.10.2008 21:13) *
Не могу понять как посчитать и вывести на экран число перестановок эл-в при перестановке.
Речь идет о существенно различных перестановках? То есть, одинаковые элементы неразличимы? Если да, то тебе надо посчитать, сколько у тебя есть элментов каждого значения. Затем действовать по формулам комбинаторики (полагаю, ты должен их знать). Но тут может возникнуть проблема.. В формулы входят факториалы. Твой массив имеет размерность 100. Факториалы таких чисел выходят за диапазоны обычных целых числовых типов. Так что, возможно, придется использовать длинную арифметику..


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





Группа: Пользователи
Сообщений: 2
Пол: Мужской

Репутация: -  0  +


Цитата(Lapp @ 24.10.2008 21:39) *

Факториалы таких чисел выходят за диапазоны обычных целых числовых типов. Так что, возможно, придется использовать длинную арифметику..


А если попробовать:

В SortInc и SortDec после

tmp:=A[j];
A[j]:=A[j+1];
A[j+1]:=tmp;


дописать что-то вроде inc(ChisloPerestanovok), эту переменную перед циклами обнулять, а после выводить. Но как это организовать...

если же нет, то, полагаю, что игра не стоит свеч, да и писать такой код для данной задачи-неблагодарное дело...
Что ж, значит придется ограничится поиском элементов. (который я в принципе тоже не знаю как делать)
Надеюсь на помощь. Заранее спасибо
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(светлое_небо @ 25.10.2008 5:18) *
дописать что-то вроде inc(ChisloPerestanovok), эту переменную перед циклами обнулять, а после выводить. Но как это организовать...
А, ты имеешь в виду колличество перестановок, которые были произведены при сортировке? smile.gif Ну, тогда все просто, а именно - как ты и написал. Что тут еще организовывать?..
Цитата(светлое_небо @ 25.10.2008 5:18) *
Что ж, значит придется ограничится поиском элементов. (который я в принципе тоже не знаю как делать)
Надеюсь на помощь. Заранее спасибо
Поиск по значению? Нет ничего проще. Перебирай элементы в цикле и проверяй на равенство заданному числу. Когда найдешь, выводи его номер.


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 23.10.2020 7:44
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name