Меню сайта

Категории раздела
Готовимся к олимпиаде по программированию (задачи взяты с сайта http://olimpiada.com.ru) [36]
Решение олимпиадных задач по программированию
Готовимся к олимпиаде по математике [3]
Решение олимпиадных задач по математике

Мини-чат

Наш опрос
Уважаемый посетитель сайта, к какой категории вы себя относите?
Всего ответов: 5512

Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0


Главная

Регистрация

Вход
Вы вошли как Гость | Группа "Гости" | RSS


Личный сайт учителя математики и информатики

Фоновой Натальи Леонидовны



Пятница, 14.08.2020, 08:19
Главная » Файлы » Внеурочная деятельность » Готовимся к олимпиаде по программированию (задачи взяты с сайта http://olimpiada.com.ru)

Перестановки
14.02.2012, 08:14

Условие:
Даны n чисел в произвольном порядке. Вывести на экран всевозможные их перестановки.

Технические условия:
Стандартные.

Примеры входных и выходных файлов:
Отсутстсуют.

Решение:
{by Pavel <prog_mail@ukr.net>}

type mn=set of 1..200;
var m,d,n,i: integer;
s: mn;
a,b: array[1..200] of integer;

procedure View;
var i: integer;
begin
writeln;
for i:=1 to n do
write(b[a[i]],' ');
end;

procedure Per(s: mn; k: integer);
var i: integer;
begin
for i:=1 to n do
If i in s then
begin
a[k]:=i;
per(s-[i],k+1);
end;
if s=[] then view;
end;

BEGIN
writeln('Введите кол-во чисел');
readln(n);
writeln('Введите числа');
for i:=1 to n do
read(b[i]);
writeln('Перестановки :');
per([1..n],1)
END.

{by Antrax <antrax@mail.nnov.ru>}

{Реккурсивный алгоритм перестановок...}
program Perest;
type m=array[1..200] of integer;
var
a,b:m;
i,n:integer;
procedure ChangePrint;
var
i:integer;
begin
for i:=1 to n do write(b[a[i]]:3);
writeln
end;
procedure swap(var x,y:integer);
var
k:integer;
begin
k:=x;
x:=y;
y:=k
end;
procedure Change(n:integer);
var
i:integer;
begin
if n=1 then ChangePrint
else
begin
change(n-1);
for i:=1 to n-1 do
begin
swap(a[n],a[i]);
Change(n-1);
swap(a[n],a[i])
end
end
end;

begin
write('Введите количество чисел:');
readln(n);
write('Введите числа:');
for i:=1 to n do read(b[i]);
for i:=1 to n do a[i]:=i;
writeln('Перестановки:');
Change(n);
readln
end.

*********************

{Итеративный аглоритм перебора}
program change;
const nmax=100;
var
a,b:array[1..nmax] of integer;
i,n:integer;
procedure Perest;
var
i:integer;
r,l,q,p:integer;
begin
for i:=1 to n do
a[i]:=i;
for i:=1 to n do
write(b[a[i]]:3);
writeln;
repeat
l:=n-1;
while (l>=1) and (a[l]>a[l+1]) do
dec(l);
if l>0 then
begin
p:=l+1;
q:=n;
while p<q do
begin
r:=a[q];
a[q]:=a[p];
a[p]:=r;
inc(p);
dec(q)
end;
for i:=l+1 to n do
if a[l]<a[i] then
begin
r:=a[l];
a[l]:=a[i];
a[i]:=r;
break
end;
for i:=1 to n do
write(b[a[i]]:3);
end;
writeln;
until l=0;
end;

begin
write('Введите количество чисел:');
readln(n);
write('Введите числа:');
for i:=1 to n do read(b[i]);
readln;
for i:=1 to n do a[i]:=i;
perest;
readln;
end.
Категория: Готовимся к олимпиаде по программированию (задачи взяты с сайта http://olimpiada.com.ru) | Добавил: admin
Просмотров: 628 | Загрузок: 0 | Рейтинг: 0.0/0
Всего комментариев: 0
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Форма входа

Поиск

Кнопка сайта

Одна кнопка

время жизни сайта

Сайт участвует
конкурс сайтов 

Новости образовани

Фраза дня

Web-мастеру

OperaFirefoxGoogle ChromeDownload Master
QIPSkypeµTorrentTeamViewer
Dr.Web CureITAvira AntiVirTotal CommanderCDBurnerXP
PicasaIrfanViewCheMaxDAEMON Tools
AIMPKMPlayerBSplayerK-Lite Codec Pack

Установить себе такой Блок
Скрипты и HTML для uCOz

Раскрутка сайта
Graffiti Decorations(R) Studio (TM) Site Promoter

Copyright MyCorp © 2020
/td>