Link to home
Start Free TrialLog in
Avatar of emu10k1
emu10k1

asked on

combination algoryth non-recursive

Hi people, I want to make combination in 15 numbers (range number in 1 .. 25) without repetition using a algoryth non-recursive, because it is much more fast than recursive mode.

so the display would be:

1,2,3,4,5,6,7,8,9,10,11,12,13,14,15
1,2,3,4,5,6,7,8,9,10,11,12,13,14,16
1,2,3,4,5,6,7,8,9,10,11,12,13,14,17
..
..
..
1,2,3,4,5,6,7,8,9,10,11,12,13,14,50
1,2,3,4,5,6,7,8,9,10,11,12,13,15,16
1,2,3,4,5,6,7,8,9,10,11,12,13,15,17
....

Thanks

Avatar of mokule
mokule
Flag of Poland image

const
  RANGE= 25
  NUMBERS=15;
var
   ind: array[1..15] of integer;
for ind[1] := 1 to RANGE-NUMBERS do
  for ind[2] := ind[1]+1 to RANGE-NUMBERS+1 do
    for ind[3] := ind[2]+1 to RANGE-NUMBERS+2 do
...

 
ASKER CERTIFIED SOLUTION
Avatar of mokule
mokule
Flag of Poland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Russell Libby

If the ranges are in bytes, you could also use the following:

const
  BYTE_MIN       =  1;
  BYTE_MAX       =  25;
  BYTESET_SIZE   =  15;

type
  TByteSet       =  Array [0..Pred(BYTESET_SIZE)] of Byte;

var
  ByteSet:       TByteSet;

procedure  SeedByteSet(Bytes: Array of Byte);
function   IncByteSet: TByteSet;

implementation

function IncByteSet: TByteSet;
var  dwIndex:    Integer;
     cbVal:      Byte;
begin

  // Set result
  result:=ByteSet;

  dwIndex:=Pred(BYTESET_SIZE);
  while (dwIndex >= 0) do
  begin
     if (ByteSet[dwIndex] >= BYTE_MAX) then
        Dec(dwIndex)
     else
     begin
        Inc(ByteSet[dwIndex]);
        break;
     end;
  end;

  // Check for wrapping
  if (dwIndex < 0) then FillChar(ByteSet, SizeOf(ByteSet), BYTE_MIN);

end;

procedure SeedByteSet(Bytes: Array of Byte);
var  dwIndex:    Integer;
     cbVal:      Byte;
begin

  // Set the starting byte set
  FillChar(ByteSet, SizeOf(ByteSet), BYTE_MIN);

  // Iterate the bytes passed in
  for dwIndex:=0 to High(Bytes) do
  begin
     // Get the byte
     cbVal:=Bytes[dwIndex];
     // Range check
     if (cbVal = 0) or (cbVal > BYTE_MAX) then cbVal:=BYTE_MIN;
     // Only use 15 of the total bytes in the array
     if (dwIndex > Pred(BYTESET_SIZE)) then break;
     ByteSet[dwIndex]:=cbVal;
  end;

end;

------

  SeedByteSet([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]);
 
  // Call IncByteSet to increment the numbers starting from the right. If all
  // numbers hit max, then the array will be rolled over and each byte will
  // be set to min value.
  IncByteSet;


Regards,
Russell

Ignore my post, I should have double checked the iterative rollover (and didn't)

Russell
Avatar of emu10k1
emu10k1

ASKER

mokule: I need a code without repetition, you code generate:

1-2-3-4-5-6-7-8-9-10-11-12-13-14-15
1-2-3-4-5-6-7-8-9-10-12-11-13-14-15 // the same, the 12 trade the place with 11



I use:

const
  RANGE= 25;
  NUMBERS=15;
var
   i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13,i14,i15:integer;
   List: String;
begin
for i1 := 1 to RANGE-NUMBERS do
  for i2 := i1+1 to RANGE-NUMBERS+1 do
    for i3 := i2+2 to RANGE-NUMBERS+2 do
      for i4 := i3+3 to RANGE-NUMBERS+3 do
        for i5 := i3+4 to RANGE-NUMBERS+4 do
          for i6 := i3+5 to RANGE-NUMBERS+5 do
            for i7 := i3+6 to RANGE-NUMBERS+6 do
              for i8 := i3+7 to RANGE-NUMBERS+7 do
                for i9 := i3+8 to RANGE-NUMBERS+8 do
                  for i10 := i3+9 to RANGE-NUMBERS+9 do
                    for i11 := i3+10 to RANGE-NUMBERS+10 do
                      for i12 := i3+11 to RANGE-NUMBERS+11 do
                        for i13 := i3+12 to RANGE-NUMBERS+12 do
                          for i14 := i3+13 to RANGE-NUMBERS+13 do
                            for i15 := i3+14 to RANGE-NUMBERS+14 do
                            begin
                              List:=Format(
                                '%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d',
                                  [i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12,
                                    i13, i14, i15]);
                              Application.ProcessMessages;
                            end;

end;
Avatar of emu10k1

ASKER

mokule: sorry, I didn't put i2+1, i3+1, i4+1 , wait... I'm testing now...
Sorry, one more correction :-)
for i1 := 1 to RANGE-NUMBERS+1 do
  for i2 := i1+1 to RANGE-NUMBERS+2 do
    for i3 := i2+1 to RANGE-NUMBERS+3 do
      for i4 := i3+1 to RANGE-NUMBERS+4 do
        for i5 := i4+1 to RANGE-NUMBERS+5 do
          for i6 := i5+1 to RANGE-NUMBERS+6 do
          for i7 := i6+1 to RANGE-NUMBERS+7 do
          for i8 := i7+1 to RANGE-NUMBERS+8 do
Avatar of emu10k1

ASKER

yes, I already fix this... thanks anyway...

const
  RANGE= 25;
  NUMBERS=15;
var
   i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13,i14,i15:integer;
begin
for i1 := 1 to RANGE-NUMBERS+1 do
  for i2 := i1+1 to RANGE-NUMBERS+2 do
    for i3 := i2+1 to RANGE-NUMBERS+3 do
      for i4 := i3+1 to RANGE-NUMBERS+3 do
        for i5 := i4+1 to RANGE-NUMBERS+5 do
          for i6 := i5+1 to RANGE-NUMBERS+6 do
            for i7 := i6+1 to RANGE-NUMBERS+7 do
              for i8 := i7+1 to RANGE-NUMBERS+8 do
                for i9 := i8+1 to RANGE-NUMBERS+9 do
                  for i10 := i9+1 to RANGE-NUMBERS+10 do
                    for i11 := i10+1 to RANGE-NUMBERS+11 do
                      for i12 := i11+1 to RANGE-NUMBERS+12 do
                        for i13 := i12+1 to RANGE-NUMBERS+13 do
                          for i14 := i13+1 to RANGE-NUMBERS+14 do
                            for i15 := i14+1 to RANGE-NUMBERS+15 do
                            begin
                              ListBox1.Items.Add(Format(
                                '%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d-%.02d',
                                  [i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12,
                                    i13, i14, i15]));
                              Application.ProcessMessages;
                            end;

end;

It works very well... thanks man :)