Initial data commit

Task/Permutations/Pascal/permutations-1.pas

@@ -0,0 +1,71 @@
+program perm;
+
+var
+	p: array[1 .. 12] of integer;
+	is_last: boolean;
+	n: integer;
+
+procedure next;
+var i, j, k, t: integer;
+begin
+is_last := true;
+i := n - 1;
+while i > 0 do
+	begin
+	if p[i] < p[i + 1] then
+		begin
+		is_last := false;
+		break;
+		end;
+	i := i - 1;
+	end;
+
+if not is_last then
+	begin
+	j := i + 1;
+	k := n;
+	while j < k do
+		begin
+		t := p[j];
+		p[j] := p[k];
+		p[k] := t;
+		j := j + 1;
+		k := k - 1;
+		end;
+		
+	j := n;
+	while p[j] > p[i] do j := j - 1;
+	j := j + 1;
+
+	t := p[i];
+	p[i] := p[j];
+	p[j] := t;
+	end;
+end;
+
+procedure print;
+var i: integer;
+begin
+for i := 1 to n do write(p[i], ' ');
+writeln;
+end;
+
+procedure init;
+var i: integer;
+begin
+n := 0;
+while (n < 1) or (n > 10) do
+	begin
+	write('Enter n (1 <= n <= 10): ');
+	readln(n);
+	end;
+for i := 1 to n do p[i] := i;
+end;
+
+begin
+init;
+repeat
+	print;
+	next;
+until is_last;
+end.

Task/Permutations/Pascal/permutations-2.pas

@@ -0,0 +1,71 @@
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ELSE}
+  {$APPTYPE CONSOLE}
+{$ENDIF}
+uses
+  sysutils;
+type
+  tPermfield  =  array[0..15] of Nativeint;
+var
+  permcnt: NativeUint;
+
+procedure DoSomething(k: NativeInt;var x:tPermfield);
+var
+  i:integer;
+  kk:string;
+begin
+  kk:='';
+  for i:=1 to k do kk:=kk+inttostr(x[i])+' ';
+    writeln(kk);
+end;
+
+procedure PermKoutOfN(k,n: nativeInt);
+var
+  x,y:tPermfield;
+  i,yi,tmp:NativeInt;
+begin
+  //initialise
+  permcnt:= 1;
+  if k>n then
+    k:=n;
+  if k=n then
+    k:=k-1;
+  for i:=1 to n do x[i]:=i;
+  for i:=1 to k do y[i]:=i;
+
+//  DoSomething(k,x);
+  i := k;
+  repeat
+    yi:=y[i];
+    if yi <n then
+    begin
+      inc(permcnt);
+      inc(yi);
+      y[i]:=yi;
+      tmp:=x[i];x[i]:=x[yi];x[yi]:=tmp;
+      i:=k;
+//      DoSomething(k,x);
+    end
+    else
+    begin
+      repeat
+        tmp:=x[i];x[i]:=x[yi];x[yi]:=tmp;
+        dec(yi);
+      until yi<=i;
+      y[i]:=yi;
+      dec(i);
+    end;
+  until (i=0);
+end;
+
+var
+  t1,t0 : TDateTime;
+Begin
+  permcnt:= 0;
+  T0 := now;
+  PermKoutOfN(12,12);
+  T1 := now;
+  writeln(permcnt);
+  writeln(FormatDateTime('HH:NN:SS.zzz',T1-T0));
+end.

Task/Permutations/Pascal/permutations-3.pas

@@ -0,0 +1,119 @@
+program Permutations;
+(*
+Demonstrates four closely related ways of establishing a bijection between
+permutations of 0..(n-1) and integers 0..(n! - 1).
+Each integer in that range is represented by mixed-base digits d[0..n-1],
+where each d[j] satisfies 0 <= d[j] <=j.
+The integer represented by d[0..n-1] is
+  d[n-1]*(n-1)! + d[n-2]*(n-2)! + ... + d[1]*1! + d[0]*0!
+where the last term can be omitted in practice because d[0] is always 0.
+See the section "Numbering permutations" in the Wikipedia article
+"Permutation" (NB their digit array d is 1-based).
+*)
+uses SysUtils, TypInfo;
+type TPermIntMapping = (map_I, map_J, map_K, map_L);
+type TPermutation = array of integer;
+
+// Function to map an integer to a permutation.
+function IntToPerm( map : TPermIntMapping;
+                    nrItems, z : integer) : TPermutation;
+var
+  d, lookup : array of integer;
+  x, y : integer;
+  h, j, k, m : integer;
+begin
+  SetLength( result, nrItems);
+  SetLength( lookup, nrItems);
+  SetLength( d, nrItems);
+  m := nrItems - 1;
+  // Convert z to digits d[0..m] (see comment at head of program).
+  d[0] := 0;
+  y := z;
+  for j := 1 to m - 1 do begin
+    x := y div (j + 1);
+    d[j] := y - x*(j + 1);
+    y := x;
+  end;
+  d[m] := y;
+
+  // Set up the permutation elements
+  case map of
+    map_I, map_L: for j := 0 to m do lookup[j] := j;
+    map_J, map_K: for j := 0 to m do lookup[j] := m - j;
+  end;
+  for j := m downto 0 do begin
+    k := d[j];
+    case map of
+      map_I: result[lookup[k]] := m - j;
+      map_J: result[j] := lookup[k];
+      map_K: result[lookup[k]] := j;
+      map_L: result[m - j] := lookup[k];
+    end;
+    // When lookup[k] has been used, it's removed from the lookup table
+    //   and the elements above it are moved down one place.
+    for h := k to j - 1 do lookup[h] := lookup[h + 1];
+  end;
+end;
+
+// Function to map a permutation to an integer; inverse of the above.
+// Put in for completeness, not required for Rosetta Code task.
+function PermToInt( map : TPermIntMapping;
+                    p : TPermutation) : integer;
+var
+  m, i, j, k : integer;
+  d : array of integer;
+begin
+  m := High(p); // number of items in permutation is m + 1
+  SetLength( d, m + 1);
+  for k := 0 to m do d[k] := 0; // initialize all digits to 0
+
+  // Looking for inversions
+  for i := 0 to m - 1 do begin
+    for j := i + 1 to m do begin
+      if p[j] < p[i] then begin
+        case map of
+          map_I : inc( d[m - p[j]]);
+          map_J : inc( d[j]);
+          map_K : inc( d[p[i]]);
+          map_L : inc( d[m - i]);
+        end;
+      end;
+    end;
+  end;
+  // Get result from its digits (see comment at head of program).
+  result := d[m];
+  for j := m downto 2 do result := result*j + d[j - 1];
+end;
+
+// Main routine to generate permutations of the integers 0..(n-1),
+// where n is passed as a command-line parameter, e.g. Permutations 4
+var
+  n, n_fac, z, j : integer;
+  nrErrors : integer;
+  perm : TPermutation;
+  map : TPermIntMapping;
+  lineOut : string;
+  pinfo : TypInfo.PTypeInfo;
+begin
+  n := SysUtils.StrToInt( ParamStr(1));
+  n_fac := 1;
+  for j := 2 to n do n_fac := n_fac*j;
+  pinfo := System.TypeInfo( TPermIntMapping);
+  lineOut := 'integer';
+  for map := Low( TPermIntMapping) to High( TPermIntMapping) do begin
+    lineOut := lineOut + '   ' + TypInfo.GetEnumName( pinfo, ord(map));
+  end;
+  WriteLn( lineOut);
+  for z := 0 to n_fac - 1 do begin
+    lineOut := SysUtils.Format( '%7d', [z]);
+    for map := Low( TPermIntMapping) to High( TPermIntMapping) do begin
+      perm := IntToPerm( map, n, z);
+      // Check the inverse mapping (not required for Rosetta Code task)
+      Assert( z = PermToInt( map, perm));
+      lineOut := lineOut + '    ';
+      for j := 0 to n - 1 do
+        lineOut := lineOut + SysUtils.Format( '%d', [perm[j]]);
+    end;
+    WriteLn( lineOut);
+  end;
+end.