elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.


 


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo, raul338)
| | |-+  [RETO] Project Euler 3
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [RETO] Project Euler 3  (Leído 1,403 veces)
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.086



Ver Perfil WWW
[RETO] Project Euler 3
« en: 31 Enero 2013, 13:12 »

Los factores primos de 13195 son 5, 7, 13 and 29.
¿Cual es el factor primo más grande del numero 600851475143?

Debe devolver el número:
Código:
6857

Código:
http://projecteuler.net/problem=3

Estructura:
Código
  1. Public Function ProyectEuler3(Optional ByVal lNumber As Double = 600851475143) As Double

DoEvents! :P


« Última modificación: 3 Febrero 2013, 16:21 por Psyke1 » En línea

$Edu$


Desconectado Desconectado

Mensajes: 1.843



Ver Perfil
Re: Re: [RETO] Proyect Euler 3
« Respuesta #1 en: 31 Enero 2013, 15:08 »

No me gustan estos retos donde gana el que sabe buscar mejor en google jaja.


En línea

Danyfirex


Desconectado Desconectado

Mensajes: 490


My Dear Mizuho


Ver Perfil
Re: Re: [RETO] Proyect Euler 3
« Respuesta #2 en: 31 Enero 2013, 15:14 »

No me gustan estos retos donde gana el que sabe buscar mejor en google jaja.

No necesariamente todos buscan en google.
al menos yo busco en wikipedia. algo mas conceptual.
ya llevo media hora leyendo y no he buscado soluciones en google que por supuesto que ya las hay.

saludos $Edu$
En línea

Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.086



Ver Perfil WWW
Re: [RETO] Proyect Euler 3
« Respuesta #3 en: 31 Enero 2013, 16:36 »

No me gustan estos retos donde gana el que sabe buscar mejor en google jaja.

Si alguien es tan estúpido como para hacer eso adelante. No aprenderá nada y encima se estará engañando a sí mismo. :¬¬
Además, hay muchas formas de hacerlo. ;)

DoEvents! :P
En línea

$Edu$


Desconectado Desconectado

Mensajes: 1.843



Ver Perfil
Re: Re: [RETO] Proyect Euler 3
« Respuesta #4 en: 31 Enero 2013, 16:55 »

Esque lo digo por el hecho de que el mejor codigo sera el que use bien las matematicas y no todos estamos en una universidad donde hallamos aprendido esas cosas :P

Si uso lo aprendido del colegio, hago un simple bucle y listo pero se que no sera ni cerca el mas rapido xD

Pero vamos, que siempre se tienen algo entre manos ustedes :P
En línea

Elemental Code


Desconectado Desconectado

Mensajes: 622


Im beyond the system


Ver Perfil
Re: [RETO] Proyect Euler 3
« Respuesta #5 en: 1 Febrero 2013, 02:12 »

edu yo pensaba lo mismo y sin embargo gane un par de retos  ;-)

Vos no te preocupes por competir con la magia negra (ASM, movimientos en el stack, etc) (o si te preocupas, aprende y se mejor ;) )
Vos hace lo mejor que te salga.
En línea

I CODE FOR $$$
Programo por $$$
Hago tareas, trabajos para la facultad, lo que sea en VB6.0

Mis programas
DarkMatrix

Desconectado Desconectado

Mensajes: 148


Nuestro Limite es la Imaginacion


Ver Perfil WWW
Re: [RETO] Proyect Euler 3
« Respuesta #6 en: 1 Febrero 2013, 03:56 »

Bueno no creo que sea el mas rapido pero al menos da el resultado correcto xD

Código
  1. Public Function ProyectEuler3_ByDark(Optional ByVal lNumber As Double = 600851475143#) As Double
  2.  
  3.    Dim N As Double
  4.    Dim A As Double
  5.    Dim B As Double
  6.  
  7.    Do
  8.  
  9.        N = N + 1
  10.  
  11.        A = lNumber / N
  12.        B = Fix(lNumber / N)
  13.  
  14.        If A - B = 0 Then
  15.  
  16.            lNumber = B
  17.            ProyectEuler3_ByDark = N
  18.            N = 1
  19.  
  20.        End If
  21.  
  22.    Loop Until lNumber = 1
  23.  
  24. End Function
« Última modificación: 1 Febrero 2013, 04:00 por DarkMatrix » En línea

Todo aquello que no se puede hacer, es lo que no intentamos hacer.
Projecto Ani-Dimension Digital Duel Masters (Juego de cartas masivo multijugador online hecho en Visual Basic 6.0)

Desing by DarkMatrix
BlackZeroX (Astaroth)
Wiki

Conectado Conectado

Mensajes: 3.174


I'Love...!¡.


Ver Perfil WWW
Re: Re: [RETO] Proyect Euler 3
« Respuesta #7 en: 1 Febrero 2013, 08:31 »

Me trae sin cuidado por ahora la velocidad...

Código
  1. Option Explicit
  2. Option Base 0
  3.  
  4. Public Function ProyectEuler3_ByBlack(Optional ByVal lNumber As Double = 600851475143#) As Double
  5. Dim arr()   As Variant
  6. Dim auxn    As Double
  7. Dim auxd    As Double
  8. Dim i       As Long
  9.    arr = Array(2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281, 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389, 397, 401, 409, 419, 421, 431, 433, 439, 443, 449, 457, 461, 463, 467, 479, 487, 491, 499, 503, 509, 521, 523, 541, 547, 557, 563, 569, 571, 577, 587, 593, 599, 601, 607, 613, 617, 619, 631, 641, 643, 647, 653, 659, 661, 673, 677, 683, 691, 701, 709, 719, 727, 733, 739, 743, 751, 757, 761, 769, 773, 787, 797, 809, 811, 821, 823, 827, 829, 839, 853, 857, _
  10.                859, 863, 877, 881, 883, 887, 907, 911, 919, 929, 937, 941, 947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013, 1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069, 1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129, 1151, 1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223, 1229, 1231, 1237, 1249, 1259, 1277, 1279, 1283, 1289, 1291, 1297, 1301, 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373, 1381, 1399, 1409, 1423, 1427, 1429, 1433, 1439, 1447, 1451, 1453, 1459, 1471, 1481, 1483, 1487, 1489, 1493, 1499, 1511, 1523, 1531, 1543, 1549, 1553, 1559, 1567, 1571, 1579, 1583, 1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657, 1663, 1667, 1669, 1693, 1697, 1699, 1709, 1721, 1723, 1733, 1741, 1747, 1753, 1759, 1777, 1783, 1787, 1789, 1801, 1811, 1823, 1831, 1847, 1861, 1867, 1871, 1873, 1877, 1879, 1889, 1901, 1907, 1913, 1931, 1933, _
  11.                1949, 1951, 1973, 1979, 1987, 1993, 1997, 1999, 2003, 2011, 2017, 2027, 2029, 2039, 2053, 2063, 2069, 2081, 2083, 2087, 2089, 2099, 2111, 2113, 2129, 2131, 2137, 2141, 2143, 2153, 2161, 2179, 2203, 2207, 2213, 2221, 2237, 2239, 2243, 2251, 2267, 2269, 2273, 2281, 2287, 2293, 2297, 2309, 2311, 2333, 2339, 2341, 2347, 2351, 2357, 2371, 2377, 2381, 2383, 2389, 2393, 2399, 2411, 2417, 2423, 2437, 2441, 2447, 2459, 2467, 2473, 2477, 2503, 2521, 2531, 2539, 2543, 2549, 2551, 2557, 2579, 2591, 2593, 2609, 2617, 2621, 2633, 2647, 2657, 2659, 2663, 2671, 2677, 2683, 2687, 2689, 2693, 2699, 2707, 2711, 2713, 2719, 2729, 2731, 2741, 2749, 2753, 2767, 2777, 2789, 2791, 2797, 2801, 2803, 2819, 2833, 2837, 2843, 2851, 2857, 2861, 2879, 2887, 2897, 2903, 2909, 2917, 2927, 2939, 2953, 2957, 2963, 2969, 2971, 2999, 3001, 3011, 3019, 3023, 3037, 3041, 3049, 3061, 3067, 3079, 3083, 3089, _
  12.                3109, 3119, 3121, 3137, 3163, 3167, 3169, 3181, 3187, 3191, 3203, 3209, 3217, 3221, 3229, 3251, 3253, 3257, 3259, 3271, 3299, 3301, 3307, 3313, 3319, 3323, 3329, 3331, 3343, 3347, 3359, 3361, 3371, 3373, 3389, 3391, 3407, 3413, 3433, 3449, 3457, 3461, 3463, 3467, 3469, 3491, 3499, 3511, 3517, 3527, 3529, 3533, 3539, 3541, 3547, 3557, 3559, 3571, 3581, 3583, 3593, 3607, 3613, 3617, 3623, 3631, 3637, 3643, 3659, 3671, 3673, 3677, 3691, 3697, 3701, 3709, 3719, 3727, 3733, 3739, 3761, 3767, 3769, 3779, 3793, 3797, 3803, 3821, 3823, 3833, 3847, 3851, 3853, 3863, 3877, 3881, 3889, 3907, 3911, 3917, 3919, 3923, 3929, 3931, 3943, 3947, 3967, 3989, 4001, 4003, 4007, 4013, 4019, 4021, 4027, 4049, 4051, 4057, 4073, 4079, 4091, 4093, 4099, 4111, 4127, 4129, 4133, 4139, 4153, 4157, 4159, 4177, 4201, 4211, 4217, 4219, 4229, 4231, 4241, 4243, 4253, 4259, 4261, 4271, 4273, 4283, 4289, _
  13.                4297, 4327, 4337, 4339, 4349, 4357, 4363, 4373, 4391, 4397, 4409, 4421, 4423, 4441, 4447, 4451, 4457, 4463, 4481, 4483, 4493, 4507, 4513, 4517, 4519, 4523, 4547, 4549, 4561, 4567, 4583, 4591, 4597, 4603, 4621, 4637, 4639, 4643, 4649, 4651, 4657, 4663, 4673, 4679, 4691, 4703, 4721, 4723, 4729, 4733, 4751, 4759, 4783, 4787, 4789, 4793, 4799, 4801, 4813, 4817, 4831, 4861, 4871, 4877, 4889, 4903, 4909, 4919, 4931, 4933, 4937, 4943, 4951, 4957, 4967, 4969, 4973, 4987, 4993, 4999, 5003, 5009, 5011, 5021, 5023, 5039, 5051, 5059, 5077, 5081, 5087, 5099, 5101, 5107, 5113, 5119, 5147, 5153, 5167, 5171, 5179, 5189, 5197, 5209, 5227, 5231, 5233, 5237, 5261, 5273, 5279, 5281, 5297, 5303, 5309, 5323, 5333, 5347, 5351, 5381, 5387, 5393, 5399, 5407, 5413, 5417, 5419, 5431, 5437, 5441, 5443, 5449, 5471, 5477, 5479, 5483, 5501, 5503, 5507, 5519, 5521, 5527, 5531, 5557, 5563, 5569, 5573, _
  14.                5581, 5591, 5623, 5639, 5641, 5647, 5651, 5653, 5657, 5659, 5669, 5683, 5689, 5693, 5701, 5711, 5717, 5737, 5741, 5743, 5749, 5779, 5783, 5791, 5801, 5807, 5813, 5821, 5827, 5839, 5843, 5849, 5851, 5857, 5861, 5867, 5869, 5879, 5881, 5897, 5903, 5923, 5927, 5939, 5953, 5981, 5987, 6007, 6011, 6029, 6037, 6043, 6047, 6053, 6067, 6073, 6079, 6089, 6091, 6101, 6113, 6121, 6131, 6133, 6143, 6151, 6163, 6173, 6197, 6199, 6203, 6211, 6217, 6221, 6229, 6247, 6257, 6263, 6269, 6271, 6277, 6287, 6299, 6301, 6311, 6317, 6323, 6329, 6337, 6343, 6353, 6359, 6361, 6367, 6373, 6379, 6389, 6397, 6421, 6427, 6449, 6451, 6469, 6473, 6481, 6491, 6521, 6529, 6547, 6551, 6553, 6563, 6569, 6571, 6577, 6581, 6599, 6607, 6619, 6637, 6653, 6659, 6661, 6673, 6679, 6689, 6691, 6701, 6703, 6709, 6719, 6733, 6737, 6761, 6763, 6779, 6781, 6791, 6793, 6803, 6823, 6827, 6829, 6833, 6841, 6857, 6863, _
  15.                6869, 6871, 6883, 6899, 6907, 6911, 6917, 6947, 6949, 6959, 6961, 6967, 6971, 6977, 6983, 6991, 6997, 7001, 7013, 7019, 7027, 7039, 7043, 7057, 7069, 7079, 7103, 7109, 7121, 7127, 7129, 7151, 7159, 7177, 7187, 7193, 7207, 7211, 7213, 7219, 7229, 7237, 7243, 7247, 7253, 7283, 7297, 7307, 7309, 7321, 7331, 7333, 7349, 7351, 7369, 7393, 7411, 7417, 7433, 7451, 7457, 7459, 7477, 7481, 7487, 7489, 7499, 7507, 7517, 7523, 7529, 7537, 7541, 7547, 7549, 7559, 7561, 7573, 7577, 7583, 7589, 7591, 7603, 7607, 7621, 7639, 7643, 7649, 7669, 7673, 7681, 7687, 7691, 7699, 7703, 7717, 7723, 7727, 7741, 7753, 7757, 7759, 7789, 7793, 7817, 7823, 7829, 7841, 7853, 7867, 7873, 7877, 7879, 7883, 7901, 7907, 7919, 7927, 7933, 7937, 7949, 7951, 7963, 7993, 8009, 8011, 8017, 8039, 8053, 8059, 8069, 8081, 8087, 8089, 8093, 8101, 8111, 8117, 8123, 8147, 8161, 8167, 8171, 8179, 8191, 8209, 8219, _
  16.                8221, 8231, 8233, 8237, 8243, 8263, 8269, 8273, 8287, 8291, 8293, 8297, 8311, 8317, 8329, 8353, 8363, 8369, 8377, 8387, 8389, 8419, 8423, 8429, 8431, 8443, 8447, 8461, 8467, 8501, 8513, 8521, 8527, 8537, 8539, 8543, 8563, 8573, 8581, 8597, 8599, 8609, 8623, 8627, 8629, 8641, 8647, 8663, 8669, 8677, 8681, 8689, 8693, 8699, 8707, 8713, 8719, 8731, 8737, 8741, 8747, 8753, 8761, 8779, 8783, 8803, 8807, 8819, 8821, 8831, 8837, 8839, 8849, 8861, 8863, 8867, 8887, 8893, 8923, 8929, 8933, 8941, 8951, 8963, 8969, 8971, 8999, 9001, 9007, 9011, 9013, 9029, 9041, 9043, 9049, 9059, 9067, 9091, 9103, 9109, 9127, 9133, 9137, 9151, 9157, 9161, 9173, 9181, 9187, 9199, 9203, 9209, 9221, 9227, 9239, 9241, 9257, 9277, 9281, 9283, 9293, 9311, 9319, 9323, 9337, 9341, 9343, 9349, 9371, 9377, 9391, 9397, 9403, 9413, 9419, 9421, 9431, 9433, 9437, 9439, 9461, 9463, 9467, 9473, 9479, 9491, 9497, _
  17.                9511, 9521, 9533, 9539, 9547, 9551, 9587, 9601, 9613, 9619, 9623, 9629, 9631, 9643, 9649, 9661, 9677, 9679, 9689, 9697, 9719, 9721, 9733, 9739, 9743, 9749, 9767, 9769, 9781, 9787, 9791, 9803, 9811, 9817, 9829, 9833, 9839, 9851, 9857, 9859, 9871, 9883, 9887, 9901, 9907, 9923, 9929, 9931, 9941, 9949, 9967, 9973, 10007, 10009, 10037, 10039, 10061, 10067, 10069, 10079, 10091, 10093, 10099, 10103, 10111, 10133, 10139, 10141, 10151, 10159, 10163, 10169, 10177, 10181, 10193, 10211, 10223, 10243, 10247, 10253, 10259, 10267, 10271, 10273, 10289, 10301, 10303, 10313, 10321, 10331, 10333, 10337, 10343, 10357, 10369, 10391, 10399, 10427, 10429, 10433, 10453, 10457, 10459, 10463, 10477, 10487, 10499, 10501, 10513, 10529, 10531, 10559, 10567, 10589, 10597, 10601, 10607, 10613, 10627, 10631, 10639, 10651, 10657, 10663, 10667, 10687, 10691, 10709, 10711, 10723, 10729, 10733, 10739, 10753, 10771, 10781, 10789, 10799, 10831, 10837, 10847, 10853, 10859, 10861, 10867, 10883, 10889, _
  18.                10891, 10903, 10909, 10937, 10939, 10949, 10957, 10973, 10979, 10987, 10993, 11003, 11027, 11047, 11057, 11059, 11069, 11071, 11083, 11087, 11093, 11113, 11117, 11119, 11131, 11149, 11159, 11161, 11171, 11173, 11177, 11197, 11213, 11239, 11243, 11251, 11257, 11261, 11273, 11279, 11287, 11299, 11311, 11317, 11321, 11329, 11351, 11353, 11369, 11383, 11393, 11399, 11411, 11423, 11437, 11443, 11447, 11467, 11471, 11483, 11489, 11491, 11497, 11503, 11519, 11527, 11549, 11551, 11579, 11587, 11593, 11597, 11617, 11621, 11633, 11657, 11677, 11681, 11689, 11699, 11701, 11717, 11719, 11731, 11743, 11777, 11779, 11783, 11789, 11801, 11807, 11813, 11821, 11827, 11831, 11833, 11839, 11863, 11867, 11887, 11897, 11903, 11909, 11923, 11927, 11933, 11939, 11941, 11953, 11959, 11969, 11971, 11981, 11987, 12007, 12011, 12037, 12041, 12043, 12049, 12071, 12073, 12097, 12101, 12107, 12109, 12113, 12119, 12143, 12149, 12157, 12161, 12163, 12197, 12203, 12211, 12227, 12239, 12241, 12251, _
  19.                12253, 12263, 12269, 12277, 12281, 12289, 12301, 12323, 12329, 12343, 12347, 12373, 12377, 12379, 12391, 12401, 12409, 12413, 12421, 12433, 12437, 12451, 12457, 12473, 12479, 12487, 12491, 12497, 12503, 12511, 12517, 12527, 12539, 12541, 12547, 12553, 12569, 12577, 12583, 12589, 12601, 12611, 12613, 12619, 12637, 12641, 12647, 12653, 12659, 12671, 12689, 12697, 12703, 12713, 12721, 12739, 12743, 12757, 12763, 12781, 12791, 12799, 12809, 12821, 12823, 12829, 12841, 12853, 12889, 12893, 12899, 12907, 12911, 12917, 12919, 12923, 12941, 12953, 12959, 12967, 12973, 12979, 12983, 13001, 13003, 13007, 13009, 13033, 13037, 13043, 13049, 13063, 13093, 13099, 13103, 13109, 13121, 13127, 13147, 13151, 13159, 13163, 13171, 13177, 13183, 13187, 13217, 13219, 13229, 13241, 13249, 13259, 13267, 13291, 13297, 13309, 13313, 13327, 13331, 13337, 13339, 13367, 13381, 13397, 13399, 13411, 13417, 13421, 13441, 13451, 13457, 13463, 13469, 13477, 13487, 13499, 13513, 13523, 13537, 13553, _
  20.                13567, 13577, 13591, 13597, 13613, 13619, 13627, 13633, 13649, 13669, 13679, 13681, 13687, 13691, 13693, 13697, 13709, 13711, 13721, 13723, 13729, 13751, 13757, 13759, 13763, 13781, 13789, 13799, 13807, 13829, 13831, 13841, 13859, 13873, 13877, 13879, 13883, 13901, 13903, 13907, 13913, 13921, 13931, 13933, 13963, 13967, 13997, 13999, 14009, 14011, 14029, 14033, 14051, 14057, 14071, 14081, 14083, 14087, 14107, 14143, 14149, 14153, 14159, 14173, 14177, 14197, 14207, 14221, 14243, 14249, 14251, 14281, 14293, 14303, 14321, 14323, 14327, 14341, 14347, 14369, 14387, 14389, 14401, 14407, 14411, 14419, 14423, 14431, 14437, 14447, 14449, 14461, 14479, 14489, 14503, 14519, 14533, 14537, 14543, 14549, 14551, 14557, 14561, 14563, 14591, 14593, 14621, 14627, 14629, 14633, 14639, 14653, 14657, 14669, 14683, 14699, 14713, 14717, 14723, 14731, 14737, 14741, 14747, 14753, 14759, 14767, 14771, 14779, 14783, 14797, 14813, 14821, 14827, 14831, 14843, 14851, 14867, 14869, 14879, 14887, _
  21.                14891, 14897, 14923, 14929, 14939, 14947, 14951, 14957, 14969, 14983, 15013, 15017, 15031, 15053, 15061, 15073, 15077, 15083, 15091, 15101, 15107)
  22.    While lNumber > 1
  23.        auxd = lNumber / arr(i)
  24.        auxn = Fix(auxd)
  25.        If (auxd = auxn) Then
  26.            lNumber = auxn
  27.        Else
  28.            i = (i + 1)
  29.        End If
  30.    Wend
  31.    ProyectEuler3_ByBlack = arr(i)
  32. End Function
  33.  

No estoy loco para calcular cada uno a mano...

Código:
Option Explicit
Option Base 0

Private Sub Form_Load()
Dim i As Long
Dim j As Long
Dim ln As Integer
Dim c As Integer
Dim sBuff As String
Const LIMIT As Long = 5000

    ln = 1
    
    For i = 2 To &H7FFFFFFF
        j = (i - 1)
        While (i Mod j <> 0)
            j = (j - 1)
        Wend
        
        If (j < 2) Then
            c = (c + 1)
            If (ln = 50) Then
                ln = 1
                sBuff = sBuff & i & " _" & vbCrLf
            Else
                sBuff = sBuff & i & " ,"
            End If
            ln = (ln + 1)
            If (c = LIMIT) Then Exit For
        End If
    Next
    
    ' Muestro de poco en poco con una interrupción... NO TODOS LOS NÚMEROS CABEN EN EL ARRAY.
    Debug.Print Mid$(sBuff, 1, 1000)
    Debug.Print Mid$(sBuff, 1001, 1000)
    Debug.Print Mid$(sBuff, 2001, 1000)
    Debug.Print Mid$(sBuff, 3001, 1000)
    Debug.Print Mid$(sBuff, 4001, 1000)
    Debug.Print Mid$(sBuff, 5001, 1000)
    Debug.Print Mid$(sBuff, 6001, 1000)
    Debug.Print Mid$(sBuff, 7001, 1000)
    Debug.Print Mid$(sBuff, 8001, 1000)
    Debug.Print Mid$(sBuff, 9001, 1000)
    Debug.Print Mid$(sBuff, 10001, 1000)
    Debug.Print Mid$(sBuff, 11001, 1000)
    Debug.Print Mid$(sBuff, 12001, 1000)
    Debug.Print Mid$(sBuff, 13001, 1000)
    Debug.Print Mid$(sBuff, 14001, 1000)
    Debug.Print Mid$(sBuff, 15001, 1000)
    Debug.Print Mid$(sBuff, 16001, 1000)
    Debug.Print Mid$(sBuff, 17001, 1000)
    Debug.Print Mid$(sBuff, 18001, 1000)
    Debug.Print Mid$(sBuff, 19001, 1000)
    Debug.Print Mid$(sBuff, 20001, 1000)
    Debug.Print Mid$(sBuff, 21001, 1000)
    Debug.Print Mid$(sBuff, 22001, 1000)
    Debug.Print Mid$(sBuff, 23001, 1000)
    Debug.Print Mid$(sBuff, 24001, 1000)
    Debug.Print Mid$(sBuff, 25001, 1000)

End Sub

Dulces Lunas!¡.
« Última modificación: 1 Febrero 2013, 08:38 por BlackZeroX (Astaroth) » En línea




CScript (Actualizado 26/06/2013).

FileX <-- Re-modelando...
Web Principal-->[ Blog(VB6/C/C++) | Host File | Scan Port) ]

The Dark Shadow is my passion.
El infierno es mi Hogar, mi novia es Lilit y el metal mi relig
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.086



Ver Perfil WWW
Re: [RETO] Proyect Euler 3
« Respuesta #8 en: 1 Febrero 2013, 13:25 »

@BlackZeroX  



:¬¬ :laugh:

La próxima vez aclararé que NO es válido precargar valores. Así pierde la gracia... :silbar:



Esta es mi forma de hacerlo (sé que se puede simplificar código, pero en esta ocasión no me interesa):

Código
  1. Public Static Function PE3_Psyke1(Optional ByVal dNumber As Double = 600851475143#) As Double
  2. Dim lCount                              As Long
  3. Dim dDiv                                As Double
  4.  
  5.    dDiv = dNumber / 2
  6.  
  7.    If dDiv = Fix(dDiv) Then
  8.        dNumber = dDiv
  9.    End If
  10.  
  11.    lCount = &H1
  12.  
  13.    Do
  14.        lCount = lCount + &H2
  15.        dDiv = dNumber / lCount
  16.  
  17.        If dDiv = Fix(dDiv) Then
  18.            dNumber = dDiv
  19.            dDiv = dNumber / 2
  20.  
  21.            If dDiv = Fix(dDiv) Then
  22.                dNumber = dDiv
  23.            End If
  24.  
  25.            PE3_Psyke1 = lCount
  26.            lCount = &H1
  27.        End If
  28.    Loop Until dNumber = 1
  29. End Function

Ejemplo:
Código
  1.    Debug.Print PE3_Psyke1 ' 6857
  2.  

DoEvents! :P
« Última modificación: 2 Febrero 2013, 19:36 por Psyke1 » En línea

imoen


Desconectado Desconectado

Mensajes: 1.566



Ver Perfil
Re: [RETO] Proyect Euler 3
« Respuesta #9 en: 1 Febrero 2013, 18:31 »

Holaaa jajaja

Lo primero , olvidaros de que el que esta en la uni sabe mas , cada uno que lo haga como pueda , siempre se puede luego mejorar.

@BlackZeroX   XDDDDDD, no se pueden cargar valoes pregcargados ?¿ , bueno pues se generan al inicio y ponemos una ventanita de loading xDD

creo que el de psyke es el mas rapido de momento .

bs imoen

En línea

Medion Akoya p6624
i-3 370
8 gigas DDR 3 RAM //750 hd 5400
gforce gt425 optimus XDD
Esta es mi casa, mi pueblo , o lo que queda de el aun asi lucharemos ... POR BENALIA....!!

srta imoen
BlackZeroX (Astaroth)
Wiki

Conectado Conectado

Mensajes: 3.174


I'Love...!¡.


Ver Perfil WWW
Re: Re: [RETO] Proyect Euler 3
« Respuesta #10 en: 2 Febrero 2013, 05:28 »

.
El perico es verde en cualquier parte.

@Psyke1
¿Cual trampa? nadie dijo que NO se podía hacer lo que hice...

Dulces Lunas!¡.
« Última modificación: 2 Febrero 2013, 05:36 por BlackZeroX (Astaroth) » En línea




CScript (Actualizado 26/06/2013).

FileX <-- Re-modelando...
Web Principal-->[ Blog(VB6/C/C++) | Host File | Scan Port) ]

The Dark Shadow is my passion.
El infierno es mi Hogar, mi novia es Lilit y el metal mi relig
BlackZeroX (Astaroth)
Wiki

Conectado Conectado

Mensajes: 3.174


I'Love...!¡.


Ver Perfil WWW
Re: Re: [RETO] Proyect Euler 3
« Respuesta #11 en: 2 Febrero 2013, 07:08 »

Tal vez esta versión no sea rápida pero usa una generación de números primos que se deseaban...

Código
  1. Option Explicit
  2. Option Base 0
  3.  
  4. Dim ManagerPrime    As clsPrime
  5.  
  6. Private Sub Form_Load()
  7.    Set ManagerPrime = New clsPrime
  8.  
  9.    Call ManagerPrime.Clear
  10.    MsgBox ManagerPrime.ItsPrime(6857)
  11.    MsgBox "Para calcular si fue primo se calcularon " & ManagerPrime.CountPrime() & " numeros primos."
  12.    Call ManagerPrime.Clear
  13.  
  14.    ManagerPrime.BufferLimitIndex(7000) = &H7FFFFFFF
  15.    MsgBox ProyectEuler3_ByBlack
  16.  
  17.    Set ManagerPrime = Nothing
  18. End Sub
  19.  
  20. Public Function ProyectEuler3_ByBlack(Optional ByVal lNumber As Double = 600851475143#) As Double
  21. 'Dim ManagerPrime    As clsPrime
  22. Dim auxn            As Double
  23. Dim auxd            As Double
  24. Dim i               As Long
  25.    'Set ManagerPrime = New clsPrime
  26.    While lNumber > 1
  27.        DoEvents
  28.        auxd = lNumber / ManagerPrime.Prime(i)
  29.        auxn = Fix(auxd)
  30.        If (auxd = auxn) Then
  31.            lNumber = auxn
  32.        Else
  33.            i = (i + 1)
  34.        End If
  35.    Wend
  36.    ProyectEuler3_ByBlack = ManagerPrime.Prime(i)
  37.    'Set ManagerPrime = Nothing
  38. End Function
  39.  

clsPrime.cls
Código
  1. Option Explicit
  2. Option Base 0
  3.  
  4. Private m_N             As Long
  5. Private m_Now           As Long
  6. Private m_Arr()         As Long
  7. Const MAX_LIMIT_VALUE   As Long = &H7FFFFFFF
  8.  
  9. Private Sub Class_Initialize()
  10.    Clear
  11. End Sub
  12.  
  13. Private Function Calculate(ByVal Start As Long, Optional ByVal MaxLimitValue As Long = MAX_LIMIT_VALUE) As Long
  14. Dim j As Long
  15.  
  16.    For m_Now = Start To MaxLimitValue
  17.  
  18.        j = (m_Now - 1)
  19.  
  20.        Do While (m_Now Mod j <> 0)
  21.            j = (j - 1)
  22.        Loop
  23.  
  24.        If (j < 2) Then
  25.            Calculate = m_Now
  26.            Exit Function
  27.        End If
  28.    Next
  29.  
  30.    Calculate = &H80000000
  31.  
  32. End Function
  33.  
  34. Public Sub Clear()
  35.    m_N = 0
  36.    m_Now = 2
  37.    ReDim m_Arr(m_N)
  38.    m_Arr(m_N) = 2
  39. End Sub
  40.  
  41. Public Property Let BufferLimitIndex(Optional ByVal MaxLimitValue As Long = MAX_LIMIT_VALUE, ByVal n As Long)
  42. Dim lRes        As Long
  43. Dim lNow        As Long
  44.  
  45.    Do While (m_N < n)
  46.        lRes = Calculate(m_Now + 1, MaxLimitValue)
  47.        If (lRes And &H80000000) Then
  48.            Exit Do
  49.        Else
  50.            m_N = (m_N + 1)
  51.            ReDim Preserve m_Arr(m_N)
  52.            m_Arr(m_N) = lRes
  53.        End If
  54.    Loop
  55. End Property
  56.  
  57. Public Property Get CountPrime() As Long
  58.    CountPrime = (m_N + 1)
  59. End Property
  60.  
  61. Public Property Get BufferLimitIndex(Optional ByVal MaxLimitValue As Long = MAX_LIMIT_VALUE) As Long
  62.    BufferLimitIndex = m_N
  63. End Property
  64.  
  65. Public Function Prime(ByVal Index As Long, Optional ByVal MaxLimitValue As Long = MAX_LIMIT_VALUE) As Long
  66. Dim lRes        As Long
  67.    Prime = &H80000000
  68.    If Index > m_N Then
  69.        BufferLimitIndex(MaxLimitValue) = Index
  70.        If Not (Index = m_N) Then Exit Function
  71.    End If
  72.    Prime = m_Arr(Index)
  73. End Function
  74.  
  75. Public Function ItsPrime(ByVal Value As Long) As Boolean
  76. Dim i       As Long
  77. Dim lRes    As Long
  78.  
  79.    ItsPrime = True
  80.  
  81.    If (m_Now < Value) Then
  82.  
  83.        Do
  84.            lRes = Prime(m_N + 1, Value)
  85.            If (lRes And &H80000000) Then Exit Do
  86.        Loop While (m_Arr(m_N) < Value)
  87.  
  88.        If Not (m_Arr(m_N) = Value) Then ItsPrime = False
  89.  
  90.    Else
  91.        For i = 0 To m_N
  92.            If (m_Arr(i) = Value) Then Exit For
  93.        Next
  94.  
  95.        ItsPrime = False
  96.  
  97.    End If
  98.  
  99. End Function
  100.  
  101. Private Sub Class_Terminate()
  102.    Call Clear
  103. End Sub
  104.  

Dulces Lunas!¡.
« Última modificación: 2 Febrero 2013, 07:22 por BlackZeroX (Astaroth) » En línea




CScript (Actualizado 26/06/2013).

FileX <-- Re-modelando...
Web Principal-->[ Blog(VB6/C/C++) | Host File | Scan Port) ]

The Dark Shadow is my passion.
El infierno es mi Hogar, mi novia es Lilit y el metal mi relig
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.086



Ver Perfil WWW
Re: [RETO] Proyect Euler 3
« Respuesta #12 en: 2 Febrero 2013, 15:08 »

Bueno he hecho unos test, aquí está el código:

Código:
Option Explicit
Private ManagerPrime    As New clsPrime

Private Sub Form_Load()
Dim Q                   As Long
Dim t                   As New CTiming
Const LOOPS             As Long = 500

    If App.LogMode = 0 Then MsgBox "¡Compila!", vbCritical: End
    
    Me.AutoRedraw = True
    Me.Print "Con " & LOOPS & " vueltas"
    Me.Print
    
    t.Reset
    Call ManagerPrime.Clear
    ManagerPrime.BufferLimitIndex(7000) = &H7FFFFFFF
    
    For Q = 1 To LOOPS
        ProyectEuler3_ByBlack
    Next Q
    Me.Print "BlackZeroX -> ", t.sElapsed
    
    t.Reset
    For Q = 1 To LOOPS
        ProyectEuler3_ByDark
    Next Q
    Me.Print "DarkMatrix -> ", t.sElapsed
    
    t.Reset
    For Q = 1 To LOOPS
        PE3_DarkmodPsyke1
    Next Q
    Me.Print "DarkmodPsyke1 -> ", t.sElapsed
    
    t.Reset
    For Q = 1 To LOOPS
        PE3_Psyke1
    Next Q
    Me.Print "Psyke1 -> ", , t.sElapsed
    
    Set ManagerPrime = Nothing
End Sub
 
Public Function ProyectEuler3_ByBlack(Optional ByVal lNumber As Double = 600851475143#) As Double
'Dim ManagerPrime    As clsPrime
Dim auxn            As Double
Dim auxd            As Double
Dim i               As Long
    'Set ManagerPrime = New clsPrime
    While lNumber > 1
        'DoEvents
        auxd = lNumber / ManagerPrime.Prime(i)
        auxn = Fix(auxd)
        If (auxd = auxn) Then
            lNumber = auxn
        Else
            i = (i + 1)
        End If
    Wend
    ProyectEuler3_ByBlack = ManagerPrime.Prime(i)
    'Set ManagerPrime = Nothing
End Function



Public Function ProyectEuler3_ByDark(Optional ByVal lNumber As Double = 600851475143#) As Double
 
    Dim n As Double
    Dim A As Double
    Dim B As Double
 
    Do
 
        n = n + 1
 
        A = lNumber / n
        B = Fix(lNumber / n)
 
        If A - B = 0 Then
 
            lNumber = B
            ProyectEuler3_ByDark = n
            n = 1
 
        End If
 
    Loop Until lNumber = 1
 
End Function

Public Static Function PE3_DarkmodPsyke1(Optional ByVal dNumber As Double = 600851475143#) As Double
Dim lCount                              As Long
Dim dDiv                                As Double
 
    Do While dNumber > 1
        lCount = lCount + &H1
        dDiv = dNumber / lCount
 
        If dDiv = Fix(dDiv) Then
            dNumber = dDiv
            PE3_DarkmodPsyke1 = lCount
            lCount = &H1
        End If
    Loop
End Function

Public Static Function PE3_Psyke1(Optional ByVal dNumber As Double = 600851475143#) As Double
Dim lCount                              As Long
Dim dDiv                                As Double
 
    dDiv = dNumber / 2
 
    If dDiv = Fix(dDiv) Then
        dNumber = dDiv
    End If
 
    lCount = &H1
 
    Do
        lCount = lCount + &H2
        dDiv = dNumber / lCount
 
        If dDiv = Fix(dDiv) Then
            dNumber = dDiv
            dDiv = dNumber / 2
 
            If dDiv = Fix(dDiv) Then
                dNumber = dDiv
            End If
 
            PE3_Psyke1 = lCount
            lCount = &H1
        End If
    Loop Until dNumber = 1
End Function

Y aquí unos resultados:







Obviamente a la larga gana la función de BlackZeroX puesto que no tiene que calcular casi nada... :¬¬
Yo personalmente me quedaría con la mía. :silbar:

Voy posteando el siguiente. :)

DoEvents! :P
« Última modificación: 2 Febrero 2013, 17:32 por Psyke1 » En línea

imoen


Desconectado Desconectado

Mensajes: 1.566



Ver Perfil
Re: [RETO] Project Euler 3
« Respuesta #13 en: 3 Febrero 2013, 20:45 »

Y para que dais tantas vueltas?¿ jeje

Esta clar si no tiene que calcular nada , pq ya esta precargado pues poco tiene que hacer


bs imoen
En línea

Medion Akoya p6624
i-3 370
8 gigas DDR 3 RAM //750 hd 5400
gforce gt425 optimus XDD
Esta es mi casa, mi pueblo , o lo que queda de el aun asi lucharemos ... POR BENALIA....!!

srta imoen
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Project Euler
Desafíos - Wargames
Franr 1 2,038 Último mensaje 10 Abril 2010, 01:09
por Og.
Projecto Euler problema 12
Ejercicios
lDanny 5 1,968 Último mensaje 16 Octubre 2010, 04:33
por [L]ord [R]NA
[RETO] Project Euler 1 « 1 2 3 4 »
Programación Visual Basic
Psyke1 42 4,532 Último mensaje 26 Enero 2013, 11:20
por imoen
[RETO] Project Euler 2 « 1 2 »
Programación Visual Basic
Psyke1 23 1,988 Último mensaje 25 Enero 2013, 23:19
por Danyfirex
[RETO] Project Euler 4
Programación Visual Basic
Psyke1 10 1,382 Último mensaje 4 Febrero 2013, 23:32
por imoen
Powered by SMF 1.1.19 | SMF © 2006-2008, Simple Machines