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

[BDA]

Именно так (заменить на требуемую строку).

var s:string;
...
begin
  readln(s);
  Permute('',s);
end.

[Helen236]

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

Именно так (заменить на требуемую строку).

var s:string;
...
begin
  readln(s);
  Permute('',s);
end.

Спасибо. А как поставить ограничения??? Строка от 2 до 8

[BDA]

var s:string[8];
...
begin
  readln(s);
  Permute('',s);
end.

Это не ограничение (если 2<=M<=8 было написано в условии), а всего лишь говорит, какие данные будут даны (т.е. что мы можем рассчитывать, что максимальная строка 8 символов).

[Helen236]

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

var s:string[8];
...
begin
  readln(s);
  Permute('',s);
end.

Это не ограничение (если 2<=M<=8 было написано в условии), а всего лишь говорит, какие данные будут даны (т.е. что мы можем рассчитывать, что максимальная строка 8 символов).

Это понятно, но при ртправке на сервер выдает превышение времени. Решет за 3 секунды, а должна за 1. Может подскажете?

[BDA]

С этой проблемой не помогу. Не знаю, как можно ускорить функцию.
Можно попробовать:

uses
  CRT;

var
  s: string[8];

procedure Permute(t, s: string[8]; len: byte);
var
  i: byte;
begin
  if len = 0 then
    writeln(t)
  else
    for i := len downto 1 do
      if Pos(s[i], s) = i then
        Permute(t + s[i], Copy(s, 1, i - 1) + Copy(s, i + 1, len - i), len - 1)
end;

begin
  readln(s);
  Permute('', s, length(s));
end.

Но вряд ли это сильно ускорит код (попытка, не пытка).
Подождем автора оригинальной процедуры.

[Helen236]

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

Согласен, запутано..
Думаю, можно проще. Держи.
Извиняюсь перед вышевыступавшими - не стал влезать в их код, накарябал свой.. Вроде пашет. Особенно не проверял, погоняй..

procedure Permute(t,s: string);
var
  i: integer;
begin
  if s='' then
    writeln(t)
  else
    for i:=1 to Length(s) do
      if Pos(s[i],s)=i then
        Permute(t+s[i],Copy(s,1,i-1)+Copy(s,i+1,Length(s)-i))
end;

begin
  Permute('','212')
end.

Объяснить что-то, или и так все ясно? ))
Успехов тебе, Леночка236 ))

Это понятно. Огромное спасибо, но при отправке на сервер выдает превышение времени, т.е. задача должна решаться за 1 секунду, а она решается за 3. Може сможете (сможеш) чем помочь?

[Serge_Bliznykov]

Это понятно. Огромное спасибо, но при отправке на сервер выдает превышение времени, т.е. задача должна решаться за 1 секунду, а она решается за 3. Може сможете (сможеш) чем помочь?

а если такой вариант попробовать?

type str8 = string[8];

procedure Permute(const t,s: str8);
var
  i,j: integer;
  lenS : byte;
  ch : char;
begin
  lenS := length(s);
  if lenS=0 then
    write(t)
  else
    for i:=1 to lenS do begin
      ch := s[i];
      j:=1;
      while s[j]<>ch do inc(j);
      if j=i then
        Permute(t+ch, Copy(s,1,i-1)+Copy(s,i+1,Length(s)-i))
    end;
end;

begin
  Permute('','12345678');
end.

он за сколько выполняется?

[Helen236]

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

а если такой вариант попробовать?

type str8 = string[8];

procedure Permute(const t,s: str8);
var
  i,j: integer;
  lenS : byte;
  ch : char;
begin
  lenS := length(s);
  if lenS=0 then
    write(t)
  else
    for i:=1 to lenS do begin
      ch := s[i];
      j:=1;
      while s[j]<>ch do inc(j);
      if j=i then
        Permute(t+ch, Copy(s,1,i-1)+Copy(s,i+1,Length(s)-i))
    end;
end;

begin
  Permute('','12345678');
end.

он за сколько выполняется?

Этот вариант дает решение 123456781234567812345678 и т.д. ???????

[BDA]

uses crt;
type str8 = string[8];
 
var
s:str8;
 
procedure Permute(const t,s: str8);
var
  i,j: integer;
  lenS : byte;
  ch : char;
begin
  lenS := length(s);
  if lenS=0 then
    writeln(t)
  else
    for i:=1 to lenS do begin
      ch := s[i];
      j:=1;
      while s[j]<>ch do inc(j);
      if j=i then
        Permute(t+ch, Copy(s,1,i-1)+Copy(s,i+1,Length(s)-i))
    end;
end;
 
begin
  readln(s);
  Permute('',s);
end.

(программа Serge_Bliznykov, отправляйте в таком виде)

[Helen236]

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

uses crt;
type str8 = string[8];
 
var
s:str8;
 
procedure Permute(const t,s: str8);
var
  i,j: integer;
  lenS : byte;
  ch : char;
begin
  lenS := length(s);
  if lenS=0 then
    writeln(t)
  else
    for i:=1 to lenS do begin
      ch := s[i];
      j:=1;
      while s[j]<>ch do inc(j);
      if j=i then
        Permute(t+ch, Copy(s,1,i-1)+Copy(s,i+1,Length(s)-i))
    end;
end;
 
begin
  readln(s);
  Permute('',s);
end.

(программа Serge_Bliznykov, отправляйте в таком виде)

Выдает ошибку компиляции