Otro reto; A ver quien hace la funcion de factorizacion mas rapida :)
Se trata de crear una funcion que factorice cualquier numero entero positivo...
La funcion ha de devolver un Collection con todos los numeros primos que componen ese numero
Para medir el tiempo necesario se utilizará este codigo:
Private tmr As CTiming
Private Sub Form_Load()
Dim x As Long
Dim vItem As Variant
Set tmr = New CTiming
tmr.Reset
For x = 0 To 4096
'Debug.Print x, ;
'For Each vItem In iFactorize(x)
' Debug.Print vItem;
'Next vItem
'Debug.Print
Call iFactorize(x)
Next x
MsgBox tmr.sElapsed
End Sub
cTiming.cls (http://www.xbeat.net/vbspeed/download/CTiming.zip)
+Info
http://en.wikipedia.org/wiki/Integer_factorization
http://es.wikipedia.org/wiki/Factorizaci%C3%B3n_de_enteros
Suerte, espero que participeis muchos :P
v0.1:
Mi funcion tarda: 17,462 msec (Probado compilado, en un procesador de ***** :xD)
Public Function iFactorize(ByVal n As Long) As Collection
Dim cTmp As New Collection
Dim i As Long
Dim lSqrt As Long
If Not n > 0 Then GoTo Ret
lSqrt = Sqr(n)
For i = 2 To lSqrt
If n Mod i = 0 Then
Set cTmp = iFactorize(n / i)
cTmp.Add i
GoTo Ret
End If
Next i
cTmp.Add n
Ret: Set iFactorize = cTmp
End Function
:D
v0.2:
Public Function iFactorize(ByVal n As Long) As Collection
Dim cTmp As New Collection
Dim i As Long
If n = 0 Then GoTo Ret
If n = 1 Then cTmp.Add 1: GoTo Ret
While (n And 1) = 0
cTmp.Add 2
n = n / 2
Wend
i = 3
While (i <= (n ^ 0.5))
If (n Mod i) = 0 Then
cTmp.Add i
n = n / i
End If
i = i + 2
Wend
If n > 1 Then cTmp.Add n
Ret: Set iFactorize = cTmp
End Function
Ok, me apunto, pero tiene que ser con Collections a la fuerza¿? :-\
DoEvents¡! :P
Compilado!¡ 8,817 ms Proc: 2.2Ghz One Core!¡... no es una collection xP
Public Function FactorizadorBlackZeroX(ByVal vNumber As Long) As String
Dim i As Long
If vNumber < 0 Then Exit Function
For i = 2 To Sqr(vNumber)
If vNumber Mod i = 0 Then
FactorizadorBlackZeroX = FactorizadorBlackZeroX(vNumber / i) & "," & i
Exit Function
End If
Next i
FactorizadorBlackZeroX = vNumber
End Function
Source Test:
Option Explicit
Private tmr As CTiming
Private Sub Form_Load()
Dim x As Long
Dim vItem As Variant
Const limit = 5000
Dim TestResults$
Set tmr = New CTiming
tmr.Reset
For x = 0 To limit
Call FactorizadorBlackZeroX(x)
Next x
TestResults$ = "FactorizadorBlackZeroX " & tmr.sElapsed
tmr.Reset
For x = 0 To limit
Call iFactorize2(x)
Next x
Call MsgBox(TestResults$ & vbCrLf & "iFactorize2: " & tmr.sElapsed)
End Sub
Sangriento Infierno Lunar!¡.
Se me olvido preguntar la cosa es llegar el menor consumo de procesador?, se vale cualquier maña?...
Dulces Lunas!¡.
La cosa es hacerlo mas rapido posible y hacerlo con COLLECTIONS!! que es la mejor forma de trabajar mas tarde que lo que retorna la funcion...
Tu codigo en mi procesador en el mejor de los casos tarda: 21,551 msec
.
Extraño a mi el tuyo me tardo 11.850 ms; creo qué alguien mas debería de hacer los test... Moderador!¡.
Dulces Lunas!¡.
Hola BlackZeroX
Soy nuevo y sé poco.
Perdona, solo he modificado un poco tu codigo.......
Public Function FactorizadorBlackZeroX(ByVal vNumber As Long) As String
Dim i As Long
Dim TmpArray() As Long
If vNumber < 0 Then Exit Function
If vNumber Mod 2= 0 Then
FactorizadorBlackZeroX = FactorizadorBlackZeroX(vNumber / 2) & "," & 2
Exit Function
End If
For i = 3 To Sqr(vNumber) step 2
If vNumber Mod i = 0 Then
FactorizadorBlackZeroX = FactorizadorBlackZeroX(vNumber / i) & "," & i
Exit Function
End If
Next i
FactorizadorBlackZeroX = vNumber
End Function
Espero que sirva...................
Un saludo a los dos
Compilado:
FactorizadorBlackZeroX: 9.826 msec
iFactorize: 11.000 msec
FactorizadorFFernandez: 8.848 msec
Option Explicit
Private tmr As CTiming
Private Sub Form_Load()
Dim x As Long
Dim vItem As Variant
Const limit = 5000
Dim TestResults$(2)
Set tmr = New CTiming
tmr.Reset
For x = 0 To limit
Call FactorizadorBlackZeroX(x)
Next x
TestResults$(0) = tmr.sElapsed
tmr.Reset
For x = 0 To limit
Call iFactorize(x)
Next x
TestResults$(1) = tmr.sElapsed
tmr.Reset
For x = 0 To limit
Call FactorizadorFFernandez(x)
Next x
TestResults$(2) = tmr.sElapsed
MsgBox "FactorizadorBlackZeroX: " & TestResults$(0) & vbCrLf & _
"iFactorize: " & TestResults$(1) & vbCrLf & _
"FactorizadorFFernandez: " & TestResults$(2)
End Sub
Public Function iFactorize(ByVal n As Long) As Collection
Dim cTmp As New Collection
Dim i As Long
Dim lSqrt As Long
If Not n > 0 Then GoTo Ret
lSqrt = Sqr(n)
For i = 2 To lSqrt
If n Mod i = 0 Then
Set cTmp = iFactorize(n / i)
cTmp.Add i
GoTo Ret
End If
Next i
cTmp.Add n
Ret: Set iFactorize = cTmp
End Function
Public Function FactorizadorFFernandez(ByVal vNumber As Long) As String
Dim i As Long
If vNumber <= 0 Then Exit Function
If vNumber Mod 2 = 0 Then
FactorizadorFFernandez = FactorizadorFFernandez(vNumber / 2) & "," & 2
Exit Function
End If
For i = 3 To Sqr(vNumber) Step 2
If vNumber Mod i = 0 Then
FactorizadorFFernandez = FactorizadorFFernandez(vNumber / i) & "," & i
Exit Function
End If
Next i
FactorizadorFFernandez = vNumber
End Function
Public Function FactorizadorBlackZeroX(ByVal vNumber As Long) As String
Dim i As Long
If vNumber < 0 Then Exit Function
For i = 2 To Sqr(vNumber)
If vNumber Mod i = 0 Then
FactorizadorBlackZeroX = FactorizadorBlackZeroX(vNumber / i) & "," & i
Exit Function
End If
Next i
FactorizadorBlackZeroX = vNumber
End Function
Vuestras funciones no cumplen el requisito de devolver Collections! Asi que yo gano ::) (:P :rolleyes:)
.
Las colecciones jamas me han convencido las veo lentas ¬¬" >:D mejor un Array vale :xD >:D
Dulces Lunas!¡.
He actualizado mi codigo! ;) , no me ha dado tiempo a comprobar la velocidad, doy por hecho que es mas rapida porque no es recursiva :-\
Lo de las collections es el requisito basico para el reto...
Karcrack y a TODOS me gustarian que pongan las caracteristicas de la maquina donde estan probando, procesador y RAM, como para ver en que condiciones se esta probando, yo pruebo el ejemplo de Karcrack compilado obviamente y me da 4 veces mas de tiempo del que pusiste, es una notebook Intel Core 2 Duo 2Ghz y 3 GB de ram, o sea es una "buena" maquina. lo de las Collections quedo claro, BlackZeroX hacelo con Collections, debe haber miles de ejemplos mas rapidos con arrays, pero tiene que devolver lo que se dijo en el primer post y hay que cumplir las reglas :xD
Por decirlo de una forma suave y que se entienda, lo de los collections es porque me sale de los huevos >:D :laugh: :laugh: :laugh:
Pues en el portatil que lo probe tiene un Mobile Intel Pentium M LV, 1200 MHz (12 x 100) y 512MB de RAM... Una mierdecilla...
Hay va la mia
Public Function FactorizeS(ByVal S As Long) As Collection
Dim cTmp As New Collection
Dim I As Long
If S <= 0 Then GoTo Ret
If S = 1 Then cTmp.Add 1: GoTo Ret
For I = 2 To Sqr(S)
If S Mod I = 0 Then
cTmp.Add I
End If
I = I + 2
Next I
Ret: Set FactorizeS = cTmp
End Function
Claro casimente es una mejora a las otras funciones pero es mas rapida ;D
Hola Angeldj27
Prueba factorizar el nº 49.
Un saludo