Solved

Permutation

Posted on 2001-08-20
26
521 Views
Last Modified: 2010-04-06
Hi,
   I need one routine for permutation in my project as follows.

  I want 3 number combination from 1 to 15 numbers. Each combination should be put in a file, one combination per line as follows(comma seperated),

1,2,3
1,9,15
.
.
.

I want all the combinations.

Experts, help me

VeeramaniRaj
0
Comment
Question by:veeramani
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 5
  • 4
  • +4
26 Comments
 
LVL 1

Expert Comment

by:Johnch
ID: 6405300
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;
0
 
LVL 21

Expert Comment

by:ziolko
ID: 6405340
veermani do You want include combinations like : 1,1,1 ; 2,2,2 ??
ziolko.
0
 
LVL 1

Author Comment

by:veeramani
ID: 6405364
No, I don't want 1,1,1, even 1,1,2 also. The numbers should not be repeated in the combination.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 6

Expert Comment

by:kotan
ID: 6405394
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;
0
 
LVL 3

Expert Comment

by:karouri
ID: 6405397
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.

0
 
LVL 1

Expert Comment

by:Johnch
ID: 6405449
So you don't want all the combinations.

0
 
LVL 1

Author Comment

by:veeramani
ID: 6405471
Hi Karouri,
            Is it working in your computer?
0
 
LVL 6

Expert Comment

by:kotan
ID: 6405483
Hi veeramani,
     is my method work fine for your requirement.

Best Regards,
kotan
0
 
LVL 1

Author Comment

by:veeramani
ID: 6405510
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
0
 
LVL 21

Expert Comment

by:ziolko
ID: 6405522
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)
0
 
LVL 21

Expert Comment

by:ziolko
ID: 6405528
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)
0
 
LVL 21

Expert Comment

by:ziolko
ID: 6405532
ooops sorry second comment is ok so ignore first one :-))
ziolko.
0
 
LVL 6

Expert Comment

by:kotan
ID: 6405561
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)
0
 
LVL 1

Author Comment

by:veeramani
ID: 6405565
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
0
 
LVL 1

Expert Comment

by:Johnch
ID: 6405623
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;
0
 
LVL 1

Expert Comment

by:Johnch
ID: 6405624
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;
0
 
LVL 3

Expert Comment

by:karouri
ID: 6405759
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..
0
 
LVL 6

Expert Comment

by:kotan
ID: 6406781
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
0
 
LVL 3

Expert Comment

by:karouri
ID: 6406855
I am sorry, I think I have overlooked the 'combinations not permutations' question..
0
 
LVL 10

Accepted Solution

by:
Jacco earned 100 total points
ID: 6407227
These are some routines I used for generating permutations. The algoritm uses string representing binary numbers. It is a non-recursive routine since recusion eats stack space. The starting string must have all 1 to the right of the string.

000000000000111 is the first

NextPerm permutes to the next state
CheckPerm checks whether a next permutation can be made

The routine can do something more of which I stripped some code. It can permute groups of bits inside the string. For example you can have two groups of six bits starting out as

000111000111

NextPerm(s, 1, 6) permutes the first part
NextPerm(s, 7, 6) permutes the second part

This way you can combine the statistics for 3 out of 6 with another 3 out of six. Maybe this is usefull in you code as well.

MakeInit is used when using groups.

When using groups you have to call NextPerm hierarchically

Hope this works for you

Regards Jacco

procedure MakeInit(var s: String; iStart, iLength: Integer);
var
  SubStr: String;
  iPos: Integer;
  TempStr: String;
begin
  TempStr := '';
  SubStr := Copy(s,iStart,iLength);
  for iPos:=1 to Length(SubStr) do
    if SubStr[iPos]='1' then TempStr := TempStr + '1';
  for iPos:=Length(TempStr)+1 to iLength do
    TempStr := '0' + TempStr;
  Delete(s,iStart,iLength);
  Insert(TempStr,s,iStart);
end;

function NextPerm(var s: String; iStart, iLength: Integer): Boolean;
var
  SubStr: String;
  iPos1,iPos2: Integer;
begin
  Result := False;
  SubStr := Copy(s,iStart,iLength);
  if Pos('0',SubStr)=0 then Exit;
  iPos1 := Pos('01',SubStr);
  iPos2 := Pos('1',SubStr);
  if iPos1<>0 then begin
    Delete(SubStr,iPos1,2);
    Insert('10',SubStr,iPos1);
    if (iPos2 <> 0) and (iPos2 < iPos1) then begin
      MakeInit(SubStr,1,iPos1-1);
    end;
    Delete(s,iStart,iLength);
    Insert(SubStr,s,iStart);
    Result := True;
  end;
end;

function CheckPerm(s: String; iStart, iLength: Integer): Boolean;
var
  SubStr: String;
begin
  Result := False;
  SubStr := Copy(s,iStart,iLength);
  if Pos('0',SubStr)=0 then Exit;
  if Pos('01',SubStr)=0 then Exit;
  Result := True;
end;

procedure OutputLine(var F: TextFile; const s: string);
var
  i: Integer;
  b: Boolean;
begin
  b := True;
  // Form1.Memo1.Lines.Add(IntToStr(i)+' - '+s);
  for i := 1 to Length(s) do
    if s[i] = '1' then
    begin
      if b then
        b := False
      else
        Write(F, ',');
      Write(F, IntToStr(i));
    end;
  WriteLn(F);
end;

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);
      OutputLine(F, s);
      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;
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6407271
Sorry you should delete the second OutputLine in the last procedure

Regards
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6407281
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;
0
 
LVL 3

Expert Comment

by:VSF
ID: 6407492
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.
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6413334
Veeramani? Are you still with us?

Jacco
0
 
LVL 1

Author Comment

by:veeramani
ID: 6413562
Listening.....
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6414559
Are you going to grade the question?

Regards Jacco
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…
Finding and deleting duplicate (picture) files can be a time consuming task. My wife and I, our three kids and their families all share one dilemma: Managing our pictures. Between desktops, laptops, phones, tablets, and cameras; over the last decade…

752 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question