Задачка для мастеров

← →
Ahmad K © (2003-06-28 07:54) [0]

Задачка для мастеров.
Небольшая задача для мастеров. Зададим допустим в Edit1 слово состоящее из 4-8 букв, например: ДЕЛФИ, теперь надо чтобы в ListBox1 появились все вариации перестановок букв в этом слове, например: ФИДЕЛ, ЛЕДИФ и т.д.
Ну, слабо?

← →
zzet © (2003-06-28 08:05) [1]

Слабо.. А мож че полегче придумаешь?

← →
MBo © (2003-06-28 08:11) [2]

... ясливарпу йогурд-цясем аз от ,иисрукер или халкиц о ланз отк ыб илсЕ (; шиниф йынлоп ,онченок ,ачадаЗ

← →
Юрий Зотов © (2003-06-28 09:10) [3]

> Ahmad K © (28.06.03 07:54)

Ох, и правда трудная задача. Представляете - целых 5 минут пришлось по клавишам стучать. Правда, решил все-таки. Но код не приведу. Потому что задачку-то эту задали Вам, а не форуму.

← →
sergey2 (2003-06-28 09:14) [4]

(: .ьтавишарпс емуроф ан олыб онжун йен о отч ,огокат ,ечадаз йотэ в огонжолс огечин ужив еН.

← →
Ahmad K © (2003-06-28 11:09) [5]

> ... ясливарпу йогурд-цясем аз от ,иисрукер или халкиц о
> ланз отк ыб илсЕ (; шиниф йынлоп ,онченок ,ачадаЗ

я просил писать не задом на перед а просто переставлять буквы в словах. В циклах и рекурсии я мало смыслю честно сказать, про рекурсии правда вообще ничего не слышал :)

> (: .ьтавишарпс емуроф ан олыб онжун йен о отч ,огокат ,ечадаз
> йотэ в огонжолс огечин ужив еН.

Это не вопрос это - задача.

> Ох, и правда трудная задача. Представляете - целых 5 минут
> пришлось по клавишам стучать. Правда, решил все-таки. Но
> код не приведу. Потому что задачку-то эту задали Вам, а
> не форуму.

Мне никто задачи не задает, я не изучаю и не работаю с делфи, так для интереса иногда рисую формы, мне просто интересно было кто какой вариант предложит, у меня такая процедура тормозит не подетски если слово большое, хотел посмотреть как у людей.

← →
Ahmad K © (2003-06-28 11:10) [6]

Все равно всем спасибо, хоть с делфи вы и незнакомы но отмазываться умеете :)

← →
Ihor Osov'yak © (2003-06-28 11:53) [7]

Я конечно, не ЮЗ, пять минут мне мало, но думаю - не более 15 это точно. Начинаем эксперемент, всмысле начинаю старт. По окончании - дам реализацию сюда :-)

← →
Ihor Osov'yak © (2003-06-28 12:14) [8]

Усе, готово. Сейчас резулт постить буду, ну не настолько я морально устойчав, как ЮЗ :-)..

Зы - написание оптимального кода не преследовалось..

← →
Bayer_Linse © (2003-06-28 12:17) [9]

Задача с завидным упорством появляется на форуме. Пора ее уже в FAQ заносить. :-)

Решение- в первом томе Кнута. Два варианта.

← →
Ihor Osov'yak © (2003-06-28 12:19) [10]

Итого 21 минута, с них 1 ушла на беседу в аське и две на угон кошки, чтобы не мешала..
Как обратил внимание Олег Гашев (а именно с ним в аьке говорил) - не должно быть повторений в результ. варианте. Например, если исходное слово МАМА - то вариант МАМА должен был присутствовать один раз. Но я с этим не согласился, так как это не следует с условия. То есть я пошел по пути упрощения..

Итак:

unit mfPerest; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) edSrc: TEdit; btStart: TButton; listResult: TListBox; procedure btStartClick(Sender: TObject); private { Private declarations } procedure WriteOneCombination(aStr:string); procedure DoIt(aStr:string; aFixPos:integer); public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.btStartClick(Sender: TObject); begin // if edSrc.Text="" then begin ShowMessage("

← →
Bayer_Linse © (2003-06-28 12:23) [11]

Такое не интересно решать. Вот Вам, подумайте:

Представьте себе целочисленную шкалу - ну, то есть, бесконечный в обе стороны ряд точек, занумерованных целыми числами - положительными и отрицательными.
Теперь представьте себе, что на эту самую шкалу спускаются на парашютах два робота. Они приземляются одновременно. В разных точках, естественно. После приземления каждый из роботов тут же бросает свой парашют прямо в той точке, на которую приземлился, и, не теряя времени даром, начинает действовать строго по заложенной в нем программе. Программа написана на простеньком языке, состоящем всего из четырех операторов:

[<метка>:] Left
[<метка>:] Right
[<метка>:] GoTo <метка>
[<метка>:] PGoTo <метка>

При исполнении оператора Left робот делает один шаг влево, то есть перепрыгивает на точку с числом на единицу меньшим, а при исполнении оператора Right - шаг вправо. Оператор GoTo - обычный оператор безусловного перехода на указанную метку в программе. Оператор PGoTo - оператор условного перехода, где условием является наличие парашюта в той точке, на которой стоит робот (все равно - своего парашюта или чужого).
Итак, роботы приземляются, бросают парашюты и в один и тот же момент начинают действовать по заложенным в них программам. Причем действуют они синхронно. Давайте будем считать, что каждую секунду роботы одновременно исполняют очередной оператор своей программы (на исполнение операторов GoTo и PGoTo тоже требуется одна секунда).
Теперь представьте себе, что программы у роботов совершенно одинаковые. Тогда они и вести себя будут совершенно одинаково, весело прыгая по точкам и не мешая друг другу. Правда? Ничего подобного! Оказывается, можно написать такую программу, при исполнении которой роботы обязательно встретятся, то есть в какой-то момент прыгнут в одну и ту же точку!
Именно такую программу вам и предстоит написать. Учтите, что программа должна быть честной. Она не должна содержать операторов, отличных от упомянутых четырех, и, кроме того, ее текст, конечно же, должен быть конечным - то есть состоять из конечного числа строк-операторов. Постарайтесь придумать как можно более короткую программу.
Совершенно не обязательно, чтобы программа закончилась в тот самый момент, когда роботы встретятся. Пусть себе прыгают дальше - лишь бы встретились хоть раз. Не обязательно даже, чтобы программа вообще кончалась. Она вполне может включать бесконечный цикл.

А то перестановки, рекурсия. Старо.

← →
Ihor Osov'yak © (2003-06-28 12:25) [12]

ShowMessage("

← →
Ihor Osov'yak © (2003-06-28 13:01) [13]

2 Bayer_Linse © (28.06.03 12:23)

тут такое дело.. Думал, думал... А тут змей-искуситель Гашев дал линк на решение.. Я не удержался.. Потому что Гашев сказал, что оно не верное.. Верное оно, но гашев упустил из виду тот факт, что на безусловный и условный переход тоже время нужно.. Но решение красивое..

← →
Ihor Osov'yak © (2003-06-28 13:02) [14]

Зы.. В моем постинге есть уже очень юольшая подсказка к решению..

Зы2. Смог ли бы я ее самоостоятельно решить - не знаю..

← →
JohnJ © (2003-06-28 15:16) [15]

Интересная задачка - домой приеду, решу обязательно! :)
Если тема будет ещё актуальна, то выложу решение сюда.

← →
Ihor Osov'yak © (2003-06-28 16:00) [16]

в дополнение к Ihor Osov"yak © (28.06.03 13:02)

.. Но надеюсь, что смог-бы..

← →
Marser © (2003-06-28 16:42) [17]

Мы такое "слабо" на информатике проходили. Даже без того материала можно сделать через множества.

Множества имеют ограниченную длину. Найди для 6 хотя бы.

А у меня своё решение. Только оно тормозит когда больше 6, и буквы должны все быть разные. Зато подход оригинальный, коротко и писал сам, а не из книжки переписывал.

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, ValEdit, StdCtrls; type TForm1 = class(TForm) ValueListEditor1: TValueListEditor; Button1: TButton; Edit1: TEdit; ListBox1: TListBox; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var i, j, b : Integer; s1, s2 : String; begin j:=1; for i:=1 to Length(Edit1.Text) do begin j:=j*i; end; s1 := Edit1.Text; ValueListEditor1.Strings.Clear; repeat b := Random(Length(s1))+1; s2 := Copy(s1,b,1); Delete(s1,b,1); s1 := s1+s2; ValueListEditor1.Values[s1] :=s1; until (ValueListEditor1.RowCount>j) ; ListBox1.Items.Clear; for i:=1 to ValueListEditor1.RowCount-1 do begin ListBox1.Items.Add(ValueListEditor1.Keys[i]); end; caption := "Вариантов: "+IntToStr(ValueListEditor1.RowCount-1); end; end.

Форма :

object Form1: TForm1 Left = 292 Top = 114 Width = 573 Height = 387 Caption = "Form1" Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = "MS Sans Serif" Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object ValueListEditor1: TValueListEditor Left = 240 Top = 16 Width = 306 Height = 305 TabOrder = 0 end object Button1: TButton Left = 144 Top = 16 Width = 75 Height = 25 Caption = "Button1" TabOrder = 1 OnClick = Button1Click end object Edit1: TEdit Left = 16 Top = 16 Width = 121 Height = 21 TabOrder = 2 Text = "Edit1" end object ListBox1: TListBox Left = 16 Top = 48 Width = 217 Height = 273 ItemHeight = 13 TabOrder = 3 end end

Кстати а ведь эту задачку достаточно решить всего один раз !
А дальше достаточно лишь делать замену символов в ЛистБоксе.

> Ihor Osov"yak

Ваш вариант мне больше понравился, по крайней мере не тормозит как мой иработает с любой длиной и слюбыми буквами, единсктвенная проблема была удалять схожие варианты, но это не трудно:
procedure TForm1.Button1Click(Sender: TObject); var i, s: Integer; begin l.Sorted:=true; for i:=L.Items.Count-1 downto 1 do if l.Items[i]=l.Items[i-1] then begin s:=i-1; l.Items.Delete(s); end; end; end.

Тута появляются много сообщений, типа "мы это в детсадике проходили..." поясняю еще раз, я нигде и ничего про делфю или программирование не изучал и работал чисто методом тыка, а когда столкнулся с такой проблемо, долго и нудно расписывал исходник (на страницу почти что) и в итоге он тормозил, хотел просто узнать у кого решение получше...
Всем спасибо!

Ahmad K © (29.06.03 04:59)

Неверно. Проверу нельзя делать. Иначе для слова из 15 разных букв придется долго ждать, пока произойдет проверка.

В твоем случае для удаления одинаковых вариантов нужно по другому сторить алгоритм, когда просто автоматически не будут генирироваться повторы.

Есть такой метод: перебор с отходом назад. Об этом методе смотри http://algolist.manual.ru/maths/combinat/sequential.php .

Что проверять. Если, например, у тебя в слове X[1]=X[3] и есть какой-то вариант P(X[3],a,b...) то при генерации варианта b<>X[1], потому что он был сгенерирован раннее.

> Bayer_Linse

Спасибо за ссылку обязательно прочитаю, но мне нужно пока только слово не длиннее 8 букв, поэтому пока мой вариант годится.
Еще раз спасибо!

> Bayer_Linse © (29.06.03 09:24)
> Ahmad K © (29.06.03 04:59)
>
> Неверно. Проверу нельзя делать. Иначе для слова из 15 разных
> букв придется долго ждать, пока произойдет проверка.
Ха ! Для слова из 15 разных букв ... Да всех наших винчестеров вместе взятых не хватит для хранения всех возможных вариантов от слова из 15 разных букв.

Задачка для мастеров Найти похожие ветки