Отправляет email-рассылки с помощью сервиса Sendsay

Олимпиадные задачи с решениями на Turbo Pascal

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 3.825 RSS
←   Февраль 2002   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
28.02.2002
00:18:54
23:38:21


За последние 60 дней ни разу не выходила


Открыта: 02-12-2001

Автор
Aslof

Статистика

3.825 подписчиков
0 за неделю
←   Все выпуски   →

Олимпиадные задачи с решениями на Turbo Pascal


Служба Рассылок Subscribe.Ru
Олимпиадные задачи c решениями на Turbo Pascal

Олимпиадные задачи с решениями на Turbo Pascal

Рассылка проекта Sapisoft.By.Ru [#017]

Подписчиков на 23.02.2002 - 2662 человека.
Главная Программы Задачи Рассылки Гостевая книга Контакты

Здравствуйте!
  С праздничком! В этом выпуске предлагаем вам ещё два решения задачи "Перестановки" из 9-го выпуска рассылки.

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

Решение: (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.
Реклама в рассылке:

RLE Banner Network    

  

Рассылки проекта Sapisoft:
Новости проекта Sapisoft [Шамис Алексей]
Информация о выходе новых версий программ и прочих обновлениях на сайте.

 Уроки программирования на Turbo Pascal [Галин Павел]
Хотите стать Великим Программистом? Начните свой путь к вершине славы с изучения языка Turbo Pascal. Он как нельзя лучше подходит для начинающих программистов и в то же время используется для разработки сложных "профессиональных" программ.

 Олимпиадные задачи с решениями на Turbo Pascal [Шамис Алексей]
В рассылке публикуются решения интересных олимпиадных задач различного уровня. Периодичность - 2-3 раза в неделю. Каждый выпуск содержит решение 2-3 задач с подробным анализом описанием алгоритма решения.

 Задача в неделю. Олимпиадные задачи по информатике [Алексеев Александр]
Каждый понедельник в рассылке публикуется задача, которую необходимо решить и в следующий понедельник прислать программу на тестирование. Решения проверяются и в пятницу публикуется разбор и итоги тестирования.

Всегда рады видеть Вас на нашем сайте. Жду ваших предложений и замечаний, Шамис Алексей

Copyright © 2001-2002 by Shamis Alex.

http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное