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

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

Форум программистов > Perl: Общие вопросы > случайно поменять местами N% символов в строке

Автор: Ramirez 3.9.2007, 14:54

Необходимо случайным образом переставить местами N% символов в строке. Как наиболее оптимально это сделать?
У меня только какие-то страшные нагромождения получаются =(

Автор: tishaishii 3.9.2007, 15:34

Код

sub randomize {
    my($len, $str, $res)=(length $_[0], shift);
    $res.=substr $str, rand $len--, 1, undef while $len;
    +$res
}

print randomize abcdefghijklmnopqrstuvwxyz

Добавлено через 7 минут и 19 секунд

Код

sub randomize {
    my($len, $str, $i, $res)=(length $_[0], shift);
    substr($res, rand $i++, 0)=substr $str, $len--, 1, undef while $len;
    +$res
}

print randomize abcdefghijklmnopqrstuvwxyz

Добавлено через 10 минут и 21 секунду
А здесь настраиваемый беспорядок.
Второй параметр не должен быть больше длинны строки.

Код

sub randomize {
    my($len, $str, $shuffle)=(length $_[0], \shift, shift);
    $shuffle%=$len;
    substr($$str, rand $len, 0)=substr $$str, rand $len--, 1, undef while $shuffle--;
    +$str
}

print ${+randomize abcdefghijklmnopqrstuvwxyz, 10};

Автор: Ramirez 3.9.2007, 15:45

спасибо, фен-шуй, блин =)
только эта функция вообще все перемешивает, а мне надо было перемешивать некоторый процент символов.

Автор: tishaishii 3.9.2007, 15:49

Последняя?
Перемешивает и настраивается сколько символов перемешивать.

Ну из последней легко сделать это:

Код

sub randomize {
    my($len, $shuffle, $str)=(length $_[0], int $_[1] * length $_[0], \shift);
    substr($$str, rand $len--, 0)=substr $$str, rand $len, 1, undef while $shuffle--;
    +$str
}

print ${
    +randomize abcdefghijklmnopqrstuvwxyz, 2#00%
};

Автор: Ramirez 3.9.2007, 15:59

погоди. хорошо тебе, со встроенным оптимизатором кода, а мне надо сначала переварить как оно работает =)

Автор: tishaishii 3.9.2007, 16:01

Цитата

хорошо тебе, со встроенным оптимизатором кода

)) Инсталлировал его не долго. Тихими тёплыми ночами с заданиями.
К стати, где взять такой оптимизатор?

Автор: amg 4.9.2007, 08:28

tishaishii, твой последний алгоритм затрагивает начало строки с гораздо больней вероятностью, чем конец, и переставляет уже однажды переставленные символы. Например, твой
randomize($str, 1) может дать THCOJfGDAKIElVmnBpqrsuwxyz (заглавные буквы - переставленные),
хотя по условию задания нужно было "переставить местами 100% символов в строке". Но, может быть, я неправильно понял задание.

Другой вариант, со вспомогательным массивом:

Код


$str = 'abcdefghijklmnopqrstuvwxyz';
print randomize($str, 0.1), "\n";

sub randomize {
  my @str = split '', $_[0];
  my $shuffle = int($_[1] * @str / 2);
  my @a = 0..$#str;
  while ($shuffle--) {
    my ($place1, $place2) = (splice(@a,rand @a,1), splice(@a,rand @a,1));
    # uc в следующей строке - для наглядности, из рабочего кода убрать
    ($str[$place1], $str[$place2]) = (uc $str[$place2], uc $str[$place1]);
  }
  return join '', @str;
}

Автор: tishaishii 5.9.2007, 17:47

Ну это только за счёт $len--. А если текст большой? Как работать с массивом символов и указателями?

Вот без $len--. А значит, всё зависит от псевдо-случайной величины: переставить $shuffle раз любой символ с любым. Чтобы переставить строго N% символов - недо ещё морочаться, тогда задача может быть гораздо сложнее. Вот простое решение как переставить <=N% символов.

Код

sub randomize {
    my($len, $shuffle, $str)=(length $_[0], int $_[1] * length $_[0], \shift);
    substr $$str, rand $len, 0, substr $$str, rand $len, 1, undef while $shuffle--;
    +$str
}

print ${
    +randomize abcdefghijklmnopqrstuvwxyz, 2#00%
}

Автор: tishaishii 5.9.2007, 18:09

В результате 1_000_000 испытаний с указанными 20% перестановок букв в тексте, число букв хотя бы один раз переставленных, сводится к 23.076923077267%????. При чём, как оказалось, это число не зависит от количества заявленных процентов букв для смешивания (второй аргумент). ????

Код


sub randomize {
    my($len, $shuffle, $str)=(length($_[0]), int($_[1] * length $_[0]), \shift);
    substr $$str, rand $len, 0, uc substr $$str, rand $len, 1, undef while $shuffle--;
    +$str
}

my$str='abcdefghijklmnopqrstuvwxyz';
my$len=length $str;
my$summ=0;
my$res;

for(my$i=0; $i<1e6; $i++) {
    $res=&randomize($str, .2);
    $summ+=int($res=~tr{ABCDEFGHIJKLMNOPQRSTUVWXYZ}{ABCDEFGHIJKLMNOPQRSTUVWXYZ})/$len;
}

print $summ/1e6;

Задача: алгоритм, который гарантировал бы перестановку =N% символов.

Автор: amg 6.9.2007, 08:56

Цитата(tishaishii @ 5.9.2007, 17:47

)

А если текст большой? Как работать с массивом символов и указателями?

Мой алгоритм совсем несложно преобразовать так, чтобы передавалась ссылка на строку, и в строке делать перестановки с помощью substr. Но я намеренно это не сделал, так как данную задачу оптимизировать нужно скорее по скорости, чем по памяти. А преобразовать один раз строку в массив и затем быстро переставлять элементы массива - это существенно быстрее, чем много-много раз делать substr.

Цитата(tishaishii @ 5.9.2007, 18:09

)

Задача: алгоритм, который гарантировал бы перестановку =N% символов.

Так мой алгоритм как раз это и старается сделать, если $length($str) * $shuffle / 2 - целое число, то гарантированно, при невыполнении этого условия, но длинной строке - почти точно.

Автор: Ramirez 6.9.2007, 09:55

Даже не ожидал, что мой вопрос вызовет столь бурные дебаты. Спасибо. Я пок играюсь с обоими вариантами, но алгоритм amg, на первый взгляд действительно работает быстрее.

а из примеров tishaishii, как всегда узнаешь кучу необычных конструкций =)

Автор: amg 6.9.2007, 12:04

Ramirez, если скорость работы действительно критична, то вот такое изменение кода приводит к ускорению в 20 раз:

Код


use List::Util qw(shuffle);
sub randomize {
  my @str = split '', $_[0];
  my $shuffle = int($_[1] * @str / 2);
  my @a = shuffle(0..$#str);
  while ($shuffle--) {
    my ($place1, $place2) = (shift @a, shift @a);
    # uc в следующей строке - для наглядности, из рабочего кода убрать
    ($str[$place1], $str[$place2]) = (uc $str[$place2], uc $str[$place1]);
  }
  return join '', @str;
}

Думаю, что по мелочам можно еще ускорить.

Ирония в том, что при такой скорости работы уже имеет смысл задумываться об оптимизации по памяти.

Автор: tishaishii 12.9.2007, 11:41

и можно ещё железо докупить.