Autor
|
Tema: numeros grandes (Leído 3,094 veces)
|
rextor
Desconectado
Mensajes: 6
|
hola
cuales serian los pasos para tratar numeros grandes,o sea como la calculadora de windows pero mas grandes.
Por ejemplo cojer 100 numeros y elevarlos a 5 y que salga en un textbox el resultado entero.
Saludos y thx
|
|
|
En línea
|
|
|
|
Slasher-K
Desconectado
Mensajes: 1.477
|
Hace un tiempo escribi unas funciones para trabajar con números grandes. Si no me equivoco a la de multiplicar tenía que cambiarle algo , pero ahora la probé y funciona. Las demás funcionan bien. La suma y la resta la hace muy rápido, la multiplicación y división bastante rápido. Los probé con un número de 256KB de extensión y la suma y resta lo hace en 2 o 3 segundos. Siento que no puse los comentarios, pero es demasiado código como para ponerlos ahora. ' 'Coded by Slasher- ' Option Explicit Option Base 1
Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long
Public Const CA1 = 1 Public Const CA2 = 2 Public Const SIGN_MAGN = 3
Public Const NUM_CMP_EQUAL = 1 Public Const NUM_CMP_MAJOR = 2 Public Const NUM_CMP_MINOR = 3
Function AddN(ByVal Number1 As String, ByVal Number2 As String) As String Dim btNum1() As Byte, btNum2() As Byte Dim btTotal() As Byte, lCnt& Dim iByte1%, iByte2% Dim iByteTotal% Dim lLen1&, lLen2& Dim iCarry%, i&, r& Dim bSigned As Boolean
If NumCmp(Number1, 0, NUM_CMP_MINOR) And NumCmp(Number2, 0, NUM_CMP_MAJOR) Then AddN = SubN(Number2, Mid$(Number1, 2)) Exit Function ElseIf NumCmp(Number1, 0, NUM_CMP_MAJOR) And NumCmp(Number2, 0, NUM_CMP_MINOR) Then AddN = SubN(Number1, Mid$(Number2, 2)) Exit Function ElseIf NumCmp(Number1, 0, NUM_CMP_MINOR) And NumCmp(Number2, 0, NUM_CMP_MINOR) Then bSigned = True End If If Left$(Number1, 1) Like "-" Then Number1 = Mid$(Number1, 2) If Left$(Number2, 1) Like "-" Then Number2 = Mid$(Number2, 2) lLen1 = EqualStr(Number1, Number2, "0") lLen2 = lLen1 lCnt = lLen1 + lLen2 ReDim btTotal(lLen1 + lLen2) As Byte btNum1 = StrToByteVal(Number1) btNum2 = StrToByteVal(Number2)
For i = 1 To lLen1 iByte1 = btNum1(lLen1 - i) iByte2 = btNum2(lLen2 - i) iByteTotal = iByte1 + iByte2 + iCarry If iByteTotal >= 10 Then btTotal(lCnt) = Val(Mid$(iByteTotal, 2, 1)) iCarry = 1 Else btTotal(lCnt) = iByteTotal iCarry = 0 End If lCnt = lCnt - 1 Next AddN = ByteToStrVal(btTotal()) End Function
Function SubN(ByVal Number1 As String, ByVal Number2 As String) As String Dim btNum1() As Byte, btNum2() As Byte Dim btTotal() As Byte, lCnt& Dim iByte1%, iByte2% Dim iByteTotal%, sTotal$ Dim lLen1&, lLen2& Dim iNextByte%, i& Dim bSigned As Boolean Dim sTemp$, iTempByte$
'Analiza los dos números antes de realizar la resta, para 'reemplazar la operación en caso que sea necesario por los 'signos, y así simplificar la función. ' If NumCmp(Number1, Number2, NUM_CMP_EQUAL) And NumCmp(Number1, 0, NUM_CMP_MAJOR) Then 'Num1>0 And Num2>0 SubN = 0 Exit Function ElseIf NumCmp(Number1, Number2, NUM_CMP_EQUAL) And NumCmp(Number1, 0, NUM_CMP_MINOR) Then 'Num1=Num2 And Num2<0 SubN = "-" & AddN(Mid$(Number1, 2), Mid$(Number2, 2)) Exit Function ElseIf NumCmp(Number1, 0, NUM_CMP_MINOR) And NumCmp(Number2, 0, NUM_CMP_MINOR) Then 'Num1 < 0 And Num2 < 0 ' If Left$(Number1, 1) Like "-" Then Number1 = Mid$(Number1, 2) If Left$(Number2, 1) Like "-" Then Number2 = Mid$(Number2, 2) SubN = "-" & AddN(Number1, Number2) Exit Function
ElseIf NumCmp(Number1, Number2, NUM_CMP_MINOR) Then If NumCmp(Number1, 0, NUM_CMP_MAJOR) And NumCmp(Number2, 0, NUM_CMP_MAJOR) Then 'Num1 > 0 And Num2 > 0 ' sTemp = Number2 Number2 = Number1 Number1 = sTemp
bSigned = True ElseIf NumCmp(Number1, 0, NUM_CMP_MINOR) And NumCmp(Number2, 0, NUM_CMP_MAJOR) Then 'Num1 < 0 And Num2 > 0 ' bSigned = True End If If Left$(Number1, 1) Like "-" Then Number1 = Mid$(Number1, 2) If Left$(Number2, 1) Like "-" Then Number2 = Mid$(Number2, 2) End If lLen1 = EqualStr(Number1, Number2, "0") - 1 lLen2 = lLen1 btNum1 = StrToByteVal(Number1) btNum2 = StrToByteVal(Number2) ReDim btTotal(lLen1 + lLen2 + 1) As Byte lCnt = lLen1 + lLen2 + 1 For i = 0 To lLen1 iByte1 = btNum1(lLen1 - i) iByte2 = btNum2(lLen2 - i) If (iByte1 < iByte2) And i < lLen1 Then iByte1 = iByte1 + 10 iNextByte = btNum1(lLen1 - i - 1) btNum1(lLen1 - i - 1) = iNextByte - 1 End If iByteTotal = iByte1 - iByte2 btTotal(lCnt) = iByteTotal lCnt = lCnt - 1 Next If bSigned Then SubN = "-" & ByteToStrVal(btTotal) Else SubN = ByteToStrVal(btTotal) End If End Function
Function ProN(ByVal Number1 As String, ByVal Number2 As String) As String Dim btNum1() As Byte, btNum2() As Byte Dim btTotal() As Byte, lCnt& Dim iByte1%, iByte2% Dim iByteTotal%, sTotal$ Dim lLen1&, lLen2& Dim iCarry%, sSum$() Dim i&, ind&
lLen1 = Len(Number1) - 1 lLen2 = Len(Number2) - 1
btNum1 = StrToByteVal(Number1) btNum2 = StrToByteVal(Number2) For i = 0 To lLen2 iByte2 = btNum2(lLen2 - i) 'If i > 9 Then Stop For ind = 0 To lLen1 iByte1 = btNum1(lLen1 - ind) iByteTotal = (iByte1 * iByte2) + iCarry If iByteTotal >= 10 Then If ind < lLen1 Then sTotal = Right$(iByteTotal, 1) & sTotal iCarry = CInt(Left$(iByteTotal, Len(CStr(iByteTotal)) - 1)) Else sTotal = iByteTotal & sTotal End If Else sTotal = iByteTotal & sTotal iCarry = 0 End If Next
sTotal = sTotal & String$(i, "0") ReDim Preserve sSum$(i + 1) sSum(i + 1) = sTotal sTotal = vbNullString iCarry = 0 Next sTotal = sSum(1) For i = 2 To lLen2 + 1 sTotal = AddN(sTotal, sSum(i)) Next ProN = sTotal End Function
Function DivN(ByVal Number1 As String, ByVal Number2 As String, Optional MaxDec = 30) As String Dim btNum1() As Byte, lLen1& Dim btTotal() As Byte, lCnt& Dim iByte1% Dim sCurDiv$, iCurFac% Dim iDecCnt%, i&, ind%
If MaxDec < 0 Then MaxDec = 30 Do While NumCmp(Number1, Number2, NUM_CMP_MINOR) 'El dividendo debe ser mayor que el divisor. ' Number1 = Number1 & "0" iDecCnt = iDecCnt + 1 Loop lLen1 = Len(Number1) - 1
btNum1 = StrToByteVal(Number1) lCnt = 1 ReDim btTotal(lCnt) As Byte If iDecCnt > 0 Then ReDim Preserve btTotal(3) As Byte btTotal(1) = vbKey0 'Cero btTotal(2) = 44 'Coma lCnt = 3 For i = 3 To iDecCnt btTotal(i) = vbKey0 lCnt = lCnt + 1 ReDim Preserve btTotal(lCnt) As Byte Next End If For i = 0 To lLen1 iByte1 = btNum1(i) sCurDiv = sCurDiv & iByte1 If NumCmp(sCurDiv, Number2, NUM_CMP_MAJOR) Or NumCmp(sCurDiv, Number2, NUM_CMP_EQUAL) Then Exit For End If Next Do iCurFac = 1 Do While NumCmp(sCurDiv, ProN(Number2, iCurFac), NUM_CMP_MAJOR) iCurFac = iCurFac + 1 Loop If CLng(sCurDiv) Mod CLng(Number2) = 0 Then btTotal(lCnt) = iCurFac + vbKey0 sCurDiv = SubN(sCurDiv, ProN(Number2, iCurFac)) & Mid$(Number1, Len(sCurDiv) + 1) Else btTotal(lCnt) = (iCurFac - 1) + vbKey0 sCurDiv = SubN(sCurDiv, ProN(Number2, (iCurFac - 1))) & Mid$(Number1, Len(sCurDiv) + 1) End If If NumCmp(sCurDiv, Number2, NUM_CMP_MINOR) Then If NumCmp(sCurDiv, "0", NUM_CMP_EQUAL) And Len(sCurDiv) > 1 Then lCnt = lCnt + 1 ReDim Preserve btTotal(lCnt) As Byte btTotal(lCnt) = vbKey0 Exit Do ElseIf NumCmp(sCurDiv, "0", NUM_CMP_EQUAL) Then Exit Do Else If iDecCnt = 0 Then lCnt = lCnt + 1 ReDim Preserve btTotal(lCnt) As Byte btTotal(lCnt) = 44 'Coma End If iDecCnt = iDecCnt + 1
sCurDiv = sCurDiv & "0" If iDecCnt > MaxDec Then Exit Do End If End If lCnt = lCnt + 1 ReDim Preserve btTotal(lCnt) As Byte
Loop DivN = ByteToStrVal(btTotal)
End Function
Function EqualStr(String1 As String, String2 As String, CharFill As String) As Long Dim lLen1&, lLen2&
lLen1 = Len(String1) lLen2 = Len(String2) If CharFill Like vbNullString Then CharFill = vbNullChar If lLen1 < lLen2 Then String1 = String$(lLen2 - lLen1, CharFill) & String1 lLen1 = lLen2 ElseIf lLen2 < lLen1 Then String2 = String$(lLen1 - lLen2, CharFill) & String2 lLen2 = lLen1 End If
EqualStr = lLen1 End Function
Function NumCmp(ByVal Number1 As String, ByVal Number2 As String, CmpType As Integer) As Integer Dim iByte1%, iByte2% Dim lLen1&, lLen2& Dim sTempNum$ Dim i&
'Realiza la comparación por signo. ' iByte1 = Left$(Number1, 1) Like "-" iByte2 = Left$(Number2, 1) Like "-" Select Case CmpType Case NUM_CMP_EQUAL: If iByte1 <> iByte2 Then Exit Function Case NUM_CMP_MAJOR If (iByte1 <> 0) And (iByte2 = 0) Then NumCmp = 0 Exit Function End If Case NUM_CMP_MINOR If (iByte1 <> 0) And (iByte2 = 0) Then NumCmp = 1 Exit Function End If End Select If (iByte1 <> 0) And (iByte2 <> 0) Then Number1 = Mid$(Number1, 2) Number2 = Mid$(Number2, 2) sTempNum = Number2 Number2 = Number1 Number1 = sTempNum End If 'Realiza la comprobación exaustiva- ' lLen1 = EqualStr(Number1, Number2, "0") lLen2 = lLen1
For i = 1 To lLen1 iByte1 = Val(Mid$(Number1, i, 1)) iByte2 = Val(Mid$(Number2, i, 1)) Select Case CmpType Case NUM_CMP_EQUAL If iByte1 <> iByte2 Then NumCmp = 0 Exit For Else NumCmp = 1 End If Case NUM_CMP_MAJOR If iByte1 > iByte2 Then NumCmp = 1 Exit For ElseIf iByte1 <> iByte2 Then Exit For End If Case NUM_CMP_MINOR If iByte1 < iByte2 Then NumCmp = 1 Exit For ElseIf iByte1 <> iByte2 Then Exit For End If End Select Next End Function
Function ByteToStrVal(NumSpec() As Byte) As String On Error Resume Next Dim i&, sData$
sData = StrConv(NumSpec, vbUnicode) For i = LBound(NumSpec) To UBound(NumSpec) If NumSpec(i) <> 0 Then Exit For Next sData = Mid$(sData, i) For i = 0 To 9 sData = Replace$(sData, Chr$(i), CStr(i)) Next ByteToStrVal = sData End Function
Function StrToByteVal(Number As String) As Byte() On Error Resume Next Dim i&, lLen& Dim btData() As Byte
lLen = Len(Number) btData = StrConv(Number, vbFromUnicode) For i = 0 To lLen - 1 btData(i) = btData(i) - vbKey0 Next StrToByteVal = btData End Function
Saludos.
|
|
|
En línea
|
A la reina de las profundidades que cuida los pasos de una sombra en la noche :*
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
Factorial de numeros grandes en Java
Java
|
SAHEKA_14
|
0
|
3,544
|
2 Octubre 2011, 04:53 am
por SAHEKA_14
|
|
|
Como arreglar preoblemas de numeros grandes en C++
Programación C/C++
|
Andrsz
|
9
|
7,765
|
1 Enero 2014, 01:11 am
por leosansan
|
|
|
desafio diffie-hellman (log2 de grandes numeros)
Desafíos - Wargames
|
eberfalu2
|
1
|
5,526
|
12 Enero 2016, 00:01 am
por keniaboy
|
|
|
Números de longitud variable en C (Numeros muy grandes)
Programación C/C++
|
AlbertoBSD
|
0
|
2,704
|
30 Abril 2016, 20:40 pm
por AlbertoBSD
|
|
|
Como manejar números mas grandes en Vbs
Scripting
|
Flamer
|
1
|
1,872
|
18 Diciembre 2016, 19:45 pm
por tincopasan
|
|