%bedmas
setscreen ("graphics:2000;1900")
var x, start, endd, tempp, interval, area : real
var equation, temp : string
var problem : boolean
var c1, c2, bs, be, n, equ2n : int
var equ : array 1 .. 1000 of string
var equ2 : array 1 .. 1000 of string
const pi := 3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825
const e := 2.718281828459045235360287471352662497757
% pi from: http://www.wpdpi.com/pi.shtml e from: http://mathworld.wolfram.com/e.html
proc sort %sort out the equation
c2 := 1
c1 := 1
loop
temp := ""
if strintok (equation (c1)) then
for i : c1 .. length (equation)
if strintok (equation (i)) then
c1 := c1 + 1
temp := temp + equation (i)
if c1 > length (equation) then
equ (c2) := temp
c2 := c2 + 1
return
end if
else
equ (c2) := temp
c2 := c2 + 1
exit
end if
end for
elsif equation (c1) = "*" and equation (c1 + 1) = "*" then
c1 := c1 + 2
equ (c2) := "**"
c2 := c2 + 1
if c1 > length (equation) then
return
end if
else
equ (c2) := equation (c1)
c1 := c1 + 1
c2 := c2 + 1
if c1 > length (equation) then
return
end if
end if
end loop
end sort
proc sort2 % takes care of negative signs
c1 := 1
loop
if equ (c1) = "~" and strrealok (equ (c1 + 1)) then
equ (c1) := realstr ((strreal (equ (c1 + 1)) * -1), 0)
c2 := c2 - 1
for i : c1 + 1 .. c2
equ (i) := equ (i + 1)
end for
end if
c1 := c1 + 1
if c1 > c2 then
exit
end if
end loop
end sort2
c1 := 1
proc dd % eh..
for i : 1 .. c2
equ2 (i) := equ (i)
end for
end dd
proc abc %bedmas calculations
tempp := 0
for i : bs .. be
if equ (i) = "sin" or equ (i) = "cos" or equ (i) = "tan" or equ (i) = "log" or equ (i) = "ln" then %various other crap
if equ (i) = "sin" and strrealok (equ (i + 1)) then
tempp := sind (strreal (equ (i + 1)))
equ (i) := realstr (tempp, 0)
c2 := c2 - 1
for j : i + 1 .. c2
equ (j) := equ (j + 1)
end for
return
end if
if equ (i) = "cos" and strrealok (equ (i + 1)) then
tempp := cosd (strreal (equ (i + 1)))
equ (i) := realstr (tempp, 0)
c2 := c2 - 1
for j : i + 1 .. c2
equ (j) := equ (j + 1)
end for
return
end if
if equ (i) = "tan" and strrealok (equ (i + 1)) then
tempp := sind (strreal (equ (i + 1))) / cosd (strreal (equ (i + 1)))
equ (i) := realstr (tempp, 0)
c2 := c2 - 1
for j : i + 1 .. c2
equ (j) := equ (j + 1)
end for
return
end if
if equ (i) = "log" and strrealok (equ (i + 1)) then
tempp := ln (strreal (equ (i + 1))) / ln (10)
equ (i) := realstr (tempp, 0)
c2 := c2 - 1
for j : i + 1 .. c2
equ (j) := equ (j + 1)
end for
return
end if
if equ (i) = "ln" and strrealok (equ (i + 1)) then
tempp := ln (strreal (equ (i + 1)))
equ (i) := realstr (tempp, 0)
c2 := c2 - 1
for j : i + 1 .. c2
equ (j) := equ (j + 1)
end for
return
end if
end if
end for
for i : bs .. be
if equ (i) = "**" then %performs exponents
tempp := strreal (equ (i - 1)) ** strreal (equ (i + 1))
equ (i - 1) := realstr (tempp, 0)
c2 := c2 - 2
for j : i .. c2
equ (j) := equ (j + 2)
end for
return
end if
end for
for i : bs .. be % sorts negative
sort2
end for
if c2 = 1 then
return
end if
for i : bs .. be
if equ (i) = "*" or equ (i) = "/" then % performs division and multiplicaiton
if equ (i) = "*" then
tempp := strreal (equ (i - 1)) * strreal (equ (i + 1))
equ (i - 1) := realstr (tempp, 0)
c2 := c2 - 2
for j : i .. c2
equ (j) := equ (j + 2)
end for
return
end if
if equ (i) = "/" then
tempp := strreal (equ (i - 1)) / strreal (equ (i + 1))
equ (i - 1) := realstr (tempp, 0)
c2 := c2 - 2
for j : i .. c2
equ (j) := equ (j + 2)
end for
return
end if
end if
end for
for i : bs .. be
if equ (i) = "+" or equ (i) = "-" then %performs addition and subtraction
if equ (i) = "+" then
tempp := strreal (equ (i - 1)) + strreal (equ (i + 1))
equ (i - 1) := realstr (tempp, 0)
c2 := c2 - 2
for j : i .. c2
equ (j) := equ (j + 2)
end for
return
end if
if equ (i) = "-" then
tempp := strreal (equ (i - 1)) - strreal (equ (i + 1))
equ (i - 1) := realstr (tempp, 0)
c2 := c2 - 2
for j : i .. c2
equ (j) := equ (j + 2)
end for
return
end if
end if
end for
problem := false
return
end abc
proc bracket % performs bedmas
for i : 1 .. c2
if equ (i) = "(" then %brackets first
for j : i + 1 .. c2
if equ (j) = ")" then
bs := i
be := j
if be - bs = 2 then
c2 := c2 - 2
equ (bs) := equ (bs + 1)
for k : bs + 1 .. c2
equ (k) := equ (k + 2)
end for
return
else
abc
return
end if
elsif equ (j) = "(" then
exit
end if
end for
return
end if
end for
sort2
bs := 1
be := c2
abc % when no more brackets, goes to next sorting...
return
end bracket
proc dfdf
loop
put " y= " ..
for i : 1 .. c2
put equ (i) ..
end for
put " "
put " "
delay (50)
if c2 > 1 then
bracket
elsif c2 = 1 then
return
end if
exit when hasch
if problem = false then
put "error, program ended"
return
end if
end loop
end dfdf
loop
problem := true
cls
setscreen ("graphics:2000;1900")
put " watch the equation become sorted out"
put " "
put " MATH bedmas MATH"
put " "
put " "
put " * multiplication constants: e, pi"
put " / division rest: cos"
put " - subtraction sin"
put " + addition tan"
put " ** exponents log"
put " ~ negative sign ln"
put " "
put " "
put " enter equation (don't use x): "
put " y= " ..
get equation
put " "
put " "
put " while it is calculating, just press any key to stop "
put " "
put " "
sort % divide the eqation into seperate characters
c2 := c2 - 1
c1 := 1
loop %sort out the equation
if equ (c1) = "." then
equ (c1 - 1) := equ (c1 - 1) + "." + equ (c1 + 1)
c2 := c2 - 2
for i : c1 .. c2
equ (i) := equ (i + 2)
end for
elsif equ (c1) = "~" and strrealok (equ (c1 + 1)) then
equ (c1) := "-" + equ (c1 + 1)
c2 := c2 - 1
for i : c1 + 1 .. c2
equ (i) := equ (i + 1)
end for
elsif equ (c1) = "s" and equ (c1 + 1) = "i" and equ (c1 + 2) = "n" then
equ (c1) := "sin"
c2 := c2 - 2
for i : c1 + 1 .. c2
equ (i) := equ (i + 2)
end for
elsif equ (c1) = "c" and equ (c1 + 1) = "o" and equ (c1 + 2) = "s" then
equ (c1) := "cos"
c2 := c2 - 2
for i : c1 + 1 .. c2
equ (i) := equ (i + 2)
end for
elsif equ (c1) = "t" and equ (c1 + 1) = "a" and equ (c1 + 2) = "n" then
equ (c1) := "tan"
c2 := c2 - 2
for i : c1 + 1 .. c2
equ (i) := equ (i + 2)
end for
elsif equ (c1) = "l" and equ (c1 + 1) = "o" and equ (c1 + 2) = "g" then
equ (c1) := "log"
c2 := c2 - 2
for i : c1 + 1 .. c2
equ (i) := equ (i + 2)
end for
elsif equ (c1) = "p" and equ (c1 + 1) = "i" then
equ (c1) := realstr (pi, 0)
c2 := c2 - 1
for i : c1 + 1 .. c2
equ (i) := equ (i + 1)
end for
elsif equ (c1) = "l" and equ (c1 + 1) = "n" then
equ (c1) := "ln"
c2 := c2 - 1
for i : c1 + 1 .. c2
equ (i) := equ (i + 1)
end for
elsif equ (c1) = "e" then
equ (c1) := realstr (e, 0)
end if
c1 := c1 + 1
if c1 > c2 then
exit
end if
end loop
c1 := 1
loop %another sorting
if equ (c1) = "x" or strrealok (equ (c1)) then % x(3) becomes x * (3),, xsin becomes x * sin .. etc.,
if c2 > c1 then
if equ (c1 + 1) = "(" or equ (c1 + 1) = "log" or equ (c1 + 1) = "sin" or equ (c1 + 1) = "cos" or equ (c1 + 1) = "tan" or strrealok (equ (c1 + 1)) then
dd
equ (c1 + 1) := "*"
c2 := c2 + 1
for i : c1 + 2 .. c2
equ (i) := equ2 (i - 1)
end for
end if
end if
if c1 > 1 then % (3)x becomes (3) * x, 3x becomes 3 * x ... etc.,
if equ (c1 - 1) = ")" or strrealok (equ (c1 - 1)) then
dd
equ (c1) := "*"
c2 := c2 + 1
for i : c1 + 1 .. c2
equ (i) := equ2 (i - 1)
end for
end if
end if
end if
c1 := c1 + 1
exit when c1 > c2
end loop
equ2n := c2
for i : 1 .. c2
equ2 (i) := equ (i)
end for
% the sorted equ2 is saved and used over and over again with differnt x values
%%%%%%%%%%% SORTING IS DONE %%%%%%%%%%%
dfdf
put ""
put ""
put " go again? (y/n): " ..
get temp
if temp = "n" then
exit
end if
end loop
cls
put "good bye"
|
Register
Wiki
Blog
Search
Turing
Chat Room
Members
