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:
6857
http://projecteuler.net/problem=3
Estructura:
Public Function ProyectEuler3(Optional ByVal lNumber As Double = 600851475143) As Double
DoEvents! :P
No me gustan estos retos donde gana el que sabe buscar mejor en google jaja.
Cita de: $Edu$ en 31 Enero 2013, 15:08 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$
Cita de: $Edu$ en 31 Enero 2013, 15:08 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
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
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.
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
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!¡.
@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
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
.
El perico es verde en cualquier parte.
@Psyke1
¿Cual trampa? nadie dijo que NO se podía hacer lo que hice...
Dulces Lunas!¡.
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!¡.
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
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