Foro de elhacker.net

Programación => Programación Visual Basic => Mensaje iniciado por: Psyke1 en 23 Enero 2013, 12:15 pm


Título: [RETO] Project Euler 1
Publicado por: Psyke1 en 23 Enero 2013, 12:15 pm
¿Qué os parece si hacemos todos los retos de Proyect Euler (http://projecteuler.net) ?
Después se podría poner una chincheta con todos los ejercicios guardados. :)

¿Empezamos por el 1?
Código:
http://projecteuler.net/problem=1

DoEvents! :P

Título: Re: [RETO] Proyect Euler 1
Publicado por: Danyfirex en 23 Enero 2013, 12:24 pm
me parece excelente.  ;D
Aqui tienes a un participante. Por cierto pésimo en matemáticas. jajajaja

EDITO:

segun el problema dice esto.

If we list all the natural numbers below 10 that are multiples of 3 or 5, we get 3, 5, 6 and 9. The sum of these multiples is 23.

Find the sum of all the multiples of 3 or 5 below 1000.

según lo que se 10 es divisible entre 5.

entonces la suma seria 33. o no ?


EDITO. 1


Si esta bien no leí la palabra below.

saludos


EDITO: 2

Aquí esta el mio.



Código
  1. Private Sub Form_Load()
  2. Dim resultado As Long
  3. Dim i As Integer
  4. Dim d1, d2 As Boolean
  5. For i = 1 To 999
  6. d1 = CBool((i / 3) = Int(i / 3))
  7. d2 = CBool((i / 5) = Int(i / 5))
  8. If d1 Or d2 Then
  9. resultado = resultado + i
  10. End If
  11. Next i
  12. MsgBox (resultado)
  13. End Sub


Como Funcion para un Numero dado.

Código
  1. Function mul_3_5(Numero As Long) As Long
  2. Dim resultado As Long
  3. Dim i As Integer
  4. Dim d1, d2 As Boolean
  5. For i = 1 To Numero
  6. d1 = CBool((i / 3) = Int(i / 3))
  7. d2 = CBool((i / 5) = Int(i / 5))
  8. If d1 Or d2 Then
  9. resultado = resultado + i
  10. End If
  11. Next i
  12. mul_3_5 = (resultado)
  13. End Function

saludos

Título: Re: [RETO] Proyect Euler 1
Publicado por: 79137913 en 23 Enero 2013, 14:17 pm
HOLA!!!

Dany, yo que vos busco sobre optimizacion de codigo.

Código
  1. Private Function mul5and3below1000() As Long
  2.     Dim ct As Long
  3.     Dim aux As Long
  4.     Do
  5.         mul5and3below1000 = mul5and3below1000 + aux + aux2
  6.         ct = ct + 1
  7.         aux = ct + ct + ct
  8.         aux2 = ct + ct + ct + ct + ct
  9.     Loop While aux2 < 1000
  10.     Do
  11.         mul5and3below1000 = mul5and3below1000 + aux
  12.         ct = ct + 1
  13.         aux = ct + ct + ct
  14.     Loop While aux < 1000
  15.     ct = 0
  16.     aux = 0
  17.     Do
  18.         mul5and3below1000 = mul5and3below1000 - aux
  19.         ct = ct + 1
  20.         aux = ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct
  21.     Loop While aux < 1000
  22. End Function

GRACIAS POR LEER!!!

Título: Re: [RETO] Proyect Euler 1
Publicado por: Danyfirex en 23 Enero 2013, 15:27 pm
Cita de: 79137913 en 23 Enero 2013, 14:17 pm
HOLA!!!
Dany, yo que vos busco sobre optimizacion de codigo.

gracias por el Consejo.

Codigo optimizado:

Código
  1. Function mul_3_5() As Long
  2. Dim i As Integer
  3. For i = 1 To 999
  4. If (i Mod 3) < 1 Or (i Mod 5) < 1 Then
  5. mul_3_5 = mul_3_5 + i
  6. End If
  7. Next i
  8. End Function

Saludos

Título: Re: [RETO] Proyect Euler 1
Publicado por: 79137913 en 23 Enero 2013, 16:29 pm
HOLA!!!

Bueno, mejoraste el largo del codigo y un poco la velocidad esta bien, pero mira el mio y tu codigo.

Podras observar que en mi codigo funciona haciendo sumas de los casos positivos dentro de el campo muestral (1-999) y quitando al final las superposiciones mientras que el tuyo lo que hace es analizar una por una todas las probabilidades y extraer de ellas las que cumplen las condiciones. la cantidad de vueltas del primer bucle es de 200 , el segundo 133 y el tercero 66, dando un total de 399 vueltas muchas menos que en tu codigo de 999.

En definitiva tu codigo hace prueba y error, el mio une los 2 grupos de multiplos y quita los repetidos.

P.d: Eso que hago de ct + ct + ct es lo mismo que ct *3 pero es mas rapido para que lo tengas en cuenta.

GRACIAS POR LEER!!!

Título: Re: [RETO] Proyect Euler 1
Publicado por: $Edu$ en 23 Enero 2013, 16:42 pm
Me instalaria el visual basic especialmente para esos retos xD Pero podrias traducirlos y plantear el ejercicio como haces siempre Psyke? asi nadie se confunde traduciendo y terminamos haciendo todos cosas distintas jaja, y ademas de que esta bueno cuando pones como queres la funcion y ejemplos de valores que retornara.

Título: Re: [RETO] Proyect Euler 1
Publicado por: Danyfirex en 23 Enero 2013, 16:45 pm
Cita de: 79137913 en 23 Enero 2013, 16:29 pm
HOLA!!!

Bueno, mejoraste el largo del codigo y un poco la velocidad esta bien, pero mira el mio y tu codigo.

Podras observar que en mi codigo funciona haciendo sumas de los casos positivos dentro de el campo muestral (1-999) y quitando al final las superposiciones mientras que el tuyo lo que hace es analizar una por una todas las probabilidades y extraer de ellas las que cumplen las condiciones. la cantidad de vueltas del primer bucle es de 200 , el segundo 133 y el tercero 66, dando un total de 399 vueltas muchas menos que en tu codigo de 999.

En definitiva tu codigo hace prueba y error, el mio une los 2 grupos de multiplos y quita los repetidos.

P.d: Eso que hago de ct + ct + ct es lo mismo que ct *3 pero es mas rapido para que lo tengas en cuenta.

GRACIAS POR LEER!!!

Claro pero si te fijas en tu código haciendo tantas sumas pierdes velocidad. si te fijas en el tiempo aun mi función con 999 repeticiones es un 30% o 40%  mas rápida que la tuya.

Edito: un 20% o 10%



Título: Re: [RETO] Proyect Euler 1
Publicado por: 79137913 en 23 Enero 2013, 17:09 pm
HOLA!!!

Eso que me decis me deja atonito...

Hice los testeos y los acabe de realizar nuevamente, tu funcion es aprox 100% mas lenta que la mia ( y siendo generoso 100%), proba con este ejemplo que arme para medir el timing, acordate que se testea compilado.

(borre el codigo por que lo hizo E_C abajo.

GRACIAS POR LEER!!!

Título: Re: [RETO] Proyect Euler 1
Publicado por: Elemental Code en 23 Enero 2013, 17:29 pm
Código
  1. Private Sub Form_Load()
  2.     Form1.Show
  3.     Form1.AutoRedraw = True
  4.     MsgBox "empezara luego del ok"
  5.     t = Timer
  6.     For x = 0 To 100000
  7.         Call mul5and3below1000
  8.     Next
  9.     Form1.Print "tiempo 7913 " & Timer - t
  10.     Form1.Print "resultado 7913 " & mul5and3below1000
  11.     t = Timer
  12.     For x = 0 To 100000
  13.         Call mul_3_5
  14.     Next
  15.     Form1.Print "Tiempo dany " & Timer - t
  16.     Form1.Print "Resultado dani " & mul_3_5
  17. End Sub
  18. Private Function mul5and3below1000() As Long
  19.    Dim ct As Long
  20.    Dim aux As Long
  21.    Do
  22.        mul5and3below1000 = mul5and3below1000 + aux + aux2
  23.        ct = ct + 1
  24.        aux = ct + ct + ct
  25.        aux2 = ct + ct + ct + ct + ct
  26.    Loop While aux2 < 1000
  27.    Do
  28.        mul5and3below1000 = mul5and3below1000 + aux
  29.        ct = ct + 1
  30.        aux = ct + ct + ct
  31.    Loop While aux < 1000
  32.    ct = 0
  33.    aux = 0
  34.    Do
  35.        mul5and3below1000 = mul5and3below1000 - aux
  36.        ct = ct + 1
  37.        aux = ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct
  38.    Loop While aux < 1000
  39. End Function
  40.  
  41. Function mul_3_5() As Long
  42. Dim i As Integer
  43. For i = 1 To 999
  44. If (i Mod 3) < 1 Or (i Mod 5) < 1 Then
  45. mul_3_5 = mul_3_5 + i
  46. End If
  47. Next i
  48. End Function

Ok, con esta funcion de testeo los resultados mios son:
(http://s14.postimage.org/jnu95aarx/Tiempos.png)

Título: Re: [RETO] Proyect Euler 1
Publicado por: Danyfirex en 23 Enero 2013, 17:51 pm
Cita de: 79137913 en 23 Enero 2013, 17:09 pm
HOLA!!!

Eso que me decis me deja atonito...

Hice los testeos y los acabe de realizar nuevamente, tu funcion es aprox 100% mas lenta que la mia ( y siendo generoso 100%), proba con este ejemplo que arme para medir el timing, acordate que se testea compilado.

(borre el codigo por que lo hizo E_C abajo.

GRACIAS POR LEER!!!

Estabas en lo cierto. bueno no un 100 pero si mucho mas.

la comprobé así.

Código
  1. Dim ct As New CTiming
  2. Private Sub Form_Load()
  3. Form1.Show
  4. MsgBox "empezara luego del ok"
  5. ct.Reset
  6. For x = 1 To 10000
  7. Call mul5and3below1000
  8. Next
  9. Form1.Print "Tiempo 7913 -->" & ct.sElapsed
  10. Form1.Print "Resultado 7913 -->" & mul5and3below1000()
  11. ct.Reset
  12. For x = 1 To 10000
  13. Call mul_3_5
  14. Next
  15. Form1.Print "Tiempo dany -->" & ct.sElapsed
  16. Form1.Print "Resultado dany -->" & mul_3_5()
  17. End Sub
  18.  
  19.  
  20. Private Function mul5and3below1000() As Long
  21.     Dim ct As Long
  22.     Dim aux As Long
  23.     Do
  24.         mul5and3below1000 = mul5and3below1000 + aux + aux2
  25.         ct = ct + 1
  26.         aux = ct + ct + ct
  27.         aux2 = ct + ct + ct + ct + ct
  28.     Loop While aux2 < 1000
  29.     Do
  30.         mul5and3below1000 = mul5and3below1000 + aux
  31.         ct = ct + 1
  32.         aux = ct + ct + ct
  33.     Loop While aux < 1000
  34.     ct = 0
  35.     aux = 0
  36.     Do
  37.         mul5and3below1000 = mul5and3below1000 - aux
  38.         ct = ct + 1
  39.         aux = ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct
  40.     Loop While aux < 1000
  41. End Function
  42.  
  43. Function mul_3_5() As Long
  44. Dim i As Integer
  45. For i = 1 To 999
  46. If (i Mod 3) < 1 Or (i Mod 5) < 1 Then
  47. mul_3_5 = mul_3_5 + i
  48. End If
  49. Next i
  50. End Function
  51.  

gracias vere si la puedo mejorar.

saludos

Título: Re: [RETO] Proyect Euler 1
Publicado por: LeandroA en 23 Enero 2013, 20:38 pm
Hola yo la verdad, no entiendo, en primer instancia dice que  3, 5, 6 and 9 son los que estan por devajo de 10, hasta hay todo bien, pero luego sus resultados no me son coherentes con esta lógica (aunque segun la pagina el resultado final es correcto)

pero por ejemplo el ejemplo de Danyfirex, solo mirando los primeros números de multiplos de 3 imprime esto
Citar
1             2             4             5             7             8             10            11

y no veo que el 2 sea un múltiplo de 3 , ni el resto de los siguientes.

ami la logica me dice algo asi,
Código
  1. Private Sub Form_Load()
  2.     Dim i As Long
  3.     Dim lSum As Long
  4.     Dim lResult As Long
  5.  
  6.     For i = 1 To 1000000
  7.         lResult = 3 * i
  8.         If lResult >= 1000 Then
  9.             Exit For
  10.         Else
  11.             lSum = lSum + lResult
  12.         End If
  13.  
  14.     Next
  15.  
  16.     For i = 1 To 1000000
  17.         lResult = 5 * i
  18.  
  19.         If lResult >= 1000 Then
  20.             Exit For
  21.         Else
  22.             lSum = lSum + lResult
  23.         End If
  24.  
  25.     Next
  26.  
  27.     Debug.Print lSum
  28. End Sub
  29.  

porque estoy equivocado???







Título: Re: [RETO] Proyect Euler 1
Publicado por: Danyfirex en 23 Enero 2013, 20:44 pm
Cita de: LeandroA en 23 Enero 2013, 20:38 pm
Hola yo la verdad, no entiendo, en primer instancia dice que  3, 5, 6 and 9 son los que estan por devajo de 10, hasta hay todo bien, pero luego sus resultados no me son coherentes con esta lógica (aunque segun la pagina el resultado final es correcto)

pero por ejemplo el ejemplo de Danyfirex, solo mirando los primeros números de multiplos de 3 imprime esto
y no veo que el 2 sea un múltiplo de 3 , ni el resto de los siguientes.

ami la logica me dice algo asi,


porque estoy equivocado???








hasta ahi vas bien. pero entonces te faltaría quitar los múltiplos de 15.

Título: Re: [RETO] Proyect Euler 1
Publicado por: Psyke1 en 23 Enero 2013, 22:04 pm
¡Jajajaja! ¡Menudo lío se ha montado! :laugh: Y eso que estamos con el reto 1. :silbar:

Creo que lo idóneo sería que le pudieramos pasar el número por parámetro, es más genérico.
Y la función debe funcionar SIEMPRE.

Aquí dejo unos ejemplos de llamadas que deben de devolver resultado correcto:
Código
  1. Debug.Print Euler1(1000) '-> 233168
  2. Debug.Print Euler1(0)    '-> 0
  3. Debug.Print Euler1(-983) '-> 0


Aquí dejo mi forma de hacerlo:
Código
  1. Public Static Function PE_1(ByVal lNum As Long) As Long
  2. Dim Q                           As Long
  3.  
  4.     If lNum And &H80000000 Then Exit Function
  5.  
  6.     lNum = lNum - 1
  7.  
  8.     For Q = 3 To lNum Step 3
  9.         PE_1 = PE_1 + Q
  10.     Next Q
  11.  
  12.     For Q = 5 To lNum Step 5
  13.         If Q Mod 3 Then
  14.             PE_1 = PE_1 + Q
  15.         End If
  16.     Next Q
  17. End Function

La próxima vez pondré el reto traducido, y el resultado que debe retornar para evitar confusiones. :rolleyes:

DoEvents! :P

Título: Re: [RETO] Proyect Euler 1
Publicado por: Danyfirex en 23 Enero 2013, 22:08 pm
@Psyke1
creo la primera debería imprimir 234168 en vez de 233168.

100% de acuerdo en poner el reto en Español.

Título: Re: [RETO] Proyect Euler 1
Publicado por: Psyke1 en 23 Enero 2013, 22:13 pm
@Danyfirex

Código:
http://code.google.com/p/projecteuler-solutions/wiki/ProjectEulerSolutions

Ahí está el resultado de todas las soluciones. ;)

DoEvents! :P

Título: Re: [RETO] Proyect Euler 1
Publicado por: Danyfirex en 23 Enero 2013, 22:21 pm
Cita de: Psyke1 en 23 Enero 2013, 22:13 pm
@Danyfirex

Código:
http://code.google.com/p/projecteuler-solutions/wiki/ProjectEulerSolutions

Ahí está el resultado de todas las soluciones. ;)

DoEvents! :P

A pues así pues si. bueno en fin aqui dejo la mia como la pides. no es lo mas optimo pero funciona bien.


Código
  1. Function mul_3_5(numero As Long) As Long
  2. Dim i As Integer
  3. For i = 0 To numero - 1
  4. If (i Mod 3) = 0 Or (i Mod 5) = 0 Then mul_3_5 = mul_3_5 + i
  5. Next i
  6. End Function



Cuando y donde podemos colocar el reto 2?

Título: Re: [RETO] Proyect Euler 1
Publicado por: imoen en 24 Enero 2013, 04:35 am
En mi opinion este es el codigo mas claro

Al final pongo el visual basic eh xD

bs imoen

Título: Re: [RETO] Proyect Euler 1
Publicado por: BlackZeroX en 24 Enero 2013, 04:37 am
mmm el código es fácil de hacer por lo cual yo solo me preocupe por la velocidad... evite calcular el modulo/residuo... ¿Alguien puede probar la velocidad?... se ve que la simplicidad de la función de 79137913 es más veloz.

Versión 1.
Código
  1. Public Function mul3and5(Optional ByVal dwBelowTo As Long = &H3E8&) As Long
  2. Dim i As Long
  3. Dim dwNewMax As Long
  4.  
  5.     If (dwBelowTo And &H80000000&) Then Exit Function
  6.  
  7.     dwNewMax = (dwBelowTo + &HFFFFFFFF&)
  8.     dwNewMax = (dwNewMax - (dwNewMax Mod &HF&))
  9.  
  10.     For i = &H5& To dwNewMax Step &HF&
  11.         mul3and5 = mul3and5 + i + i + &HFFFFFFFE&
  12.     Next
  13.     For i = &HA& To dwNewMax Step &HF&
  14.         mul3and5 = mul3and5 + i + i + i + &HFFFFFFFB&
  15.     Next
  16.     For i = &HF& To dwNewMax Step &HF&
  17.         mul3and5 = mul3and5 + i + i + &HFFFFFFFD&
  18.     Next
  19.  
  20.     i = (dwNewMax + &H3&):
  21.                     If (i >= dwBelowTo) Then Exit Function
  22.     mul3and5 = mul3and5 + i
  23.     i = (i + &H2&):    If (i >= dwBelowTo) Then Exit Function
  24.     mul3and5 = mul3and5 + i
  25.     i = (i + &H1&):    If (i >= dwBelowTo) Then Exit Function
  26.     mul3and5 = mul3and5 + i
  27.     i = (i + &H3&):    If (i >= dwBelowTo) Then Exit Function
  28.     mul3and5 = mul3and5 + i
  29.     i = (i + &H1&):    If (i >= dwBelowTo) Then Exit Function
  30.     mul3and5 = mul3and5 + i
  31.     i = (i + &H2&):    If (i >= dwBelowTo) Then Exit Function
  32.     mul3and5 = mul3and5 + i
  33. End Function
  34.  

Versión 2 (Menos iteraciones, más código).
Código
  1. Public Function mul3and5_Ver2(Optional ByVal dwBelowTo As Long = &H3E8&) As Long
  2. Dim i As Long
  3. Dim dwNewMax As Long
  4. Dim dwNewMaxFast As Long
  5.  
  6.     If (dwBelowTo And &H80000000) Then Exit Function
  7.  
  8.     dwNewMax = (dwBelowTo + &HFFFFFFFF)
  9.     dwNewMax = (dwNewMax - (dwNewMax Mod &HF&))
  10.  
  11.     If (dwNewMax > &H1E&) Then
  12.         dwNewMaxFast = (dwNewMax - (dwNewMax Mod &H1E&))
  13.         For i = &H5& To dwNewMaxFast Step &H1E&
  14.             mul3and5_Ver2 = mul3and5_Ver2 + i + i + i + i + &H1A&
  15.         Next
  16.         For i = &HA& To dwNewMaxFast Step &H1E&
  17.             mul3and5_Ver2 = mul3and5_Ver2 + i + i + i + i + i + i + &H23&
  18.         Next
  19.         For i = &HF& To dwNewMaxFast Step &H1E&
  20.             mul3and5_Ver2 = mul3and5_Ver2 + i + i + i + i + &H18&
  21.         Next
  22.     End If
  23.  
  24.     For i = dwNewMaxFast + &H5& To dwNewMax Step &HF&
  25.         mul3and5_Ver2 = mul3and5_Ver2 + i + i + &HFFFFFFFE&
  26.     Next
  27.     For i = dwNewMaxFast + &HA& To dwNewMax Step &HF&
  28.         mul3and5_Ver2 = mul3and5_Ver2 + i + i + i + &HFFFFFFFB
  29.     Next
  30.     For i = dwNewMaxFast + &HF& To dwNewMax Step &HF&
  31.         mul3and5_Ver2 = mul3and5_Ver2 + i + i + &HFFFFFFFD
  32.     Next
  33.  
  34.     i = (dwNewMax + &H3&):
  35.                     If (i >= dwBelowTo) Then Exit Function
  36.     mul3and5_Ver2 = mul3and5_Ver2 + i
  37.     i = (i + &H2&):    If (i >= dwBelowTo) Then Exit Function
  38.     mul3and5_Ver2 = mul3and5_Ver2 + i
  39.     i = (i + &H1&):    If (i >= dwBelowTo) Then Exit Function
  40.     mul3and5_Ver2 = mul3and5_Ver2 + i
  41.     i = (i + &H3&):    If (i >= dwBelowTo) Then Exit Function
  42.     mul3and5_Ver2 = mul3and5_Ver2 + i
  43.     i = (i + &H1&):    If (i >= dwBelowTo) Then Exit Function
  44.     mul3and5_Ver2 = mul3and5_Ver2 + i
  45.     i = (i + &H2&):    If (i >= dwBelowTo) Then Exit Function
  46.     mul3and5_Ver2 = mul3and5_Ver2 + i
  47. End Function
  48.  

P.D.: ¿Empezare a realizar el segundo... o me espero?.

Dulces Lunas!¡.

Título: Re: [RETO] Proyect Euler 1
Publicado por: BlackZeroX en 24 Enero 2013, 06:29 am
Estos resultados fueron generados desde el IDE ya que no puedo compilar.
Código:
Tiempo 7913   978.902 msec
Resultado 7913              233168

Tiempo dany   1,647.315 msec
Resultado dany              233168

Tiempo Spyke1 488.101 msec
Resultado Spyke1            233168

Tiempo BlackZeroX V1        205.944 msec
Resultado BlackZeroX V1     233168

Tiempo BlackZeroX V2        125.884 msec
Resultado BlackZeroX V2     233168

CTiming.cls (http://www.xbeat.net/vbspeed/download/CTiming.zip)

Código:
 
Option Explicit
Option Base 0
 
Sub main()
Const LIM       As Long = 1000&
Const MAX_FOR   As Long = 100000
 
Dim i   As Long
Dim ct  As New CTiming
Dim obj As Object
 
    MsgBox "Empezara luego del Ok"
 
    ct.Reset
    For i = 1 To MAX_FOR
        mul3and5_Ver2 LIM
    Next
 
    Debug.Print "Tiempo BlackZeroX V2", ct.sElapsed
    Debug.Print "Resultado BlackZeroX V2", mul3and5_Ver2(LIM) & vbCrLf
 
    ct.Reset
    For i = 1 To MAX_FOR
        mul3and5 LIM
    Next
    Debug.Print "Tiempo BlackZeroX V1", ct.sElapsed
    Debug.Print "Resultado BlackZeroX V1", mul3and5(LIM) & vbCrLf
 
    ct.Reset
    For i = 1 To MAX_FOR
        mul5and3below1000
    Next
    Debug.Print "Tiempo 7913", ct.sElapsed
    Debug.Print "Resultado 7913", mul5and3below1000() & vbCrLf
 
    ct.Reset
    For i = 1 To MAX_FOR
        mul_3_5
    Next
    Debug.Print "Tiempo dany", ct.sElapsed
    Debug.Print "Resultado dany", mul_3_5() & vbCrLf
 
    ct.Reset
    For i = 1 To MAX_FOR
        PE_1 LIM
    Next
    Debug.Print "Tiempo Spyke1", ct.sElapsed
    Debug.Print "Resultado Spyke1", PE_1(LIM) & vbCrLf
 
End Sub
 
 
Private Function mul5and3below1000() As Long
    Dim ct As Long
    Dim aux As Long
    Dim aux2 As Long
    Do
        mul5and3below1000 = mul5and3below1000 + aux + aux2
        ct = ct + 1
        aux = ct + ct + ct
        aux2 = ct + ct + ct + ct + ct
    Loop While aux2 < 1000
    Do
        mul5and3below1000 = mul5and3below1000 + aux
        ct = ct + 1
        aux = ct + ct + ct
    Loop While aux < 1000
    ct = 0
    aux = 0
    Do
        mul5and3below1000 = mul5and3below1000 - aux
        ct = ct + 1
        aux = ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct + ct
    Loop While aux < 1000
End Function
 
Function mul_3_5() As Long
Dim i As Integer
For i = 1 To 999
If (i Mod 3) < 1 Or (i Mod 5) < 1 Then
mul_3_5 = mul_3_5 + i
End If
Next i
End Function
 
Public Static Function PE_1(ByVal lNum As Long) As Long
Dim Q                           As Long
 
    If lNum And &H80000000 Then Exit Function
 
    lNum = lNum - 1
 
    For Q = 3 To lNum Step 3
        PE_1 = PE_1 + Q
    Next Q
 
    For Q = 5 To lNum Step 5
        If Q Mod 3 Then PE_1 = PE_1 + Q
    Next Q
End Function
 
Public Function mul3and5(Optional ByVal dwBelowTo As Long = &H3E8&) As Long
Dim i As Long
Dim dwNewMax As Long
 
    If (dwBelowTo And &H80000000) Then Exit Function
 
    dwNewMax = (dwBelowTo + &HFFFFFFFF)
    dwNewMax = (dwNewMax - (dwNewMax Mod &HF&))
 
    For i = &H5& To dwNewMax Step &HF&
        mul3and5 = mul3and5 + i + i + &HFFFFFFFE
    Next
    For i = &HA& To dwNewMax Step &HF&
        mul3and5 = mul3and5 + i + i + i + &HFFFFFFFB
    Next
    For i = &HF& To dwNewMax Step &HF&
        mul3and5 = mul3and5 + i + i + &HFFFFFFFD
    Next
 
    i = (dwNewMax + &H3&):
                    If (i >= dwBelowTo) Then Exit Function
    mul3and5 = mul3and5 + i
    i = (i + &H2&):    If (i >= dwBelowTo) Then Exit Function
    mul3and5 = mul3and5 + i
    i = (i + &H1&):    If (i >= dwBelowTo) Then Exit Function
    mul3and5 = mul3and5 + i
    i = (i + &H3&):    If (i >= dwBelowTo) Then Exit Function
    mul3and5 = mul3and5 + i
    i = (i + &H1&):    If (i >= dwBelowTo) Then Exit Function
    mul3and5 = mul3and5 + i
    i = (i + &H2&):    If (i >= dwBelowTo) Then Exit Function
    mul3and5 = mul3and5 + i
End Function
 
Public Function mul3and5_Ver2(Optional ByVal dwBelowTo As Long = &H3E8&) As Long
Dim i As Long
Dim dwNewMax As Long
Dim dwNewMaxFast As Long
 
    If (dwBelowTo And &H80000000) Then Exit Function
 
    dwNewMax = (dwBelowTo + &HFFFFFFFF)
    dwNewMax = (dwNewMax - (dwNewMax Mod &HF&))
 
    If (dwNewMax > &H1E&) Then
        dwNewMaxFast = (dwNewMax - (dwNewMax Mod &H1E&))
        For i = &H5& To dwNewMaxFast Step &H1E&
            mul3and5_Ver2 = mul3and5_Ver2 + i + i + i + i + &H1A&
        Next
        For i = &HA& To dwNewMaxFast Step &H1E&
            mul3and5_Ver2 = mul3and5_Ver2 + i + i + i + i + i + i + &H23&
        Next
        For i = &HF& To dwNewMaxFast Step &H1E&
            mul3and5_Ver2 = mul3and5_Ver2 + i + i + i + i + &H18&
        Next
    End If
 
    For i = dwNewMaxFast + &H5& To dwNewMax Step &HF&
        mul3and5_Ver2 = mul3and5_Ver2 + i + i + &HFFFFFFFE
    Next
    For i = dwNewMaxFast + &HA& To dwNewMax Step &HF&
        mul3and5_Ver2 = mul3and5_Ver2 + i + i + i + &HFFFFFFFB
    Next
    For i = dwNewMaxFast + &HF& To dwNewMax Step &HF&
        mul3and5_Ver2 = mul3and5_Ver2 + i + i + &HFFFFFFFD
    Next
 
    i = (dwNewMax + &H3&):
                    If (i >= dwBelowTo) Then Exit Function
    mul3and5_Ver2 = mul3and5_Ver2 + i
    i = (i + &H2&):    If (i >= dwBelowTo) Then Exit Function
    mul3and5_Ver2 = mul3and5_Ver2 + i
    i = (i + &H1&):    If (i >= dwBelowTo) Then Exit Function
    mul3and5_Ver2 = mul3and5_Ver2 + i
    i = (i + &H3&):    If (i >= dwBelowTo) Then Exit Function
    mul3and5_Ver2 = mul3and5_Ver2 + i
    i = (i + &H1&):    If (i >= dwBelowTo) Then Exit Function
    mul3and5_Ver2 = mul3and5_Ver2 + i
    i = (i + &H2&):    If (i >= dwBelowTo) Then Exit Function
    mul3and5_Ver2 = mul3and5_Ver2 + i
End Function


Dulces Lunas!¡.

Título: Re: [RETO] Proyect Euler 1
Publicado por: MCKSys Argentina en 24 Enero 2013, 10:58 am
Pongo el mío, aunque es más lento que el de BlackZeroX:

Código
  1. Public Function Euler_1(ByVal lNum As Long) As Long
  2. Dim Q As Long
  3. Dim S5 As Long
  4.  
  5.     If lNum& And &H80000000 Then Exit Function
  6.  
  7.     lNum& = lNum& - &H1
  8.  
  9.     For Q& = &H0 To (lNum& \ &HF)
  10.         Euler_1& = Euler_1& + (&HF * Q&)
  11.     Next Q
  12.  
  13.     S5& = 0
  14.     For Q& = &H1 To (lNum& \ &H5)
  15.         S5& = S5& + (&H5 * Q&)
  16.     Next Q
  17.     Euler_1& = S5& - Euler_1&
  18.  
  19.     For Q& = &H1 To (lNum& \ &H3)
  20.         Euler_1& = Euler_1& + (&H3 * Q&)
  21.     Next Q
  22. End Function
  23.  

En un EXE compilado, los tiempos me dan:

Código:
Tiempo BlackZeroX V2        55.732 msec
Resultado BlackZeroX V2     233168

Tiempo BlackZeroX V1        39.737 msec
Resultado BlackZeroX V1     233168

Tiempo 7913   152.260 msec
Resultado 7913              233168

Tiempo dany   1,627.764 msec
Resultado dany              233168

Tiempo Spyke1 175.199 msec
Resultado Spyke1            233168

Tiempo MCKSys 98.207 msec
Resultado MCKSys            233168

PD: Mirando el ASM generado, veo que el secreto está en no usar multiplicaciones ni divisiones. Aunque no es sencillo hallar un algoritmo con eso (y que sea diferente al de BlackZeroX!!  ;D)

Título: Re: [RETO] Proyect Euler 1
Publicado por: MCKSys Argentina en 24 Enero 2013, 11:13 am
Nueva función:

Código
  1. Public Function Euler_1(ByVal lNum As Long) As Long
  2. Dim S5 As Long
  3.  
  4.     If lNum& And &H80000000 Then Exit Function
  5.  
  6.     lNum& = lNum& - &H1
  7.  
  8.     Euler_1& = ((lNum& \ &HF) * ((lNum& \ &HF) + 1) \ 2) * &HF
  9.  
  10.     S5& = ((lNum& \ &H5) * ((lNum& \ &H5) + 1) \ 2) * &H5
  11.  
  12.     Euler_1& = S5& - Euler_1&
  13.  
  14.     Euler_1& = Euler_1& + (((lNum& \ &H3) * ((lNum& \ &H3) + 1) \ 2) * &H3)
  15. End Function
  16.  

Compilados, estos son los tiempos:

Código:
Tiempo BlackZeroX V2        66.052 msec
Resultado BlackZeroX V2     233168

Tiempo BlackZeroX V1        43.226 msec
Resultado BlackZeroX V1     233168

Tiempo 7913   144.274 msec
Resultado 7913              233168

Tiempo dany   1,635.416 msec
Resultado dany              233168

Tiempo Spyke1 176.800 msec
Resultado Spyke1            233168

Tiempo MCKSys 0.983 msec
Resultado MCKSys            233168


Estoy desvelado y no lo puedo creer aún, así que verifiquen!!!!!!!!!!!

Saludos!

Título: Re: [RETO] Proyect Euler 1
Publicado por: BlackZeroX en 24 Enero 2013, 11:27 am
Cita de: MCKSys Argentina en 24 Enero 2013, 10:58 am
PD: Mirando el ASM generado, veo que el secreto está en no usar multiplicaciones ni divisiones.

Si no mal recuerdo de mis clases la base del procesamiento numérico de una computadora esta en la SUMA...

Se zarpaste con esas operaciones aun que NO funciona para varios números!¡... Probé tu función y la mía (Debido a la alta complejidad) con la función de Spyke1...
Código
  1. Const MAX_FOR   As Long = 10000
  2. Dim i as long
  3.  
  4.     For i = 1 To MAX_FOR
  5.         If Not (PE_1(i) = Euler_1(i)) Then
  6.             Debug.Print "BlackZeroX Error: "; i
  7.         End If
  8.     Next
  9.  
  10.     For i = 1 To MAX_FOR
  11.         If Not (PE_1(i) = mul3and5(i)) Then
  12.             Debug.Print "MCKSys Argentina Error: "; i
  13.         End If
  14.     Next
  15.  

Son mas errores pero me corta las primeras salidas el Debug...
Código:
MCKSys Argentina Error:  7038 
MCKSys Argentina Error:  7053 
MCKSys Argentina Error:  7068 
MCKSys Argentina Error:  7083 
MCKSys Argentina Error:  7098 
MCKSys Argentina Error:  7113 
MCKSys Argentina Error:  7128 
MCKSys Argentina Error:  7143 
MCKSys Argentina Error:  7158 
MCKSys Argentina Error:  7173 
MCKSys Argentina Error:  7188 
MCKSys Argentina Error:  7203 
MCKSys Argentina Error:  7218 
MCKSys Argentina Error:  7233 
MCKSys Argentina Error:  7248 
MCKSys Argentina Error:  7263 
MCKSys Argentina Error:  7278 
MCKSys Argentina Error:  7293 
MCKSys Argentina Error:  7308 
MCKSys Argentina Error:  7323 
MCKSys Argentina Error:  7338 
MCKSys Argentina Error:  7353 
MCKSys Argentina Error:  7368 
MCKSys Argentina Error:  7383 
MCKSys Argentina Error:  7398 
MCKSys Argentina Error:  7413 
MCKSys Argentina Error:  7428 
MCKSys Argentina Error:  7443 
MCKSys Argentina Error:  7458 
MCKSys Argentina Error:  7473 
MCKSys Argentina Error:  7488 
MCKSys Argentina Error:  7503 
MCKSys Argentina Error:  7518 
MCKSys Argentina Error:  7533 
MCKSys Argentina Error:  7548 
MCKSys Argentina Error:  7563 
MCKSys Argentina Error:  7578 
MCKSys Argentina Error:  7593 
MCKSys Argentina Error:  7608 
MCKSys Argentina Error:  7623 
MCKSys Argentina Error:  7638 
MCKSys Argentina Error:  7653 
MCKSys Argentina Error:  7668 
MCKSys Argentina Error:  7683 
MCKSys Argentina Error:  7698 
MCKSys Argentina Error:  7713 
MCKSys Argentina Error:  7728 
MCKSys Argentina Error:  7743 
MCKSys Argentina Error:  7758 
MCKSys Argentina Error:  7773 
MCKSys Argentina Error:  7788 
MCKSys Argentina Error:  7803 
MCKSys Argentina Error:  7818 
MCKSys Argentina Error:  7833 
MCKSys Argentina Error:  7848 
MCKSys Argentina Error:  7863 
MCKSys Argentina Error:  7878 
MCKSys Argentina Error:  7893 
MCKSys Argentina Error:  7908 
MCKSys Argentina Error:  7923 
MCKSys Argentina Error:  7938 
MCKSys Argentina Error:  7953 
MCKSys Argentina Error:  7968 
MCKSys Argentina Error:  7983 
MCKSys Argentina Error:  7998 
MCKSys Argentina Error:  8013 
MCKSys Argentina Error:  8028 
MCKSys Argentina Error:  8043 
MCKSys Argentina Error:  8058 
MCKSys Argentina Error:  8073 
MCKSys Argentina Error:  8088 
MCKSys Argentina Error:  8103 
MCKSys Argentina Error:  8118 
MCKSys Argentina Error:  8133 
MCKSys Argentina Error:  8148 
MCKSys Argentina Error:  8163 
MCKSys Argentina Error:  8178 
MCKSys Argentina Error:  8193 
MCKSys Argentina Error:  8208 
MCKSys Argentina Error:  8223 
MCKSys Argentina Error:  8238 
MCKSys Argentina Error:  8253 
MCKSys Argentina Error:  8268 
MCKSys Argentina Error:  8283 
MCKSys Argentina Error:  8298 
MCKSys Argentina Error:  8313 
MCKSys Argentina Error:  8328 
MCKSys Argentina Error:  8343 
MCKSys Argentina Error:  8358 
MCKSys Argentina Error:  8373 
MCKSys Argentina Error:  8388 
MCKSys Argentina Error:  8403 
MCKSys Argentina Error:  8418 
MCKSys Argentina Error:  8433 
MCKSys Argentina Error:  8448 
MCKSys Argentina Error:  8463 
MCKSys Argentina Error:  8478 
MCKSys Argentina Error:  8493 
MCKSys Argentina Error:  8508 
MCKSys Argentina Error:  8523 
MCKSys Argentina Error:  8538 
MCKSys Argentina Error:  8553 
MCKSys Argentina Error:  8568 
MCKSys Argentina Error:  8583 
MCKSys Argentina Error:  8598 
MCKSys Argentina Error:  8613 
MCKSys Argentina Error:  8628 
MCKSys Argentina Error:  8643 
MCKSys Argentina Error:  8658 
MCKSys Argentina Error:  8673 
MCKSys Argentina Error:  8688 
MCKSys Argentina Error:  8703 
MCKSys Argentina Error:  8718 
MCKSys Argentina Error:  8733 
MCKSys Argentina Error:  8748 
MCKSys Argentina Error:  8763 
MCKSys Argentina Error:  8778 
MCKSys Argentina Error:  8793 
MCKSys Argentina Error:  8808 
MCKSys Argentina Error:  8823 
MCKSys Argentina Error:  8838 
MCKSys Argentina Error:  8853 
MCKSys Argentina Error:  8868 
MCKSys Argentina Error:  8883 
MCKSys Argentina Error:  8898 
MCKSys Argentina Error:  8913 
MCKSys Argentina Error:  8928 
MCKSys Argentina Error:  8943 
MCKSys Argentina Error:  8958 
MCKSys Argentina Error:  8973 
MCKSys Argentina Error:  8988 
MCKSys Argentina Error:  9003 
MCKSys Argentina Error:  9018 
MCKSys Argentina Error:  9033 
MCKSys Argentina Error:  9048 
MCKSys Argentina Error:  9063 
MCKSys Argentina Error:  9078 
MCKSys Argentina Error:  9093 
MCKSys Argentina Error:  9108 
MCKSys Argentina Error:  9123 
MCKSys Argentina Error:  9138 
MCKSys Argentina Error:  9153 
MCKSys Argentina Error:  9168 
MCKSys Argentina Error:  9183 
MCKSys Argentina Error:  9198 
MCKSys Argentina Error:  9213 
MCKSys Argentina Error:  9228 
MCKSys Argentina Error:  9243 
MCKSys Argentina Error:  9258 
MCKSys Argentina Error:  9273 
MCKSys Argentina Error:  9288 
MCKSys Argentina Error:  9303 
MCKSys Argentina Error:  9318 
MCKSys Argentina Error:  9333 
MCKSys Argentina Error:  9348 
MCKSys Argentina Error:  9363 
MCKSys Argentina Error:  9378 
MCKSys Argentina Error:  9393 
MCKSys Argentina Error:  9408 
MCKSys Argentina Error:  9423 
MCKSys Argentina Error:  9438 
MCKSys Argentina Error:  9453 
MCKSys Argentina Error:  9468 
MCKSys Argentina Error:  9483 
MCKSys Argentina Error:  9498 
MCKSys Argentina Error:  9513 
MCKSys Argentina Error:  9528 
MCKSys Argentina Error:  9543 
MCKSys Argentina Error:  9558 
MCKSys Argentina Error:  9573 
MCKSys Argentina Error:  9588 
MCKSys Argentina Error:  9603 
MCKSys Argentina Error:  9618 
MCKSys Argentina Error:  9633 
MCKSys Argentina Error:  9648 
MCKSys Argentina Error:  9663 
MCKSys Argentina Error:  9678 
MCKSys Argentina Error:  9693 
MCKSys Argentina Error:  9708 
MCKSys Argentina Error:  9723 
MCKSys Argentina Error:  9738 
MCKSys Argentina Error:  9753 
MCKSys Argentina Error:  9768 
MCKSys Argentina Error:  9783 
MCKSys Argentina Error:  9798 
MCKSys Argentina Error:  9813 
MCKSys Argentina Error:  9828 
MCKSys Argentina Error:  9843 
MCKSys Argentina Error:  9858 
MCKSys Argentina Error:  9873 
MCKSys Argentina Error:  9888 
MCKSys Argentina Error:  9903 
MCKSys Argentina Error:  9918 
MCKSys Argentina Error:  9933 
MCKSys Argentina Error:  9948 
MCKSys Argentina Error:  9963 
MCKSys Argentina Error:  9978 
MCKSys Argentina Error:  9993 
[code]

Dulces Lunas!¡.
[/code]

Título: Re: [RETO] Proyect Euler 1
Publicado por: imoen en 24 Enero 2013, 11:45 am
Hola

Una pregunta chicos , con la velocidad de los codigos , jeje, veamos dos cosas

A) Sabeis que para medir la velocidad debeis de usar el mismo equipo ?¿?¿ puesto que cad aprocessador aportara distintas velocidades, en esto incluso afectara el sistema operativo y la velocidad de la ram.

B) Un codigo un poco mas rapido no puede ser a costa de ofuscar el codigo o hacer como he visto por hay CT+CT+ct .... asi hasta el infinito y mas alla , para eso se invento los incrementadores add ct,ct.

C) exacto no usar divi y multiplicaciones hace uqe la velocidad aumente pero y si en vez de eso usais los movimientos de bytes ?¿( correr bytes)

bueno eso son mis opiniones
bs imoen

Título: Re: [RETO] Proyect Euler 1
Publicado por: MCKSys Argentina en 24 Enero 2013, 11:59 am
Cita de: BlackZeroX (Astaroth) en 24 Enero 2013, 11:27 am
Si no mal recuerdo de mis clases la base del procesamiento numérico de una computadora esta en la SUMA...

Se zarpaste con esas operaciones aun que NO funciona para varios números!¡... Probé tu función y la mía (Debido a la alta complejidad) con la función de Spyke1...
Código
  1. Const MAX_FOR   As Long = 10000
  2. Dim i as long
  3.  
  4.     For i = 1 To MAX_FOR
  5.         If Not (PE_1(i) = Euler_1(i)) Then
  6.             Debug.Print "BlackZeroX Error: "; i
  7.         End If
  8.     Next
  9.  
  10.     For i = 1 To MAX_FOR
  11.         If Not (PE_1(i) = mul3and5(i)) Then
  12.             Debug.Print "MCKSys Argentina Error: "; i
  13.         End If
  14.     Next
  15.  

Son mas errores pero me corta las primeras salidas el Debug...
Código:
MCKSys Argentina Error:  7038 
MCKSys Argentina Error:  7053 
...
...
...
MCKSys Argentina Error:  9963 
MCKSys Argentina Error:  9978 
MCKSys Argentina Error:  9993 
[code]

Dulces Lunas!¡.
[/code]

Me parece que están al revés. Euler_1 es mi función y mul3and5 es la tuya.  :P

Título: Re: [RETO] Proyect Euler 1
Publicado por: BlackZeroX en 24 Enero 2013, 12:04 pm
en VB 6 no existe los operadores para desplazamiento de bits... para simularlo los multiplicamos o dividimos según sea el caso...

Código:
a << 1 // Desplazamiento de 1 a la izquierda en C/C++.
a * 2 // Simulación en vb6 y en cualquier lenguaje.

a << 4 // Desplazamiento de 4 bits a la izquierda en C/C++.
a * 16 // Simulacion en vb6 y en cualquier lenguaje.

a >> 1 // Desplazamiento de 1 bit a la derecha en C/C++
a \ 2 // No ocupar / ya que devuelve decimales...

a >> 4 // Desplazamiento de 4 bits a la derecha en C/C++
a \ 16 // No ocupar / ya que devuelve decimales...

La cosa de estos retos es generar códigos con las LIMITACIONES que nos da el lenguaje.

 * La velocidades SON RELATIVAS no importa el procesador puesto que se podría hacer una simple regla de 3!¡, es decir si una función es mas rápida en procesarse que otra en un procesador que dura Y tiempo, este mismo tiempo será relativo en otro procesador con un tiempo Y +/- Mili-segundos... Has la prueba y veras... Las velocidades son aproximadas.

---->

Había puesto mal el código de prueba ya lo corregí (mi versión V2 JAMA se llamaba).

Código:
Tiempo 7913   872.496 msec
Resultado 7913              233168

Tiempo dany   1,650.228 msec
Resultado dany              233168

Tiempo Spyke1 480.171 msec
Resultado Spyke1            233168

Tiempo BlackZeroX V1        202.318 msec
Resultado BlackZeroX V1     233168

Tiempo BlackZeroX V2        129.462 msec
Resultado BlackZeroX V2     233168

Tiempo MCKSys Argentina     7.249 msec
Resultado MCKSys Argentina  233168


Dulces Lunas!¡.

Título: Re: [RETO] Proyect Euler 1
Publicado por: BlackZeroX en 24 Enero 2013, 12:10 pm
Cita de: MCKSys Argentina en 24 Enero 2013, 11:59 am
Me parece que están al revés. Euler_1 es mi función y mul3and5 es la tuya.  :P

Madre que me desvelo son las 06:00 am y no e dormido.

->> Error Corregido las dos funciones trabajan perfecto... Madre todo por un "="

Lineas 21 (Versión 1) y 31 (Versión 2) de mi funciones respectivas
Código
  1.                     If (i > dwBelowTo) Then Exit Function
  2.  
To
Código
  1.                     If (i >= dwBelowTo) Then Exit Function
  2.  

Dulces Lunas!¡.

Título: Re: [RETO] Proyect Euler 1
Publicado por: MCKSys Argentina en 24 Enero 2013, 12:14 pm
Cita de: BlackZeroX (Astaroth) en 24 Enero 2013, 12:10 pm
Madre que me desvelo son las 06:00 am y no e dormido.

Dulces Lunas!¡.

jejeje.. estamos igual  :)

De todas formas, estuve probando hasta 20000 y mi función no genera errores (Comparada con la de Psyke1).

Creo que fue buena idea sacrificar los bucles por las multiplicaciones y divisiones...  :)

Título: Re: [RETO] Proyect Euler 1
Publicado por: BlackZeroX en 24 Enero 2013, 12:18 pm
Cita de: MCKSys Argentina en 24 Enero 2013, 12:14 pm
Creo que fue buena idea sacrificar los bucles por las multiplicaciones y divisiones...  :)

Ya ando trabajando en algo...

Dulces Lunas!¡.

Título: Re: [RETO] Proyect Euler 1
Publicado por: BlackZeroX en 24 Enero 2013, 14:12 pm
Esta es la tercera versión... mejore el tiempo pero que alguien compruebe compilado!¡.

Código:
Tiempo 7913   930.892 msec
Resultado 7913              233168

Tiempo dany   1,693.349 msec
Resultado dany              233168

Tiempo Spyke1 521.769 msec
Resultado Spyke1            233168

Tiempo BlackZeroX V1        234.119 msec
Resultado BlackZeroX V1     233168

Tiempo BlackZeroX V2        130.859 msec
Resultado BlackZeroX V2     233168

Tiempo BlackZeroX V3        6.550 msec
Resultado BlackZeroX V3     233168

Tiempo MCKSys Argentina     10.054 msec
Resultado MCKSys Argentina  233168

Código
  1. Public Function mul3and5_Ver3(Optional ByVal dwBelowTo As Long = &H3E8&) As Long
  2. Dim N As Long
  3. Dim M As Long
  4. Dim I As Long
  5.     If (dwBelowTo < &H4) Then Exit Function
  6.     dwBelowTo = (dwBelowTo - &H1)
  7.     N = dwBelowTo \ &H3
  8.     M = dwBelowTo \ &H5
  9.     I = M \ &H3
  10.     mul3and5_Ver3 = (&H3 * N * (N + &H1) \ &H2) + (&H5 * ((M * (M + &H1) \ &H2) - &H3 * (I * (I + &H1) \ &H2)))
  11. End Function
  12.  

Les dejo mi Análisis que anduve asiendo en el Block de Notas... Algo similar hice en las versiones anteriores.
Lo que trato de obtener son simples formulas de series numéricas bajo patrones...

/*
01 02 03 04 05 06 07 08 09 10
11 12 13 14 15 16 17 18 19 20
21 22 23 24 25 26 27 28 29 30

Cantidad múltiplos de 3 = 10 <--- Tomamos TODOS los múltiplos de 3 (3, 6, 9, 12, 15, 18, 21, 24, 27, 30, ...)

01 02    04 05    07 08    10
11    13 14    16 17    19 20
   22 23    25 26    28 29    

Cantidad múltiplos de 5 = 6
Removiendo múltiplos de 3 que se repitan en los de 5 = 4 múltiplos de 5 son los que quedan.
Se recurre en un patrón de 2 múltiplos de 5 y el siguiente se excluye por que será múltiplo de 3 como se ve en los números anteriores ( 5, 10, 20, 25, 35, 40, ...).

Por lo tanto Para 30

=1(3) + 2(3) + 3(3) + 4(3) + 5(3) + 6(3) + 7(3) + 8(3) + 9(3) + 10(3)
=3 * (1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10) <--- Se genera una sumatoria multiplicada por 3.
=3 * 10 * (10 + 1) \ 2
Por lo tanto:
z = Numero Máximo.
N = Z \ 3
= 3 * N * (N + 1) \ 2 <--- Formula trozo 1 Ok...


= 1(5) + 2(5) + 4(5) + 5(5)
= 5 * (1 + 2 + 4 + 5) <-- Casi se genera una sumatoria así que sumo 3 y resto 3 ( 3-3 = 0 ) esto no importa no afecta...
= 5 * (1 + 2 + 3 + 4 + 5 - 3) <-- Sumatoria que se le resta 3 y a su resultado se multiplica 5.
= 5 * (5 * (5 + 1) \ 2 - 3)
Por lo tanto:
z = Numero Máximo.
N = Z \ 5
 = 5 * (N * (N + 1) \ 2 - 3 ) <-- Aun falta corroborar si no hay que multiplicar o dividir ese -3 por lo tanto Expando...


= 5 * (1 + 2 + 4 + 5 + 7 + 8 + 10 + 11)
= 5 * (1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11    - 3 - 6 - 9)
= 5 * (1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11    - 3(1 + 2 + 3)) <-- Si habia algo que hacerle a ese -3 se le multipplicaba por una sumatoria.
= 5 * (11 * (11 + 1) \ 2        - 3 ( 3 * (3 + 1) \ 2))
Por lo tanto:
z = Numero Máximo.
M = Z \ 5
I = M \ 3
= 5 * ((M * (M + 1) \ 2) - 3 ( I * (I + 1) \ 2)) <-- Formula trozo 2 Ok

Por lo tanto para calcular la sumatoria de los múltiplos de 3 y 5 es:

(3 * N * (N + 1) \ 2 + N) + (5 * ((M * (M + 1) \ 2) - 3 * (I * (I + 1) \ 2)))
Donde:
z = Numero Máximo.
N = Z \ 3
M = Z \ 5
I = M \ 3
Todas las divisiones son en ENTEROS "\"

*/

--> Edito

Me estoy dando cuenta que el código es SIMILAR pero no igual al de MCKSys Argentina (Saca una sumatoria hasta 15, en base a un análisis similar)... me di cuenta ya tarde...

Dulces Lunas!¡.

Título: Re: [RETO] Proyect Euler 1
Publicado por: Danyfirex en 24 Enero 2013, 15:04 pm
Bueno aquí dejo  mi otra funcion un poco mas optima que las anteriores ("mias")  :¬¬


Código
  1. Function mul_3_5(numero As Long) As Long
  2. Dim a, b, c, d, e, f, g, i As Integer
  3. a = 3
  4. b = 2
  5. c = 1
  6. d = 3
  7. e = 1
  8. f = 2
  9. g = 3
  10. i = 0
  11. While i < numero
  12. i = i + a
  13. mul_3_5 = mul_3_5 + i
  14. If i = numero - 1 Then Exit Function
  15. i = i + b
  16. mul_3_5 = mul_3_5 + i
  17. If i = numero - 1 Then Exit Function
  18. i = i + c
  19. mul_3_5 = mul_3_5 + i
  20. If i = numero - 1 Then Exit Function
  21. i = i + d
  22. mul_3_5 = mul_3_5 + i
  23. If i = numero - 1 Then Exit Function
  24. i = i + e
  25. mul_3_5 = mul_3_5 + i
  26. If i = numero - 1 Then Exit Function
  27. i = i + f
  28. mul_3_5 = mul_3_5 + i
  29. If i = numero - 1 Then Exit Function
  30. i = i + g
  31. mul_3_5 = mul_3_5 + i
  32. If i = numero - 1 Then Exit Function
  33. Wend
  34.  
  35. End Function


Muy Rápidas  las de  BlackZeroX  & MCKSys Argentina  :o


saludos

Título: Re: [RETO] Proyect Euler 1
Publicado por: MCKSys Argentina en 24 Enero 2013, 16:18 pm
Cita de: BlackZeroX (Astaroth) en 24 Enero 2013, 14:12 pm
Me estoy dando cuenta que el código es SIMILAR pero no igual al de MCKSys Argentina (Saca una sumatoria hasta 15, en base a un análisis similar)... me di cuenta ya tarde...

Creo que la idea es muy similar: En mi caso dividí la cosa en 3 partes: la sumatoria de los multiplos de 3, la de los de 5 y la sumatoria de las "colisiones" entre ambos. La primera cuenta calcula la suma de todos los "15"s que hay entre 3 y el numero dado. Luego calculas la suma de los multiplos de 5 y le resta los ya obtenidos y por ultimo hace lo mismo pero con los de 3.

La formula n * (n+1) / 2 me vino al pelo para reemplazar la sumatoria 1..n y asi quitar los bucles.

En fin, creo que este reto ya ha sido superado y convendria pasar al siguiente, aunque, bueno, no se si estan todos de acuerdo...  :)

Saludos!

PD: @BlackZeroX: Esta noche, cuando llegue a casa, hago benchmarks con compilados!

Título: Re: [RETO] Proyect Euler 1
Publicado por: Psyke1 en 24 Enero 2013, 16:54 pm
Cita de: MCKSys Argentina en 24 Enero 2013, 16:18 pm
En fin, creo que este reto ya ha sido superado y convendria pasar al siguiente, aunque, bueno, no se si estan todos de acuerdo...  :)

¡Eso creo yo también!
Es genial que se participe tanto, porque la verdad es que vuestras formas de hacerlo no se me hubieran ocurrido. :D
Voy a crear el segundo reto.

DoEvents! :P

Título: Re: [RETO] Proyect Euler 1
Publicado por: LeandroA en 24 Enero 2013, 19:39 pm
Bueno esta es la mía, pero solo responde el enunciado de la pagina no tiene mas opciones.

Código
  1. Private Function Euler1_LeandroA() As Long
  2.  
  3.     Dim i As Long, lResult As Long, lSum As Long
  4.  
  5.     For i = 1 To 999 \ 3 Step 3
  6.         lSum = lSum + (i * 9) + 9
  7.     Next
  8.  
  9.     For i = 1 To 999 \ 5 Step 5
  10.         lResult = (i * 25) + 25
  11.         If (lResult Mod 15) Then lSum = lSum + lResult
  12.     Next
  13.  
  14.     Euler1_LeandroA = lSum - 15
  15.  
  16. End Function
  17.  

Título: Re: [RETO] Proyect Euler 1
Publicado por: rob1104 en 24 Enero 2013, 22:28 pm
Va el mio, seguro gano al mas lento  ;D

Código
  1. Function robEuler1() As Long
  2.     Dim i As Integer, suma As Long
  3.     For i = 0 To 999
  4.         If i Mod 3 = 0 Or i Mod 5 = 0 Then
  5.             suma = suma + i
  6.         End If
  7.     Next i
  8.     robEuler1 = suma
  9. End Function

Saludos!!!

Título: Re: [RETO] Proyect Euler 1
Publicado por: imoen en 25 Enero 2013, 12:32 pm
HOla

Rob1104 , tu codigo es lo mas normal , y no es el mas lento me gusta por que es clarito simple y funcional

LeandroA, siento decirte que tu código es el mas lento de todo, o al menos eso creo , pq recorres el campo de datos 2 veces , aunque vallas haciendo los saltos de 3 y 5 ademas que los bucles for son quizá los mas lentos , eso combinado con que calculas el modulo te ponen en el codigo mas lento.


Una cosa el código sea lento no significa que sea el peor , pq insisto en que los códigos deben ser legibles y entendibles por cualquiera , un codigo muy veloz pero ofuscado tampoco es rentable a pesar de ser muy rapido pero bueno , que esta muy bien que haya de todo :)

bs imoen

Título: Re: [RETO] Proyect Euler 1
Publicado por: Psyke1 en 25 Enero 2013, 12:42 pm
Cierto, pero en estos retos se trata de exprimir al máximo la velocidad. Es indiferente que no sea bonito (en este caso en concreto).
Vale todo. ;)

DoEvents! :P

Título: Re: [RETO] Proyect Euler 1
Publicado por: imoen en 25 Enero 2013, 12:46 pm
Pues te lanzo la version del reto 1.1

Como hay que hacerlo rapido , y di distribuyes cada calculo de busqueda los 3 por un lado y los 5 por el otro , peroo cada bloque aun core distinto del procesador :P  ( tambien me sirve si haces dos hilos y ejecutas los hilos a la vez ) uhh , en el caso de no haber cores pero tener HT pues es lo mismo, lo que no se es si VB6 permite el balanceo de carga por nucleos :P

bs imoen

PD -> como lo flipo ehh XDDD

Título: Re: [RETO] Proyect Euler 1
Publicado por: MCKSys Argentina en 25 Enero 2013, 20:48 pm
En este caso, para mejorar la velocidad, solo tuve que analizar el problema, plantear diferentes ideas y usar matematica. Por lo que veo, BlackZeroX hizo lo mismo.

Recuerda que el procesador mas poderoso del planeta esta sobre tus hombros y es el UNICO que funciona mejor mientras MAS lo usas.  ;)

Saludos!

Título: Re: [RETO] Proyect Euler 1
Publicado por: BlackZeroX en 25 Enero 2013, 23:20 pm
Cita de: imoen en 25 Enero 2013, 12:32 pm
Una cosa el código sea lento no significa que sea el peor , pq insisto en que los códigos deben ser legibles y entendibles por cualquiera , un codigo muy veloz pero ofuscado tampoco es rentable a pesar de ser muy rapido pero bueno , que esta muy bien que haya de todo :)

Los análisis matemáticos para no dejarle la carga a el CPU no es igual a ofuscar el código... de hecho cuando se tienen limitan-tes como en los PICS se deben usar mucho las matemáticas de cualquier índole.

Cita de: imoen en 25 Enero 2013, 12:46 pm
Pues te lanzo la version del reto 1.1

Como hay que hacerlo rapido , y di distribuyes cada calculo de busqueda los 3 por un lado y los 5 por el otro , peroo cada bloque aun core distinto del procesador :P  ( tambien me sirve si haces dos hilos y ejecutas los hilos a la vez ) uhh , en el caso de no haber cores pero tener HT pues es lo mismo, lo que no se es si VB6 permite el balanceo de carga por nucleos :P

bs imoen

PD -> como lo flipo ehh XDDD

Los hilos y balanceo por núcleo es inestable en VB6... sin en cambio solo son llamadas a APIS.

El código en C se parecería algo así... en VB6 sería prácticamente lo mismo.
Código
  1. void threadFunc()
  2. {
  3.     //  Codigo...
  4.     ExitThread (dwAlgunValor);
  5. }
  6.  
  7. // Los siguiente en alg&#250;n proceso X como main()...
  8.  
  9. 	GetSystemInfo(&sysInfo);
  10. 	printf("Numero de nucleos: %d.\n", (int)sysInfo.dwNumberOfProcessors);
  11. 	hThread = CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)threadFunc, NULL, 0, &dwThreadId);
  12.  
  13. 	if (SetThreadAffinityMask(hThread, 1 << (bCoreToUse % 8)) != 0)
  14. 		printf("ThreadAffinity se establecio con exito en el nucleo %d.\n", (int)bCoreToUse);
  15. 	else
  16. 		printf("ThreadAffinity error! El sistema repartira la carga del Thread!");
  17.  
  18.         if (!GetExitCodeThread (hThread, &dwRes)
  19. 		printf("Imposible de obtener el resultado del hilo");
  20. ...
  21.  
  22.  

Aun así este proceso es MUY LENTO cuando ya se a generado una formula matemática a lápiz y papel la cual es la mas optima posible.

P.D.: Los programadores estamos muchos años atrasados en la tecnología debido a que SIEMPRE le dejamos el trabajo pesado al hardware...

Dulces Lunas!¡.

Título: Re: [RETO] Proyect Euler 1
Publicado por: imoen en 25 Enero 2013, 23:50 pm
Hola

he estado investigando un poco sobre VB6 y aunque no tiene exactamente de forma nativa el uso de nucleos si que se puede hacer algun apaño

os dejo un link ;http://www.svcommunity.org/forum/vb/threads-o-hilos-en-vb6-0/

Claro en C si hay mas opciones , y estamos seguros que distribuir la carga a cada core es mas lento que la formulita matematica ?¿

bs imoen

Título: Re: [RETO] Proyect Euler 1
Publicado por: BlackZeroX en 25 Enero 2013, 23:53 pm
Cita de: imoen en 25 Enero 2013, 23:50 pm
y estamos seguros que distribuir la carga a cada core es mas lento que la formulita matematica ?¿

Has un benchmark EN CUALQUIER LENGUAJE y nos cuentas.

Dulces Lunas!¡.

Título: Re: [RETO] Proyect Euler 1
Publicado por: LeandroA en 26 Enero 2013, 10:44 am
Cita de: imoen en 25 Enero 2013, 12:32 pm
LeandroA, siento decirte que tu código es el mas lento de todo, o al menos eso creo , pq recorres el campo de datos 2 veces , aunque vallas haciendo los saltos de 3 y 5 ademas que los bucles for son quizá los mas lentos , eso combinado con que calculas el modulo te ponen en el codigo mas lento.

Te equivocas, es uno de los mas rápidos dentro de los que usan bucles, pero reconozco que es una suerte de mentira ya que no no podría usar otro numero que no sea  1000 (al menos eso creo).

eso si ni se acerca a la de MCKSys Argentina y a la V3 de BlackZeroX

Citar
Tiempo BlackZeroX V2                   951,788 msec
Resultado BlackZeroX V2               233168

Tiempo BlackZeroX V1                   1.537,512 msec
Resultado BlackZeroX V1                233168

Tiempo 7913                                  6.466,132 msec
Resultado 7913                               233168

Tiempo dany                                  6.169,530 msec
Resultado dany                               233168

Tiempo Spyke1                               3.692,984 msec
Resultado Spyke1                            233168

Tiempo Argentina                            60,390 msec
Resultado Argentina                         233168

Tiempo LeandroA                             1.336,028 msec
Resultado LeandroA                         233168

Tiempo BlackZeroX V3                     53,147 msec
Resultado BlackZeroX V3                 233168

Saludos.

Título: Re: [RETO] Proyect Euler 1
Publicado por: imoen en 26 Enero 2013, 11:20 am
LEandro

Acabas de convertirte en testeador oficial del proyecto xDDDDDDDDDDD, yo te nombrbo in nomime patre et filium XDDD, puedes retocar el code para que ordene del mas rápido al mas lento , y ya eres el testeador oficial del reto xDD

Uh , por una lado tiene suerte pq a 1000 es div by 5 , entoces vale step 5 en el for , y tambien en el 3 step 3 , pero si fuera efectivamente 1001 ya no valdria xD

bs imoen


Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines