Calculator

Module Module1
    'problem when numbers that are negative
    Public Structure lastnumber
        Dim number As Int64
        Dim power As Integer
    End Structure
    Sub Main()
start:  'incase a link back to the start is needed
        Dim equation As String
        Console.WriteLine("Welcome to your calculator.")
        Console.Write("Start: ")
        equation = removespace(Console.ReadLine())
        equation = dofunctionsuntil(equation)
        equation = constantsToNumbers(equation)
        equation = errorhandle(equation)
        equation = dobracuntil(equation)
        equation = dorununtil(equation)
        Console.WriteLine(equation)
show:
        Console.ReadKey()
        GoTo start
    End Sub
    Public Function removespace(ByVal equation)
        'do until there are no longer spaces in the string
        Do Until InStr(equation, " ") = 0
            'remove the first space in the string
            equation = Mid(equation, 1, InStr(equation, " ") - 1) & Mid(equation, InStr(equation, " ") + 1, Len(equation) - InStr(equation, " "))
        Loop
        'return a value
        removespace = equation
    End Function

    Public Function dofunctionsuntil(ByVal equation)
        'call the dofunction function until there are no longer functions in the string
        Do Until InStr(equation, "sin") = 0 And InStr(equation, "cos") = 0 And InStr(equation, "tan") = 0 And InStr(equation, "log") = 0 And InStr(equation, "pri") = 0 And InStr(equation, "sca") = 0 And InStr(equation, "sol") = 0 And InStr(equation, "der") = 0
            equation = FindFunction(equation)
        Loop
        'return a value
        dofunctionsuntil = equation
    End Function

    Public Function errorhandle(ByVal equation)
        'define i as integer as it will count through things
        Dim I As Integer
        'find out if the brackets are even
        'level increaces and decreaces depending on whether the scanner finds an open
        'bracket or a close bracket. If at the end of the string level is what it started on then
        'the brackets are equale
        Dim level As Integer
        level = 0
        'go through each caractor of the string
        For I = 1 To Len(equation)
            'if it's an open bracket then increace the level
            If Mid(equation, I, 1) = "(" Then
                level = level + 1
            ElseIf Mid(equation, I, 1) = ")" Then
            'else decreace the level
                level = level - 1
            End If
        Next
        'if the level is less than it started then there are to many close brackets
        If level < 0 Then
            Console.WriteLine("Too many close brackets!")
            Call Main()
        ElseIf level > 0 Then
        'else if level is more than it started then there are too many open brackets
            Console.WriteLine("Too many open brackets!")
            Call Main()
        End If
        'remove bad symbols
        'scan through the string
        For I = 1 To Len(equation)
            'if the current charactor is not a number and its not one of the signs and it's not an acceptable charactor in another way then:
            If ifnumber(Mid(equation, I, 1)) = False And ifsign(Mid(equation, I, 1)) = False And ifexeption(Mid(equation, I, 1)) = False Then
                'get rid of it
                equation = Mid(equation, 1, I - 1) & Mid(equation, I + 1, Len(equation) - I)
                'correct for the fact that the string is now smaller
                i=i-1
            End If
        Next

        'identifying empty brackets
        For I = 1 To Len(equation)
            If Mid(equation, I, 2) = "()" Then
                Console.WriteLine("Error open bracket leads on to close brackets directly!")
                Call Main()
            End If
        Next
        errorhandle = equation
    End Function

    Public Function ifconst1(ByVal letter) As String
        letter = UCase(letter)
        If letter = "C" Then
            ifconst1 = 299792458
        ElseIf letter = "G" Then
            ifconst1 = 6.673 * 10 ^ -11
        ElseIf letter = "E" Then
            ifconst1 = 2.71828183
        ElseIf letter = "A" Then
            ifconst1 = 1
        Else
            ifconst1 = 0
        End If
    End Function 'identify 1 charactor constants
    Public Function ifconst2(ByVal letter)
        letter = UCase(letter)
        If letter = "KE" Then
            ifconst2 = 8.9875517873681758 * 10 ^ 9
        ElseIf letter = "PI" Then
            ifconst2 = Math.PI
        Else
            ifconst2 = 0
        End If

    End Function'identify 2 charactor constants
    Public Function constantsToNumbers(ByVal equation)
        'define i as a counting number
        Dim i As Integer
        'go throught the string looking for double charactors first
        'this is done because a signle charactor constant could make up a double charactor constant
        'for example in ke is e
        'only go to the second last charactor because you can't have a two charactor word starting at the last charactor
        For i = 1 To Len(equation) - 1
            If ifconst2(Mid(equation, i, 2)) <> 0 Then
                'if it is a constant then replace it with its numerical value
                equation = Mid(equation, 1, i - 1) & ifconst2(Mid(equation, i, 2)) & Mid(equation, i + 2, Len(equation) - i)
            End If
        Next
        'look for single charactor constants
        For i = 1 To Len(equation)
            If ifconst1(Mid(equation, i, 1)) <> 0 Then
                'if it's a charactor then replace it
                equation = Mid(equation, 1, i - 1) & ifconst1(Mid(equation, i, 1)) & Mid(equation, i + 1, Len(equation) - i)
            End If
        Next
        constantsToNumbers = equation
    End Function
    Public Function isolatebrackets(ByVal equation)
        Dim i As Integer
        Dim layer As Integer
        layer = 0 'set layer
        For i = 1 To Len(equation) 'set up scan of equation from the charactor after the trig function
            If Mid(equation, i, 1) = "(" Then 'if open brackets go in a  layer
                layer = layer + 1
            ElseIf Mid(equation, i, 1) = ")" Then ' if close brackets go out a layer
                layer = layer - 1
                If layer = 0 Then ' if layer is on the layer we started at then finish
                    GoTo isolated
                End If
            End If
        Next
isolated:
        isolatebrackets = Mid(equation, 2, i - 2) ' remove the first bracket and last bracket and submit code
    End Function
    Public Function ifsign(ByVal chr)
        If chr = "-" Or chr = "/" Or chr = "+" Or chr = "*" Or chr = "^" Then
            ifsign = True
        Else
            ifsign = False
        End If
    End Function
    Public Function ifnumber(ByVal charactor As String)
        If charactor = "0" Or charactor = "1" Or charactor = "2" Or charactor = "3" Or charactor = "4" Or charactor = "5" Or charactor = "6" Or charactor = "7" Or charactor = "8" Or charactor = "9" Or charactor = "." Then
            ifnumber = True
        Else
            ifnumber = False
        End If
    End Function
    Public Function iffunction(ByVal function_)
        function_ = UCase(function_)
        If function_ = "SIN" Or function_ = "COS" Or function_ = "TAN" Or function_ = "LOG" Or function_ = "PRI" Or function_ = "SCA" Or function_ = "SOL" Or function_ = "DER" Then
            iffunction = True
        Else
            iffunction = False
        End If
    End Function
    Public Function ifexeption(ByVal charactor As String)
        If charactor = ")" Or charactor = "(" Or charactor = "^" Then
            ifexeption = True
        Else
            ifexeption = False
        End If
    End Function
    Public Function FindFunction(ByVal equation)
        Dim I As Integer
        Dim bracsum As String
        Dim expantion As String
        Dim FunctionName As String
        ' find the trig function closest to the right
        For I = Len(equation) - 3 To 1 Step -1

            If iffunction(Mid(equation, I, 3)) Then
                FunctionName = Mid(equation, I, 3)
                If Mid(equation, I + 3, 1) = "(" Then 'if there are brackets after the equation
                    bracsum = isolatebrackets(Mid(equation, I + 3, Len(equation) - (I + 3))) 'find which brackets are after the function
                Else
                    Console.WriteLine("The function must be contained in brackets e.g. sin(30)")
                    Call Main()
                    Exit Function
                End If

                expantion = doFunction(FunctionName, bracsum)
                equation = Mid(equation, 1, I - 1) & expantion & Mid(equation, I + Len(bracsum) + 5, Len(equation) - (I + Len(bracsum) + 1)) ' compleat equation
                GoTo badger  'exit for loop when brackets compleat
            End If ' end if a trig function
        Next
badger:

        FindFunction = equation ' return function value

    End Function
    Public Function doFunction(ByVal Function_name, ByVal equation)
        Function_name = UCase(Function_name)
        'functions that contain iligal charactors
        If Function_name = "SCA" Then
            Do Until Len(equation) = 1
                If Len(equation) = 2 Then
                    equation = signmath(equation)
                Else
                    equation = signmath(equation) & Mid(equation, 3, Len(equation) - 3)
                End If
            Loop
            doFunction = equation
            Exit Function
        ElseIf Function_name = "DER" Then
            On Error GoTo iferrorondev
            If InStr(equation, "x") = 0 Then
                doFunction = 0
            Else
                doFunction = der(equation)
            End If
            Exit Function
iferrorondev:
            Console.WriteLine("A user caused error has occured, you must type in an algibaic equation")
            Exit Function
        ElseIf Function_name = "SOL" Then
            doFunction = solvealgibra(equation)
            Exit Function
        ElseIf Function_name = "LOG" Then
            Dim numbers() As String = Split(equation, ",")
            Dim number1 As Integer
            Dim number2 As Double
            If numbers.GetLength(0) = 1 Then
                number2 = dobracuntil(dobracuntil(numbers(0)))
                doFunction = Math.Log(number2, 10)
            Else
                number1 = Int(dobracuntil(dobracuntil(numbers(0))))
                number2 = dobracuntil(dobracuntil(numbers(1)))
                doFunction = Math.Log(number2, number1)
            End If
            Exit Function
        End If
        'clearing illigal charactors
        equation = constantsToNumbers(equation)
        equation = errorhandle(equation)
        equation = dobracuntil(equation)
        'functions that use numbers
        If Function_name = "SIN" Then
            doFunction = Math.Sin(equation)
        ElseIf Function_name = "COS" Then
            doFunction = Math.Cos(equation)
        ElseIf Function_name = "TAN" Then
            doFunction = Math.Tan(equation)
        ElseIf Function_name = "PRI" Then
            Dim number As Int64
            Dim i As Int64
            Dim lastnumber As lastnumber
            number = equation
            i = number
            lastnumber.number = 0
            lastnumber.power = 1
            Do Until i = 1
                i = factor(i)
                If lastnumber.number = number / i Then
                    lastnumber.power = lastnumber.power + 1
                Else
                    If lastnumber.number <> 0 Then
                        If lastnumber.power = 1 Then
                            Console.WriteLine(lastnumber.number)
                        Else
                            Console.WriteLine(lastnumber.number & "^" & lastnumber.power)
                        End If
                    End If
                    lastnumber.number = number / i
                    lastnumber.power = 1
                End If
                number = i


            Loop
            If lastnumber.power = 1 Then
                Console.WriteLine(lastnumber.number)
            Else
                Console.WriteLine(lastnumber.number & "^" & lastnumber.power)
            End If
            doFunction = 1
        End If
    End Function
    Public Function factor(ByVal number)
        Dim i As Int64
        Dim n As Int64
        For i = Int(number / 2) To 1 Step -1
            If number Mod i = 0 Then
                n = i
                Exit For
            End If
        Next
        factor = n
    End Function
    Public Function signmath(ByVal equation)
        Dim sign1 As String
        Dim sign2 As String
        sign1 = Mid(equation, 1, 1)
        sign2 = Mid(equation, 2, 1)
        If sign1 = "+" And sign2 = "+" Then
            signmath = "+"
        ElseIf sign1 = "+" And sign2 = "-" Then
            signmath = "-"
        ElseIf sign1 = "-" And sign2 = "+" Then
            signmath = "-"
        Else
            signmath = "+"
        End If
    End Function
    Public Function reaplace(ByVal equation, ByVal number)

        Dim i As Integer
        i = 1
        Do Until InStr(equation, "x") = 0
            If Mid(equation, i, 1) = "x" Then
                If i <> 1 Then
                    If Mid(equation, i - 1, 1) = "-" Or Mid(equation, i - 1, 1) = "+" Or Mid(equation, i - 1, 1) = "(" Or Mid(equation, i - 1, 1) = "/" Or Mid(equation, i - 1, 1) = "*" Or Mid(equation, i - 1, 1) = "^" Then
                        equation = Mid(equation, 1, i - 1) & number & Mid(equation, i + 1, Len(equation) - i)
                    Else
                        equation = Mid(equation, 1, i - 1) & "*" & number & Mid(equation, i + 1, Len(equation) - i)
                    End If
                Else
                    equation = number & Mid(equation, 2, Len(equation) - 1)
                End If

            End If
            i = i + 1

        Loop

        reaplace = equation
    End Function
    Public Function solvealgibra(ByVal original) As Double
        Dim derivitive As String
        Dim i As Integer = 0
        derivitive = dev(original)
        Dim x, x0 As Double
        x = 1
        Dim equation As String
        equation = "x-((" & original & ")/(" & derivitive & "))"
        Do Until x = x0 Or i > 10000
            x0 = x
            x = dorununtil(dobracuntil(reaplace(equation, x0)))
            i = i + 1
        Loop
        If i > 10000 Then
            solvealgibra = 0 / 0
        Else
            solvealgibra = x
        End If
        Exit Function
errorhandle:
        Console.WriteLine("The function sol can be used to solve non liner algibreic equations!")
        Console.WriteLine("You must first munipulat the equation so that 'something = 0'")
        Console.WriteLine("You then write in the calculator program 'sol(something)'")
        solvealgibra = 0 / 0
    End Function
    Public Function dev(ByVal origin)
        Dim i As Integer
        Dim bits(scan(origin))
        If bits.GetLength(0) <> 1 Then
            Dim n As Integer
            Dim carry As Integer
            n = 0
            carry = 1
            For i = 1 To Len(origin)
                If Mid(origin, i, 1) = "-" Then
                    bits(n) = Mid(origin, carry, i - carry)
                    carry = i
                    n = n + 1
                ElseIf Mid(origin, i, 1) = "+" Then
                    bits(n) = Mid(origin, carry, i - carry)
                    carry = i
                    n = n + 1
                End If
            Next
        Else
            bits(0) = origin
        End If
        Dim derivitive As String
        Dim power As String

        Dim constant As Double
        derivitive = ""
        For i = 0 To bits.GetLength(0) - 1
            If InStr(bits(i), "x") <> 0 Then
                If InStr(bits(i), "^") = 0 Then
                    power = 1
                Else
                    power = Mid(bits(i), InStr(bits(i), "^") + 1, Len(bits(i)) - (InStr(bits(i), "^")))
                End If

                If Mid(bits(i), 1, InStr(bits(i), "x") - 1) = "" Then
                    constant = 1
                ElseIf Mid(bits(i), 1, InStr(bits(i), "x") - 1) = "-" Then
                    constant = -1
                Else
                    constant = Mid(bits(i), 1, InStr(bits(i), "x") - 1)
                End If
                If power <> "1" Then
                    derivitive = derivitive & "+(" & power & "*" & constant & "x^(" & power & "- 1))"
                Else
                    derivitive = derivitive & "+" & constant
                End If
            End If
        Next
        dev = Mid(derivitive, 2, Len(derivitive) - 1)
    End Function
    Public Function scan(ByVal text)
        Dim i, number As Integer
        number = 0
        For i = 1 To Len(text)
            If Mid(text, i, 1) = "-" Then
                number = number + 1
            ElseIf Mid(text, i, 1) = "+" Then
                number = number + 1
            End If
        Next
        scan = number
    End Function
    Public Function der(ByVal origin)
        Dim i As Integer
        Dim bits(scan(origin))
        If bits.GetLength(0) <> 1 Then
            Dim n As Integer
            Dim carry As Integer
            n = 0
            carry = 1
            For i = 1 To Len(origin)
                If Mid(origin, i, 1) = "-" Then
                    bits(n) = Mid(origin, carry, i - carry)
                    carry = i
                    n = n + 1
                ElseIf Mid(origin, i, 1) = "+" Then
                    bits(n) = Mid(origin, carry, i - carry)
                    carry = i
                    n = n + 1
                End If
            Next
        Else
            bits(0) = origin
        End If
        Dim derivitive As String
        Dim power As Integer

        Dim constant As Double
        derivitive = ""
        For i = 0 To bits.GetLength(0) - 1
            If InStr(bits(i), "x") <> 0 Then
                If InStr(bits(i), "^") = 0 Then
                    power = 1
                Else
                    power = Int(Mid(bits(i), InStr(bits(i), "^") + 1, Len(bits(i)) - (InStr(bits(i), "^"))))
                End If

                If Mid(bits(i), 1, InStr(bits(i), "x") - 1) = "" Then
                    constant = 1
                ElseIf Mid(bits(i), 1, InStr(bits(i), "x") - 1) = "-" Then
                    constant = -1
                Else
                    constant = Mid(bits(i), 1, InStr(bits(i), "x") - 1)
                End If
                If power <> "1" Then
                    derivitive = derivitive & "+" & power * constant & "x^" & power - 1
                Else
                    derivitive = derivitive & "+" & constant
                End If
            End If
        Next
        der = Mid(derivitive, 2, Len(derivitive) - 1)
    End Function
    Public Function dorununtil(ByVal equation)

        Do Until InStr(equation, "*") = 0 And InStr(equation, "/") = 0 And InStr(equation, "^") = 0 And answer(equation)
            equation = run(equation)
        Loop
        dorununtil = equation
    End Function
    Public Function answer(ByVal equation)
        Dim i, signs As Integer
        signs = 0
        For i = 2 To Len(equation)
            If Mid(equation, i, 1) = "-" Then
                If Mid(equation, i - 1, 1) <> "E" Then
                    signs = signs + 1
                End If
            ElseIf Mid(equation, i, 1) = "+" Then
                If Mid(equation, i - 1, 1) <> "E" Then
                    signs = signs + 1
                End If
            End If
        Next
        If signs = 0 Then
            answer = True
        Else
            answer = False
        End If
    End Function
    Public Function dobracuntil(ByVal equation)
        Do Until InStr(equation, "(") = 0
            equation = dobrackets(equation)
        Loop
        dobracuntil = equation
    End Function
    Public Function run(ByVal number As String)
        On Error GoTo errorhandels
        Dim num(NoOfNumbers(number)) As String
        Dim i As Integer
        Dim sign(NoOfNumbers(number) - 1) As Char
        Dim current As Integer
        Dim strnext As String
        strnext = ""
        current = 0
        'making the numbers = to "" so that when more digits are added to the end there isnt a 0 infront
        For i = 0 To num.GetLength(0) - 1
            num(i) = ""
        Next
        'splitting the string into numbers and calculations
        'if the first number is negative then set it as negative
        num(0) = Mid(number, 1, 1) ' putting the first charactor at the start of the first number
        For i = 2 To Len(number) ' this loop looks at charactors 2 to the last and decids weather to put them in a number or sign
            If ifsign(Mid(number, i, 1)) = False Then ' if the current charactor is not a sign
                If Mid(number, i, 1) = "E" Then ' if the current charactor is E then put the next charactor as it will be part of the next number but might be confused as a sign by the program
                    num(current) = num(current) & Mid(number, i, 2) ' adding both charactors to number
                    i = i + 1 ' including the fact that two charactors where added
                Else
                    num(current) = num(current) & Mid(number, i, 1) 'stooringcharactor to number
                End If
            ElseIf ifsign(Mid(number, i - 1, 1)) = True Then 'if the sign shows the charge of the number then ...
                num(current) = num(current) & Mid(number, i, 1) ' put this number at the start of the number
            Else ' ie the sign is what we want to calculate

                sign(current) = Mid(number, i, 1) 'storing sign
                current = current + 1   'changing the number that digits are stoored to after a sign
            End If
        Next
        'writing numbers before calculation
        For i = 0 To signpick(sign) - 1
            strnext = strnext & num(i) & sign(i)
        Next
        'writing calculation
        strnext = strnext & sum(num(signpick(sign)), sign(signpick(sign)), num(signpick(sign) + 1))
        'writing numbers after calculation
        For i = signpick(sign) + 1 To sign.GetLength(0) - 1
            strnext = strnext & sign(i) & num(i + 1)
        Next

        run = Mid(strnext, 1, Len(strnext) - 1)
        Exit Function
errorhandels:

        Console.WriteLine("More than two signs in a row!!!")
        Console.WriteLine("Programs progress:")
        Console.WriteLine(number)
        Console.WriteLine("This may be the answer to a sum inside some brackets! So please take mesures to avoid this such as;")
        Console.WriteLine("If you type in 1+-(8-9) please insted type 1-(8-9)")
        Console.WriteLine("Or you can use the function sca() for example sca(--+) would give the answer +")
        Console.WriteLine("You can also use it in an equation for example 5sca(--++-+)7 which would give you 12")
    End Function
    Public Function signpick(ByVal signs() As Char)
        Dim i As Integer

        For i = 0 To signs.GetLength(0) - 1
            If signs(i) = "^" Then
                signpick = i
                Exit Function
            End If
        Next
        For i = 0 To signs.GetLength(0) - 1
            If signs(i) = "*" Then
                signpick = i
                Exit Function
            End If
        Next
        For i = 0 To signs.GetLength(0) - 1
            If signs(i) = "/" Then
                signpick = i
                Exit Function
            End If
        Next
        signpick = 0
    End Function
    Public Function dobrackets(ByVal equation)

        Dim I As Integer
        Dim bracsum As String
        Dim expantion As String
        I = Len(equation)
        ' find the open bracket closest to the right
        For I = Len(equation) To 1 Step -1
            If Mid(equation, I, 1) = "(" Then
                bracsum = Mid(equation, I + 1, Len(equation) - (I)) 'go on using instr' isolate sum
                bracsum = Mid(bracsum, 1, InStr(bracsum, ")") - 1)
                expantion = dorununtil(bracsum)
                equation = Mid(equation, 1, I - 1) & expantion & Mid(equation, I + Len(bracsum) + 2, Len(equation) - (I + Len(bracsum) + 1)) ' compleat equation
                GoTo badger  'exit for loop when brackets compleat
            End If
        Next
badger:
        dobrackets = equation ' return function value

    End Function
    Public Function NoOfNumbers(ByVal number)
        Dim i As Integer
        Dim numbers As Integer
        numbers = 1
        For i = 2 To Len(number)
            If ifsign(Mid(number, i, 1)) = True Then
                numbers = numbers + 1
            End If
        Next
        NoOfNumbers = numbers
    End Function
    Public Function sum(ByVal a As Single, ByVal sign As Char, ByVal b As Single)
        If sign = "*" Then
            sum = a * b
        ElseIf sign = "/" Then
            sum = a / b
        ElseIf sign = "+" Then
            sum = a + b
        ElseIf sign = "-" Then
            sum = a - b
        Else
            sum = a ^ b
        End If
    End Function

End Module