"Jimmy" <spoerg@efter.den> wrote in message
news:9i%q9.84$6T.2004@news.get2net.dk...
> Jeg skal lave mig et stykke kode, som udskriver samtlige kombinationer af
en
> række input.
> Vi kunne eks. have "a", "b" og "c".
> Det ville kunne resultere i
>
> abc
> acb
> bac
> bca
> cab
> cba
Hej Jimmy
Jeg synes din opgave var en sjov lille udfordring så jeg har lavet koden,
den fungerer rekursivt.
Resultatet er et array af arrays af strings, så jeg har levet en lille
funktion til at udskrive den datastruktur (WriteArrayArray), resten af koden
har kommentare der burde være mulige at gennemskue hvis du har arbejdet med
rekursion før.
Koden kan optimeres, men det ville være noget nemmere at gøre i et "Rigtigt"
programmeringssprog fordi VBScript er meget tungt at arbejde med når det
kommer til advancerede datastrukture, derudover begynder det også at slå
igennem at det er et fortolket sprog hvis du skal lave "større"
kombinationer. Tidskompleksiteten er O(N! * N), den burde kunne reduceres
til noget i stil med O(N!*Log(N)), som stadig er ret slem, men der opstår jo
hurtigt mange kombinationer og du skal bruge dem allesammen ikke. Hvis du
bare skal checke om en enkelt given kombination er mulig givet en række data
kan du sikkert lave noget der er O(N*Log(N)) el. lig.
For at udregne factorial har jeg brugt den simple rekursive implementation,
den er ikke effektiv hvis du skal arbejde med store datasæt kan denne
optimeres:
http://www.luschny.de/math/factorial/FastFactorialFunctions.htm
En sidste kommentar: Jeg går ud fra at alle arrays er 0 (nul) indekseret.
Nå nok snak, her er koden:
Dim aIn, aOut
aIn = Array("a", "b", "c", "d")
aOut = CrossJoin(aIn)
Response.Write "Result:<br>"
call WriteArrayArray(aOut)
function CrossJoin(ByVal paIn)
Dim aShortIn, strLastElement, aCombine, aOut, intInLength, aTmp, i, j, k, l
intInLength = (UBound(paIn)-LBound(paIn)+1) 'get length og array
'with an empty array we do not know what to return
if intInLength<=0 then exit function
'with an array of length 1 we return the array
if intInLength = 1 then
aOut = Array(paIn)
else
'with an array og length 2 or greater we calculate the combinations
recursively
'create an array with room for all the combinations
Redim aOut(factorial(intInLength)-1)
'get last element
strLastElement = paIn(UBound(paIn))
'remove last element
aShortIn = paIn
Redim Preserve aShortIn(intInLength-2)
'get all combinations for array without last element
aCombine = CrossJoin(aShortIn)
'for each combination for array without last element...
m=0
Redim aTmp(intInLength-1)
for i=0 to UBound(aCombine)
'...insert lastelement into combination at every possible position
for j=0 to (UBound(aCombine(i))+1)
'generate array with lastelement at at the j'th position
for k=0 to UBound(aCombine(i))+1
if k<j then
aTmp(k) = aCombine(i)(k)
elseif k>j then
aTmp(k) = aCombine(i)(k-1)
else
aTmp(k) = strLastElement
end if
next
aOut(m) = aTmp
m = m+1
next
next
end if
CrossJoin = aOut
end function
Function factorial(n)
dim i, intOut
intOut = 1
for i = 1 to n
intOut = intOut * i
next
factorial = intOut
End Function
Function WriteArrayArray(paaIn)
Dim i
for i=0 to UBound(paaIn)
Response.Write i & " : " & Join((paaIn(i)), ",") & "<br>"
next
End function