diff --git a/MathDisplay/DataTypes/AliasMap.fs b/MathDisplay.Tests.Benchmarks/AliasMap.fs similarity index 92% rename from MathDisplay/DataTypes/AliasMap.fs rename to MathDisplay.Tests.Benchmarks/AliasMap.fs index a7dc46c..b29d8a7 100644 --- a/MathDisplay/DataTypes/AliasMap.fs +++ b/MathDisplay.Tests.Benchmarks/AliasMap.fs @@ -19,7 +19,7 @@ type AliasMap<'Key, 'Value when 'Key : comparison and 'Value : comparison> = interface System.Collections.IEnumerable with member this.GetEnumerator() = (AliasMap.toSeq this :> System.Collections.IEnumerable).GetEnumerator() interface System.Collections.Generic.IEnumerable> with - member this.GetEnumerator() = match this with | AliasMap (k2v, _) -> (k2v :> System.Collections.Generic.IEnumerable<_>).GetEnumerator() + member this.GetEnumerator() = match this with AliasMap (k2v, _) -> (k2v :> System.Collections.Generic.IEnumerable<_>).GetEnumerator() interface System.Collections.Generic.IReadOnlyCollection> with member this.Count = AliasMap.count this interface System.Collections.Generic.IReadOnlyDictionary<'Key, 'Value> with @@ -92,13 +92,4 @@ module AliasMap = /// Takes a list of (Primary key you get by indexing with the value, Other keys, Value) let ofListWithValueMap valueMap list = ofListWtihKeyKeysValueMap id id valueMap list /// Takes a list of (Primary key you get by indexing with the value, Other keys, Value) - let ofListWithKeyValueMap keyMap valueMap list = ofListWtihKeyKeysValueMap keyMap (List.map keyMap) valueMap list - -type INT = INT of int -type L() = - class - member __.Item with get(f : INT) = f - member __.Item with get(f : int) = f - static member IUEWOKJU(this : L) = this.[1] - end - \ No newline at end of file + let ofListWithKeyValueMap keyMap valueMap list = ofListWtihKeyKeysValueMap keyMap (List.map keyMap) valueMap list \ No newline at end of file diff --git a/MathDisplay.Tests.Benchmarks/MathDisplay.Tests.Benchmarks.fsproj b/MathDisplay.Tests.Benchmarks/MathDisplay.Tests.Benchmarks.fsproj index 8e4b615..aabd622 100644 --- a/MathDisplay.Tests.Benchmarks/MathDisplay.Tests.Benchmarks.fsproj +++ b/MathDisplay.Tests.Benchmarks/MathDisplay.Tests.Benchmarks.fsproj @@ -8,6 +8,7 @@ + diff --git a/MathDisplay.Tests/UnitTests.fs b/MathDisplay.Tests/UnitTests.fs index a472eed..750178e 100644 --- a/MathDisplay.Tests/UnitTests.fs +++ b/MathDisplay.Tests/UnitTests.fs @@ -15,9 +15,8 @@ type TestClass () = [] member __.``Gather output`` () = - let fff = MathDisplay.DataTypes.List.partitionWhile ((=) 'a') ['a'; 'a'; 'a'; 'a'; 'b'; 'c'] let x = - @"123" - |> LaTeX.toAtom LaTeX.Options.Default + @"\left.\frac\sqrt{23}4\right)" + |> LaTeX.ToAtom LaTeX.Options.Default (match x with Ok r -> r | Error e -> InfoException e |> raise).ToString() |> Assert.Pass \ No newline at end of file diff --git a/MathDisplay/DataTypes/AliasDictionary.fs b/MathDisplay/DataTypes/AliasDictionary.fs new file mode 100644 index 0000000..4f2b901 --- /dev/null +++ b/MathDisplay/DataTypes/AliasDictionary.fs @@ -0,0 +1,53 @@ +namespace MathDisplay.DataTypes + +open System.Collections.Generic + +/// Holds a d:Dictionary<'X,'Y>, and an e:Dictionary<'Y,'X> which are quasi-inverses in the sense that +/// for any key x in d, x.[d] is key in 'Y, and d.[e.[y]] = y. +/// d-keys are "Aliases" of e-keys, and a e-key may have many aliases mapping to it (so d may not be injective), +/// but there is a primary alias corresponding to each e-key (so e is injective). +type AliasDictionary<'X, 'Y when 'X : equality and 'Y : equality> private(d:Dictionary<'X,'Y>, e:Dictionary<'Y,'X>) = + new() = AliasDictionary(Dictionary<'X, 'Y>(), Dictionary<'Y, 'X>()) + member __.Aliases = d.Keys + /// Add primary aliases + member __.AddPrimary(primaryAlias:'X, value:'Y) = + d.Add(primaryAlias, value) + e.Add(value, primaryAlias) + /// Add secondary aliases + member __.AddMore(secondaryAliases:seq<'X>, value:'Y) = + for x in secondaryAliases do d.Add(x, value) + member this.Add(primaryAlias:'X, secondaryAliases : seq<'X>, value:'Y) = + d.Add(primaryAlias, value) + e.Add(value, primaryAlias) + this.AddMore(secondaryAliases, value) + /// The first item of aliases is primary. + member this.Add(aliases : 'X list, value:'Y) = + match aliases with + | primaryAlias::secondaryAliases -> + d.Add(primaryAlias, value) + e.Add(value, primaryAlias) + this.AddMore(secondaryAliases, value) + | [] -> () + /// The first of any 'X list is primary. + member this.AddList(pairs:('X list * 'Y) list) = + pairs |> List.iter (fun (keys, value) -> + match keys with + | primaryKey::secondaryKeys -> + this.Add(primaryKey, secondaryKeys, value) + | [] -> ()) + /// The first of any 'X list is primary. + new(pairs:('X list * 'Y) list) as this = + AliasDictionary<'X, 'Y>() then + this.AddList pairs + /// The first of any 'X list is primary. + new(valueComparer:IEqualityComparer<'Y>, pairs:('X list * 'Y) list) as this = + AliasDictionary<'X, 'Y>(Dictionary<'X, 'Y>(), Dictionary<'Y, 'X>(valueComparer)) then + this.AddList pairs + member __.TryGetKey value = + match e.TryGetValue value with + | true, v -> ValueSome v + | false, _ -> ValueNone + member __.TryGetValue key = + match d.TryGetValue key with + | true, v -> ValueSome v + | false, _ -> ValueNone \ No newline at end of file diff --git a/MathDisplay/DataTypes/ListExtensions.fs b/MathDisplay/DataTypes/ListExtensions.fs index 306a0c2..1081177 100644 --- a/MathDisplay/DataTypes/ListExtensions.fs +++ b/MathDisplay/DataTypes/ListExtensions.fs @@ -4,8 +4,18 @@ module MathDisplay.DataTypes.List /// Partition elements of a list using the specified predicate. /// The result is a tuple containing elements (from the beginning /// of the list that satisfy the predicate) and the rest of the list. - let inline partitionWhile f = + let partitionWhile (f: 'T -> bool) = let rec loop acc = function | x::xs when f x -> loop (x::acc) xs | xs -> List.rev acc, xs - loop [] \ No newline at end of file + loop [] + + // TODO: What is this? Simplify type signature and document, or remove + let mapFoldResult f (state:'State) (list: 'T list) : Result<'Result list * 'State, 'Error> = + let rec loop acc state = function + | [] -> (List.rev acc, state) |> Ok + | x::xs -> + match f state x with + | Ok (value, state) -> loop (value::acc) state xs + | Error e -> Error e + loop [] state list \ No newline at end of file diff --git a/MathDisplay/MathAtom/LaTeX.fs b/MathDisplay/MathAtom/LaTeX.fs index ccc4b9e..7ddc0a7 100644 --- a/MathDisplay/MathAtom/LaTeX.fs +++ b/MathDisplay/MathAtom/LaTeX.fs @@ -1,25 +1,31 @@ module MathDisplay.MathAtom.LaTeX +open System.Collections.Generic open MathDisplay.DataTypes -[] type internal Read = Until of char | UntilRightDelimiter | OneArgument | All -type TableEnvironment = { Name:string voption; Ended:bool; NumRows:int } type Options = { - Delimiters: AliasMap + Delimiters: AliasDictionary + Commands: AliasDictionary } with static member Default = { - Delimiters = LaTeXDefaultMaps.delimiters + Delimiters = LaTeXDefaultMaps.Delimiters + Commands = LaTeXDefaultMaps.Commands } + + +[] type internal Read = Until of char | UntilRightDelimiter | OneArgument | All +type TableEnvironment = { Name:string voption; Ended:bool; NumRows:int } exception ImplementationHasUnreadCharactersException of InputLaTeX:string * UnreadChars:char list * UnfinishedAtomList:MathAtom list with override this.Message = "The implementation has not read some characters yet, despite succeeding. The input LaTeX was: \n\n" + this.InputLaTeX + "\n\nThe unread characters were: \n\n" + this.UnreadChars.ToString() + "\n\nThe Unfinished atom list was: \n\n" + this.UnfinishedAtomList.ToString() -let toAtom (settings: Options) latex = +let ToAtom (settings: Options) latex = let errorArgMissing = Error "Unexpected end of input, missing argument" let errorDelimMissing cmd = Error (cmd + " was not found in delimiter map") - let collapse xs = match xs with [x] -> x | x -> Row x - let skipSpaces cs = List.skipWhile System.Char.IsWhiteSpace cs + /// Simplifies a Row by replacing a Row with a single item x with x. + let collapseRow(xs:MathAtom list) = match xs with [x] -> x | x -> Row x + let skipSpaces = List.skipWhile System.Char.IsWhiteSpace let isAlphabet c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') let (|PartitionAlphabets|) cs = List.partitionWhile isAlphabet cs let (|CommandName|) cs = match cs with @@ -32,28 +38,20 @@ let toAtom (settings: Options) latex = | [] -> errorArgMissing | '\\'::CommandName(cmd, cs) -> let cmd = match cmd with "|" -> "||" | _ -> cmd - match AliasMap.tryFindValue cmd settings.Delimiters with - | Some v -> Ok (v, cs) - | None -> errorDelimMissing cmd + match settings.Delimiters.TryGetValue cmd with + | ValueSome v -> Ok (v, cs) + | ValueNone -> errorDelimMissing cmd | c::cs -> let c = string c - match AliasMap.tryFindValue c settings.Delimiters with - | Some v -> Ok (v, cs) - | None -> errorDelimMissing c + match settings.Delimiters.TryGetValue c with + | ValueSome v -> Ok (v, cs) + | ValueNone -> errorDelimMissing c ///Reads an environment let readEnvironment cs = match cs with | '{'::PartitionAlphabets (ab, '}'::cs) -> Ok (System.String.Concat ab, cs) | c::cs -> Ok (string c, cs) //Seems allowed by LaTeX? | _ -> "Invalid environment, contains non-A-to-Z characters: " + System.String.Concat cs |> Error - ///Reads an argument that is a block and applies it to the functions provided - let readBlock until atomMaker useAtom cs = - read tableEnv until cs [] |> Result.bind (fun (_, cs, arg) -> atomMaker arg |> useAtom cs) - ///Reads an optional argument and returns it, cs should start with '[' to be recognized - let readOption cs = - match cs with - | '['::cs -> readBlock (Until ']') collapse (fun cs atom -> (cs, atom) |> ValueSome |> Ok) cs - | _ -> Ok ValueNone let readTable name cs = Error "ghvgjhkjnlbvgcfy" //let rec innerReadTable rows currentRow cs = //read (ValueSome { Name = name; Ended = false; NumRows = 0 }) until cs list @@ -62,21 +60,93 @@ let toAtom (settings: Options) latex = // match cs with // | '&'::cs -> innerReadTable //) - ///Processes (N+1) arguments, then continues reading - let inline argPlus1 argN cs atomMaker = readBlock OneArgument (collapse >> atomMaker) argN cs - ///Processes 0 arguments, then continues reading - let arg0 cs atom = + + let processAtom atom cs = + let rec readArgsUntilId id tableEnv (argDict:LaTeXArgumentDictionary) cs = + match argDict.Required id with + | ValueSome arg -> Ok (tableEnv, arg, cs) + | ValueNone -> + match cs with + | '['::cs -> + read tableEnv (Until ']') cs [] + |> Result.bind (fun (tableEnv, cs, atoms) -> + collapseRow atoms |> argDict.AddOptional + readArgsUntilId id tableEnv argDict cs) + | [] -> Error "Unexpected end of text, argument missing" + | _ -> + read tableEnv OneArgument cs [] + |> Result.bind (fun (tableEnv, cs, atoms) -> + collapseRow atoms |> argDict.AddRequired + readArgsUntilId id tableEnv argDict cs) + let rec readOptionalArgsUntilId id tableEnv (argDict:LaTeXArgumentDictionary) cs = + match argDict.Optional id with + | ValueSome arg -> Ok (tableEnv, ValueSome arg, cs) + | ValueNone -> + match cs with + | '['::cs -> + read tableEnv (Until ']') cs [] + |> Result.bind (fun (tableEnv, cs, atoms) -> + collapseRow atoms |> argDict.AddOptional + readOptionalArgsUntilId id tableEnv argDict cs) + | _ -> Ok (tableEnv, ValueNone, cs) + + /// + ///Looks for and and replaces them with arguments from LaTeX input + /// + let rec replaceArguments atom state = + //Not working... + //let replaceNp1 replaceN atomMaker (_, argDict, _ as state) atom = Result.bind (fun (tableEnv, atom', cs) -> replaceN (atomMaker atom') (tableEnv, argDict, cs)) (replaceArguments atom state) + let replace1 atomMaker state atom = Result.map (fun (tableEnv, atom', cs) -> (tableEnv, atomMaker atom', cs)) (replaceArguments atom state) + let replace2 atomMaker (_, argDict, _ as state) atom1 atom2 = + Result.bind (fun (tableEnv, atom', cs) -> replace1 (atomMaker atom') (tableEnv, argDict, cs) atom2) (replaceArguments atom1 state) + //let replace3 atomMaker (_, argDict, _ as state) atom1 atom2 atom3 = + // Result.bind (fun (tableEnv, atom', cs) -> replace2 (atomMaker atom') (tableEnv, argDict, cs) atom3 atom2) (replaceArguments atom1 state) + let replaceList argDict = List.mapFoldResult (fun struct(tableEnv, cs) arg -> + replaceArguments arg (tableEnv, argDict, cs) |> Result.map (fun (tableEnv, result, cs) -> result, struct(tableEnv, cs))) + match atom with + | Argument id -> + let tableEnv, argDict, cs = state + readArgsUntilId id tableEnv argDict cs + | Argument_Optional (id, defaultValue) -> + let tableEnv, argDict, cs = state + match readOptionalArgsUntilId id tableEnv argDict cs with + | Ok (tableEnv, ValueSome atom, cs) -> Ok (tableEnv, atom, cs) + | Ok (tableEnv, ValueNone, cs) -> Ok (tableEnv, defaultValue, cs) + | Error e -> Error e + | Row list -> + let tableEnv, argDict, cs = state + replaceList argDict struct(tableEnv, cs) list + |> Result.map (fun (list, struct(tableEnv, cs)) -> tableEnv, Row list, cs) + | Number _ | Variable _ | UnaryOperator _ | Ordinary _ + | BinaryOperator _ | BinaryRelationalOperator _ | OpenBracket _ | CloseBracket _ + | LargeOperator _ | Punctuation _ | PlaceholderInput | Primes _ | Space _ as atom -> Ok (tableEnv, atom, cs) + | Fraction (num, den, nAlign, dAlign, thickness) -> replace2 (fun num den -> Fraction (num, den, nAlign, dAlign, thickness)) state num den + | Radical (degree, radicand) -> replace2 (fun degree radicand -> Radical (degree, radicand)) state degree radicand + | Superscripted atom -> replace1 Superscripted state atom + | Subscripted atom -> replace1 Subscripted state atom + | Offsetted (atom, x, y) -> replace1 (fun atom -> Offsetted(atom, x, y)) state atom + | Delimited (left, atom, right) -> replace1 (fun atom -> Delimited(left, atom, right)) state atom + | Underlined atom -> replace1 Underlined state atom + | Overlined atom -> replace1 Overlined state atom + | Accented (atom, accent) -> replace1 (fun atom -> Accented(atom, accent)) state atom + | Styled (atom, style) -> replace1 (fun atom -> Styled(atom, style)) state atom + | Colored (atom, color) -> replace1 (fun atom -> Colored(atom, color)) state atom + | Table (atomss, interColumnSpacing, interRowAdditionalSpacing, columnAlignments) -> + let tableEnv, argDict, cs = state + List.mapFoldResult (replaceList argDict) struct(tableEnv, cs) atomss + |> Result.map (fun (atomss, struct(tableEnv, cs)) -> tableEnv, Table(atomss, interColumnSpacing, interRowAdditionalSpacing, columnAlignments), cs) + replaceArguments atom (tableEnv, LaTeXArgumentDictionary(), cs) + + let continueReading (tableEnv, atom, cs) = let list = atom::list match until with | OneArgument -> (tableEnv, cs, list) |> Ok | _ -> read tableEnv until cs list - ///Processes 1 argument, then continues reading - let arg1 = argPlus1 arg0 - ///Processes 2 arguments, then continues reading - let arg2 = argPlus1 arg1 - //* No calls to read in this function after this point or you risk ImplementationHasUnreadCharactersException * - //* Use the arg functions! + let processAtomCommand cmd cs = + match settings.Commands.TryGetValue cmd with + | ValueSome atom -> processAtom atom cs + | ValueNone -> @"Unrecognized command: " + cmd |> Error match skipSpaces cs with | [] -> @@ -88,71 +158,35 @@ let toAtom (settings: Options) latex = | Until c -> "Expected character not found: " + c.ToString() |> Error | c::cs when (match until with Until u -> c = u | _ -> false) -> (tableEnv, cs, List.rev list) |> Ok | '\\'::CommandName (cmd, cs) -> - let infixFracCmd hasRule cs delims = - match readBlock until collapse (fun cs atom -> Ok struct(cs, atom)) cs with - | Ok struct(cs, denom) -> - let numer = List.rev list |> collapse - let frac = Fraction (numer, denom, Center, Center, if hasRule then ValueNone else ValueSome 0.) - Ok (tableEnv, cs, - [match delims with - | ValueSome struct(left, right) -> yield Delimited (left, frac, right) - | ValueNone -> yield frac]) - | Error e -> Error e match cmd with - | "1" -> TestResult___ "It's 1!" |> arg0 cs - //Commands that return - | "right" -> match until with - | UntilRightDelimiter -> (tableEnv, cs, List.rev list) |> Ok - | _ -> Error @"Missing \left" - | "over" -> ValueNone |> infixFracCmd true cs - | "atop" -> ValueNone |> infixFracCmd false cs - | "choose" -> ValueSome struct(Delimiter "(", Delimiter ")") |> infixFracCmd false cs - | "brack" -> ValueSome struct(Delimiter "[", Delimiter "]") |> infixFracCmd false cs - | "brace" -> ValueSome struct(Delimiter "{", Delimiter "}") |> infixFracCmd false cs - | "atopwithdelims" -> - readDelimiter cs |> Result.bind (fun (left, cs) -> - readDelimiter cs |> Result.bind (fun (right, cs) -> - ValueSome(struct(left, right)) |> infixFracCmd false cs)) - | @"\" | "cr" -> - match tableEnv with - | ValueSome env -> (ValueSome { env with NumRows = env.NumRows + 1 }, cs, List.rev list) |> Ok - | ValueNone -> readTable ValueNone cs - - | "frac" -> (fun n d -> Fraction (n, d, Center, Center, ValueNone)) |> arg2 cs - | "binom" -> (fun n d -> Fraction (n, d, Center, Center, ValueSome 0.)) |> arg2 cs - | "sqrt" -> match readOption cs with - | Ok (ValueSome (cs, degree)) -> arg1 cs (fun radicand -> Radical (ValueSome degree, radicand)) - | Ok ValueNone -> arg1 cs (fun radicand -> Radical (ValueNone, radicand)) - | Error e -> Error e - | "left" -> match readDelimiter cs with - | Ok (left, cs) -> - - readBlock UntilRightDelimiter collapse (fun cs inner -> - match readDelimiter cs with - | Ok (right, cs) -> Delimited (left, inner, right) |> arg0 cs - | Error e -> Error e - ) cs - | Error e -> Error e - | "overline" -> arg1 cs Overlined - | "underline" -> arg1 cs Underlined - | "begin" -> match readEnvironment cs with - | Ok (env, cs) -> failwith "not implemented" - | Error e -> Error e - | _ -> @"Unrecognized command: \" + cmd |> Error - | '^'::cs -> arg1 cs Superscript - | '_'::cs -> arg1 cs Subscript - | '{'::cs -> readBlock (Until '}') Row arg0 cs + | "left" -> + readDelimiter cs + |> Result.bind (fun (left, cs) -> + read tableEnv UntilRightDelimiter cs [] + |> Result.bind (fun (tableEnv, cs, list) -> + readDelimiter cs + |> Result.bind (fun (right, cs) -> + continueReading (tableEnv, Delimited (left, collapseRow list, right), cs)))) + | "right" -> + match until with + | UntilRightDelimiter -> (tableEnv, cs, List.rev list) |> Ok + | _ -> Error @"Missing \left" + | _ -> processAtomCommand cmd cs |> Result.bind continueReading + | '^'::cs -> processAtom (Superscripted (Argument 1)) cs |> Result.bind continueReading + | '_'::cs -> processAtom (Subscripted (Argument 1)) cs |> Result.bind continueReading + | '{'::cs -> read tableEnv (Until '}') cs [] |> Result.bind (fun (tableEnv, cs, list) -> continueReading (tableEnv, Row list, cs)) | '}'::_ -> Error "Missing opening brace" //| '&'::cs -> | '\''::cs -> let primes, cs = List.partitionWhile ((=) '\'') cs //primes do not include the one already matched - List.length primes + 1 |> Primes |> arg0 cs - | c::cs -> string c |> Ordinary |> arg0 cs + continueReading (tableEnv, List.length primes + 1 |> Primes, cs) + | c::cs -> continueReading (tableEnv, string c |> Ordinary, cs) match read ValueNone All (List.ofSeq latex) [] with | Ok (ValueNone, [], atoms) | Ok (ValueSome { Name = ValueNone }, [], atoms) -> - collapse atoms |> Ok + collapseRow atoms |> Ok | Ok (ValueSome { Name = ValueSome envName }, [], _) -> (@"Missing \end{" + envName + "}") |> Error | Error e -> Error e - | Ok (_, unreadChars, atoms) -> ImplementationHasUnreadCharactersException (latex, unreadChars, atoms) |> raise \ No newline at end of file + | Ok (_, unreadChars, atoms) -> ImplementationHasUnreadCharactersException (latex, unreadChars, atoms) |> raise + \ No newline at end of file diff --git a/MathDisplay/MathAtom/LaTeXArgumentDictionary.fs b/MathDisplay/MathAtom/LaTeXArgumentDictionary.fs new file mode 100644 index 0000000..baa9593 --- /dev/null +++ b/MathDisplay/MathAtom/LaTeXArgumentDictionary.fs @@ -0,0 +1,13 @@ +namespace MathDisplay.MathAtom + +open System.Collections.Generic + +type LaTeXArgumentDictionary() = + let required = new List() + let optional = new List() + member __.AddOptional atom = optional.Add atom + member __.AddRequired atom = required.Add atom + ///1-based index + member __.Optional with get id = if id <= optional.Count then ValueSome optional.[id - 1] else ValueNone + ///1-based index + member __.Required with get id = if id <= required.Count then ValueSome required.[id - 1] else ValueNone \ No newline at end of file diff --git a/MathDisplay/MathAtom/LaTeXDefaultMaps.fs b/MathDisplay/MathAtom/LaTeXDefaultMaps.fs index f1ee270..ab3690a 100644 --- a/MathDisplay/MathAtom/LaTeXDefaultMaps.fs +++ b/MathDisplay/MathAtom/LaTeXDefaultMaps.fs @@ -3,48 +3,45 @@ open MathDisplay.DataTypes //Use (Alt+Left mouse) drag to create multiple cursors so that spaces can be inputted simultaneously -[] -let delimiters = - [".", [], "" // . means no delimiter - "(", [], "(" - ")", [], ")" - "[", [], "[" - "]", [], "]" - "{", ["lbrace"], "{" - "}", ["rbrace"], "}" - "<", ["langle"], "\u2329" - ">", ["rangle"], "\u232A" - "/", [], "/" - "\\", ["backslash"], "\\" - "|", ["vert"], "|" - "||", ["Vert"], "\u2016" - "uparrow", [], "\u2191" - "downarrow", [], "\u2193" - "updownarrow", [], "\u2195" - "Uparrow", [], "\u21D1" - "Downarrow", [], "\u21D3" - "Updownarrow", [], "\u21D5" - "lgroup", [], "\u27EE" - "rgroup", [], "\u27EF" - "lceil", [], "\u2308" - "rceil", [], "\u2309" - "lfloor", [], "\u230A" - "rfloor", [], "\u230B"] +let Delimiters = + [ ["."], Delimiter.Empty // . means no delimiter + ["("], Delimiter.LBracket + [")"], Delimiter.RBracket + ["["], Delimiter.LSquareBracket + ["]"], Delimiter.RSquareBracket + ["{";"lbrace"], Delimiter.LCurlyBracket + ["}";"rbrace"], Delimiter.RCurlyBracket + ["<";"langle"], Delimiter.LAngle + [">";"rangle"], Delimiter.RAngle + ["/"], Delimiter.ForwardSlash + ["\\";"backslash"], Delimiter.BackSlash + ["|";"vert"], Delimiter.Vert + ["||";"Vert"], Delimiter.DoubleVert + ["uparrow"], Delimiter.UpArrow + ["downarrow"], Delimiter.DownArrow + ["updownarrow"], Delimiter.UpDownArrow + ["Uparrow"], Delimiter.UpArrow + ["Downarrow"], Delimiter.DoubleDownArrow + ["Updownarrow"], Delimiter.UpDownArrow + ["lgroup"], Delimiter.LGroup + ["rgroup"], Delimiter.RGroup + ["lceil"], Delimiter.LCeil + ["rceil"], Delimiter.RCeil + ["lfloor"], Delimiter.LFloor + ["rfloor"], Delimiter.RFloor] - |> AliasMap.ofListWithValueMap Delimiter + |> AliasDictionary -[] -let matrixEnvironments = - ["matrix", [], (".", ".") - "pmatrix", [], ("(", ")") - "bmatrix", [], ("[", "]") - "Bmatrix", [], ("{", "}") - "vmatrix", [], ("|", "|") - "Vmatrix", [], ("||", "||")] - |> AliasMap.ofListWithValueMap (fun (l, r) -> (Option.get delimiters.[l], Option.get delimiters.[r])) - -[] -let charToAtom c = +let MatrixEnvironments = + [ ["matrix"], (Delimiter.Empty, Delimiter.Empty) + ["pmatrix"], (Delimiter.LBracket, Delimiter.RBracket) + ["bmatrix"], (Delimiter.LBracket, Delimiter.RBracket) + ["Bmatrix"], (Delimiter.LCurlyBracket, Delimiter.RCurlyBracket) + ["vmatrix"], (Delimiter.Vert, Delimiter.Vert) + ["Vmatrix"], (Delimiter.DoubleVert, Delimiter.DoubleVert)] + |> AliasDictionary + +let ``(charToAtom) <--- Unused for now....`` c = let (|Space|_|) s = if System.Char.IsControl s || System.Char.IsWhiteSpace s then Some Space else None match c with | _ when '0' <= c && c <= '9' -> string c |> Number |> ValueSome @@ -58,4 +55,10 @@ let charToAtom c = | '+' | '*' -> BinaryOperator c |> ValueSome | '-' | '\u2212' -> BinaryOperator '\u2212' |> ValueSome // use the math minus sign | '.' -> string c |> Number |> ValueSome - | '"' | '/' | '@' | '`' | '|' | _ -> string c |> Ordinary |> ValueSome \ No newline at end of file + | '"' | '/' | '@' | '`' | '|' | _ -> string c |> Ordinary |> ValueSome + +let Commands = + [ ["frac"], Fraction (Argument 1, Argument 2, Center, Center, ValueNone) + ["sqrt"], Radical (Argument_Optional (1, Row []), Argument 1) + ["1"], Ordinary "1"] + |> AliasDictionary \ No newline at end of file diff --git a/MathDisplay/MathAtom/LaTeX_Old.fs b/MathDisplay/MathAtom/LaTeX_Old.fs new file mode 100644 index 0000000..ccc4b9e --- /dev/null +++ b/MathDisplay/MathAtom/LaTeX_Old.fs @@ -0,0 +1,158 @@ +module MathDisplay.MathAtom.LaTeX + +open MathDisplay.DataTypes + +[] type internal Read = Until of char | UntilRightDelimiter | OneArgument | All +type TableEnvironment = { Name:string voption; Ended:bool; NumRows:int } +type Options = { + Delimiters: AliasMap +} with + static member Default = { + Delimiters = LaTeXDefaultMaps.delimiters + } +exception ImplementationHasUnreadCharactersException of InputLaTeX:string * UnreadChars:char list * UnfinishedAtomList:MathAtom list + with override this.Message = "The implementation has not read some characters yet, despite succeeding. The input LaTeX was: \n\n" + this.InputLaTeX + + "\n\nThe unread characters were: \n\n" + this.UnreadChars.ToString() + + "\n\nThe Unfinished atom list was: \n\n" + this.UnfinishedAtomList.ToString() + +let toAtom (settings: Options) latex = + let errorArgMissing = Error "Unexpected end of input, missing argument" + let errorDelimMissing cmd = Error (cmd + " was not found in delimiter map") + let collapse xs = match xs with [x] -> x | x -> Row x + let skipSpaces cs = List.skipWhile System.Char.IsWhiteSpace cs + let isAlphabet c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') + let (|PartitionAlphabets|) cs = List.partitionWhile isAlphabet cs + let (|CommandName|) cs = match cs with + | c::cs when not <| isAlphabet c -> string c, cs + | PartitionAlphabets (ab, cs) -> System.String.Concat ab, skipSpaces cs + let rec read tableEnv until cs list = + ///Reads a delimiter + let readDelimiter cs = + match cs with + | [] -> errorArgMissing + | '\\'::CommandName(cmd, cs) -> + let cmd = match cmd with "|" -> "||" | _ -> cmd + match AliasMap.tryFindValue cmd settings.Delimiters with + | Some v -> Ok (v, cs) + | None -> errorDelimMissing cmd + | c::cs -> + let c = string c + match AliasMap.tryFindValue c settings.Delimiters with + | Some v -> Ok (v, cs) + | None -> errorDelimMissing c + ///Reads an environment + let readEnvironment cs = + match cs with + | '{'::PartitionAlphabets (ab, '}'::cs) -> Ok (System.String.Concat ab, cs) + | c::cs -> Ok (string c, cs) //Seems allowed by LaTeX? + | _ -> "Invalid environment, contains non-A-to-Z characters: " + System.String.Concat cs |> Error + ///Reads an argument that is a block and applies it to the functions provided + let readBlock until atomMaker useAtom cs = + read tableEnv until cs [] |> Result.bind (fun (_, cs, arg) -> atomMaker arg |> useAtom cs) + ///Reads an optional argument and returns it, cs should start with '[' to be recognized + let readOption cs = + match cs with + | '['::cs -> readBlock (Until ']') collapse (fun cs atom -> (cs, atom) |> ValueSome |> Ok) cs + | _ -> Ok ValueNone + let readTable name cs = Error "ghvgjhkjnlbvgcfy" + //let rec innerReadTable rows currentRow cs = + //read (ValueSome { Name = name; Ended = false; NumRows = 0 }) until cs list + //|> Result.bind (fun (cs, atoms) -> + // let atom = collapse atoms + // match cs with + // | '&'::cs -> innerReadTable + //) + ///Processes (N+1) arguments, then continues reading + let inline argPlus1 argN cs atomMaker = readBlock OneArgument (collapse >> atomMaker) argN cs + ///Processes 0 arguments, then continues reading + let arg0 cs atom = + let list = atom::list + match until with + | OneArgument -> (tableEnv, cs, list) |> Ok + | _ -> read tableEnv until cs list + ///Processes 1 argument, then continues reading + let arg1 = argPlus1 arg0 + ///Processes 2 arguments, then continues reading + let arg2 = argPlus1 arg1 + + //* No calls to read in this function after this point or you risk ImplementationHasUnreadCharactersException * + //* Use the arg functions! + + match skipSpaces cs with + | [] -> + match until with + | All -> (tableEnv, [], List.rev list) |> Ok + | OneArgument -> errorArgMissing + | UntilRightDelimiter -> @"Missing \right" |> Error + | Until '}' -> "Missing closing brace" |> Error + | Until c -> "Expected character not found: " + c.ToString() |> Error + | c::cs when (match until with Until u -> c = u | _ -> false) -> (tableEnv, cs, List.rev list) |> Ok + | '\\'::CommandName (cmd, cs) -> + let infixFracCmd hasRule cs delims = + match readBlock until collapse (fun cs atom -> Ok struct(cs, atom)) cs with + | Ok struct(cs, denom) -> + let numer = List.rev list |> collapse + let frac = Fraction (numer, denom, Center, Center, if hasRule then ValueNone else ValueSome 0.) + Ok (tableEnv, cs, + [match delims with + | ValueSome struct(left, right) -> yield Delimited (left, frac, right) + | ValueNone -> yield frac]) + | Error e -> Error e + match cmd with + | "1" -> TestResult___ "It's 1!" |> arg0 cs + //Commands that return + | "right" -> match until with + | UntilRightDelimiter -> (tableEnv, cs, List.rev list) |> Ok + | _ -> Error @"Missing \left" + | "over" -> ValueNone |> infixFracCmd true cs + | "atop" -> ValueNone |> infixFracCmd false cs + | "choose" -> ValueSome struct(Delimiter "(", Delimiter ")") |> infixFracCmd false cs + | "brack" -> ValueSome struct(Delimiter "[", Delimiter "]") |> infixFracCmd false cs + | "brace" -> ValueSome struct(Delimiter "{", Delimiter "}") |> infixFracCmd false cs + | "atopwithdelims" -> + readDelimiter cs |> Result.bind (fun (left, cs) -> + readDelimiter cs |> Result.bind (fun (right, cs) -> + ValueSome(struct(left, right)) |> infixFracCmd false cs)) + | @"\" | "cr" -> + match tableEnv with + | ValueSome env -> (ValueSome { env with NumRows = env.NumRows + 1 }, cs, List.rev list) |> Ok + | ValueNone -> readTable ValueNone cs + + | "frac" -> (fun n d -> Fraction (n, d, Center, Center, ValueNone)) |> arg2 cs + | "binom" -> (fun n d -> Fraction (n, d, Center, Center, ValueSome 0.)) |> arg2 cs + | "sqrt" -> match readOption cs with + | Ok (ValueSome (cs, degree)) -> arg1 cs (fun radicand -> Radical (ValueSome degree, radicand)) + | Ok ValueNone -> arg1 cs (fun radicand -> Radical (ValueNone, radicand)) + | Error e -> Error e + | "left" -> match readDelimiter cs with + | Ok (left, cs) -> + + readBlock UntilRightDelimiter collapse (fun cs inner -> + match readDelimiter cs with + | Ok (right, cs) -> Delimited (left, inner, right) |> arg0 cs + | Error e -> Error e + ) cs + | Error e -> Error e + | "overline" -> arg1 cs Overlined + | "underline" -> arg1 cs Underlined + | "begin" -> match readEnvironment cs with + | Ok (env, cs) -> failwith "not implemented" + | Error e -> Error e + | _ -> @"Unrecognized command: \" + cmd |> Error + | '^'::cs -> arg1 cs Superscript + | '_'::cs -> arg1 cs Subscript + | '{'::cs -> readBlock (Until '}') Row arg0 cs + | '}'::_ -> Error "Missing opening brace" + //| '&'::cs -> + | '\''::cs -> + let primes, cs = List.partitionWhile ((=) '\'') cs //primes do not include the one already matched + List.length primes + 1 |> Primes |> arg0 cs + | c::cs -> string c |> Ordinary |> arg0 cs + match read ValueNone All (List.ofSeq latex) [] with + | Ok (ValueNone, [], atoms) + | Ok (ValueSome { Name = ValueNone }, [], atoms) -> + collapse atoms |> Ok + | Ok (ValueSome { Name = ValueSome envName }, [], _) -> + (@"Missing \end{" + envName + "}") |> Error + | Error e -> Error e + | Ok (_, unreadChars, atoms) -> ImplementationHasUnreadCharactersException (latex, unreadChars, atoms) |> raise \ No newline at end of file diff --git a/MathDisplay/MathAtom/MathAtom.fs b/MathDisplay/MathAtom/MathAtom.fs index 24c20c3..7cf46af 100644 --- a/MathDisplay/MathAtom/MathAtom.fs +++ b/MathDisplay/MathAtom/MathAtom.fs @@ -4,12 +4,64 @@ open MathDisplay.DataTypes [] type Accent = Accent of char [] type Operator = Operator of char type Style = class end -[] type Delimiter = Delimiter of string +[] +type Delimiter = + | Empty + | LBracket + | RBracket + | LSquareBracket + | RSquareBracket + | LCurlyBracket + | RCurlyBracket + | LAngle + | RAngle + | ForwardSlash + | BackSlash + | Vert + | DoubleVert + | UpArrow + | DownArrow + | DoubleUpArrow + | DoubleDownArrow + | UpDownArrow + | LGroup + | RGroup + | LCeil + | RCeil + | LFloor + | RFloor + member t.Char = + match t with + | Empty -> "" + | LBracket -> "(" + | RBracket -> ")" + | LSquareBracket -> "[" + | RSquareBracket -> "]" + | LCurlyBracket -> "{" + | RCurlyBracket -> "}" + | LAngle -> "\u2329" + | RAngle -> "\u232A" + | ForwardSlash -> "/" + | BackSlash -> "\\" + | Vert -> "|" + | DoubleVert -> "\u2016" + | UpArrow -> "\u2191" + | DownArrow -> "\u2193" + | DoubleUpArrow -> "\u21D1" + | DoubleDownArrow -> "\u21D3" + | UpDownArrow -> "\u21D5" + | LGroup -> "\u27EE" + | RGroup -> "\u27EF" + | LCeil -> "\u2308" + | RCeil -> "\u2309" + | LFloor -> "\u230A" + | RFloor -> "\u230B" [] type mu type MathAtom = - | TestResult___ of string + | Argument of id:int + | Argument_Optional of id:int * defaultValue:MathAtom | Row of MathAtom list (*| Ordinary = Number | Variable | UnaryOperator*) | Number of string @@ -17,20 +69,21 @@ type MathAtom = | UnaryOperator of char | Ordinary of string /// sin/cos, integral, etc. - | LargeOperator of Operator * lowerLimit:MathAtom voption * upperLimit:MathAtom voption + | LargeOperator of Operator | BinaryOperator of char | BinaryRelationalOperator of char //Bracket characters, need not be balanced. | OpenBracket of char | CloseBracket of char | Fraction of numerator:MathAtom * denominator:MathAtom * nXAlign:Alignment * dXAlign:Alignment * customRuleThickness:float voption - | Radical of degree:MathAtom voption * radicand:MathAtom + //(Row []) to indicate empty degree + | Radical of degree:MathAtom * radicand:MathAtom | Punctuation of char | PlaceholderInput //Scripts of previous atom - | Superscript of MathAtom - | Subscript of MathAtom - | Offsetted of x:float * y:float + | Superscripted of MathAtom + | Subscripted of MathAtom + | Offsetted of MathAtom * x:float * y:float | Delimited of left:Delimiter * atom:MathAtom * right:Delimiter | Underlined of MathAtom | Overlined of MathAtom @@ -39,8 +92,23 @@ type MathAtom = //| Boundary (changed to Delimiter) | Space of float ///Style changes during rendering - | Styled of Style * MathAtom - | Text of string - | Colored of System.Drawing.Color * MathAtom + | Styled of MathAtom * Style + //| Text of string -> | Ordinary of string + | Colored of MathAtom * System.Drawing.Color ///A table. Not part of TeX. - | Table of MathAtom list list * interColumnSpacing:float * interRowAdditionalSpacing:float * columnAlignments: Alignment list \ No newline at end of file + | Table of MathAtom list list * interColumnSpacing:float * interRowAdditionalSpacing:float * columnAlignments: Alignment list + +type MathAtomPatternMatcher() = + interface System.Collections.Generic.IEqualityComparer with + member __.GetHashCode x = + match x with + //Cannot contain Arguments + | Number _ | Variable _ | UnaryOperator _ | Ordinary _ + | LargeOperator _ | BinaryOperator _ | BinaryRelationalOperator _ | OpenBracket _ | CloseBracket _ + | Punctuation _ | PlaceholderInput | Primes _ | Space _ + as x -> let h = hash x in if h = 0 then -1 else h + //Can contain Arguments, put in same bucket for linear search + | Argument _ | Argument_Optional _ | Row _ | Fraction _ | Radical _ | Superscripted _ + | Subscripted _ | Offsetted _ | Delimited _ | Underlined _ | Overlined _ | Accented _ | Styled _ | Colored _ | Table _ + -> 0 + member __.Equals(x, y) = false \ No newline at end of file diff --git a/MathDisplay/MathDisplay.fsproj b/MathDisplay/MathDisplay.fsproj index b196373..61d71ae 100644 --- a/MathDisplay/MathDisplay.fsproj +++ b/MathDisplay/MathDisplay.fsproj @@ -12,9 +12,10 @@ - + +