|
412
|
Programación / Programación Visual Basic / Re: [RETO] IsFibonacciNumber(N as long) as Boolean
|
en: 15 Febrero 2011, 19:31 pm
|
colgandome de lo que dijeron de cual era el limite se me ocurrio hacer trampa Public Function FibonacciChecker_eCode(ByRef lNumero As Long) As Boolean Dim FiSplit() As String Dim i As Long Const Fi As String = "0,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946,17711,28657,46368" FiSplit() = Split(Fi, ",", -1, vbBinaryCompare) For i = 0 To 23 If lNumero = CLng(FiSplit(i)) Then FibonacciChecker_eCode = True: Exit Function If lNumero < CLng(FiSplit(i)) Then FibonacciChecker_eCode = False: Exit Function Next i End Function
ahora reviso el codigo que no le tenia fe y resulto ser el mas rapido
Edito Aca dejo optimizado el codigo que use antes, ahora reconoce el 0 y el 1 Public Function IsFibonacci_eCode(ByRef lNumber As Long) As Boolean Dim i As Long 'anterior Dim y As Long 'actual Dim x As Long 'Restultado a checkear y = 1 Do While x < lNumber If x = lNumber Then IsFibonacci_eCode = True: Exit Function x = i + y i = y y = x Loop IsFibonacci_eCode = False End Function
Estoy maserando otro codigo, paciencia que ya voy
Wiiiii Gracias a MrFrog que me dijo que use el do-loop para armar esto Public Function IsFibonacci_eCodeMatrix(ByRef lNumero As Long) As Boolean Dim f() As Long Dim i As Long ReDim f(1) f(0) = 0 f(1) = 1 i = 2 Do Debug.Print i; ","; f(i - 1) If lNumero = f(i - 1) Then IsFibonacci_eCode = True: Exit Function If lNumero < f(i - 1) Then IsFibonacci_eCode = False: Exit Function ReDim Preserve f(i) f(i) = f(i - 1) + f(i - 2) i = i + 1 Loop End Function
Tres codes para un reto. toy demasiado al pedo
|
|
|
415
|
Programación / Programación Visual Basic / Re: [RETO] IsFibonacciNumber(N as long)
|
en: 14 Febrero 2011, 19:59 pm
|
wiiiiii siempre me gusto fibbonacci che pero los numeros que nos vas a dar van de 1 a infinito? o hay algun tope? Ya le entro
EDITO: Esto puede ser muy lento, despues lo optimizo por ahora anda bien Public Function IsFibonacci(ByRef lNumber As Long) As Boolean Dim i As Long 'anterior Dim y As Long 'actual Dim x As Long 'Restultado a checkear i = 1 y = 1 Do While x < lNumber x = i + y i = y y = x If x = lNumber Then IsFibonacci = True: Exit Function Loop IsFibonacci = False End Function
|
|
|
416
|
Programación / Programación Visual Basic / Re: [RETO] Obtener nombre de archivo
|
en: 14 Febrero 2011, 17:50 pm
|
a pesar de que el hombre rana algo raro hizo porque dio mas rapido mi segunda funcion que la primera el pibe gano. ================================================================================ º Contest Name : ObtenerNombreArchivo º Explanation : Mas claro, hechale agua º Arguments : C:\Documents and Settings\Llamazares\Mis documentos\Downloads\SexoDeRanas.avi º Loops : 1000 º Date & Hour : 02-14-2011 <-> 13:47:25 ================================================================================ Results [compiled] : ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1.- MrFrogGetFileFast -> 23,140550 msec 2.- SacarFilenameE_C -> 25,971375 msec 3.- SacarFilenameE_Cv2 -> 29,063666 msec 4.- getFileNameIgnorante -> 31,133647 msec 5.- SacarFilenameE_CB -> 33,288770 msec 6.- getFileNameIgnoranteMODSeba -> 37,030797 msec 7.- GetFilename123 -> 37,921469 msec 8.- nombre_archivoGrester -> 48,419315 msec 9.- Fn7913 -> 257,055627 msec ================================================================================ º The following functions returns incorrect results : ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1.- StripPathSeba ================================================================================ >>> Test made by cFrogContest.cls <-> Visit foro.elhacker.net <<< ================================================================================ Se me hace medio imposible que la segunda funcion que hice funcione mas rapido que la primera ya que instrReverse es casi el doble de lento que el instr comun :S
|
|
|
418
|
Programación / Programación Visual Basic / Re: [RETO] Obtener nombre de archivo
|
en: 13 Febrero 2011, 22:51 pm
|
Van a pensar que salio asi porque lo hice yo ================================================================================ º Contest Name : ObtenerNombreArchivo º Explanation : Mas claro, hechale agua º Arguments : C:\Documents and Settings\Llamazares\Mis documentos\Downloads\SexoDeRanas.avi º Loops : 1000 º Date & Hour : 02-13-2011 <-> 18:48:31 ================================================================================ Results [compiled] : ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1.- SacarFilenameE_C -> 24,129044 msec 2.- SacarFilenameE_Cv2 -> 27,445965 msec 3.- getFileNameIgnorante -> 30,370386 msec 4.- getFileNameIgnoranteMODSeba -> 36,459560 msec 5.- GetFilename123 -> 38,079072 msec 6.- nombre_archivoGrester -> 46,986994 msec 7.- Fn7913 -> 256,390794 msec ================================================================================ º The following functions returns incorrect results : ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1.- GetFileMrFrog 2.- StripPathSeba ================================================================================ >>> Test made by cFrogContest.cls <-> Visit foro.elhacker.net <<< ================================================================================
capas que le erre en algo Asi esta codeado: Private cFC As New cFrogContest '// Class declaration.
Private Declare Sub PathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String) Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer Public Function SacarFilenameE_C(ByRef sPath As String) As String SacarFilenameE_C = StrReverse$(Left$(StrReverse$(sPath), InStr(1, StrReverse(sPath), "\", vbBinaryCompare) - 1)) End Function Public Function SacarFilenameE_Cv2(ByRef sPath As String) As String SacarFilenameE_Cv2 = Right$(sPath, Len(sPath) - InStrRev(sPath, "\", Len(sPath), vbBinaryCompare)) End Function Public Static Function GetFileMrFrog(ByRef sFile As String) As String GetFileMrFrog = RightB$(sFile, InStrRev(sFile, "\") * 2 - 2) End Function Public Function getFileNameIgnorante(ByVal path As String) As String Dim cM As Integer cM = InStrRev(path, "\") + 1 If cM = 0 Then Exit Function getFileNameIgnorante = Mid(path, cM) End Function Public Function StripPathSeba(ByVal sPath As String) As String Call PathStripPath(sPath) StripPathSeba = sPath End Function Public Function getFileNameIgnoranteMODSeba(ByVal path As String) As String getFileNameIgnoranteMODSeba = Mid$(path, InStrRev(path, "\") + 1) End Function Public Function nombre_archivoGrester(ByVal Ruta As String) As String Dim partes() As String partes = Split(Ruta, "\") nombre_archivoGrester = partes(UBound(partes)) End Function Public Function Fn7913(ByVal sPath As String) As String Dim Buffer As String Buffer = String(255, 0) GetFileTitle sPath, Buffer, Len(Buffer) Fn7913 = Left$(Buffer, InStr(1, Buffer, Chr$(0)) - 1) End Function Public Function GetFileName123(ByRef vPath As String) As String GetFileName123 = Right$(vPath, Len(vPath) - InStrRev(vPath, "\")) End Function
Private Sub Form_Load() With cFC .ContestName = "ObtenerNombreArchivo" '// The constest name. .Explanation = "Mas claro, hechale agua" '// Little explanation. .SaveDirectory = App.path '// Directory where you saved the test. .ReplaceFile = True '// To overwrite the file. .Functions "Fn7913,GetFileMrFrog,GetFilename123,getFileNameIgnorante,getFileNameIgnoranteMODSeba,nombre_archivoGrester,SacarFilenameE_C,SacarFilenameE_Cv2,StripPathSeba" '// Name of the functions. .Arguments "C:\Documents and Settings\Llamazares\Mis documentos\Downloads\SexoDeRanas.avi" '// Arguments of functions (must be the same in all functions). .NumberOfLoops = 1000 '// Number of Loop to call them. .Result = "SexoDeRanas.avi" '// This result should give functions. .SetObject Me '// Object (needed to make the calls). .TestIt '// Execute the test and save it. .ShowTest '// Shows the txt file. End With End
End Sub
y necesita la clase que codeo mi amigo ranafonico. http://foro.elhacker.net/programacion_visual_basic/src_cfrogcontestcls_by_mr_frog_copy-t318871.0.html
|
|
|
419
|
Programación / Programación Visual Basic / Re: [RETO] Obtener nombre de archivo
|
en: 13 Febrero 2011, 21:53 pm
|
No creo que sea la mas rapida pero tampoco creo que sea la mas lenta Public Function SacarFilenameE_C(ByRef sPath As String) As String SacarFilenameE_C = StrReverse$(Left$(StrReverse$(sPath), InStr(1, StrReverse$(sPath), "\", vbBinaryCompare) - 1)) End Function
EDITO: Medio segundo despues de que puse el tema encontre la funcion InStrRev aca una segunda funcion Public Function SacarFilenameE_Cv2(ByRef sPath As String) As String SacarFilenameE_Cv2 = Right$(sPath, Len(sPath) - InStrRev(sPath, "\", Len(sPath), vbBinaryCompare)) End Function
|
|
|
420
|
Programación / Programación Visual Basic / Re: Alguien me ayuda con un tema de logica
|
en: 13 Febrero 2011, 16:12 pm
|
para verificar si algo existe yo hice un modulo y se termino convirtiendo en un reto. busca bien. Ahora para la logica te lo dejo en pseudocodigo mas o menos si existe el archivo "c:\program files\a.exe" & existe el archivo "c:\a.txt" entonces Haces la vertical en el bidet sino miras un video XXX de mr Frog O.o? finsi
Asi es lo que necesitas? :S
|
|
|
|
|
|
|