Test Foro de elhacker.net SMF 2.1

Solo es un simple algoritmo para simplificación de números en un array!¡.

la idea es ingresar números y qué los Simplifique, es decir 1,2,3,4,5,9,10,15,16,17,18,555,342,423,422 los ordena de la siguiente manera:

1~5,9,10,15~18,555,342,423,422

si se integra un ordenamiento QuickSort (http://foro.elhacker.net/programacion_vb/source_ordenar_array_low_y_fast-t272312.0.html) ordenaría adecuadamente!¡.

OJO: NO Es RECOMENDABLE USARLO CON NÚMEROS DECIMALES!¡.



'
'   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Código siempre y cuando   //
'   // no se eliminen los créditos originales de este código   //
'   // No importando qué sea modificado/editado o engrandecido //
'   // o achicado, si es en base a este código                 //
'   /////////////////////////////////////////////////////////////
Option Explicit

Public Function GetSimplificNumbers(ByRef ArrayOfNumbers() As Variant) As String()
If (Not ArrayOfNumbers) = -1 Then Exit Function '   //  Array entrante, iniciado?.
Dim Lng_ArrayTmp$()                             '   //  Colección de Números Simplificados!¡.
Dim Lng_Ini&, Lng_End&, Lng_Index&              '   //  Variables para el Bucle.
Dim Lng_AntPosNumber&                           '   //  Indice del Numero anterior (Numero del Array entrante).
Dim Lng_ResNumber&                              '   //  residuo de Lng_Index& - Lng_AntPosNumber&.
Dim Lng_ArrayCount&                             '   //  Contador de las dimensiones de Lng_ArrayTmp$.
Dim Bool_Swith                  As Boolean      '   //  swith para saber si se debe simplificar!¡.

   '   //  Call Start_QuickSort(ArrayOfNumbers(), AcendetOrder)    '   //  http://foro.elhacker.net/programacion_vb/source_ordenar_array_low_y_fast-t272312.0.html
   
   Lng_Ini = LBound(ArrayOfNumbers):   Lng_End = UBound(ArrayOfNumbers)
   ReDim Lng_ArrayTmp$(Lng_ArrayCount&)
   Lng_ArrayTmp$(Lng_ArrayCount&) = ArrayOfNumbers(Lng_Index&)
   
   For Lng_Index& = Lng_Ini + 1 To Lng_End
       Lng_ResNumber& = ArrayOfNumbers(Lng_Index&) - ArrayOfNumbers(Lng_Index& - 1)
       If Lng_ResNumber& > 1 Then
           If Bool_Swith Then
               If Lng_AntPosNumber& > 2 Then
                   Lng_ArrayTmp$(Lng_ArrayCount&) = Lng_ArrayTmp$(Lng_ArrayCount&) & "~" & ArrayOfNumbers(Lng_Index& - 1)
               Else
                   Lng_ArrayCount& = Lng_ArrayCount& + 1
                   ReDim Preserve Lng_ArrayTmp$(Lng_ArrayCount&)
                   Lng_ArrayTmp$(Lng_ArrayCount&) = ArrayOfNumbers(Lng_Index& - 1)
               End If
           End If
           Lng_ArrayCount& = Lng_ArrayCount& + 1
           ReDim Preserve Lng_ArrayTmp$(Lng_ArrayCount&)
           Lng_ArrayTmp$(Lng_ArrayCount&) = ArrayOfNumbers(Lng_Index&)
           Bool_Swith = False
       ElseIf Lng_ResNumber& = 1 Then
           If Not Bool_Swith Then Lng_AntPosNumber& = 0
           Bool_Swith = True
           If Lng_Index& = Lng_End Then
               If conversion.cbool(InStr(1, Lng_ArrayTmp$(Lng_ArrayCount& - 1), "~")) Then
                   Lng_ArrayCount& = Lng_ArrayCount& + 1
                   ReDim Preserve Lng_ArrayTmp$(Lng_ArrayCount&)
                   Lng_ArrayTmp$(Lng_ArrayCount&) = ArrayOfNumbers(Lng_Index&)
               Else
                   Lng_ArrayTmp$(Lng_ArrayCount&) = Lng_ArrayTmp$(Lng_ArrayCount&) & "~" & ArrayOfNumbers(Lng_Index&)
               End If
           Else
               Lng_AntPosNumber& = Lng_AntPosNumber& + 1
           End If
       ElseIf Lng_ResNumber& = 0 Then
           If Lng_AntPosNumber& > 0 Then
               Lng_AntPosNumber& = Lng_AntPosNumber& + 1
           Else
               Lng_AntPosNumber& = 0
           End If
       End If
   Next
   GetSimplificNumbers = Lng_ArrayTmp$
End Function



Ejemplo:



Public Function NumeroAleatorio(MinNum As Long, MaxNum As Long) As Long
Dim Tmp                                 As Long
   If MaxNum < MinNum Then: Tmp = MaxNum: MaxNum = MinNum: MinNum = Tmp
   Randomize: NumeroAleatorio = (MinNum - MaxNum + 1) * Rnd + MaxNum
End Function

Sub main()
Dim ArrayTmp() As Variant
Dim i&, i2&
   i& = 100
   ReDim ArrayTmp(i&)
   For i2& = 0 To i&
       ArrayTmp(i2&) = CStr(NumeroAleatorio(5, 99))
   Next
   Call Start_QuickSort(ArrayTmp(), AcendetOrder) '   //  http://foro.elhacker.net/programacion_vb/source_ordenar_array_low_y_fast-t272312.0.html
   Call MsgBox(Strings.Join(GetSimplificNumbers(ArrayTmp), ","))
End Sub



Alternativas:
http://foro.elhacker.net/programacion_visual_basic/src_abbreviatenumericarray_by_psyke1-t298689.0.html

P.D.: No escribí los números yo en Array fueron generados aleatoria-mente!¡.

Sangriento Infierno Lunar!¡.

Cita de: BlackZeroX▓▓▒▒░░ en  5 Julio 2010, 23:09 PM
P.D.: No escribí los números yo en Array fueron generados aleatoria-mente!¡.

Hubiera sido lindo que el array se generara consecutiva y aleatoriamente ;)



Public Function NumeroAleatorio(MinNum As Long, MaxNum As Long) As Long
Dim Tmp                                 As Long
   If MaxNum < MinNum Then: Tmp = MaxNum: MaxNum = MinNum: MinNum = Tmp
   Randomize: NumeroAleatorio = (MinNum - MaxNum + 1) * Rnd + MaxNum
End Function

Sub main()
Dim ArrayTmp() As Variant
Dim i&, i2&
   i& = 100
   ReDim ArrayTmp(i&)
   For i2& = 0 To i&
       ArrayTmp(i2&) = CStr(NumeroAleatorio(5, 99))
   Next
   Call Start_QuickSort(ArrayTmp(), AcendetOrder) '   //  http://foro.elhacker.net/programacion_vb/source_ordenar_array_low_y_fast-t272312.0.html
   Call MsgBox(Strings.Join(GetSimplificNumbers(ArrayTmp), ","))
End Sub



Sangriento Infierno Lunar!¡.

Muy buena Black!!! ;-)
Y encima es el doble de rapida que la mia... :-\

Dulces Ranas¡! :)