Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 06.04.2012, 23:11   #1
Helen236
Пользователь
 
Регистрация: 05.04.2012
Сообщений: 23
По умолчанию Перестановки

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

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



Заранее ОГРОМНОЕ спасибо!!!!!
Helen236 вне форума Ответить с цитированием
Старый 06.04.2012, 23:57   #2
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,285
По умолчанию

Код:
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, т.е. где есть одинаковые буквы).
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
BDA на форуме Ответить с цитированием
Старый 07.04.2012, 10:30   #3
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

я когда то давно писал, тоже через рекурсию..
Код:
{$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.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 07.04.2012, 11:22   #4
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,285
По умолчанию

Serge_Bliznykov, красиво)
Однако наблюдается общая для наших решений проблема (мне кажется, можно ее считать таковой):
при вводе, например, 122, будет выдано:
Цитата:
122
212
221
212
221
, т.е. повторы.
(лично я не знаю, как от них избавиться).
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
BDA на форуме Ответить с цитированием
Старый 07.04.2012, 11:57   #5
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
, т.е. повторы.
(лично я не знаю, как от них избавиться).
насколько я понимаю, задачи избавления от них НЕ СТОИТ!
Если бы такая задача стояла, то я согласен, решение задачи было бы чуть-чуть сложнее.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 07.04.2012, 12:03   #6
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,285
По умолчанию

Если судить по второму примеру топикстартера, то стоит.
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
BDA на форуме Ответить с цитированием
Старый 07.04.2012, 21:26   #7
Helen236
Пользователь
 
Регистрация: 05.04.2012
Сообщений: 23
По умолчанию

Так как же все-таки избавиться от повторов?????
Helen236 вне форума Ответить с цитированием
Старый 08.04.2012, 20:40   #8
Helen236
Пользователь
 
Регистрация: 05.04.2012
Сообщений: 23
По умолчанию

Please!!!!!! Help!!!!!
Во вторник зачет, а эта задача зачетная
Helen236 вне форума Ответить с цитированием
Старый 09.04.2012, 07:43   #9
denisbrain
Форумчанин
 
Регистрация: 29.05.2011
Сообщений: 449
Радость

Цитата:
Сообщение от 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
придется еще две функции написать
задания на pascal/delphi ICQ 368254335
Tel +79177425326 mail denis-naymov1985(at)mail.ru login skype denis.new.skype

Последний раз редактировалось denisbrain; 09.04.2012 в 08:20.
denisbrain вне форума Ответить с цитированием
Старый 09.04.2012, 08:40   #10
denisbrain
Форумчанин
 
Регистрация: 29.05.2011
Сообщений: 449
Радость

Код:
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;
задания на pascal/delphi ICQ 368254335
Tel +79177425326 mail denis-naymov1985(at)mail.ru login skype denis.new.skype
denisbrain вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перестановки SVing Паскаль, Turbo Pascal, PascalABC.NET 26 27.02.2012 22:01
C# Перестановки pro100saniok Помощь студентам 5 21.12.2010 00:12
перестановки символов mrkheggy Помощь студентам 7 12.12.2010 23:39
перестановки fedd Помощь студентам 2 27.11.2009 22:59
Перестановки H'orn Общие вопросы .NET 4 11.11.2009 03:08