Комбинаторика. Получение возможных вариантов.

[Alex Cones]

Предположим есть некоторое число в String, например 8907. Необходимо получить все возможные комбинации цифр числа, находящиеся по-порядку. Поясню, для числа 123 это будет:

123:
  3
 2
 23
1
1 3
12
123

Думаю, что можно решить так: взять некоторый Integer (или LongInt, если не хватит) и до определенного предела перечислять значения (от 1 до ... ) каждое значение будет указывать на определенную комбинацию, которая будет получена путем рассмотрения битов числа - 1 = цифра участвует, 0 = нет.

Есть более простое решение?

[Utkin]

Тебе нужны именно сами варианты или их количество?

[Alex Cones]

Тебе нужны именно сами варианты или их количество?

Все варианты.

Значицца так - что уже сделал. С помощью Goodwin`а создал маленькую функу на асме по проверке разряда бита. На скорость проверки сейчас не смотрю - по миллиону лет на 32 разряда. Основная проблема сейчас в другом - больше 32 символов на входе банально не поддерживается (хотя я представляю, сколько времени будут считаться 2 млрд вариантов в 32-х символах).

В общем проблемы сейчас 3 -
1) Скорость вычислений.

Function BitIsSet(Number, Bit : LongInt) : LongBool;
 Begin
  Result := FALSE;
  Asm
   pusha
   xor eax,eax
   mov ebx,[Bit]
   bt Number,ebx
   setc al;
   mov Result, eax
   popa
  End;
 End;

 Procedure GetLet(I : LongInt);
 Var
  Num : Integer;
  J : LongInt;
  S : String;
 Begin
  S := '';
  For J := 0 To 31 Do
   If BitIsSet(I, J) Then S := S + StrLetters[J + 1];
  {If Form1.Checkbox1.Checked Then }For Num := 0 To SLBook1.Count - 1 Do If S = SLBook1.Strings[Num] Then Form1.Memo1.Lines.Add(S);
  {If Form1.Checkbox2.Checked Then }For Num := 0 To SLBook2.Count - 1 Do If S = SLBook2.Strings[Num] Then Form1.Memo1.Lines.Add(S);
  {If Form1.Checkbox3.Checked Then }For Num := 0 To SLBook3.Count - 1 Do If S = SLBook3.Strings[Num] Then Form1.Memo1.Lines.Add(S);
  {If Form1.Checkbox4.Checked Then }For Num := 0 To SLBook4.Count - 1 Do If S = SLBook4.Strings[Num] Then Form1.Memo1.Lines.Add(S);
  {If Form1.Checkbox6.Checked Then }For Num := 0 To SLBook5.Count - 1 Do If S = SLBook5.Strings[Num] Then Form1.Memo1.Lines.Add(S);
 End;

 Procedure GetVariants;
 Var
  I : LongInt;
 Begin
  Form1.Label5.Caption := 'Получение комбинаций';
  Form1.Label5.Refresh;

  For I := 1 To Round(Exp(Length(StrLetters) * Ln(2)))-1 Do
   Begin
    GetLet(I);
    If I mod 10000 = 0 Then Form1.Label5.Caption := 'Получение комбинаций (' + IntToStr(I) +' из '+IntToStr(Round(Exp(Length(StrLetters) * Ln(2)))-1)+')';
    If I mod 10000 = 0 Then Form1.Label5.Refresh;
   End;
 End;

Считает около 300 000 в секунду. Надобно больше

2) Проблема Билла Гейтса ("640 килобайт хватит всем") - больше 32-х разрядо не поддерживаются. Либо делать как то поддержку 64-х разрядов, либо менять всю логику.

3) Фиг его знает, почему, но

For Num := 0 To SLBook1.Count - 1 Do If S = SLBook1.Strings[Num] Then Form1.Memo1.Lines.Add(S);

Не срабатывает, не смотря на то, что в SLBook1 загружен текстовый файл с некоторыми вариантами. Менял Мемо на сообщение - тоже не выводится.

[veniside]

Не знаю, зачем вам это безумие, но вот консольная программка, которая генерит все комбинации. Количество бит сейчас максимум 128, но можно расширить при желании до скольки угодно.

Основное время тратится на запись в файл, если убрать FileWrite() из yield(), генерит примерно миллион комбинаций в секунду.

Да, если задать число разрядов (c_max_chars) больше 84, прогресс будет выводиться неверно, лень исправлять.

По-хорошему, конечно, нужно раскидать весь диапазон на ядра проца, чтобы не простаивали зря, но это уже не бесплатно )

{$APPTYPE CONSOLE}

program
  Project1;

uses
  SysUtils;

type
  uint32 = LongWord;

const
  c_max_chars = 33;	// from 1 to 128

var
  bits: array[0..3] of uint32;		// 128 bits
  chars: array[0..127] of AnsiChar;	// 128 characters
  combination: AnsiString;
  f: tHandle;
  DoneSoFarMB: Integer;
  DoneSoFar: Int64;
  GrandTotal: Int64;

procedure yield(maxchars: integer);
var
  c: Integer;
  ofs: Integer;
  v: uint32;
begin
  ofs := -1;
  c := 0;
  while (c < maxchars) do begin
    //
    if (0 = c and $1F) then begin
      //
      inc(ofs);
      v := bits[ofs];
    end;
    //
    if (0 = v and 1) then
      combination[c + 1] := ' '		// skip
    else
      combination[c + 1] := chars[c];	// hit
    //
    v := v shr 1;
    inc(c);
  end;
  //
  FileWrite(f, combination[1], c_max_chars + 2);	// + CRLF
  inc(DoneSoFarMB);
  //
  if (1 shl 20 < DoneSoFarMB) then begin
    //
    DoneSoFarMB := 0;
    inc(DoneSoFar);
    writeLn('Done so far: ' + IntToStr(DoneSoFar) + 'MB; ' + IntToStr(round((DoneSoFar * 100) / GrandTotal)) + '%');
  end;
end;

// --  --
procedure enumerate(maxchars: integer);
begin
  asm
	push 	ecx
	push	ebx
	push	edx
	push	edi
	push	esi

	mov	ecx, maxchars
	mov	edx, ecx
	add	edx, 32
	dec	ecx
	shr	ecx, 5
	inc	ecx
	mov	ebx, ecx	// save ecx

	lea	edi, bits
	lea	esi, bits
	sub	eax, eax

  @zerofill:
	stosd
	sub	edx, 32
	loop	@zerofill

	mov	ecx, ebx	// restore ecx
	//
	cmp	edx, 32
	mov	ebx, 0
	je	@doneshift

	mov	ebx, 1
	inc	edx
  @shiftme:
	dec	edx
	jz	@doneshift
	shl	ebx, 1
	jmp 	@shiftme

  @doneshift:

	// ECX = (number of bytes to use from bits array) - 1
	// EBX = mask (or 0 if full byte)
	// ESI = bits

  @loopbytes:
	sub	edx, edx

  @yield:
	push	edx
	push	ecx

	mov	eax, maxchars
	call	yield

	pop	ecx
	pop	edx

	inc	[esi]

	cmp	ecx, 1	// last byte?
	jnz	@fullbyte

	cmp	ebx, 0
	jz	@fullbyte

	// see if we had hit the barrier
	mov	eax, [esi]
	and	eax, ebx
	jnz	@donewithbyte

	jmp	@yield

  @fullbyte:
	dec	edx
	cmp	edx, 0
	jne     @yield

  @donewithbyte:
	loop	@loopbytes

	pop	esi
	pop	edi
	pop	edx
	pop	ebx
	pop	ecx
  end;
end;

var
  c: Integer;
begin
  Randomize();
  for c := low(chars) to high(chars) do
    chars[c] := ansichar(ord('0') + random(10));
  //
  f := FileCreate('combinations.txt');
  try
    SetLength(combination, c_max_chars + 2);
    DoneSoFarMB := 0;
    DoneSoFar := 0;
    GrandTotal := Int64(1) shl (c_max_chars - 20);
    //
    combination[c_max_chars + 1] := #13;
    combination[c_max_chars + 2] := #10;
    FileWrite(f, chars, c_max_chars);			// write source string
    FileWrite(f, combination[c_max_chars + 1], 2);	// CRLF
    //
    enumerate(c_max_chars);
    //
    combination := 'Total: ' + IntToStr(DoneSoFar) + #13#10;
    FileWrite(f, combination[1], length(combination));	// CRLF
  finally
    FileClose(f);
  end;
end.