"Exact" Calculations...
Posted: Mon May 08, 2006 7:46 am
Hi, I need really help now - my nephew has a problem in school to do a precise calculation of a math term:
result = rho . h . delta r^4 . delta phi . n . Sum [(2*j-1)/2 ]^3 j:1...n
So I wrote (quick and dirty and SLOOOW!) procedures for "+", "-" and "*" which do calculations of numbers stored into strings...
The routines ignore signs (should be changed in the future, for now the formula above it is not important) and they are all very slow.
So my question - has anyone done something like this already for Purebasic (V4)? Maybe in assembler? I need to speed up the program very urgently...
result = rho . h . delta r^4 . delta phi . n . Sum [(2*j-1)/2 ]^3 j:1...n
So I wrote (quick and dirty and SLOOOW!) procedures for "+", "-" and "*" which do calculations of numbers stored into strings...
The routines ignore signs (should be changed in the future, for now the formula above it is not important) and they are all very slow.
So my question - has anyone done something like this already for Purebasic (V4)? Maybe in assembler? I need to speed up the program very urgently...
Code: Select all
; Define
;Procedure.d summe(a.d,b.d)
; Protected sum.d=0
; Protected j.d=a
; While j<=b
; sum+Pow((2*j-1)/2,3)
; j+1
; Wend
; ProcedureReturn sum
;EndProcedure
;
;Global h.d=0.5
;Global D1.d=4.3
;Global D2.d=3.8
;Global rho.d=7800
;
;Global n.d=360
;Global m.d=10000
;
;Global delta_r.d=D1/2/m
;Global delta_phi.d=360/n*#PI/180
;
;Debug rho*h*Pow(delta_r,4)*delta_phi*n*summe(1,m)
EnableExplicit
Global max
Global Pi.s="3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701938521105559644622948954930381964428810975665933446128475648233786783165271201909145648566923460348610454326648213393607260249141273724587006606315588174881520920962829254091715364367892590360011330530548820466521384146951941511609433057270365759591953092186117381932611793105118548074462379962749567351885752724891227938183011949129833673362440656643086021394946395224737190702179860943702770539217176293176752384674818467669405132000568127145263560827785771342757789609173637178721468440901224953430146549585371050792279689258923542019956112129021960864034418159813629774771309960518707211349999998372978049951059731732816096318595024459455346908302642522308253344685035261931188171010003137838752886587533208381420617177669147303598253490428755468731159562863882353787593751957781857780532171226806613001927876611195909216420199"
Global h.s
Global D1.s
Global D2.s
Global rho.s
Global einsdurchm.s
Global delta_r.s
Global zweipi.s
Global power.s
Global ergebnis.s
Global mstellen
Global m.q
Enumeration
#h
#D
#rho
#m
#mstellen
#max
#maxstellen
#go
#output
EndEnumeration
Global Ausgabe.s
Global Abort
Global Active
Global win
; EndDefine
Procedure.s Normalize(zahl.s)
If FindString(zahl,".",1)=0
zahl+"."
EndIf
ProcedureReturn zahl
EndProcedure
Procedure.s AddLeadingZeros(zahl.s,n)
ProcedureReturn LSet("",n,"0")+zahl
EndProcedure
Procedure.s AddTrailingZeros(zahl.s,n)
ProcedureReturn zahl+LSet("",n,"0")
EndProcedure
Procedure.s StripZeros(zahl.s)
Protected i=0
Protected komma=FindString(zahl,".",1)
If komma>2
While (i<komma-2) And (PeekB(@zahl+i)='0')
i+1
Wend
If i>0
zahl=Mid(zahl,i+1,#MAXSHORT)
komma-i
EndIf
EndIf
i=Len(zahl)-1
While (i>komma) And (PeekB(@zahl+i)='0')
i-1
Wend
zahl=Left(zahl,i+1)
ProcedureReturn zahl
EndProcedure
Procedure.s Add(a.s,b.s)
Protected i
Protected k
Protected s
Protected sum.s
a=Normalize(a)
b=Normalize(b)
Protected komm_a=FindString(a,".",1)
Protected komm_b=FindString(b,".",1)
If komm_a>komm_b : Swap a,b : Swap komm_a,komm_b :EndIf
a=AddLeadingZeros(a,komm_b-komm_a+1)
b=AddLeadingZeros(b,1)
Protected len_a=Len(a)
Protected len_b=Len(b)
If len_a<len_b
a=AddTrailingZeros(a,len_b-len_a)
Else
b=AddTrailingZeros(b,len_a-len_b)
EndIf
i=Len(a)
k=FindString(a,".",1)-1
s=0
sum=Space(i)
While i
i-1
If i=k
PokeB(@sum+i,'.')
Else
s+PeekB(@a+i)+PeekB(@b+i)-96
PokeB(@sum+i,s%10+48)
s=s/10
EndIf
Wend
ProcedureReturn StripZeros(sum)
EndProcedure
Procedure.s Sub(a.s,b.s)
Protected i
Protected k
Protected s
Protected sub.s
a=Normalize(a)
b=Normalize(b)
Protected komm_a=FindString(a,".",1)
Protected komm_b=FindString(b,".",1)
If komm_a<komm_b
a=AddLeadingZeros(a,komm_b-komm_a)
Else
b=AddLeadingZeros(b,komm_a-komm_b)
EndIf
Protected len_a=Len(a)
Protected len_b=Len(b)
If len_a<len_b
a=AddTrailingZeros(a,len_b-len_a)
Else
b=AddTrailingZeros(b,len_a-len_b)
EndIf
; Debug a
; Debug b
i=Len(a)
k=FindString(a,".",1)-1
s=0
sub=Space(i)
While i
i-1
If i=k
PokeB(@sub+i,'.')
Else
s=PeekB(@a+i)-PeekB(@b+i)-s
If s<0
PokeB(@sub+i,s+58)
s=1
Else
PokeB(@sub+i,s+48)
s=0
EndIf
EndIf
Wend
ProcedureReturn StripZeros(sub)
EndProcedure
Procedure.s Mul(a.s,b.s)
Protected lena,lenb
Protected summe=0
Protected mul.s
a=Normalize(a)
b=Normalize(b)
Protected komm_a=FindString(a,".",1)
Protected komm_b=FindString(b,".",1)
a=Left(a,komm_a-1)+Mid(a,komm_a+1,#MAXSHORT)
b=Left(b,komm_b-1)+Mid(b,komm_b+1,#MAXSHORT)
lena=Len(a)
lenb=Len(b)
mul=LSet("0",lena+lenb,"0")
Repeat
lena-1
lenb=Len(b)
Repeat
lenb-1
If lena+lenb<max
summe=(PeekB(@a+lena)-48)*(PeekB(@b+lenb)-48)+(PeekB(@mul+lena+lenb+1)-48);Puffer(lena+lenb+1)
;Puffer(lena+lenb+1)=summe%10
;Puffer(lena+lenb)+summe/10
PokeB(@mul+lena+lenb+1,summe%10+48)
PokeB(@mul+lena+lenb,PeekB(@mul+lena+lenb)+summe/10)
EndIf
Until lenb=0
Until lena = 0
ProcedureReturn StripZeros(Left(mul,komm_a+komm_b-2)+"."+Mid(mul,komm_a+komm_b-1,#MAXSHORT))
EndProcedure
Procedure.s Sigma(a.q,b.q)
Protected sum.s="0"
Protected j.s
Protected c.s
Protected i.q
i=a
While i<=b
j=StrQ(i)
j=sub(j,"0.5")
c=j
j=mul(j,c)
j=mul(j,c)
sum=add(sum,j)
i+1
If i%5000=0
SetGadgetText(#output,Ausgabe+StrQ(i))
UpdateWindow_(win)
If (WindowEvent()=#PB_Event_Gadget) And (EventGadget()=#go) : Abort=#True : EndIf
If Abort
i=b
EndIf
EndIf
Wend
ProcedureReturn sum
EndProcedure
Procedure Calc()
rho=GetGadgetText(#rho)
D1=GetGadgetText(#d)
h=GetGadgetText(#h)
Abort=0
SetGadgetText(#go,"Abbruch")
delta_r=mul(D1,"0.5")
delta_r=mul(delta_r,einsdurchm)
;Debug "Delta r: "+delta_r
power=mul(delta_r,delta_r)
power=mul(power,power)
;Debug "Power: "+power
ergebnis=mul(rho,h)
;Debug "Rho*h: "+ergebnis
ergebnis=mul(ergebnis,power)
;Debug "Rho*h*Power: "+ergebnis
zweipi=mul("2",Pi)
ergebnis=mul(ergebnis,zweipi)
;Debug ergebnis
ergebnis=mul(ergebnis,sigma(1,m))
SetClipboardText(ergebnis)
Ausgabe=Ausgabe+Left(ergebnis,50)+"... "
If Abort
Ausgabe+"abgebrochen"
Else
Ausgabe+"m = 10^"+Str(mstellen)
EndIf
Ausgabe+#CRLF$
SetGadgetText(#output,Ausgabe)
;Debug rho*h*Pow(delta_r,4)*delta_phi*n*summe(1,m)
SetGadgetText(#go,"Start")
EndProcedure
Procedure Win()
Protected quit=0
win=OpenWindow(1,0,0,640,290,"Kalkulation",#PB_Window_Invisible|#WS_THICKFRAME|#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
CreateGadgetList(win)
TextGadget(901,10,23,50,20,"h:")
TextGadget(902,10,53,50,20,"D:")
TextGadget(903,10,83,50,20,"rho:")
TextGadget(904,10,113,50,20,"m:")
TextGadget(905,10,178,50,20,"Stellen:")
StringGadget(#h,50,20,135,22,h)
StringGadget(#D,50,50,135,22,D1)
StringGadget(#rho,50,80,135,22,rho)
StringGadget(#m,50,110,135,22,"")
DisableGadget(#m,1)
TrackBarGadget(#mstellen, 50,135,135,22, 1, 10,#PB_TrackBar_Ticks)
StringGadget(#max,50,175,135,22,"")
DisableGadget(#max,1)
TrackBarGadget(#maxstellen, 50,200,135,22,1,100)
SetGadgetState(#mstellen,mstellen)
m=Pow(10,mstellen)
einsdurchm=LSet("0.",mstellen+1,"0")+"1"
SetGadgetText(#m,StrQ(m))
SetGadgetState(#maxstellen,max/100)
SetGadgetText(#max,Str(max))
ButtonGadget(#go,10,240,175,30,"Start")
EditorGadget(#output,220,20,400,250,#PB_Editor_ReadOnly)
;DisableGadget(#output,1)
SetTimer_(win,1,200,0)
StickyWindow(1,1)
HideWindow(1,0)
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case #mstellen
mstellen=GetGadgetState(#mstellen)
m=Pow(10,mstellen)
einsdurchm=LSet("0.",mstellen+1,"0")+"1"
SetGadgetText(#m,StrQ(m))
Case #maxstellen
max=GetGadgetState(#maxstellen)*100
SetGadgetText(#max,Str(max))
Case #go
If Active
abort=#True
Else
Active=#True
Calc()
Active=#False
EndIf
EndSelect
Case #PB_Event_CloseWindow
quit=1
EndSelect
Until quit
EndProcedure
Procedure Main()
h="0.5"
D1="4.3"
D2="3.8"
rho="7800"
max=100
mstellen=1
Win()
EndProcedure
Main()