Logic table generator

Program.fs

type Token =
    | LParen // Left parenthesis '('
    | RParen // Right parenthesis ')'
    | NotOp // NOT operator '!'
    | AndOp // AND operator '&'
    | OrOp // OR operator '|'
    | ImpliesOp // Implication operator '->'
    | BiconditionalOp // Biconditional operator '<->'
    | Variable of string // A logical variable (e.g., "P", "Q")
    | Eof // End of file/input marker

/// Converts an input string into a list of tokens.
let lex (input: string) : Token list =
    let mutable i = 0
    let chars = input.ToCharArray()
    let length = chars.Length

    /// Peeks at a character at a given offset from the current position.
    let peek (offset: int) =
        if i + offset < length then
            Some chars.[i + offset]
        else
            None

    /// Advances the current position by a given count.
    let advance (count: int) = i <- i + count

    let rec loop (acc: Token list) : Token list =
        if i >= length then
            // If end of input, reverse the accumulated tokens and add Eof.
            List.rev (Eof :: acc)
        else
            match chars.[i] with
            // Skip whitespace characters.
            | ' '
            | '\t'
            | '\n'
            | '\r' ->
                advance 1
                loop acc
            | '(' ->
                advance 1
                loop (LParen :: acc)
            | ')' ->
                advance 1
                loop (RParen :: acc)
            | '!' ->
                advance 1
                loop (NotOp :: acc)
            | '&' ->
                advance 1
                loop (AndOp :: acc)
            | '|' ->
                advance 1
                loop (OrOp :: acc)
            | '-' ->
                // Check for '->'
                if peek 1 = Some '>' then
                    advance 2
                    loop (ImpliesOp :: acc)
                else
                    failwithf "Lexer error: Unexpected character '%c' at position %d. Expected '->'." chars.[i] i
            | '<' ->
                // Check for '<->'
                if peek 1 = Some '-' && peek 2 = Some '>' then
                    advance 3
                    loop (BiconditionalOp :: acc)
                else
                    failwithf "Lexer error: Unexpected character '%c' at position %d. Expected '<->'." chars.[i] i
            // Handle variables (single uppercase letters).
            | c when System.Char.IsLetter c && System.Char.IsUpper c ->
                advance 1
                loop (Variable(string c) :: acc)
            // Report unexpected characters.
            | c -> failwithf "Lexer error: Unexpected character '%c' at position %d" c i

    loop [] // Start the lexing process.


type Expr =
    | Var of string // A variable (e.g., P, Q)
    | Not of Expr // Logical NOT
    | And of Expr * Expr // Logical AND
    | Or of Expr * Expr // Logical OR
    | Implies of Expr * Expr // Logical Implication
    | Biconditional of Expr * Expr // Logical Biconditional
    | True // Literal True value (not used in parsing, but good for completeness)
    | False // Literal False value (not used in parsing, but good for completeness)

let mutable currentTokens: Token list = []

/// Consumes the expected token from the current token stream.
let consume (expected: Token) =
    match currentTokens with
    | head :: tail when head = expected -> currentTokens <- tail // Advance the token stream
    | head :: _ -> failwithf "Parser error: Expected %A but found %A" expected head
    | [] -> failwithf "Parser error: Expected %A but reached end of input" expected

/// Peeks at the next token in the stream without consuming it.
let peek () =
    match currentTokens with
    | head :: _ -> head
    | [] -> Eof

/// Primary expressions: variables or parenthesized expressions.
let rec parsePrimary () : Expr =
    match peek () with
    | Variable v ->
        consume (Variable v)
        Var v
    | LParen ->
        consume LParen
        let expr = parseBiconditional () // Parse the full expression inside parentheses
        consume RParen
        expr
    | _ -> failwithf "Parser error: Expected variable or '(' but found %A" (peek ())

/// NOT operator (highest precedence, right-associative).
and parseNot () : Expr =
    if peek () = NotOp then
        consume NotOp
        Not(parseNot ()) // NOT is right-associative
    else
        parsePrimary ()

/// AND operator (left-associative).
and parseAnd () : Expr =
    let mutable left = parseNot () // Start with an expression of higher precedence

    while peek () = AndOp do
        consume AndOp
        let right = parseNot () // Parse the right-hand side
        left <- And(left, right) // Combine with the AND operator

    left

/// OR operator (left-associative).
and parseOr () : Expr =
    let mutable left = parseAnd () // Start with an expression of higher precedence

    while peek () = OrOp do
        consume OrOp
        let right = parseAnd () // Parse the right-hand side
        left <- Or(left, right) // Combine with the OR operator

    left

/// Implication operator (right-associative).
and parseImplies () : Expr =
    let left = parseOr () // Start with an expression of higher precedence

    if peek () = ImpliesOp then
        consume ImpliesOp
        let right = parseImplies () // Implies is right-associative, so recursively call itself
        Implies(left, right)
    else
        left

/// Biconditional operator (lowest precedence, left-associative).
and parseBiconditional () : Expr =
    let mutable left = parseImplies () // Start with an expression of higher precedence

    while peek () = BiconditionalOp do
        consume BiconditionalOp
        let right = parseImplies () // Parse the right-hand side
        left <- Biconditional(left, right) // Combine with the Biconditional operator

    left

/// Takes a list of tokens and returns the root of the AST.
let parse (tokens: Token list) : Expr =
    currentTokens <- tokens // Initialize the mutable token stream
    let expr = parseBiconditional () // Start parsing from the lowest precedence operator

    if peek () <> Eof then
        failwithf "Parser error: Unexpected tokens remaining after parsing: %A" currentTokens

    expr


/// Evaluates a logical expression given a map of variable assignments.
let rec evaluate (expr: Expr) (assignments: Map<string, bool>) : bool =
    match expr with
    | Var v ->
        // Look up the variable's truth value in the assignments map.
        match assignments.TryFind v with
        | Some value -> value
        | None -> failwithf "Evaluation error: Variable '%s' not found in assignments." v
    | Not e -> not (evaluate e assignments) // NOT operation
    | And(e1, e2) -> (evaluate e1 assignments) && (evaluate e2 assignments) // AND operation
    | Or(e1, e2) -> (evaluate e1 assignments) || (evaluate e2 assignments) // OR operation
    | Implies(e1, e2) -> not (evaluate e1 assignments) || (evaluate e2 assignments) // Implication: P -> Q is equivalent to !P || Q
    | Biconditional(e1, e2) -> (evaluate e1 assignments) = (evaluate e2 assignments) // Biconditional: P <-> Q is equivalent to (P && Q) || (!P && !Q)
    | True -> true // Literal True
    | False -> false // Literal False


/// Recursively extracts all unique variable names from an expression.
let rec getVariables (expr: Expr) : Set<string> =
    match expr with
    | Var v -> Set.singleton v // If it's a variable, add it to the set.
    | Not e -> getVariables e // Recurse for NOT.
    | And(e1, e2)
    | Or(e1, e2)
    | Implies(e1, e2)
    | Biconditional(e1, e2) ->
        // For binary operators, union the variables from both sub-expressions.
        Set.union (getVariables e1) (getVariables e2)
    | True
    | False -> Set.empty // True/False literals have no variables.


/// Generates and prints the truth table for a given logical expression.
let generateTruthTable (expr: Expr) (formulaString: string) =
    // Get unique variables and sort them for consistent column order.
    let vars = getVariables expr |> Set.toList |> List.sort
    let numVars = List.length vars

    // Calculate column widths for pretty printing.
    let varHeaders = vars |> List.map (fun v -> v)
    let varHeaderString = String.concat " | " varHeaders
    let formulaHeaderString = formulaString

    // Print header row.
    printfn "%s | %s" varHeaderString formulaHeaderString

    // Print separator line.
    let varSeparator = String.replicate varHeaderString.Length "-"
    let formulaSeparator = String.replicate formulaHeaderString.Length "-"
    printfn "%s-+-%s" varSeparator formulaSeparator

    // Recursive function to generate all possible truth assignments for variables.
    let rec generateAssignments (index: int) (current: Map<string, bool>) : (Map<string, bool>) list =
        if index = numVars then
            [ current ] // Base case: all variables assigned, return the current assignment.
        else
            let var = vars.[index] // Get the current variable to assign.
            // Recursively generate assignments with the current variable set to true.
            let assignmentsWithTrue = generateAssignments (index + 1) (current.Add(var, true))
            // Recursively generate assignments with the current variable set to false.
            let assignmentsWithFalse = generateAssignments (index + 1) (current.Add(var, false))
            // Combine the two sets of assignments.
            List.append assignmentsWithTrue assignmentsWithFalse

    // Generate all combinations of truth values starting with an empty map.
    let allAssignments = generateAssignments 0 Map.empty

    // Print each row of the truth table.
    for assignments in allAssignments do
        // Get the truth values for each variable in the current assignment.
        let varValues = vars |> List.map (fun v -> if assignments.[v] then "T" else "F")
        // Evaluate the main formula with the current assignment.
        let result = evaluate expr assignments
        let resultStr = if result then "T" else "F" // Format result as 'T' or 'F'

        // Print the row, aligning values with headers.
        let formattedVarValues = String.concat " | " varValues
        printfn "%s | %s" formattedVarValues resultStr


[<EntryPoint>]
let main _ =
    printfn "Enter a logical formula (e.g., P & Q -> R, !A | B):"
    let formulaInput = System.Console.ReadLine()

    try
        // 1. Lex the input string into tokens.
        let tokens = lex formulaInput
        // printfn "Tokens: %A" tokens // Uncomment to see tokens for debugging

        // 2. Parse the tokens into the AST.
        let parsedExpr = parse tokens
        // printfn "Parsed Expression: %A" parsedExpr // Uncomment to see AST for debugging

        // 3. Generate and print the truth table.
        generateTruthTable parsedExpr formulaInput

    with ex ->
        eprintfn "Error: %s" ex.Message

    0