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

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

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

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

Ответ
 
Опции темы Поиск в этой теме
Старый 13.03.2011, 11:28   #1
vereney
Пользователь
 
Регистрация: 01.03.2011
Сообщений: 28
Смущение Задача про множество

Дано конечное множество A. Требуется сгенерировать все возможные перестановки его элементов в лексикографическом порядке.Требования к заданию множества – в нем не должно быть повторяющихся элементов, кроме того, удобнее использовать или только буквы, или только цифры.
Программа должна сначала упорядочить все элементы заданного множества по возрастанию (это первый – минимальный – набор), затем – посредством МИНИМАЛЬНО ВОЗМОЖНЫХ ПЕРЕСТАНОВОК! – сгенерировать последовательно возрастающие (лексикографически) наборы, вплоть до последнего, в котором все элементы упорядочены по убыванию.
Следует оценивать количество возможных перестановок и в случае, если они не поместятся на экран, выполнять их вывод в файл с выдачей на экран соответствующей информации для пользователя и выполнять поэкранный вывод с ожиданием нажатия клавиши.
Предоставить пользователю возможность выбора другого варианта работы программы, в котором за исходную точку упорядочивания наборов выбирается не минимальный набор, а набор в таком порядке, как он задан пользователем.
Вот така задача. Я не знаю как выполнять поэкранный вывод с ожиданием нажатия клавиши. ПОдскажите, пожалуйста.
ВОт что у меня получилось
Код:
uses  Crt;
const
  chis=['0'..'9'];
var
  current_array, user_array:array [1..20] of integer;
  mnog: set of byte;
  key:char;
  number_of_elements1:integer;

procedure write_current_array; {Процедура вывода множества}
var
  i: integer;
begin
  for i:= 1 to number_of_elements1 do write(current_array[i],' ');
  writeln();
end;

procedure enter_user_array(); {Процедура ввода множества}
var
  number_of_elements: integer;
begin
  clrscr;
  mnog:=[];
  writeln('Процедура заполнения множества (нажмите "1..9" для добавления элементов или "q" для завершения процедуры');
  number_of_elements:=1;
  repeat
  key:= readkey;
  if (key in chis) and ((integer(key)-48 in mnog)=false) then {Запрет на ввод повторяющихся и нечисловых элементов}
    begin
    writeln(key);
    writeln('Элемент ', integer(key)-48, ' добавлен в множество');
    user_array[number_of_elements]:=(integer(key) - 48);
    number_of_elements:=number_of_elements+1;
    mnog:= mnog+[integer(key) - 48];
    end;
  until key='q';
  write('Процедура заполнения завершена. Множество имеет следующий вид: ');
  number_of_elements1:= number_of_elements-1;
  current_array:= user_array;
  write_current_array();
  writeln('Для продолжения жмякните любую клавишу...');
  key:=readkey;
end;

procedure sort_current_array(sort_abc: boolean); {Процедура сортировка выбранного массива}
var
  temp,j,i,k:integer;
begin
  clrscr;
  if sort_abc=true then
  begin
  for i:=1 to number_of_elements1 do
    for j:=1 to number_of_elements1-i do
      if current_array[j]>current_array[j+1] then
        begin
          temp:=current_array[j];
          current_array[j]:=current_array[j+1];
          current_array[j+1]:=temp;
          k:=k+1;
          write('Перестановка №', k,': ');
          write_current_array();
        end;
  writeln('Для продолжения жмякните любую клавишу...');
  key:=readkey;          
  end
  else if sort_abc=false then
  begin
  for i:=1 to number_of_elements1 do
    for j:=1 to number_of_elements1-i do
      if current_array[j]<current_array[j+1] then
        begin
          temp:=current_array[j];
          current_array[j]:=current_array[j+1];
          current_array[j+1]:=temp;
        end;
  end;
end;

procedure menu(); {Процедура вывода пользовательского меню}
begin
  clrscr;
  writeln('1: Заполнение множества');
  writeln('2: Сортировка минимальным количеством перестановок');
  writeln('3: Сортировка исходного множества');
  writeln('4: Выход из программы');
  key:= readkey;
  case key of
    '1' :
        enter_user_array();
    '2' :
      begin
        current_array:= user_array;
        sort_current_array(false);
        sort_current_array(true);
      end;
     '3' :
      begin
        current_array:= user_array;
        sort_current_array(true);        
      end;
     '4' :
        exit;
  end;
  menu();
end;

begin
  menu();
{  
  current_array:= user_array;
  sort_current_array(true);
  //writeln(number_of_elements1);
  write('Конечное множество имеет вид: ');
  write_current_array();}
end.
vereney вне форума Ответить с цитированием
Старый 13.03.2011, 13:13   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Опиши еще одну переменку e:integer
и доправь процедуру sort_current_array
Код:
...
          write('Перестановка №', k,': ');
          write_current_array();
          inc(e);
          if (e mod 24)=0 then begin write('Press any key to continue...');readln; end;
...
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 13.03.2011, 13:35   #3
vereney
Пользователь
 
Регистрация: 01.03.2011
Сообщений: 28
По умолчанию

спасибо, попробую
vereney вне форума Ответить с цитированием
Старый 20.03.2011, 21:09   #4
vereney
Пользователь
 
Регистрация: 01.03.2011
Сообщений: 28
По умолчанию

Ещё вопрос можНо?Посредством МИНИМАЛЬНО ВОЗМОЖНЫХ ПЕРЕСТАНОВОК! – сгенерировать последовательно возрастающие (лексикографически) наборы, вплоть до последнего, в котором все элементы упорядочены по убыванию.
НАпример,
Перестановки должны быть в
лексикографическом порядке, как слова в словаре. Например,
если это множество {1,2,3,4}:
1 2 3 4
1 2 4 3
1 3 2 4
1 3 4 2
2 1 3 4
2 1 4 3
2 3 1 4
2 3 4 1
А У меня получилось по другому(((.Подскажите, пожалуйста, какой способ применить?
vereney вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
задача на множество точек MariyaVo Паскаль, Turbo Pascal, PascalABC.NET 2 14.01.2009 21:59
Задача про деревья. WhyBeNormal Паскаль, Turbo Pascal, PascalABC.NET 0 21.12.2008 23:51