Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Синтаксис
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 30.12.2007, 19:15
MagestiK MagestiK вне форума
Прохожий
 
Регистрация: 30.12.2007
Сообщения: 25
Репутация: 10
Восклицание Как перебрать все значения

Человеки, плиз подскажите пример как из данных букв перебрать все значения?
Например дано: QWA(количество букв не известно)
Значения: QWA
WQA
AQW
QAW
WAQ и т.д
ОЧень нужно, чесно.
Ответ нужен как можно скорее.
Заранее пасибо !
Ответить с цитированием
  #2  
Старый 02.01.2008, 14:48
Rosenkrantz Rosenkrantz вне форума
Активный
 
Регистрация: 04.12.2007
Адрес: Москва
Сообщения: 234
Версия Delphi: Delphi 7
Репутация: 40
По умолчанию

Код:
program Reshuffle;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  StrLen  : Integer;

//------------------------------------------------------------------------------
// Обменять местами символы в строке
//------------------------------------------------------------------------------
procedure Swap(var S: String; l, k: Integer);
var
  C: Char;
begin
  C    := S[l];
  S[l] := S[k];
  S[k] := C;
end;

//------------------------------------------------------------------------------
// Сортировка строки
//------------------------------------------------------------------------------
function  SortString(const S: String): String;
var
  i, j   : Integer;
  NoSwap : Boolean;
begin
  Result := S;
  for i := 1 to StrLen - 1 do begin
    NoSwap := True;
    for j := StrLen downto i do
      if Result[j] <=Result[i] then begin
        Swap(Result, i, j);
        NoSwap := False;
      end;
    if NoSwap then Exit;
  end;
end;

//------------------------------------------------------------------------------
// Получить следующую комбинацию символов
//------------------------------------------------------------------------------
function GetNext(var S: String): Boolean;
var
  i, j: Integer;
begin
  i := pred(StrLen);

  while (i > 0) and (S[i] > S[i + 1]) do
    dec(i);

  if i > 0 then begin
    j := i + 1;
     {поиск j}
    while (j < StrLen) and (S[j + 1] > S[i]) do
      inc(j);

    Swap(S, i, j);

    for j := i + 1 to (StrLen + i) div 2 do
      Swap(S, j, StrLen - j + i + 1);

    Result := True
  end else
    Result := False;
end;

var
  Str     : String;
  Stop    : Boolean;
  iCount  : Integer;
begin
  Write('String: ');
  Readln(Str);

  StrLen := Length(Str);
  Str    := SortString(Str);

  iCount := 0;  // Это просто счетчик комбинаций для красоты

  repeat
    iCount := iCount + 1;

    Writeln(iCount:10, '. ', Str);
  	Stop := GetNext(Str);
  until not Stop;

  Writeln;
  Writeln('Press Enter...');
  Readln;
end.

Алгоритм перестановок взял отсюда и переделал для строки. Работает только на упорядоченных последовательностях, поэтому строка предварительно сортируется. Сортировка пузырьковая, самая простая.

UPD: Если в строке будут повторяющиеся символы, то его клинит. Но по условию задачи их быть не должно.

Последний раз редактировалось Rosenkrantz, 02.01.2008 в 14:51.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 12:48.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter