Permutation

Here is some code, just add a button with the following code.


John.



procedure TForm1.Button1Click(Sender: TObject);
var f:textfile;
num1,num2,num3:integer;
begin
          assignfile(f,'c:\numbers.csv');
          if not fileexists('c:\numbers.csv') then
               rewrite(F)
          else
               append(f);
          for num1 := 1 to 15 do
          begin
               for num2:= 1 to 15 do
               begin
                    for num3:=1 to 15 do
                    begin
                    writeln(f,inttostr(num1),',',inttostr(num2),',',inttostr(num3));
                    end;
               end;

          end;
          closefile(f);
end;

veermani do You want include combinations like : 1,1,1 ; 2,2,2 ??
ziolko.

No, I don't want 1,1,1, even 1,1,2 also. The numbers should not be repeated in the combination.

try this for not repeating.

 for num1 := 1 to 15 do
 begin
    for num2:= 1 to 15 do
    begin
       if num2 <> num1 then begin
          for num3:=1 to 15 do
          begin
             if num3 <> num1 and num3 <> num2 then begin                             writeln(f,inttostr(num1),',',inttostr(num2),',',inttostr(num3));
          end;
          end;
       end;
    end;
 end;

This is a code that permutes any string you give, making all possible permutations. It needs a little modification to insert the commasunit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    ListBox1: TListBox;
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure Permute(s:string;sl:TStrings);
var
  slbuf:TStringList;
  i,j:integer;
begin
  if Length(s)=2 then
  begin
    sl.Clear;
    sl.Add(s);
    sl.Add(s[2]+s[1]);
    exit;
  end;
  slbuf:=TStringList.Create();
  try
    sl.Clear;
    for i:=1 to Length(s) do
    begin
      Permute(Copy(s,1,i-1)+Copy(s,i+1,length(s)),slbuf);
      for j:=0 to slbuf.Count-1 do
        sl.Add(s[i]+slbuf[j]);
    end;
  finally
    slbuf.Free;
  end;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then
  begin
    Permute(Edit1.Text,ListBox1.Items);
  end;
end;

end.

So you don't want all the combinations.

Hi Karouri,
            Is it working in your computer?

Hi veeramani,
     is my method work fine for your requirement.

Best Regards,
kotan

Hi Kotan,
         It's working, but repeating
i mean , it gives 1 2 3 as well as 1 3 2

I want unique combinations after sorting

for i1:=1 to 15 do
  for i2:=i1+1 to 15 do
    for i3:=i1 to 15 do
      comb:=InttoStr(i1)+','+IntToStr(i2)+','+IntToStr(i3)

for i1:=1 to 15 do
  for i2:=1 to 15 do
    if i2<>i1 then
      for i3:=i1 to 15 do
      comb:=InttoStr(i1)+','+IntToStr(i2)+','+IntToStr(i3)

ooops sorry second comment is ok so ignore first one :-))
ziolko.

I think should be like this,

for i1:=1 to 15 do
   for i2:=i1+1 to 15 do
        for i3:=i2+1 to 15 do
          comb:=InttoStr(i1)+','+IntToStr(i2)+','+IntToStr(i3)

All restricted to only limit of three, but, if i change it to some 6 or 7, it won't work. I want a algorithamic approch.

Regards,

veeramaniraj

Surely if you want unique then all you increment is the outside value. Like this.


procedure TForm1.Button1Click(Sender: TObject);
var f:textfile;
num1,num2,num3:integer;
begin
         assignfile(f,'c:\numbers.csv');
         if not fileexists('c:\numbers.csv') then
              rewrite(F)
         else
              append(f);
         num1 := 1;
         num2:= 2;
         
                   for num3:=3 to 15 do
                   begin
                   writeln(f,inttostr(num1),',',inttostr(num2),',',inttostr(num3));
                   end;
             

         
         closefile(f);
end;

Surely if you want unique then all you increment is the outside value. Like this.


procedure TForm1.Button1Click(Sender: TObject);
var f:textfile;
num1,num2,num3:integer;
begin
         assignfile(f,'c:\numbers.csv');
         if not fileexists('c:\numbers.csv') then
              rewrite(F)
         else
              append(f);
         num1 := 1;
         num2:= 2;
         
                   for num3:=3 to 15 do
                   begin
                   writeln(f,inttostr(num1),',',inttostr(num2),',',inttostr(num3));
                   end;
             

         
         closefile(f);
end;

my method is working on my computer, but the following problem may have happened to you:
It uses recursion in a memory intensive way. I will post another method that uses much less memory later..

This is a solution using recursive method, may be there are some syntax error. Because I am new to Delphi.

procedure permute(r: Integer, n: Integer)
strP: string[r];
begin
    recurpermute(r, n, 0, strP);
end;

procedure recurpermute(r: Integer, n: Integer, loop: Integer, strP: string)
i, c: Integer;
begin
    for i := loop + 1 to n do
    begin
        strP[r] := i;
        if r <> 1 then
        begin
            recurpermute(r - 1, n, i, strP);
        end else
        begin
            for c := strP[0] downto 1 do
            begin
                write(f, strP[c]);
                if c <> 1 then
                    write(', ')
                else
                    writeln();
            end;
        end;
    end
end;

Hope this helps.

Best Regard,
kotan

I am sorry, I think I have overlooked the 'combinations not permutations' question..

Sorry you should delete the second OutputLine in the last procedure

Regards

Here is the correct Button1Click

procedure TForm1.Button1Click(Sender: TObject);
var
  s: String;
  i: Integer;
  t1: TDateTime;
  F: TextFile;
begin
  AssignFile(F, 'c:\permutations.csv');
  try
    Rewrite(F);
    s := '000000000000111';
    i := 0;
    t1 := Now;
    while CheckPerm(s,1,15) do begin
      OutputLine(F, s);
      NextPerm(s,1,15);
      Inc(i);
    end;
    OutputLine(F, s);
    t1 := Now - t1;
    Memo1.Lines.Add(IntToStr(i) + ' perms in second: '+FloatToStrF(t1*60*60*24,ffFixed,15,2));
  finally
    CloseFile(F);
  end;
end;

This is a Complete Pascal7 program to make permutation of  given numbers!
It can be easily converted to delphi!

Hope this helps!
VSF
www.victory.hpg.com.br


Program permutations;

Uses Crt;

Type hold_em_here = Array[1..15] of Integer;

Var  numbers,combs,bot2a : Integer;
     ans,top,bot1,bot2b : Real;
     hold_Array : hold_em_here;

Function permutate_this(number1 : Integer) : Real;
Var i : Integer;
    a : Real;
begin
 a := number1;
 For i := (number1 - 1) doWNto 1 do a := a  * i;
 permutate_this := a;
end;

Procedure input_numbers(Var hold_Array : hold_em_here; counter : Integer);
Var i,j : Integer;
begin
 For i := 1 to counter do begin
  Write(' Input #',i:2,': ');
  READLN(j);
  hold_Array[i] := j;
 end;
end;

Procedure show_numbers(hold_Array : hold_em_here; counter : Integer);
Var i,j : Integer;
begin
 WriteLN;
 Write('Array looks like this: ');
 For i := 1 to counter do Write(hold_Array[i]:3);
 WriteLN
end;

begin
 ClrScr;
 WriteLN;
 WriteLN('  Permutations');
 WriteLN;
 Write('     Enter number of digits (1-15): ');
 READLN(numbers);
 Write('Enter number in combination (2-10): ');
 READLN(combs);
 top := permutate_this(numbers);
 bot1 := permutate_this(combs);
 bot2a := numbers - combs;
 bot2b := permutate_this(bot2a);
 ans := top/(bot1*bot2b);
 WriteLN('   total permutations For above is: ',ans:3:0);
 WriteLN;
 input_numbers(hold_Array,numbers);
 show_numbers(hold_Array,numbers);
END.

Veeramani? Are you still with us?

Jacco

Listening.....

Are you going to grade the question?

Regards Jacco