Título: [RETO] Project Euler 3
Publicado por: Psyke1 en 31 Enero 2013, 13:12 pm
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: http://projecteuler.net/problem=3 Estructura: Public Function ProyectEuler3(Optional ByVal lNumber As Double = 600851475143) As Double
DoEvents! :P
Título: Re: Re: [RETO] Proyect Euler 3
Publicado por: $Edu$ en 31 Enero 2013, 15:08 pm
No me gustan estos retos donde gana el que sabe buscar mejor en google jaja.
Título: Re: Re: [RETO] Proyect Euler 3
Publicado por: Danyfirex en 31 Enero 2013, 15:14 pm
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$
Título: Re: [RETO] Proyect Euler 3
Publicado por: Psyke1 en 31 Enero 2013, 16:36 pm
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
Título: Re: Re: [RETO] Proyect Euler 3
Publicado por: $Edu$ en 31 Enero 2013, 16:55 pm
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
Título: Re: [RETO] Proyect Euler 3
Publicado por: Elemental Code en 1 Febrero 2013, 02:12 am
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.
Título: Re: [RETO] Proyect Euler 3
Publicado por: DarkMatrix en 1 Febrero 2013, 03:56 am
Bueno no creo que sea el mas rapido pero al menos da el resultado correcto xD 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
Título: Re: Re: [RETO] Proyect Euler 3
Publicado por: BlackZeroX en 1 Febrero 2013, 08:31 am
Me trae sin cuidado por ahora la velocidad... Option Explicit Option Base 0 Public Function ProyectEuler3_ByBlack(Optional ByVal lNumber As Double = 600851475143#) As Double Dim arr() As Variant Dim auxn As Double Dim auxd As Double Dim i As Long 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, _ 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, _ 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, _ 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, _ 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, _ 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, _ 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, _ 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, _ 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, _ 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, _ 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, _ 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, _ 14891, 14897, 14923, 14929, 14939, 14947, 14951, 14957, 14969, 14983, 15013, 15017, 15031, 15053, 15061, 15073, 15077, 15083, 15091, 15101, 15107) While lNumber > 1 auxd = lNumber / arr(i) auxn = Fix(auxd) If (auxd = auxn) Then lNumber = auxn Else i = (i + 1) End If Wend ProyectEuler3_ByBlack = arr(i) End Function
No estoy loco para calcular cada uno a mano... 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!¡.
Título: Re: [RETO] Proyect Euler 3
Publicado por: Psyke1 en 1 Febrero 2013, 13:25 pm
@BlackZeroX (http://t2.gstatic.com/images?q=tbn:ANd9GcTpbB61D_KUtOz5AdBMPKtKgLa_G1-01ai8czI8hU1OyAWHhRnB6g) :¬¬ :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): 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
Ejemplo: Debug.Print PE3_Psyke1 ' 6857
DoEvents! :P
Título: Re: [RETO] Proyect Euler 3
Publicado por: imoen en 1 Febrero 2013, 18:31 pm
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
Título: Re: Re: [RETO] Proyect Euler 3
Publicado por: BlackZeroX en 2 Febrero 2013, 05:28 am
. El perico es verde en cualquier parte.
@Psyke1 ¿Cual trampa? nadie dijo que NO se podía hacer lo que hice...
Dulces Lunas!¡.
Título: Re: Re: [RETO] Proyect Euler 3
Publicado por: BlackZeroX en 2 Febrero 2013, 07:08 am
Tal vez esta versión no sea rápida pero usa una generación de números primos que se deseaban... Option Explicit Option Base 0 Dim ManagerPrime As clsPrime Private Sub Form_Load() Set ManagerPrime = New clsPrime Call ManagerPrime.Clear MsgBox ManagerPrime.ItsPrime(6857) MsgBox "Para calcular si fue primo se calcularon " & ManagerPrime.CountPrime() & " numeros primos." Call ManagerPrime.Clear ManagerPrime.BufferLimitIndex(7000) = &H7FFFFFFF MsgBox ProyectEuler3_ByBlack 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
clsPrime.cls Option Explicit Option Base 0 Private m_N As Long Private m_Now As Long Private m_Arr() As Long Const MAX_LIMIT_VALUE As Long = &H7FFFFFFF Private Sub Class_Initialize() Clear End Sub Private Function Calculate(ByVal Start As Long, Optional ByVal MaxLimitValue As Long = MAX_LIMIT_VALUE) As Long Dim j As Long For m_Now = Start To MaxLimitValue j = (m_Now - 1) Do While (m_Now Mod j <> 0) j = (j - 1) Loop If (j < 2) Then Calculate = m_Now Exit Function End If Next Calculate = &H80000000 End Function Public Sub Clear() m_N = 0 m_Now = 2 ReDim m_Arr(m_N) m_Arr(m_N) = 2 End Sub Public Property Let BufferLimitIndex(Optional ByVal MaxLimitValue As Long = MAX_LIMIT_VALUE, ByVal n As Long) Dim lRes As Long Dim lNow As Long Do While (m_N < n) lRes = Calculate(m_Now + 1, MaxLimitValue) If (lRes And &H80000000) Then Exit Do Else m_N = (m_N + 1) ReDim Preserve m_Arr(m_N) m_Arr(m_N) = lRes End If Loop End Property Public Property Get CountPrime() As Long CountPrime = (m_N + 1) End Property Public Property Get BufferLimitIndex(Optional ByVal MaxLimitValue As Long = MAX_LIMIT_VALUE) As Long BufferLimitIndex = m_N End Property Public Function Prime(ByVal Index As Long, Optional ByVal MaxLimitValue As Long = MAX_LIMIT_VALUE) As Long Dim lRes As Long Prime = &H80000000 If Index > m_N Then BufferLimitIndex(MaxLimitValue) = Index If Not (Index = m_N) Then Exit Function End If Prime = m_Arr(Index) End Function Public Function ItsPrime(ByVal Value As Long) As Boolean Dim i As Long Dim lRes As Long ItsPrime = True If (m_Now < Value) Then Do lRes = Prime(m_N + 1, Value) If (lRes And &H80000000) Then Exit Do Loop While (m_Arr(m_N) < Value) If Not (m_Arr(m_N) = Value) Then ItsPrime = False Else For i = 0 To m_N If (m_Arr(i) = Value) Then Exit For Next ItsPrime = False End If End Function Private Sub Class_Terminate() Call Clear End Sub
Dulces Lunas!¡.
Título: Re: [RETO] Proyect Euler 3
Publicado por: Psyke1 en 2 Febrero 2013, 15:08 pm
Bueno he hecho unos test, aquí está el 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: (http://i48.tinypic.com/sdfx5i.jpg) (http://i48.tinypic.com/24gvw38.jpg) (http://i50.tinypic.com/350o1g6.jpg) 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
Título: Re: [RETO] Project Euler 3
Publicado por: imoen en 3 Febrero 2013, 20:45 pm
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
|