| |
|
131
|
Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero dado es un numero de la suerte
|
en: 15 Agosto 2010, 18:27 pm
|
Oigan, aquí les dejo mi cuarto intento junto con sus funciones. Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
Private Declare Sub RtlMoveMemory Lib "Kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal length As Long)
Private Declare Function GetTickCount Lib "Kernel32" () As Long
Private Sub Form_Load()
Dim x As Long
Dim s As String
Dim t1 As Long
Dim t2 As Long
' If App.LogMode = 0 Then End
Me.AutoRedraw = True
'Dessa
Me.Print "Dessa"
t1 = GetTickCount
For x = 5000 To 7000
If IsLucky(x) Then
s = s & x & " "
End If
Next
t2 = GetTickCount
Me.Print t2 - t1 & vbNewLine
MsgBox s, vbOKOnly, "Dessa"
s = ""
'*PsYkE1*
Me.Print "PsYkE1"
t1 = GetTickCount
For x = 5000 To 7000
If Check_Lucky_Number3(x) Then
s = s & x & " "
End If
Next
t2 = GetTickCount
Me.Print t2 - t1 & vbNewLine
MsgBox s, vbOKOnly, "PsYkE1"
s = ""
'LeandroA
Me.Print "LeandroA"
t1 = GetTickCount
For x = 5000 To 7000
If IsLuckyNumber(x) Then
s = s & x & " "
End If
Next
t2 = GetTickCount
Me.Print t2 - t1 & vbNewLine
MsgBox s, vbOKOnly, "LeandroA"
s = ""
'Tokes
Me.Print "Tokes"
t1 = GetTickCount
For x = 5000 To 7000
If verifnum4(x) Then
s = s & x & " "
End If
Next
t2 = GetTickCount
Me.Print t2 - t1 & vbNewLine
MsgBox s, vbOKOnly, "Tokes"
s = ""
End Sub
'Dessa
Function IsLucky(lngNum As Long) As Boolean
Dim x As Long, cont As Long, contStep As Long, Indice As Long, numLuck() As Long
If lngNum < 1 Then Exit Function
If lngNum Mod 2 = 0 Then Exit Function
If lngNum = 1 Or lngNum = 3 Then IsLucky = True: Exit Function
If lngNum = 5 Then Exit Function
For x = 1 To lngNum Step 2
ReDim Preserve numLuck(contStep)
numLuck(contStep) = x
contStep = contStep + 1
Next
contStep = 0: cont = 0: Indice = 1
While numLuck(Indice) <= UBound(numLuck)
If numLuck(UBound(numLuck)) <> lngNum Then Exit Function
x = -1
While x < UBound(numLuck)
x = x + 1
If cont = numLuck(Indice) - 1 Then
cont = 0
Else
numLuck(contStep) = numLuck(x)
cont = cont + 1
contStep = contStep + 1
End If
Wend
If contStep = numLuck(Indice + 1) Then
ReDim Preserve numLuck(contStep - 2)
Else
ReDim Preserve numLuck(contStep - 1)
End If
cont = 0
contStep = 0
Indice = Indice + 1
Wend
For x = 0 To UBound(numLuck)
If numLuck(x) = lngNum Then
IsLucky = True
Exit For
End If
Next
End Function
'-PsYkE1
Public Function Check_Lucky_Number3(ByVal lNumber As Long) As Boolean
Dim lTempArray() As Long
Dim NextElim As Long
Dim lArrayUBound As Long
Dim m As Long
Dim x As Long
If lNumber = 1 Or lNumber = 3 Then
GoTo IsLucky
ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then
m = 1
For x = 1 To lNumber Step 2
ReDim Preserve lTempArray(m)
lTempArray(m) = x
m = m + 1
Next
NextElim = 3: m = 2
Do
x = NextElim
Do While x <= UBound(lTempArray)
lArrayUBound = UBound(lTempArray)
If Not x = lArrayUBound Then
RtlMoveMemory VarPtr(lTempArray(x)), VarPtr(lTempArray(x + 1)), (lArrayUBound - x) * 4
ReDim Preserve lTempArray(lArrayUBound - 1)
Else
Exit Function
End If
x = x + (NextElim - 1)
Loop
m = m + 1
NextElim = lTempArray(m)
Loop While Not NextElim > lArrayUBound
IsLucky: Check_Lucky_Number3 = True
End If
End Function
'LeandroA
Private Function IsLuckyNumber(ByVal Num As Long) As Boolean
Dim lCount As Long, lPos As Long, i As Long
Dim Arr() As Long
If Num < 1 Then Exit Function
If Num Mod 2 = 0 Then Exit Function
ReDim Preserve Arr(CLng(Num / 2) + (Num Mod 2))
For lPos = 1 To Num Step 2
i = i + 1
Arr(i) = lPos
Next
lCount = 1
Do While UBound(Arr) > lCount
lCount = lCount + 1
lPos = Arr(lCount)
Do
If lPos > UBound(Arr) Then Exit Do
If lPos < UBound(Arr) Then CopyMemory Arr(lPos), Arr(lPos + 1), 4 * (UBound(Arr) - lPos)
ReDim Preserve Arr(UBound(Arr) - 1)
lPos = lPos + Arr(lCount) - 1
Loop
If Arr(UBound(Arr)) <> Num Then Exit Function
Loop
IsLuckyNumber = True
End Function
' Tokes (Cuarto intento)
Private Function verifnum4(ByVal Num As Long) As Boolean
Dim bufA() As Long
Dim indElim As Long
Dim indElim_aux As Long
Dim ordenElim As Long
Dim i As Long
Dim i_auxA As Long
Dim i_auxB As Long
If (Num And 1) = 0 Then
Exit Function
End If
If Num < 5 Then
verifnum4 = True
Exit Function
End If
ReDim bufA(0 To Num)
ordenElim = 2
i = 1
For i_auxA = 1 To Num Step 2
bufA(i) = i_auxA
i = i + 1
Next i_auxA
i = i - 1
Do
indElim = bufA(ordenElim)
If indElim > i Then
verifnum4 = True
Exit Function
End If
If indElim = i Then Exit Function
i_auxA = indElim
i_auxB = indElim + 1
Do
For indElim_aux = indElim - 2 To 0 Step -1
If i_auxB > i Then Exit Do
bufA(i_auxA) = bufA(i_auxB)
i_auxA = i_auxA + 1
i_auxB = i_auxB + 1
Next indElim_aux
If i_auxB = i Then Exit Function
i_auxB = i_auxB + 1
Loop
i = i_auxA - 1
ordenElim = ordenElim + 1
Loop
End Function Mis resultados son: Dessa --> 12859 PsYkE1 --> 5109 LeandroA --> 3438 Tokes --> 4359 Saludos. |
|
|
|
|
133
|
Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero dado es un numero de la suerte
|
en: 15 Agosto 2010, 00:21 am
|
Señores, he corregido mi código. Finalmente pude hacer la función un tanto más compacta y más rápida que la primera y la segunda versión que hice. Les dejo el código (la función se llama verifnum3 porque es el tercer intento que hice): Private Function verifnum3(ByVal num As Long) As Boolean
Dim bufA() As Long
Dim indElim As Long
Dim indElim_aux As Long
Dim ordenElim As Long
Dim iniciales As Long
Dim i As Long
Dim i_auxA As Long
Dim i_auxB As Long
If (num And 1) = 0 Then
Exit Function
End If
ReDim bufA(0 To num)
ReDim bufB(0 To num)
ordenElim = 2
iniciales = 1
i = 1
Do While iniciales <= num
bufA(i) = iniciales
iniciales = iniciales + 2
i = i + 1
Loop
i = i - 1
If ordenElim >= i Then
verifnum3 = True
Exit Function
End If
Do
indElim = bufA(ordenElim)
ordenElim = ordenElim + 1
If indElim > i Then
verifnum3 = True
Exit Function
End If
If bufA(indElim) = num Then Exit Function
i_auxA = indElim
i_auxB = indElim + 1
Do
For indElim_aux = 2 To indElim
If i_auxB > i Then Exit Do
bufA(i_auxA) = bufA(i_auxB)
i_auxA = i_auxA + 1
i_auxB = i_auxB + 1
Next indElim_aux
If i_auxB = i Then Exit Function
i_auxB = i_auxB + 1
Loop
i = i_auxA - 1
Loop
End Function |
|
|
|
|
134
|
Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero dado es un numero de la suerte
|
en: 14 Agosto 2010, 02:55 am
|
Bueno, he hecho una pequeña correción en el código y queda así. Me parece que ahora si da los números bien y es un poquitín más rápido. Se necesitan 2 command buttons (Command1 y Command2) y textbox Text1 y una label Label1. El Command1 dice si el número del Text1 es de la suerte. El command2 da los números de la suerte desde el 1 hasta el especificado en Text1. La Label1 debe ser un tantito grande para que le quepan todos los números. La función que verifica si el número es de la suerte se llama verifnum. Option Explicit
Private Sub Command1_Click()
Dim esdesuerte As Boolean
Dim t1 As Long, t2 As Long, tdif As Long
t1 = timeGetTime()
esdesuerte = IsLucky2(Val(Text1.Text))
t2 = timeGetTime()
tdif = t2 - t1
If esdesuerte = False Then
MsgBox ("El número " & Val(Text1.Text) & " no es de la suerte" _
& Chr(13) & "t1 = " & t1 & Chr(13) & "t2 = " & t2 & Chr(13) _
& "Tiempo = " & tdif)
Else
MsgBox ("El número " & Val(Text1.Text) & " es de la suerte" _
& Chr(13) & "t1 = " & t1 & Chr(13) & "t2 = " & t2 & Chr(13) _
& "Tiempo = " & tdif)
End If
End Sub
Private Function verifnum(ByVal num As Long) As Boolean
Dim bufA() As Long
Dim bufB() As Long
Dim indElim As Long
Dim ordenElim As Long
Dim iniciales As Long
Dim i As Long
Dim i_auxA As Long
Dim i_auxB As Long
If (num And 1) = 0 Then
verifnum = False
Exit Function
End If
ReDim bufA(0 To num)
ReDim bufB(0 To num)
ordenElim = 2
iniciales = 1
i = 1
Do While iniciales <= num
bufA(i) = iniciales
iniciales = iniciales + 2
i = i + 1
Loop
i = i - 1
Do
If ordenElim >= i Then
verifnum = True
Exit Function
End If
indElim = bufA(ordenElim)
ordenElim = ordenElim + 1
i_auxA = indElim
While i_auxA <= i
If bufA(i_auxA) = num Then
verifnum = False
Exit Function
End If
bufA(i_auxA) = 0
i_auxA = i_auxA + indElim
Wend
i_auxA = 1
i_auxB = 1
While i_auxA <= i
If bufA(i_auxA) > 0 Then
bufB(i_auxB) = bufA(i_auxA)
i_auxB = i_auxB + 1
End If
i_auxA = i_auxA + 1
Wend
i = i_auxB - 1
If ordenElim >= i Then
verifnum = True
Exit Function
End If
indElim = bufB(ordenElim)
ordenElim = ordenElim + 1
i_auxB = indElim
While i_auxB <= i
If bufB(i_auxB) = num Then
verifnum = False
Exit Function
End If
bufB(i_auxB) = 0
i_auxB = i_auxB + indElim
Wend
i_auxA = 1
i_auxB = 1
While i_auxB <= i
If bufB(i_auxB) > 0 Then
bufA(i_auxA) = bufB(i_auxB)
i_auxA = i_auxA + 1
End If
i_auxB = i_auxB + 1
Wend
i = i_auxA - 1
Loop
'End If
End Function
Private Sub Command2_Click()
Dim strvis As String
Dim i As Long
Dim t1 As Long, t2 As Long
t1 = timeGetTime
strvis = "Los números de la suerte entre el 1 y el " & Text1.Text & " son:" & Chr(13)
If verifnum(1) = True Then
strvis = strvis & CStr(1)
End If
For i = 2 To Text1.Text
If verifnum(i) = True Then
strvis = strvis & ", " & Str(i)
End If
Next i
t2 = timeGetTime
strvis = strvis & Chr(13) & "Tiempo = " & t2 - t1
'MsgBox (strvis)
Label1 = strvis
End Sub Y el código del módulo es: Option Explicit
Public Declare Function timeGetTime Lib "winmm.dll" () As Long Bueno, el código es un poco largo pero me parece que va un poquitín más rápido. |
|
|
|
|
135
|
Programación / Programación Visual Basic / Re: [RETO] Comprobar si un numero dado es un numero de la suerte
|
en: 13 Agosto 2010, 22:22 pm
|
|
Hola a todos:
No pude evitar hacer un código después de ver el ímpetu que demuestran.
Hice un código que recibe un número y despliega un mensaje, informando si ese número es o no es de la suerte. El mensaje también muestra el tiempo transcurrido en realizar las operaciones; muestra el tiempo antes de iniciar las operaciones, el tiempo después de realizar las operaciones y por último, la diferencia entre ambos, es decir, el tiempo total empleado en realizar las operaciones.
Sólo lo probé con los números del 1 al 37, ya que me dió flojera probar con más números.
Pero bueno, se necesita un cuadro de texto Text1 y un botón de comando Command1. El código es el siguiente:
Option Explicit
Private Sub Command1_Click()
Dim esdesuerte As Boolean
Dim t1 As Long, t2 As Long, tdif As Long
t1 = timeGetTime()
esdesuerte = verifnum(Val(Text1.Text))
t2 = timeGetTime()
tdif = t2 - t1
If esdesuerte = False Then
MsgBox ("El número " & Val(Text1.Text) & " no es de la suerte" _
& Chr(13) & "t1 = " & t1 & Chr(13) & "t2 = " & t2 & Chr(13) _
& "Tiempo = " & tdif)
Else
MsgBox ("El número " & Val(Text1.Text) & " es de la suerte" _
& Chr(13) & "t1 = " & t1 & Chr(13) & "t2 = " & t2 & Chr(13) _
& "Tiempo = " & tdif)
End If
End Sub
Private Function verifnum(ByVal num As Long) As Boolean
Dim bufA(33000) As Long
Dim bufB(33000) As Long
Dim indElim As Long
Dim iniciales As Long
Dim i As Long
Dim i_auxA As Long
Dim i_auxB As Long
If num Mod 2 = 0 Then
verifnum = False
Exit Function
End If
indElim = 2
iniciales = 1
i = 1
Do While iniciales <= num
bufA(i) = iniciales
iniciales = iniciales + 2
i = i + 1
Loop
i = i - 1
If indElim >= i Then
verifnum = True
Else
Do
indElim = bufA(indElim)
If indElim > i Then
verifnum = True
Exit Function
End If
i_auxA = indElim
While i_auxA <= i
If bufA(i_auxA) = num Then
verifnum = False
Exit Function
End If
bufA(i_auxA) = bufA(i_auxA) * -1
i_auxA = i_auxA + indElim
Wend
i_auxA = 1
i_auxB = 1
While i_auxA <= i
If bufA(i_auxA) > 0 Then
bufB(i_auxB) = bufA(i_auxA)
i_auxB = i_auxB + 1
End If
i_auxA = i_auxA + 1
Wend
i = i_auxB - 1
indElim = bufB(indElim)
If indElim > i Then
verifnum = True
Exit Function
End If
i_auxB = indElim
While i_auxB <= i
If bufB(i_auxB) = num Then
verifnum = False
Exit Function
End If
bufB(i_auxB) = bufB(i_auxB) * -1
i_auxB = i_auxB + indElim
Wend
i_auxA = 1
i_auxB = 1
While i_auxB <= i
If bufB(i_auxB) > 0 Then
bufA(i_auxA) = bufB(i_auxB)
i_auxA = i_auxA + 1
End If
i_auxB = i_auxB + 1
Wend
i = i_auxA - 1
Loop
End If
End Function
Y en el módulo el código es el siguiente:
Option Explicit
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
En fín, si alguien quiere hacerme el favor de revisarlo para números arriba del 37 se los agradeceré. Es que es demasiado fastidioso estar generando a mano los números de la suerte.
Saludos
|
|
|
|
|
136
|
Informática / Electrónica / Re: ¿Como eliminar el ruido de un sensor de corriente?
|
en: 13 Agosto 2010, 18:43 pm
|
|
Con respecto al problema, todavía no lo soluciono, decidí tomar un pequeño descanso o la frustración me mataría.
En cuanto al motor, disculpa mi ignorancia ¿Cómo puedo modelarlo? De motores sé lo mismo que de física relativista (nada, relativamente).
Gracias por tu comentario.
|
|
|
|
|
137
|
Informática / Electrónica / Re: ¿Como eliminar el ruido de un sensor de corriente?
|
en: 29 Julio 2010, 05:02 am
|
|
Je, je, tengo buenas y malas noticias:
Las buenas: Realicé un filtrado digital con el atmega y la lectura de la corriente es más estable (no al 100 %, pero mejor que antes).
Las malas: El atmega está tan ocupado realizando el filtrado que ya no tiene tiempo para comunicarse correctamente con la PC.
Bien, seguiré intentando.
|
|
|
|
|
139
|
Informática / Electrónica / Re: ¿Como eliminar el ruido de un sensor de corriente?
|
en: 27 Julio 2010, 23:16 pm
|
|
De pico a pico sin ruido tengo aproximadamente 20 mV. Pero con ruido son como 50 mV.
En cuanto a promediar el voltaje ¿Te refieres a promediarlo con todo y los ruidos? Yo había pensado algo similar, pero no me decidía (de hecho, todavía no me decido) si realizar un promedio permanente o un promedio por lapsos, es decir, promediar los voltajes detectados durante 1 segundo y después borrar ese promedio y volver a comenzar el promedio para el siguiente segundo, y así tener un promedio de voltaje por cada segundo.
Aunque me pregunto: ¿Será acaso problema de el protoboard donde lo estoy haciendo? ¿Acaso es la punta de osciloscopio? Es que me sucede algo curioso:
Al medir la tensión de alimentación en un punto del protoboard obtengo una cierta cantidad de ruido; pero al medir la tensión de alimentación en otro orificio del protoboard obtengo una señal de ruido diferente.
Aclaro que el circuito está bien armado y funciona, lo único que me falla es el sensor de corriente.
Agradezco sus comentarios y respuestas.
|
|
|
|
|
140
|
Informática / Electrónica / Re: protocolo para controladores
|
en: 27 Julio 2010, 21:06 pm
|
|
Pues mira, mi hermano, no sé si te sirva lo que te voy a decir. Yo estoy haciendo un proyectito para comunicar una PC con un ATMEGA16.
En un principio, cuando se energiza el circuito, el microcontrolador tiene desactivado prácticamente todos sus recursos (los timer's, el ADC, el TWI, etc.), excepto la USART.
Cuando el usuario de la PC oprime un determinado botón, por ejemplo "INICIAR COMUNICACIÓN", el software (que está hecho en visual basic 6.0) le envía al microcontrolador una cadena de caracteres, que es: "CNT" (CoNecTar).
Al final de cada cadena se envía también el ASCII 13 (retorno de carro) para indicar que hasta ahí llegó la cadena de caracteres.
El microcontrolador entonces, al recibir el caracter ASCII 13 (retorno de carro) sabe que ha recibido una cadena completa y que tiene que procesarla para saber que es lo que debe hacer, por ejemplo:
Si la cadena que recibió es: "LED1-OFF", el micro apaga un pin del puerto.
Si la cadena recibida es: "LED1-ON", el micro enciende el pin del puerto correspondiente.
Si la cadena recibida es: "FIN-COM", el micro sabe que la comunicación ha terminado y se pone en modo de bajo consumo.
El código de transmisión (a grandísimos rasgos) podría ser algo así como:
// En caso que se quiera encender el led 1.
USART_puts("LED1-ON\r"); // el caracter \r es el retorno de carro que indica
// que hasta ahí llega la cadena.
El código de recepción (tamién a grandísimos rasgos) sería algo así:
char srx[10]; // Se declara un vector de 10 carateres.
USART_gets(srx); // Recibe carateres por la USART y los guarda en el vector
// srx hasta encontrar un retorno de carro.
if(strcmp(srx, "LED1-OFF")==0) bit_clear(PUERTO, LED1);
else if(strcmp(srx, "LED1-ON")==0) bit_set(PUERTO, LED1);
Espero que te sirva. Nos vemos.
|
|
|
|
|
|
| |
|
Mostrar Mensajes