Перестановки

[Helen236]

Помогите пожалуйста с решением задачи. (Pascal)
Дана строка, состоящая из М символов. Вывести все перестановки символов данной строки.
2<=M<=8

Example:AB - AB , BA
122 - 122, 212, 221



Заранее ОГРОМНОЕ спасибо!!!!!

[BDA]

Uses CRT;
const
z='********';

var
d:string;
tmp:string;

procedure createp(var s:string;d:string);
var
i,j:integer;
begin
i:=pos('*',s);
if i=0 then
	writeln(s)
else
begin
	for j:=1 to length(d) do
	begin
		s[i]:=d[j];
		createp(s,copy(d,1,j-1)+copy(d,j+1,length(d)-j));
	end;
	s[i]:='*';
end;
end;

BEGIN
writeln('Input string:');
readln(d);
tmp:=copy(z,1,length(d));
createp(tmp,d);
readln;
END.

Что-то "топорное".
Строит перестановки (неправильно работает на примере 122, т.е. где есть одинаковые буквы).

[Serge_Bliznykov]

я когда то давно писал, тоже через рекурсию..

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}
{$M 48124,0,655360}
var S:string;
    LenS : byte absolute S;
    a1,a2 : string;

procedure ShowVariant(S0,S1 : string);
var I :byte;
begin
  if length(S1)=1 then begin WriteLn(S0+S1); Exit end;
  a1 := '';
  a2 :=  copy(S1,I+1,length(S1));
  for i:=1 to length(S1) do ShowVariant(S0+S1[i],copy(S1,1,I-1)+
                             copy(S1,I+1,length(S1)));
end;

begin
  Writeln('Переборщик строк     v1.0 by B_SA (Specailly for Nataly & Juliy)');
  if ParamCount < 1 then begin WriteLn('Укажите в командной строке требуемую строчку.');
      Writeln('Для выдачи результатов в файл введите combine.exe ТРАТАТА > имя_файла');
      Writeln('   ТРАТАТА - строка для преобразования'); Halt(1)
  end;
  S := paramstr(1);
  ShowVariant('',S);
end.

[BDA]

Serge_Bliznykov, красиво)
Однако наблюдается общая для наших решений проблема (мне кажется, можно ее считать таковой):
при вводе, например, 122, будет выдано:

122
212
221
212
221

, т.е. повторы.
(лично я не знаю, как от них избавиться).

[Serge_Bliznykov]

, т.е. повторы.
(лично я не знаю, как от них избавиться).

насколько я понимаю, задачи избавления от них НЕ СТОИТ!
Если бы такая задача стояла, то я согласен, решение задачи было бы чуть-чуть сложнее.

[BDA]

Если судить по второму примеру топикстартера, то стоит.

[Helen236]

Так как же все-таки избавиться от повторов?????

[Helen236]

Please!!!!!! Help!!!!!
Во вторник зачет, а эта задача зачетная

[denisbrain]

Сообщение от Helen236

Так как же все-таки избавиться от повторов?????

записывать все что получилось и искать повторения

uses math;

function FromDec(stroka:string;Value:integer;rdec:integer):string; // функция переводит Value:real в rdec - систему счисления
   var
     s:String;   { временная переменная}
     m:longint;  { временная переменная для целой части}
     n,l:real;  { временная переменная}
     r,i:integer;
begin
     n:=Value;
     r:=rdec;
     s:=''; { временная переменная  для вывода в строковом типе}
     m:=trunc(n);   { целая часть числа}
     repeat
        s:=stroka[(m mod r)+1]+s; { остаток от деления на rdec записываем  при 8 mod 3 = 8-(3*2)= 8-6=2}
        m:=m div r; { целочисленной деление  8 div 3 = trunc(8/3)=trunc(2.666666)=2}
     until m=0;    { продолжаем пока не 0}
     l:=frac(n); { получаем часть числа полсле запятой}
     result:=s;
end;

// маска числа firstChar- первый символ "0"
// Value - строка 11
// len - длина числа = 4
// result строка  0011
Function Formatadd(firstChar:Char;value:string;len:integer):string;
var x:integer;
s2:string;
begin
  for X:=length(value) to len-1 do begin
    s2:=s2+firstChar;
  end;
  result:=s2+value;
end;


Function GetVariantABC(s:string):string;
var s2:string;
    x:integer;
    s3:string;
    Variant_abc:string;
begin
  s2:='';
  s3:='';
  for x:=0 to round(power(length(s),length(s)))-1 do begin
  Variant_abc:=Formatadd(s[1],FromDec(s,x,length(s)),length(s));
  if pos(';'+Variant_abc+'$',s2)=0 then begin
   s2:=s2+';'+Variant_abc+'$';
   s3:=s3+Variant_abc+#13+#10;
  end;
  end;
  result:=s3;
end;

222
221
212
211
122
121
112
111

если нужен ответ

221
212
122

придется еще две функции написать

[denisbrain]

Tcharvalue=record
    c:char; // знак
    value:integer; // кол-во знаков
  end;

TMaskR=record
   m:array of Tcharvalue; // массив знаков и кол-ва знаков
   Mcount:integer; // размер массива
end;



// подсчет числа разрешонных знаков
Function GetFormatShisla(s:string):TMaskR;
var x:integer;
   r:TMaskR;
Function AddChar(c:char):integer;
  var x:integer;
begin
  result:=-1;
  for x:=0 to r.Mcount-1 do begin
     if r.m[x].c=c then begin r.m[x].value:=r.m[x].value+1; exit; end;
  end;
 r.Mcount:=r.Mcount+1;
 setlength(r.M,r.Mcount);
 r.m[r.Mcount-1].c:=c;
 r.m[r.Mcount-1].value:=1;
end;

begin
r.Mcount:=0;
Setlength(r.m,0);
   for x:=1 to length(s) do AddChar(s[x]);
   result:=r;
end;
// проверка на кол-во разрешонных знаков
Function proverca(s:string;r1:TMaskR):boolean;
var r:TMaskR;
Function GetChar(c:char):integer;
  var x:integer;
begin
  result:=-1;
  for x:=0 to r.Mcount-1 do begin
     if r.m[x].c=c then begin r.m[x].value:=r.m[x].value-1; exit; end;
  end;
end;
var x:integer;
begin
r:=r1;
result:=true;
   for x:=1 to length(s) do GetChar(s[x]);
   for x:=0 to r.mcount-1 do
    if r.m[x].value<0 then
    result:=false;
end;