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

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

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

 
 Ответить  Открыть новую тему 
> помогите доработать код
светлое_небо
сообщение 24.10.2008 20:13
Сообщение #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 
 К началу страницы 
+ Ответить 
Lapp
сообщение 24.10.2008 20:39
Сообщение #2


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

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

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


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


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
светлое_небо
сообщение 25.10.2008 4:18
Сообщение #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 
 К началу страницы 
+ Ответить 
Lapp
сообщение 25.10.2008 10:23
Сообщение #4


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

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

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


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


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

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

 

- Текстовая версия 18.07.2025 0:56
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"