VPF::Перемешивание строк - Форум программистов

MrDmitry

Дата 20.2.2012, 15:18 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет

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

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

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

Код


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 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 7
Всего: 41

Код


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;

Это сообщение отредактировал(а) Чучмек - 20.2.2012, 15:46

--------------------

умную мысль держи при себе, а дурной - поделись с другими

northener

Дата 20.2.2012, 15:38 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1361
Регистрация: 2.9.2010

Репутация: 12
Всего: 20

Код


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

--------------------

Но только лошади летают вдохновенно.
Иначе лошади разбились бы мгновенно!

Чучмек

Дата 20.2.2012, 15:50 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 7
Всего: 41

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

)

Delete(S, k,1);

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

Это сообщение отредактировал(а) Чучмек - 20.2.2012, 15:53

--------------------

умную мысль держи при себе, а дурной - поделись с другими

MrDmitry

Дата 20.2.2012, 17:03 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет

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;

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

Это сообщение отредактировал(а) MrDmitry - 20.2.2012, 17:05

northener

Дата 20.2.2012, 17:51 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1361
Регистрация: 2.9.2010

Репутация: 12
Всего: 20

Код


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

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

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

Это сообщение отредактировал(а) northener - 20.2.2012, 17:58

--------------------

Но только лошади летают вдохновенно.
Иначе лошади разбились бы мгновенно!

Чучмек

Дата 20.2.2012, 18:01 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 7
Всего: 41

Код


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;

Это сообщение отредактировал(а) Чучмек - 20.2.2012, 18:05

--------------------

умную мысль держи при себе, а дурной - поделись с другими

Qu1nt

Дата 20.2.2012, 18:45 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 602
Регистрация: 13.1.2007

Репутация: 22
Всего: 50

Fisher–Yates_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;

Это сообщение отредактировал(а) Qu1nt - 20.2.2012, 18:47

Gwire

Дата 23.2.2012, 11:49 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 216
Регистрация: 7.8.2007
Где: Николаев

Репутация: 1
Всего: 4

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

Код


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?

Это сообщение отредактировал(а) Gwire - 23.2.2012, 12:03

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »