Aikas hyvä lasku funktio.

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
User avatar
JATothrim
Tech Developer
Tech Developer
Posts: 605
Joined: Tue Aug 28, 2007 6:46 pm
Location: Kuopio

Aikas hyvä lasku funktio.

Post by JATothrim » Wed Jul 23, 2008 4:39 pm

Tämmösen näpelsin, siis laskin joka ymmärtää sulkeet, ja +-*/^ operaatiot. Osaa myös negatiivisetluvut, muttei negaatiota: -(lauskeke) :mrgreen:
Systeemin toiminta periaate selviää Wikipediasta: http://en.wikipedia.org/wiki/Shunting_yard_algorithm ja http://en.wikipedia.org/wiki/Stack_(data_structure)

Koodin lopussa on esimerkki lasku, jonka oikeaa vastausta en ole jaksanut laskea käsin. :D
Pistäkää tähän topiikiin kommentien lisäksi omia laskin systeemejäne.

Code: Select all

///////////////////////////////////////////
//   Konversio funktio infix -> postfix	 //
//      "reverse polish notation"		 //
///////////////////////////////////////////
Const STACK_BLOCK = 5 'pinon "blockin" koko. esim: "(    " eli yhteensä 5 merkkiä
Function InfixToPostfix(statement$)
	//siistitään lauseke
	statement = Replace(Trim(statement), "+", " + ")
	statement = Replace(Trim(statement), "-", " - ")
	statement = Replace(Trim(statement), "*", " * ")
	statement = Replace(Trim(statement), "/", " / ")
	statement = Replace(Trim(statement), "^", " ^ ")
	statement = Replace(Trim(statement), "(", " ( ")
	statement = Replace(Trim(statement), ")", " ) ")
	statement = Replace(Trim(statement), "  ", " ")
	
	rpn$ = ""
	opr_stack$ = ""
	prev_opr2 = False
	prev_opr1 = False
	For i = 1 To CountWords(statement)
		token$ = GetWord(statement, i)
		
		Select token
		Case "("
			opr_stack = opr_stack + "(    "
			prev_opr2 = prev_opr1
			prev_opr1 = 1
		Case ")"
			opr$ = ""
			While Len(opr_stack)>0 And opr <> "("
				opr$ = Trim(Right(opr_stack, STACK_BLOCK))
				opr_stack = StrRemove(opr_stack, Int(Max(1,Len(opr_stack)-STACK_BLOCK)), STACK_BLOCK)
				If opr <> "(" Then rpn = rpn + " " + opr
			Wend
			
		Case "+", "-"
			opr$ = ""
			While Len(opr_stack)>0 And opr <> "("
				opr$ = Trim(Right(opr_stack, 5))
				opr_stack = StrRemove(opr_stack, Int(Max(1,Len(opr_stack)-STACK_BLOCK)), STACK_BLOCK)
				If opr <> "(" Then rpn = rpn + " " + opr
			Wend
			opr_stack = opr_stack + token + "    "
			If token = "-" Then
				prev_opr2 = prev_opr1
				prev_opr1 = 2
			Else
				prev_opr2 = prev_opr1
				prev_opr1 = 1
			EndIf
			
		Case "*", "/"
			opr$ = ""
			While Len(opr_stack)>0 And opr <> "(" And (opr = "*" Or opr = "/" Or opr = "^")
				opr$ = Trim(Right(opr_stack, 5))
				opr_stack = StrRemove(opr_stack, Int(Max(1,Len(opr_stack)-STACK_BLOCK)), STACK_BLOCK)
				If opr <> "(" Then rpn = rpn + " " + opr
			Wend
			opr_stack = opr_stack + token + "    "
			prev_opr2 = prev_opr1
			prev_opr1 = 1
		Case "^"
			opr$ = ""
			While Len(opr_stack)>0 And opr <> "(" And opr = "^"
				opr$ = Trim(Right(opr_stack, 5))
				opr_stack = StrRemove(opr_stack, Int(Max(1,Len(opr_stack)-STACK_BLOCK)), STACK_BLOCK)
				If opr <> "(" Then rpn = rpn + " " + opr
			Wend
			opr_stack = opr_stack + token + "    "
			prev_opr2 = prev_opr1
			prev_opr1 = 1
		Default
			If Float(token)<>0 Or token = "0" Or token = "0.0" Then
				rpn = rpn + " "
				If prev_opr2 = 1 And prev_opr1 = 2 Then rpn = rpn + "-" + token Else rpn = rpn + token
				prev_opr2 = prev_opr1
				rev_opr1 = 0
			EndIf
		EndSelect
		
	Next i
	opr$ = ""
	While Len(opr_stack)>0
		opr$ = Trim(Right(opr_stack, 5))
		opr_stack = StrRemove(opr_stack, Int(Max(1,Len(opr_stack)-STACK_BLOCK)), STACK_BLOCK)
		rpn = rpn + " " + opr
	Wend
	Return Trim(rpn)
EndFunction

//laskee muunnetun lausekkeen arvon.
Function Calculate(math$)
	stack$ = ""
	Repeat 
		opr$ = GetWord(math$, 1)
		math$ = Trim(Mid(math$, Len(opr$)+1))
		If Float(opr$)<>0 Or opr$ = "0" Or opr$ = "0.0" Then stack$ = stack$ +" "+ opr$
		
		offset% = CountWords(stack)
		If offset=1
			'Return Float(GetWord(stack$, offset%))
		Else
		 	num1$ = GetWord(stack$, offset%)
			num2$ = GetWord(stack$, offset%-1)
		EndIf
		
		Select opr
		Case "+"
			val1# = Float(num1$)
			val2# = Float(num2$)
			pos% = Max(1,Len(stack$)-Len("  "+num1$+num2$))
			stack$ = StrRemove(stack$, pos, Len("  "+num1$+num2$))
			stack$ = Trim(stack$+" "+(val1# + val2#))
		Case "-"
			val1# = Float(num2$)
			val2# = Float(num1$)
			pos% = Max(1,Len(stack$)-Len("  "+num1$+num2$))
			stack$ = StrRemove(stack$, pos, Len("  "+num1$+num2$))
			stack$ = Trim(stack$+" "+(val1# - val2#))
		Case "*"
			val1# = Float(num1$)
			val2# = Float(num2$)
			pos% = Max(1,Len(stack$)-Len("  "+num1$+num2$))
			stack$ = StrRemove(stack$, pos, Len("  "+num1$+num2$))
			stack$ = Trim(stack$+" "+(val1# * val2#))
		Case "/"
			val1# = Float(num2$)
			val2# = Float(num1$)
			pos% = Max(1,Len(stack$)-Len("  "+num1$+num2$))
			stack$ = StrRemove(stack$, pos, Len("  "+num1$+num2$))
			stack$ = Trim(stack$+" "+(val1# / val2#))
		Case "^"
			val1# = Float(num2$)
			val2# = Float(num1$)
			pos% = Max(1,Len(stack$)-Len("  "+num1$+num2$))
			stack$ = StrRemove(stack$, pos, Len("  "+num1$+num2$))
			stack$ = Trim(stack$+" "+(val1# ^ val2#))
		EndSelect
	Until Len(math$)=0 And CountWords(stack$)=1
	Return Float(Trim(stack$))
EndFunction

SCREEN 800,300
Const math = "(100+123*0.1)/-13.0+(2.0+(6+(-7-2)+8.0)*(34/2)-3^(-2+1))^0.5"
repeat
Text 0,0,math
ticks%=Timer()
convert$ = InfixToPostfix(math)
Text 0,12, convert

Text 0,24, "answer is: "+Calculate(convert)
Text 0,36, "time went to conversion and calulation: "+(Timer()-ticks)+" ms"
DrawScreen
Forever
-On selkeästi impulsiivinen koodaaja joka...
ohjelmoi C++:lla rekursiivisesti instantioidun templaten, jonka jokainen instantiaatio instantioi sekundäärisen singleton-template-luokan, jonka jokainen instanssi käynistää säikeen tulostakseen 'jea'.

User avatar
Koodiapina
Forum Veteran
Posts: 2396
Joined: Tue Aug 28, 2007 4:20 pm
Contact:

Re: Aikas hyvä lasku funktio.

Post by Koodiapina » Wed Jul 23, 2008 5:41 pm

Toimii hienosti. Totahan voisi käyttää viikkokisaan koodissaan. Harmi vaan, että mun kieli ei tue kuin yhtä merkkiä...

BTW. Siellä on typo, se on calculation, ei calulation :D

EDIT: No löysinpäs vian kun jaksoin etsiä:

Code: Select all

(2+2+(2*2))
Antaa vastaukseksi 8.02, mistähän nuo desimaalit tulevat? Tiedän, että tuossa on ylimääräisiä sulkeita, mutta kyllä ne pitäisi hyväksyä...
Olen liian älykäs ollakseni väärässä. Jos olet kanssani eri mieltä, suosittelen sinua pohtimaan omaa elämänkatsomustasi ja sen perusteita.

User avatar
JATothrim
Tech Developer
Tech Developer
Posts: 605
Joined: Tue Aug 28, 2007 6:46 pm
Location: Kuopio

Re: Aikas hyvä lasku funktio.

Post by JATothrim » Wed Jul 23, 2008 5:57 pm

Typot. :mrgreen: Koodi on niin purkkamaista, että (2+2+(2*2))=8.02 ei ole mikään ihme. btw, sehän heittää vain 2 prosentilla. :D
-On selkeästi impulsiivinen koodaaja joka...
ohjelmoi C++:lla rekursiivisesti instantioidun templaten, jonka jokainen instantiaatio instantioi sekundäärisen singleton-template-luokan, jonka jokainen instanssi käynistää säikeen tulostakseen 'jea'.

User avatar
esa94
Guru
Posts: 1855
Joined: Tue Sep 04, 2007 5:35 pm

Re: Aikas hyvä lasku funktio.

Post by esa94 » Wed Jul 23, 2008 8:48 pm

Öh, 2 prosentilla? Ei, vaan 0,02:lla.
⁴⁰Ar
<@mikeful> kissatehtaalla on miukuhihna.

User avatar
Makesmi
Newcomer
Posts: 19
Joined: Sun Aug 26, 2007 5:42 pm
Location: Rautalampi

Re: Aikas hyvä lasku funktio.

Post by Makesmi » Thu Jul 24, 2008 6:08 am

Tälläiset on oikein hyvää harjoitusta.
Koodin lopussa on esimerkki lasku, jonka oikeaa vastausta en ole jaksanut laskea käsin. :D
Pistäkää tähän topiikiin kommentien lisäksi omia laskin systeemejäne.
Ei kai sitä käsin tarvinne laskea:

Code: Select all

Print (100+123*0.1)/-13.0+(2.0+(6+(-7-2)+8.0)*(34/2)-3^(-2+1))^0.5
WaitKey
Ja oikea vastaus on n. 0.671032. Eli pieleen meni :D

Pykäsin paremmin toimivan, yli kolme kertaa lyhemmän ja noin 25 kertaa nopeamman lausekkeenlaskufunktion:

Code: Select all

Global lauseke$
Global mlr3l%
Global mlr3i%

lauseke = "(100+123*0.1)/-13.0+(2.0+(6+(-7-2)+8.0)*(34/2)-3^(-2+1))^0.5"
Print mlr3()
WaitKey 

Function mlr3#(t=10)
  If t = 10 Then
      mlr3l = Len(lauseke)
      mlr3i = 0
  EndIf
  n = 1
  Repeat
    c$ = Mid(lauseke,mlr3i+1,1)
    o = InStr("^*/+-()",c)
    If o = 5 And n And t Then
      mlr3i = mlr3i + 1
      x# = -mlr3(0)
    ElseIf o = 6 Then
      mlr3i = mlr3i + 1
      x# = mlr3(9)
    ElseIf o Then
      n = (o Shr 1) + 1
      If t <= n Then Return x#
      mlr3i = mlr3i + 1
      If o = 7 Then Return x#
      y# = mlr3(n)
      If o = 4 Then x=x+y
      If o = 5 Then x=x-y
      If o = 2 Then x=x*y
      If o = 3 Then x=x/y
      If o = 1 Then x=x^y
    ElseIf n
      x# = Float(Mid(lauseke,mlr3i+1))
      mlr3i = mlr3i + 1
    Else
      mlr3i = mlr3i + 1
    EndIf
    n = 0
  Until mlr3i >= mlr3l
  Return x#
End Function 
Miinuksena globaalien tarve ja koodi on perinteiseen tyyliini hutaistu ja hieman vaikeaselkoista. Mutta funktion perusidea on, että merkkijono käydään vain kerran läpi ja funktiossa pompitaan rekursiivisesti operaattorien presedenssin mukaan. Voinen kyllä selittää tarkemmin tai selkeyttää ja kommentoida koodia jos jotakuta kiinnostaa.
For x=0 To 10000
If x Mod 10 Then Box +(((x Mod 10)*200+x/10)Mod 778-389),+(((x Mod 10)*200+x/10)Mod 586-293),9,9 Else DrawScreen
Next x

User avatar
Nabixy
Member
Posts: 51
Joined: Mon Aug 27, 2007 10:22 pm

Re: Aikas hyvä lasku funktio.

Post by Nabixy » Fri Jul 25, 2008 1:08 am

Kätevä ja kätevä. Kuten todettu, hiukan epätarkka ja osittain hidaskin se on. Makesmi pistikin jo parempaa settiä.
Koodeissa olisi toki voinut olla enemmänkin rakennetta selventäviä kommentteja.
esa94 wrote:Öh, 2 prosentilla? Ei, vaan 0,02:lla.
offtopic:
Eli viittanet nyt 0,02:lla prosentteihin? Vaiko kerrot meille että 2% on 0,02. Eli kaksi on kaksi? Aijaa?
(Vaiko siihen että olet 98% keskimääräistä älykkäämpi? ; ) )

En ihan ymmärtänyt postauksesi syvempiä merkityksiä.
/offtopic

TheFish
Developer
Developer
Posts: 477
Joined: Mon Aug 27, 2007 9:28 pm
Location: Joensuu

Re: Aikas hyvä lasku funktio.

Post by TheFish » Fri Jul 25, 2008 12:06 pm

naabip wrote:offtopic:
Eli viittanet nyt 0,02:lla prosentteihin? Vaiko kerrot meille että 2% on 0,02. Eli kaksi on kaksi? Aijaa?
(Vaiko siihen että olet 98% keskimääräistä älykkäämpi? ; ) )

En ihan ymmärtänyt postauksesi syvempiä merkityksiä.
/offtopic
tarkoitti sitä että lasku (2+2+(2*2))=8.02 ei heittänyt 2 % kuten Dark Code sanoi, vaan se heitti 0,02:lla. Oikea vastaushan on kahdeksan, josta 2 prosenttia on 0,16.
CoolBasic henkilökuntaa
Kehittäjä

User avatar
Jani
Devoted Member
Posts: 741
Joined: Fri Oct 31, 2008 5:53 pm

Re: Aikas hyvä lasku funktio.

Post by Jani » Fri Feb 28, 2014 11:05 pm

En nyt tiedä, mitä mieltä tästä ollaan. Haluan kuitenkin koodiani näyttää täällä joten BUUUUUUUUUMP (oletin, että parempi jatkaa jo olemassa olevaa viestiketjua uuden aloittamisen sijaan).
Törmäsin tähän viestiketjuun ja tylsyyksissäni päätin tehdä samanlaisen. Ainoastaan exponentti puuttuu, koska suunnitellessani systeemiä unohdin sen olemassaolon kokonaan. Koko on tottakai järjetön ja rekursointia käytetään rankasti hyödyksi. Koodi on täysin kommentoimatonta, mikä pitäisi ehkä jaksaessa korjata. Mielipiteitä, vikoja?

Code: Select all

SCREEN 400, 600

Print "Uber calculator."
Print "Press any key to proceed."
Print ""
Print "Result: " + Calculate("-(-40)")
Print ""
Print "Result: " + Calculate("12+(-42)")
Print ""
Print "Result: " + Calculate("1+2/3+4*5")
Print ""
Print "Result: " + Calculate("(3-(3+2)/2*2+7)/2")
Print ""
Print "The end."
WaitKey

Function Calculate(calc As String, swoop = 1)
    Dim c As String
    Dim i As Integer
    Dim brackets As Integer
    Dim bracketstart As Integer
    Dim tocalc As String
    Dim result As Float
    Dim operand As String
    Dim skip As Byte
    operand = ""
    Print "Calculate("+calc+")"
    WaitKey
    
    If Not (InStr(calc, "*") Or InStr(calc, "/")) Then swoop = 2
    
    calc = Replace(calc, " ", "")
    calc = Replace(calc, "--", "+")
    For i = 1 To Len(calc)
        c = Mid(calc, i, 1)
        //Print " " + c + " - " + tocalc + " - " + operand + " - " + result
        If brackets > 0 Then tocalc + c
        If InStr(calc, ")") Then
            Select c
                Case "("
                    If brackets = 0 Then bracketstart = i
                    brackets + 1
                Case ")"
                    If brackets = 1 Then
                        Dim ne As String
                        ne = Left(calc, bracketstart-1)
                        ne = ne + Calculate(Left(tocalc, Len(tocalc)-1))
                        ne = ne + Mid(calc, i+1)
                        Return Calculate(ne)
                    EndIf
                    brackets - 1
            EndSelect
        Else
            If brackets = 0 Then
                If swoop = 1 Then
                    If c = "*" Or c = "/" Then
                        operand = c
                        Print " Parse operand " + c + " and Left value " + tocalc
                        Dim n As Integer
                        Dim snap As Byte
                        Dim rightval As String
                        For n = 1 To Len(calc)
                            If (Not snap) And (Mid(calc, n, Len(tocalc)+1) = tocalc+operand) Then
                                If n > 1 Then Print " Disregarded from left: " + Left(calc, n-1)
                                snap = True
                                n = n + Len(tocalc+operand)
                            EndIf
                            If snap Then
                                c = Mid(calc, n, 1)
                                If rightval = "" Or (Not (c = "+" Or c = "-" Or c = "*" Or c = "/")) Then
                                    rightval + c
                                Else
                                    Print " Disregarded from right: " + Mid(calc, n)
                                    Exit
                                EndIf
                                Print " Right value is now: " + rightval
                            EndIf
                        Next n
                        tocalc = Trim(tocalc)
                        rightval = Trim(rightval)
                        If operand = "*" Then
                            Print "  " + tocalc + " * " + rightval
                            result = Float(tocalc) * Float(rightval)
                        Else
                            Print "  " + tocalc + " / " + rightval
                            result = Float(tocalc) / Float(rightval)
                        EndIf
                        c = Left(calc, InStr(calc, tocalc+operand+rightval)-1) + result + Mid(calc, n)
                        Print "> " + c
                        WaitKey
                        Return Calculate(c)
                        tocalc = ""
                        operand = c
                        skip = True
                    EndIf
                    If c = "+" Or c = "-" Then
                        If operand = "*" Then
                            result = result * Float(tocalc)
                        Else
                            result = result / Float(tocalc)
                        EndIf
                        tocalc = ""
                        operand = ""
                        skip = True
                    EndIf
                Else
                    If c = "+" Or c = "-" Then
                        If operand = "+" Or operand = "" Then
                            result = result + Float(tocalc)
                        Else
                            result = result - Float(tocalc)
                        EndIf
                        tocalc = ""
                        operand = c
                        skip = True
                    EndIf
                EndIf
                If Not skip Then tocalc + c
                skip = False
            EndIf
        EndIf
    Next i
    If operand = "*" Then
        result = result * Float(tocalc)
    ElseIf operand = "/" Then
        result = result / Float(tocalc)
    ElseIf operand = "-" Then
        result = result - Float(tocalc)
    Else
        result = result + Float(tocalc)
    EndIf
    If brackets Then Return 0
    Print "> " + result
    Return result
EndFunction

Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition

Post Reply

Who is online

Users browsing this forum: No registered users and 1 guest