Форум: "Основная";
Текущий архив: 2002.12.30;
Скачать: [xml.tar.bz2];
ВнизСоставление слов перебором вариантов букв Найти похожие ветки
← →
Luke B. Dremlin (2002-12-08 04:44) [0]Собственно вопрос. Требуется генерировать слова последовательным
перебором всех вариантов расположения букв(цифр,знаков). Количество
букв в результируещем слове выбирает пользователь. Буквы вводит он же.
Например: Введены буквы А,В,С,D нужно сгенерировать все требуквенные (цифру 3 тоже вводит пользователь)
слова получаемые из этих букв и вывести их либо в файл либо в мемо.
Примерно таким образом:
AAA
AAB
AAC
AAD
ABA
ABB
ABC
ABD
...
DDA
DDB
DDC
DDD
Окажите пожалуйста посильную помощь начинающему делфинисту.
И если не трудно с комментариями, а то я чуть не закипел :) пытаять
разобраться в отрывке похожего примера
http://delphi.mastak.ru/cgi-bin/forum.pl?look=1&id=1020973030&n=9
С огромным уважением Luke B. Dremlin
← →
Sha (2002-12-08 08:30) [1]Представь себе все числа четверичной системы счисления, меньшие четырех в кубе. Будет легче :).
← →
Netcoder (2002-12-08 11:36) [2]Объяви массив с буквами, а потом организуй четыре вложенных цикла. ПРОСТО
← →
Luke B. Dremlin (2002-12-08 14:10) [3]
> Netcoder (08.12.02 11:36)
> Объяви массив с буквами, а потом организуй четыре вложенных
> цикла. ПРОСТО
Приведенный пример - частный случай проблемы.
Дело в том что изначально неизвестно сколько вложенных циклов нужно т.к. количество букв в результате вводит юзер. Тут что-то с рекурсией но мне не совсем понятно что именно.
Ссылки по теме:
http://delphi.vitpc.com/asp/answer.asp?IDAnswer=1545
А нужно универсальное решение.
Спасибо.
← →
Юрий Зотов (2002-12-08 14:17) [4]Не нужно никаких рекурсий. Используйте в качестве массива строку, добавляйте в ее конец каждую новую введенную букву, пока не будет введен признак окончания ввода. А потом - циклы.
← →
Luke B. Dremlin (2002-12-08 14:23) [5]
> Юрий Зотов © (08.12.02 14:17)
> Не нужно никаких рекурсий. Используйте в качестве массива
> строку, добавляйте в ее конец каждую новую введенную букву,
> пока не будет введен признак окончания ввода. А потом -
> циклы.
А можно подробней?
Спасибо.
← →
Sha (2002-12-08 16:52) [6]function sNext(const sPrev, sChar: string): string;
var
i, j, k: integer;
begin;
Result:=sPrev;
k:=length(sChar);
if k<=0 then exit;
i:=length(sPrev);
while i>0 do begin;
j:=pos(sPrev[i],sChar);
if j<k then begin;
Result[i]:=sChar[j+1];
break;
end;
Result[i]:=sChar[1];
dec(i);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
c, s: string;
begin;
c:="abcd";
s:="ddd";
repeat;
s:=sNext(s,c);
Memo1.Lines.Add(IntToStr(Memo1.Lines.Count+1)+s);
until s="ddd";
end;
← →
Luke B. Dremlin (2002-12-08 17:05) [7]Спасибо. Пошел пробовать. Результаты сообщу.
← →
Дмитрий К.К. (2002-12-08 18:20) [8]Угу, будь добр, сообщи ;)
← →
Юрий Зотов (2002-12-08 18:47) [9]Еще вариант. Программа работает в консоли, если нужно - переделайте.
program Project1;
{$APPTYPE CONSOLE}
var
S, X, Z: string; // S - множество букв, X - текущее слово, Z - последнее слово
L, N: byte; // L - длина множества букв, N - длина слова
function NextWord: boolean;
// Формирует следующее слово по аналогии с целыми числами: X := X + 1
// Возвращает False, если это невозможно (текущее слово уже равно последнему).
var
i: byte;
begin
Result := X <> Z;
if Result then
for i := N downto 1 do
if X[i] <> S[L] then
begin
X[i] := S[Pos(X[i], S) + 1];
Exit
end
else X[i] := S[1]
end { NextWord };
var
Ch: char;
i, j: byte;
begin { main }
// Вводим непустой набор неповторяющихся букв
S := "";
while S = "" do
begin
WriteLn("Input your letters:");
repeat
ReadLn(Ch);
Ch := UpCase(Ch);
if (Ch in ["A".."Z"]) and (Pos(Ch, S) = 0) then S := S + Ch
until not (Ch in ["A".."Z"]);
if S = "" then WriteLn("Empty set.")
end;
// Сортируем его "пузырьком" по возрастанию
L := Length(S);
for i := 1 to L - 1 do
for j := L downto i + 1 do
if S[i] > S[j] then
begin
Ch := S[i];
S[i] := S[j];
S[j] := Ch
end;
WriteLn("Your letters are: ", S);
// Вводим ненулевую длину слова
repeat
Write("Input word length: ");
ReadLn(N);
if N = 0 then WriteLn("Invalid length.")
until N <> 0;
// Формируем первое и последнее слово
X := "";
for i := 1 to N do X := X + S[1];
Z := "";
WriteLn("Result:");
for i := 1 to N do Z := Z + S[L];
// Выводим текущее и формируем следующее слово
repeat
WriteLn(X)
until not NextWord;
// Притормаживаем консоль до нажатия Enter
ReadLn
end.
← →
Fantasist (2002-12-08 19:01) [10]Ну так с рекурсией быстрее, и признак окончания выводиться сам.
procedure TForm1.MakeList(Symbs: string; n: integer);
var
i,k:integer;
str:array of integer;
s:string;
function Next(m:integer):boolean;
begin
Result:=False;
if str[m]+1<k then
Inc(str[m])
else
if m>0 then
begin
str[m]:=0;
Result:=Next(m-1);
end
else
Result:=True;
end;
begin
SetLength(str,n);
k:=Length(Symbs);
fillchar(pointer(str)^,SizeOf(Integer)*Length(str),0);
SetLength(s,n);
repeat
for i:=1 to n do
s[i]:=Symbs[str[i-1]+1];
Memo1.Lines.Add(s);
until Next(n-1);
end;
← →
Luke B. Dremlin (2002-12-08 19:16) [11]Всем огромное СПАСИБО!
Задача решена первым способом (который предложил уважаемый Sha).
После небольшой доработки все поставленные условия задачи выполнены.
СПАСИБО ВАМ МАСТЕРА!
← →
Sego (2002-12-09 21:48) [12]Если интересно, была написана программка, если интересно-комбинация перебором любой последовательности символов-любой длинны.
http://www.geocities.com/vtk000003/files/Kergr2.zip
понравиться поищу исходник....
сразу не даю, потому как не знаю остался или он после краха сиситемы.
← →
Sha (2002-12-09 21:53) [13]Теперь попробуй написать ее так, чтобы каждый символ входил в слово не более N раз. Это гораздо интересней.
← →
Sego (2002-12-09 22:07) [14]2 Sha © (09.12.02 21:53)
писалось для генрации словарей, для подбора к архивам
прошу строго не судить просо хотел помочь да и не прграммер я совсем, хватаюсь по мере необходимости нашего админа хрен заставишь для обычного юзера че-то написать.
← →
Luke B. Dremlin (2002-12-14 17:44) [15]Для информации.
Решение предложенное уважаемым Fantasist оказалось более быстрым чем первое.
Еще раз спасибо ВСЕМ!
← →
Sha (2002-12-14 18:31) [16]Специально для любителей оптимизировать учебные примеры:
procedure sUpdate(pw, pc: pchar; i, k: integer);
var
ch: char;
begin;
dec(k);
if k>=0 then while i>0 do begin;
dec(i);
ch:=(pw+i)^;
if ch=(pc+k)^ then (pw+i)^:=pc^
else begin;
repeat; dec(k); until (k<=0) or (ch=(pc+k)^);
(pw+i)^:=(pc+k+1)^;
break;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
c, s, t: string;
pw, pc: pchar;
i, k: integer;
begin;
c:="012";
SetLength(t,4); FillChar(pchar(@t[1])^,length(t),c[length(c)]);
Memo1.Lines.BeginUpdate;
Memo1.Lines.Clear;
s:=t; pw:=@s[1]; pc:=@c[1]; i:=length(s); k:=length(c);
repeat;
sUpdate(pw,pc,i,k);
Memo1.Lines.Add(IntToStr(Memo1.Lines.Count+1)+" "+s);
until s=t;
Memo1.Lines.EndUpdate;
end;
-------------------------------------------
Оптимизация хорошо, а удобочитаемость лучше.
На встроенном asm"е будет еще быстрее, только нужно ли это в учебном примере?
← →
Sha (2002-12-14 18:46) [17]Хочу заметить также, что процедура Next, предложенная
Fantasist © (08.12.02 19:01), является внутренней и строки в нее не передаются.
При таких условиях можно написать функцию в несколько раз более быструю. Однако, такая функция вряд ли может претендовать на роль стандартной билиотечной функции - для других имен строк,
длин и т.п. ее придется переписывать заново.
← →
Sha (2002-12-16 09:24) [18]Up
← →
Vlad1 (2002-12-17 20:05) [19]Работает нормально:
function TForm1.ChangeOrderStr(k:integer; const S: String): String;
var a,b:TStringList;T:String;i,j:integer;
begin
Result:="";
if (K<=0)or(k>length(s)) then exit;
if k=1 then begin
a:=TStringList.Create;
try
a.Sorted:=true;
a.Duplicates:=dupIgnore;
for i:=1 to length(s) do
a.Add(s[i]);
Result:=a.GetText; finally
a.Free;a:=nil; end
end
else
begin
a:=TStringList.Create;
b:=TStringList.Create;
try
a.Sorted:=true;
a.Duplicates:=dupIgnore;
b.Text:=ChangeOrderStr(k-1,s);
for i:=1 to length(s) do
for j:=0 to b.Count-1 do
a.Add(s[i]+b[j]);
Result:=a.GetText;
finally
a.Free;
a:=nil;
b.Free;
b:=nil;
end;//try
end;
end;
Пример:
procedure TForm1.Button2Click(Sender: TObject);
var r,r1,r2:string;
begin
R:=ChangeOrderStr(StrToInt(Edit1.Text),Edit2.Text);
R1:=copy(r,1,10); r2:=copy(r,length(r)-10,11);
Memo1.Text:=r1+#13#10+r2;
Caption:=IntToStr(length(r))
end;
Может кое-когда получиться туева хуча строк - отсюда ограничения на вывод в Мемo
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2002.12.30;
Скачать: [xml.tar.bz2];
Память: 0.5 MB
Время: 0.008 c