Consultas, desarrollo de programas y petición de presupuestos:

lunes, 13 de junio de 2016

Shuffle (Barajar) aleatoriamente con el algoritmo Sattolo-Cycle un array en Gambas



Shuffle (Barajar) aleatoriamente

con el algoritmo Sattolo-Cycle  un array  en Gambas



Leyendo el artículo de Joedicastro (http://joedicastro.com/algoritmos-shuffle.html) sobre los distintos algoritmos de barajar arrays, donde define varios algoritmos, entre ellos el algoritmo Sattolo-Cycle:
"este algoritmo solo genera ciclos, de ahí su nombre. Es decir, reparte uniformemente los resultados solo entre algunas permutaciones que se van rotando (aunque comparte el mismo problema con los anteriores al depender de una aleatoriedad no perfecta). Para resumir su funcionamiento, lo que hace es que después de ejecutarlo, ningún elemento de la lista repite la posición anterior que tenía en la misma. Ese algoritmo fue publicado por Sandra Sattolo en 1986"

He aplicado dicho algoritmo a una función realizada en gambas, quedando el código siguiente:

' Gambas module file

Public Function barajar(listaOriginal As Variant[]) As Variant[]

Dim listatemporal As New Variant[]
Dim i, idx, sel As Integer

'1º asigna a la listaOriginal a la temporal
For i = 0 To listaOriginal.max
listatemporal.add(listaOriginal[i]) 'usa una lista temporal para no perder el orden original'
Next

'2º mezcla algoritmo Sattolo-Cycle
idx = listaOriginal.count

While idx > 1
idx = idx - 1
sel = Int(Rnd(0, idx))
Swap listatemporal[sel], listatemporal[idx] 'intercambio valores
Wend
Return listatemporal 'se devuelve la lista temporal que es la lista originnal mezclada


End

Como veis esta función recibe un array de elementos, como es variant[] admite arrays de todo tipo: int[],float[],string[], structure[], objet[] y por supuesto vaiant[], y devuelve ese array barajado.

Ejemplo:
Un pequeño ejemplo de aplicación de shuffle (o "barajar") es el siguiente, tenemos una lista de 5 cadenas: "0/4", "1/4", "2/4",  "3/4" y "4/4". Y queremos barajarlo varias veces.

Usaríamos este código:

Public Sub barajo()

Dim a As Integer
Dim lista As New String[]
Dim listaBarajada As String[]

Randomize

lista.Add("0/4")
lista.Add("1/4")
lista.Add("2/4")
lista.Add("3/4")
lista.Add("4/4")

TextLabel1.text = "-------- Inicialmente ----------" & "<br>"
For a = 0 To lista.Max
TextLabel1.text &= lista[a] & "<br>"
Next

listaBarajada = ModuleAzar.barajar(lista)
TextLabel1.text &= "-------- Barajo ----------" & "<br>"
For a = 0 To lista.Max
TextLabel1.text &= listaBarajada[a] & "<br>"
Next

TextLabel1.text &= "-------- Barajo ----------" & "<br>"
listaBarajada = ModuleAzar.barajar(listaBarajada) 'barajo sobre la lista bajada anteriormente, para no repetir posicion
For a = 0 To lista.Max
TextLabel1.text &= listaBarajada[a] & "<br>"
Next


End

El resultado seria:


Código fuente completo: enlace a google drive

En un próximo post, os presentaré un juego que hace uso de este algoritmo.

Fuentes:
http://joedicastro.com/algoritmos-shuffle.html

No hay comentarios:

Publicar un comentario en la entrada