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

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

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

Восстановить пароль

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

Ответ
 
Опции темы Поиск в этой теме
Старый 04.03.2010, 15:37   #1
DED_moroZ
 
Регистрация: 03.06.2009
Сообщений: 5
По умолчанию Прога - Генерация перестановок

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

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

program lab3;
uses crt;
label metka;
var
stroka: string;
ch:char;
exitt:boolean;
f:text;
mas,A,A1,B: array [1..100] of integer;
k,k1,n,i,i1,j,min,sch:integer;
function Fact(t:integer):integer;
var p,i:integer;
begin
p:=1;
for i:=1 to t do
p:=p*i;
Fact:=p;
end;
begin
ClrScr;
exitt:=false;
Assign(f,'Results3.txt');
Rewrite(f);
Writeln('---Лабораторная работа № 3---');
Writeln('Генерация перестановок___________________');
Writeln('Введите количество элементов множества...');
Readln(n);
Writeln('--Инициализация множества...');
for i:=1 to n do
Readln(A[i]);
B[n]:=A[1];
{Упорядочивание по возрастанию}
for i:=1 to n do
begin
for j:=1 to n do
begin
if A[j]>=B[n-i+1] then
begin
B[n-i+1]:=A[j];
min:=j;
end;

end;
A[min]:=-1;
end;
{___}
{Удаление одинаковых элементов}
for i:=1 to n do
while (B[i]=B[i+1]) and (B[i]<>0) do
begin
for j:=i to n do
B[j]:=B[j+1];
k:=k+1;
end;
n:=n-k;
for i:=1 to n do Write(f,B[i],' ');
writeln(f);
for i1:=1 to Fact(n)-1 do

if B[n]<B[n-1] then
begin
for i:=n downto 1 do
if B[i-1]>B[i] then k:=i-2
else break;

min:=B[n];


for i:=n downto k+1 do
if (B[i]>B[k]) then
begin
min:=B[i];
k1:=i;
break;
end;
sch:=B[k];
B[k]:=B[k1];
B[k1]:=sch;
A[1]:=B[k+1];

for i:=1 to n-k do
A[i]:=B[k+1];
for i:=1 to n-k do
begin
for j:=k+1 to n do
begin
if B[j]<=A[i]
then
begin
A[i]:=B[j];
min:=j;
end;
end;
B[min]:=10000;
end;
j:=1;
for i:=k+1 to n do
begin
B[i]:=A[j];
j:=j+1;
end;
for i:=1 to n do
write(f,B[i],' ');
writeln(f);
end
else
begin
sch:=B[n-1];
B[n-1]:=B[n];
B[n]:=sch;
for i:=1 to n do
write(f,B[i],' ');
writeln(f);

end;
close(f);
writeln('-=-Результаты выведены в файл "Results.txt"');
Writeln('Для просмотра результатов нажмите клавишу "c"...');
Writeln('Для выхода из программы нажмите клавишу "q"...');
j:=0;
while not exitt do begin
readln(ch);
reset(f);
if ch='c' then begin
for i:=0 to 10*j-1 do
readln(f);
for i:=0 to 10 do begin
readln(f,stroka);
writeln(stroka); end;
end
else if ch='q' then exit;
j:=j+1;
end;

close(f);
readln;
end.
DED_moroZ вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Генерация случайных чисел на СИ (простая прога) Darh Помощь студентам 0 21.12.2009 17:37
Генератор перестановок cent Microsoft Office Excel 2 02.01.2009 11:09
генератор перестановок Narkotik Помощь студентам 4 26.11.2008 05:15
прога и чюжая прога benjaminfran Общие вопросы Delphi 5 28.03.2008 15:07
поиск кратчайшей сортировки, с минимальным кол-вом перестановок sad8c Помощь студентам 9 14.12.2007 10:23