Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Для новичков > Перемешивание строк

Автор: MrDmitry 20.2.2012, 15:18

Здравствуйте, помогите справится с казалось бы легкой задачей, честно говоря такое даже спрашивать стыдно (

Есть строка, нужно перемешать символы заданное кол-во раз

попробовал так

Код


var
 s,str:string;
 i,t,k:integer;
begin
memo1.Clear;
Randomize;
for t:=1 to 2 do
 begin
    s:='абвгдеёжз';
  str:='';
  for i:=1 to length(s) do
   begin
    k:=random(Length(s));
     str:=str+Copy(S, k, 1);
    Delete(S, k,1);
   end;
  memo1.Lines.Add(str);
 end;

В таком примере у меня повторяются символы из за рандома а некоторые символы вообще не записываются в строку (((
Вот что получаем

ёждаегббб
ёеаждвааг

Автор: Чучмек 20.2.2012, 15:37

Код


var 
m:array[0..x] of type1;

countm,i,ind:integer;


for countm:=0 to high(m) do
m[countm]:=countm;//или f(countm) или  m2[countm] или ...


i:=0;
while countm>0 do
begin
ind:=random(countm-1);
rez[i]:=m[ind];
m[ind]:=m[countm-1]
inc(i);
dec(countm);
end;

Или еще лучше

Код


var 
m:array[0..x] of type1;
n:type1;

countm,ind:integer;


for countm:=0 to high(m) do
m[countm]:=countm;//или f(countm) или  m2[countm] или ...



while countm>0 do
begin
dec(countm);
ind:=random(countm);
n:=m[ind];
m[ind]:=m[countm];
m[countm]:=n;


end;

Автор: northener 20.2.2012, 15:38

Код


k:=random(Length(s))+1;

Автор: Чучмек 20.2.2012, 15:50

Цитата(MrDmitry @ 20.2.2012, 15:18

)

Delete(S, k,1);

Извиняюсь, недосмотрел.
Первую половину (моего кода)на свалку

Автор: MrDmitry 20.2.2012, 17:03

northener
Так пробовал символы все равно повторяются

Сейчас нет под рукой дельфи, но пришла в голову мысль сделать так

Код


var
 s,str:string;
 i,t,k:integer;
begin
memo1.Clear;
Randomize;
for t:=1 to 2 do
 begin
    s:='абвгдеёжз';
  str:='';
  for i:=1 to length(s) do
   begin
    k:=random(Length(s));
     while pos(s[k],str)<>0 do
       k:=random(Length(s));
     str:=str+Copy(S, k, 1);
    Delete(S, k,1);
   end;
  memo1.Lines.Add(str);
 end;

Как думаете такой вариант сработает?(Мне кажется что должен) или есть какой то другой вариант без вложенных циклов?

Автор: northener 20.2.2012, 17:51

Код


k:=random(Length(s))+1;

Ибо из справки:
random returns a random number between 0 and (num-1)

Кроме того. С этим изменением проверил код из топика. Результат
жгевабдзё
даёвжбгзе

Автор: Чучмек 20.2.2012, 18:01

Код


var
 s:string;
 ch:char;
 l,k:integer;
begin
s:='абвгдеё';
l:=length(s);
while l>0 do
 begin
 k:=1+random(l);
 ch:=s[k];
 s[k]:=s[l];
 s[l]:=ch;
 dec(l);
 end;
messagebox(0,pchar(s),'',0);
end;

Автор: Qu1nt 20.2.2012, 18:45

http://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle.

Код


function FisherYatesShuffle(const Text: String): String;
var
  I, J: Integer;
  Character: Char;
begin
  Result := Text;
  for I := Length(Text) downto 2 do
  begin
    J := Random(I) + 1;
    Character := Result[I];
    Result[I] := Result[J];
    Result[J] := Character;
  end;
end;

Автор: Gwire 23.2.2012, 11:49

Можно попробовать делать не переносом, а (истинно) перемешиванием.

Код


procedure Exchange(var A, B: Char);
var C: Char;
begin
    C:= A;    A:= B;    B:= C;
end;

function StringMix(S: String; Count: Integer): String;
var c, i, L: Integer;
begin
    Result:= S;
    L:= Length(S);
    for c:= 1 to Count do
      for i:= 1 to L do
         Exchange( Result[i], Result[Random(L)+1] );
end;

или

Код


function StringMix(S: String; Count: Integer): String;
var i, L: Integer;
begin
    Result:= S;
    L:= Length(S);
    for i:= 1 to L*Count do
       Exchange( Result[Random(L)+1], Result[Random(L)+1] );
end;

PS: А собственно, к чему это безвозвратное перемешивание строки? Или задача несколько сложнее чем юзать Random?