:: Игры Разума
Задача о перестановках
medstrax
Забанен
Автор

Сообщений: 5964
Дата регистрации: 23.03.2007
Пусть есть некий массив элементов.Задача - составить все возможные сочетания этих элементов.
Возможно я не правильно выражаюсь, но суть в том - пусть есть массив 1 2 3, на выходе должно-
123
132
132
231
213
312
321

Размерность массива значения не имеет, пксть она будет ограничена только объемом оперативы
Ваш код?



Исправлено 1 раз(а). Последнее : medstrax, 12.12.09 21:13
Ratings: 0 negative/0 positive
Re: Задача о перестановках
ssa

Сообщений: 12999
Откуда: Москва
Дата регистрации: 23.03.2005
Create Table test (f1 int AUTOINC)
Append Blank
Browse
Select * from test as t1, test as t2, test as t3


------------------
Лень - это неосознанная мудрость.
Ratings: 0 negative/0 positive
Re: Задача о перестановках
Mitchman

Сообщений: 9978
Откуда: Николаев
Дата регистрации: 24.05.2002
тогда уж из условия задачи
Select * from test as t1, test as t2, test as t3 Where Not(t1.f1=t2.f1 or t1.f1=t3.f1 or t2.f1=t3.f1)

ну и аппенд три раза в начале провторить


------------------
-
«свидомые украинцы озабочены не столько созданием украинской культуры, сколько уничтожением русской»
-
Олесь Бузина
Ratings: 0 negative/0 positive
Re: Задача о перестановках
medstrax
Забанен
Автор

Сообщений: 5964
Дата регистрации: 23.03.2007
ммм, я имел в виду случай, когда размерность произвольная
Ratings: 0 negative/0 positive
Re: Задача о перестановках
matod

Сообщений: 3062
Откуда: Иркутск
Дата регистрации: 31.10.2001
Вот что у себя нашел. Вроде работает

* Формирование всех перестановок из N элементов
* Программа использует известный алгоритм генерирования перестановок
* (http://defacto.examen.ru/db/ExamineBase/catdoc_id/6D6490394EDD25D8C3256B490039DF40/rootid/9327995FB7A6D40FC3256A02002CE0D5/defacto.html)
* Массив а содержит текущую перестановку,
* Алгоритм легко модифицируется при изменении размерности матрицы и переносим на другие языки
LOCAL a(1), mx, t, k1, k2, i, j, N
mx = 0
s1 = seconds()
*-- начальная комбинация - массив заполняется цифрами от 0 до m.N-1
N = 3 && Размерность
DIMENSION a(m.N)
for i=1 to m.N
a(i) = i-1
endfor
*-- Последовательный перебор комбинаций
do while .t.
* Здесь что-то делаем с полученной перестановкой, например выводим
?''
FOR i=1 TO m.N
??a(m.i)
ENDFOR
*-- формирование комбинации
*-- ищем с конца первый эл-т, меньший следующего
for i=m.N-1 to 1 step -1
if a(m.i)<a(m.i+1)
EXIT
endif
endfor
if m.i=0
EXIT && Все комбинации исчерпаны
endif
*-- ищем в остатке первый с конца, превосходящий найденый
for m.j=m.N to m.i+1 step -1
if a(m.j)>a(m.i)
EXIT
endif
endfor
*-- переставляем их местами
t = a(m.j)
a(m.j)=a(m.i)
a(m.i)=t
*-- упорядочиваем хвост в порядке возрастания
k2 = INT((m.N-m.i)/2)
FOR k1=1 TO m.k2
t = a( m.i+ m.k1)
a(m.i+m.k1)=a(m.N+1-m.k1)
a(m.N+1-m.k1)= t
endfor
ENDDO
* вывод результатов
s2=seconds()
Ratings: 0 negative/0 positive
Re: Задача о перестановках
leonid

Сообщений: 3202
Откуда: Рига
Дата регистрации: 03.02.2006
perestanovki('12345', 'result')
select result
browse
function perestanovki
lparameter m.str, m.alias
create cursor (m.alias) (f1 C(7))
if len(m.str)<=1
insert into (m.alias) values (m.str)
return
endif
local m.i, m.al, m.ch, m.sub
for i = 1 to len(m.str)
m.al="f"+substr(sys(2015), 3, 10)
m.ch=substr(m.str,i,1)
m.sub=stuff(m.str,i,1,"")
perestanovki(m.sub, m.al)
select * from (m.alias) union select padr(m.ch+f1,7) as f1 from (m.al) into cursor (m.alias)
use in select(m.al)
next
Ratings: 0 negative/0 positive
Re: Задача о перестановках
sphinx

Сообщений: 31166
Откуда: Каменск-Уральски
Дата регистрации: 22.11.2006
Леонид, проверьте на 9 элементах


------------------
"Veni, vidi, vici!"(с)
Ratings: 0 negative/0 positive
Re: Задача о перестановках
leonid

Сообщений: 3202
Откуда: Рига
Дата регистрации: 03.02.2006
sphinx
Леонид, проверьте на 9 элементах
Я там поставил С(7) потому, что у меня уже с 8-ью оперативки не хватало. С бесконечной оперативкой будет на любом количестве элементов работать.
Ratings: 0 negative/0 positive
Re: Задача о перестановках
sphinx

Сообщений: 31166
Откуда: Каменск-Уральски
Дата регистрации: 22.11.2006
Да, извините, размерность поля не учел. Потестирую на разном количестве элементов, но думаю, все должно работать.


------------------
"Veni, vidi, vici!"(с)
Ratings: 0 negative/0 positive
Re: Задача о перестановках
medstrax
Забанен
Автор

Сообщений: 5964
Дата регистрации: 23.03.2007
Леонид, ок, зачет, работает.
В силу своего незнания фокса и скуля к сожалению не могу оценить.
Имхо, алго, работающий без применения селектов и курсоров, был бы ценней
Ratings: 0 negative/0 positive
Re: Задача о перестановках
sphinx

Сообщений: 31166
Откуда: Каменск-Уральски
Дата регистрации: 22.11.2006
Разделителя для больших чисел нет - но, думаю, это и не есть проблема. ;)


------------------
"Veni, vidi, vici!"(с)
Ratings: 0 negative/0 positive
Re: Задача о перестановках
Mitchman

Сообщений: 9978
Откуда: Николаев
Дата регистрации: 24.05.2002
Local lcChars, liString
* где lcChars - массив для заполнения liString - длина поля заполнения(без повторов)
liString=3
lcChars="1234"
Local liChars, liLen,liI
liChars=Len(lcChars)
If liString>liChars
liString=liChars
EndIf
liLen=Fact(liChars)/Fact(liChars-liString)
Local laString(liLen)
Rasm(lcChars,liString,@laString)
? "Размещение ", lcChars, " по ", liString ," местам"
For liI=1 to liLen
? laString(liI)
EndFor
liLen=Fact(liChars)
Local laString(liLen)
Perest(lcChars,@laString)
? ""
? "Перестановка ", lcChars
For liI=1 to liLen
? laString(liI)
EndFor
Function Fact
LParameters tiI
Local liI, liFact
liFact=1
For liI=2 To tiI
liFact=liFact*liI
EndFor
Return liFact
*вот в принципе функция размещения
Function Rasm
LParameters tcChars,tiString,taString,tiStart,tcString
If Parameters()<4
tiStart=0
tcString=""
EndIf
Local liChars, lcChars, lcFirst, liI
liChars=Len(tcChars)
If liChars>1
For liI=1 to liChars
lcFirst=Substr(tcChars,liI,1)
lcChars=Chrtran(tcChars,lcFirst,"")
If tiString>1
tiStart=Rasm(lcChars,tiString-1,@taString,tiStart,tcString+lcFirst)
Else
tiStart=tiStart+1
taString(tiStart)=tcString+lcFirst
EndIF
EndFor
Else
tiStart=tiStart+1
taString(tiStart)=tcString+tcChars
EndIf
Return tiStart
*вот в принципе функция перестановки
Function Perest
LParameters tcChars,taString,tiStart,tcString
If Parameters()<3
tiStart=0
tcString=""
EndIf
Local liChars, lcChars, lcFirst, liI
liChars=Len(tcChars)
If liChars>1
For liI=1 to liChars
lcFirst=Substr(tcChars,liI,1)
lcChars=Chrtran(tcChars,lcFirst,"")
tiStart=Perest(lcChars,@taString,tiStart,tcString+lcFirst)
EndFor
Else
tiStart=tiStart+1
taString(tiStart)=tcString+tcChars
EndIf
Return tiStart

еще с Сей люблю рекурсию - жаль в фоксе такое лучше не применять - бо ограничения есть - акромя памяти

да в случае если символы в первоночальном наборе могут повториться - нать поменять строчку lcChars=Chrtran(tcChars,lcFirst,"") на lcChars=Left(tcChars,liI-1)+Substr(tcChars,liI+1)


------------------
-
«свидомые украинцы озабочены не столько созданием украинской культуры, сколько уничтожением русской»
-
Олесь Бузина




Исправлено 2 раз(а). Последнее : Mitchman, 13.12.09 15:00
Ratings: 0 negative/0 positive
Re: Задача о перестановках
medstrax
Забанен
Автор

Сообщений: 5964
Дата регистрации: 23.03.2007
leonid
sphinx
Леонид, проверьте на 9 элементах
Я там поставил С(7) потому, что у меня уже с 8-ью оперативки не хватало.
Налицо утечка памяти, простые расчеты показывают - 7 байт(на хранение престановки, юникод не учитываем) х 7! (число перестановок)... Где то глюк...



Исправлено 1 раз(а). Последнее : medstrax, 13.12.09 14:54
Ratings: 0 negative/0 positive
Re: Задача о перестановках
sphinx

Сообщений: 31166
Откуда: Каменск-Уральски
Дата регистрации: 22.11.2006
Возможно, на Си память расходуется рациональнее...


------------------
"Veni, vidi, vici!"(с)
Ratings: 0 negative/0 positive
Re: Задача о перестановках
medstrax
Забанен
Автор

Сообщений: 5964
Дата регистрации: 23.03.2007
В алго вроде бы глюка не видно,
что творит компилятор - хз
Ratings: 0 negative/0 positive
Re: Задача о перестановках
sphinx

Сообщений: 31166
Откуда: Каменск-Уральски
Дата регистрации: 22.11.2006
Интерпретатор ;)


------------------
"Veni, vidi, vici!"(с)
Ratings: 0 negative/0 positive
Re: Задача о перестановках
leonid

Сообщений: 3202
Откуда: Рига
Дата регистрации: 03.02.2006
medstrax
Имхо, алго, работающий без применения селектов и курсоров, был бы ценней
Можно и с массивами.
local ar(1)
perestanovki('123456789', @ar)
create cursor result (f1 C(20))
for i = 1 to alen(ar, 1)
insert into result values (ar(i))
next
browse
function perestanovki
lparameter m.str, ar
dimension ar(fact(len(m.str)))
if len(m.str)<=1
ar(1)=m.str
return
endif
local m.i, m.j, m.fc, m.ch, m.sub, ar2(1)
m.fc = fact(len(m.str)-1)
for i = 1 to len(m.str)
m.ch=substr(m.str,i,1)
m.sub=stuff(m.str,i,1,"")
perestanovki(m.sub, @ar2)
for j = 1 to alen(ar2, 1)
ar( m.fc*(i-1)+j) = m.ch+ar2(j)
next
next
function fact
lparameter m.n
if m.n=0
return 1
else
return fact(m.n-1)*m.n
endif
Ratings: 0 negative/0 positive
Re: Задача о перестановках
Mitchman

Сообщений: 9978
Откуда: Николаев
Дата регистрации: 24.05.2002
leonid
Можно и с массивами.

пракктически от мово не отличается - чуть выше


------------------
-
«свидомые украинцы озабочены не столько созданием украинской культуры, сколько уничтожением русской»
-
Олесь Бузина
Ratings: 0 negative/0 positive
Re: Задача о перестановках
medstrax
Забанен
Автор

Сообщений: 5964
Дата регистрации: 23.03.2007
Код хорош, пара нюансов - for i = 1 to len(m.str)
не стоит так делать, вычисление счетчика лучше вынести из цикла.
И функа fact - вычисление факториала лучше делать в цикле, рекурсия не самый быстрый метод
Ratings: 0 negative/0 positive
Re: Задача о перестановках
Влад Колосов

Сообщений: 22664
Откуда: Ростов-на-Дону
Дата регистрации: 05.05.2005
Полагаю это можно сделать рекурсией, указав глубину рекурсии и диапазоны значений.


------------------
Совершенство - это не тогда, когда нельзя
ничего прибавить, а тогда, когда нечего убавить.
Ratings: 0 negative/0 positive


Извините, только зарегистрированные пользователи могут оставлять сообщения в этом форуме.

On-line: 3 (Гостей: 3)

© 2000-2024 Fox Club 
Яндекс.Метрика