From 69bc573dd690d8e678acfe86d1f636b61706f4ad Mon Sep 17 00:00:00 2001 From: Happypig375 Date: Fri, 8 Feb 2019 23:52:11 +0800 Subject: [PATCH 01/18] Started a LaTeX code rewrite --- .../AliasMap.fs | 11 +- .../MathDisplay.Tests.Benchmarks.fsproj | 1 + MathDisplay.Tests/UnitTests.fs | 2 +- MathDisplay/DataTypes/AliasDictionary.fs | 109 ++++++++++++ MathDisplay/MathAtom/LaTeX.fs | 72 ++------ MathDisplay/MathAtom/LaTeXCommand.fs | 10 ++ MathDisplay/MathAtom/LaTeXDefaultMaps.fs | 20 ++- MathDisplay/MathAtom/LaTeX_Old.fs | 158 ++++++++++++++++++ MathDisplay/MathAtom/MathAtom.fs | 4 +- MathDisplay/MathDisplay.fsproj | 3 +- 10 files changed, 314 insertions(+), 76 deletions(-) rename {MathDisplay/DataTypes => MathDisplay.Tests.Benchmarks}/AliasMap.fs (95%) create mode 100644 MathDisplay/DataTypes/AliasDictionary.fs create mode 100644 MathDisplay/MathAtom/LaTeXCommand.fs create mode 100644 MathDisplay/MathAtom/LaTeX_Old.fs diff --git a/MathDisplay/DataTypes/AliasMap.fs b/MathDisplay.Tests.Benchmarks/AliasMap.fs similarity index 95% rename from MathDisplay/DataTypes/AliasMap.fs rename to MathDisplay.Tests.Benchmarks/AliasMap.fs index a7dc46c..a51ba06 100644 --- a/MathDisplay/DataTypes/AliasMap.fs +++ b/MathDisplay.Tests.Benchmarks/AliasMap.fs @@ -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..2678db1 100644 --- a/MathDisplay.Tests/UnitTests.fs +++ b/MathDisplay.Tests/UnitTests.fs @@ -18,6 +18,6 @@ type TestClass () = let fff = MathDisplay.DataTypes.List.partitionWhile ((=) 'a') ['a'; 'a'; 'a'; 'a'; 'b'; 'c'] let x = @"123" - |> LaTeX.toAtom LaTeX.Options.Default + |> 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..4a7208c --- /dev/null +++ b/MathDisplay/DataTypes/AliasDictionary.fs @@ -0,0 +1,109 @@ +namespace MathDisplay.DataTypes + +open System.Collections.Generic + +type AliasDictionary<'Key, 'Value when 'Key : equality and 'Value : equality> private(k2v, v2k) = + new() = AliasDictionary(Dictionary<'Key, 'Value>(), Dictionary<'Value, 'Key>()) + new(valueComparer) = AliasDictionary(Dictionary<_, _>(), Dictionary<_, _>(comparer = valueComparer)) + + member __.Add(primaryKey, value) = + k2v.Add(primaryKey, value) + v2k.Add(value, primaryKey) + member this.Add(primaryKey, key1, value) = + this.Add(primaryKey, value) + k2v.Add(key1, value) + member this.Add(primaryKey, key1 : 'Key, key2, value) = + this.Add(primaryKey, key1, value) + k2v.Add(key2, value) + member this.Add(primaryKey, key1, key2, key3, value) = + this.Add(primaryKey, key1, key2, value) + k2v.Add(key3, value) + member this.Add(primaryKey, keys : seq<_>, value) = + k2v.Add(primaryKey, value) + v2k.Add(value, primaryKey) + this.AddMoreKeys keys value + member __.AddMoreKeys keys value = for key in keys do k2v.Add(key, value) + member __.Contains key value = + match k2v.TryGetValue key with + | true, value' -> value = value' + | false, _ -> false + member __.ContainsKey key = k2v.ContainsKey key + member __.ContainsValue value = v2k.ContainsKey value + member __.CopyTo array arrayIndex = (k2v :> ICollection<_>).CopyTo(array, arrayIndex) + member __.Count = k2v.Count + member __.Clear() = k2v.Clear(); v2k.Clear() + member __.Keys = k2v.Keys + member __.Values = k2v.Values + member __.TryGetValue(key, value : byref<_>) = k2v.TryGetValue(key, &value) + member __.TryGetKey(value, key : byref<_>) = v2k.TryGetValue(value, &key) + member __.TryGetValueFSharp key = k2v.TryGetValue key + member __.TryGetKeyFSharp value = v2k.TryGetValue value + member __.Item with get key = k2v.[key] and set key value = k2v.[key] <- value; v2k.[value] <- key + member __.Item with get value = v2k.[value] and set value key = k2v.[key] <- value; v2k.[value] <- key + member __.Remove key value = + match [ for pair in k2v do if value = pair.Value then yield pair ] with + | [] -> false + | [KeyValue (key', _)] -> + if key = key' then + k2v.Remove(key) |> ignore + v2k.Remove(value) |> ignore + true + else false + | pairs -> + if List.forall (fun (KeyValue (key', _)) -> key <> key') pairs then false + else + k2v.Remove(key) |> ignore + if v2k.[value] = key then + v2k.[value] <- (List.find (fun (KeyValue (key', _)) -> key <> key') pairs).Key + true + member this.RemoveKey key = this.Remove key k2v.[key] + member __.RemoveValue value = + if v2k.Remove value then + for KeyValue (key, value') in k2v do + if value = value' then k2v.Remove(key) |> ignore + true + else false + member __.GetEnumerator() = k2v.GetEnumerator() + interface System.Collections.IEnumerable with + member this.GetEnumerator() = this.GetEnumerator() :> System.Collections.IEnumerator + interface IEnumerable> with + member this.GetEnumerator() = this.GetEnumerator() :> IEnumerator<_> + interface IReadOnlyCollection> with + member this.Count = this.Count + interface IReadOnlyDictionary<'Key, 'Value> with + member this.ContainsKey key = this.ContainsKey key + member this.Item with get(key) = this.[key] + member this.Keys = this.Keys :> seq<_> + member this.Values = this.Values :> seq<_> + member this.TryGetValue(key, value) = this.TryGetValue(key, &value) + interface ICollection> with + member this.Add (KeyValue (key, value)) = this.Add(key, value) + member this.Clear() = this.Clear() + member this.Contains (KeyValue (key, value)) = this.Contains key value + member this.CopyTo(array, arrayIndex) = this.CopyTo array arrayIndex + member this.Count = this.Count + member __.IsReadOnly = false + member this.Remove (KeyValue (key, value)) = this.Remove key value + interface IDictionary<'Key, 'Value> with + member this.Add(key, value) = this.Add(key, value) + member this.ContainsKey key = this.ContainsKey key + member this.Item with get key = this.[key] and set key value = this.[key] <- value + member this.Keys = this.Keys :> ICollection<_> + member this.Remove key = this.RemoveKey key + member this.TryGetValue(key, value : byref<_>) = this.TryGetValue(key, &value) + member this.Values = this.Values :> ICollection<_> + +[] +module internal AliasDictionary = + let aliasDict pairs = + let dict = AliasDictionary<_, _>() + for primaryKey, keys, value in pairs do dict.Add(primaryKey, keys = keys, value = value) + dict + let aliasDictValueMap map pairs = + let dict = AliasDictionary<_, _>() + for primaryKey, keys, value in pairs do dict.Add(primaryKey, keys = keys, value = map value) + dict + let aliasDictValueComparer valueComparer pairs = + let dict = AliasDictionary<_, _>(valueComparer) + for primaryKey, keys, value in pairs do dict.Add(primaryKey, keys = keys, value = value) + dict \ No newline at end of file diff --git a/MathDisplay/MathAtom/LaTeX.fs b/MathDisplay/MathAtom/LaTeX.fs index ccc4b9e..d1f6d3a 100644 --- a/MathDisplay/MathAtom/LaTeX.fs +++ b/MathDisplay/MathAtom/LaTeX.fs @@ -2,14 +2,18 @@ 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() @@ -75,6 +79,13 @@ let toAtom (settings: Options) latex = ///Processes 2 arguments, then continues reading let arg2 = argPlus1 arg1 + let processCommand cmd cs = + match settings.Commands.TryGetValueFSharp cmd with + | true, atom -> + let replaceArguments atom args = + + | false, _ -> @"Unrecognized command: " + cmd |> Error + //* No calls to read in this function after this point or you risk ImplementationHasUnreadCharactersException * //* Use the arg functions! @@ -87,58 +98,7 @@ let toAtom (settings: Options) latex = | 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 + | '\\'::CommandName (cmd, cs) -> processCommand (@"\" + cmd) | '^'::cs -> arg1 cs Superscript | '_'::cs -> arg1 cs Subscript | '{'::cs -> readBlock (Until '}') Row arg0 cs diff --git a/MathDisplay/MathAtom/LaTeXCommand.fs b/MathDisplay/MathAtom/LaTeXCommand.fs new file mode 100644 index 0000000..bbbfcc7 --- /dev/null +++ b/MathDisplay/MathAtom/LaTeXCommand.fs @@ -0,0 +1,10 @@ +module MathDisplay.MathAtom.LaTeXCommand + +[] +type LaTeXArgument = + Normal | AllBefore | AllAfter | Delimiter | String | Comment +[] type LaTeXCommand = { Name:string; Args:LaTeXArgument list } +let Normal name nargs = + { Name = name; Args = List.replicate nargs Normal } +let Symbol name = Normal name 0 +let Custom name args = { Name = name; Args = args } \ No newline at end of file diff --git a/MathDisplay/MathAtom/LaTeXDefaultMaps.fs b/MathDisplay/MathAtom/LaTeXDefaultMaps.fs index f1ee270..c942893 100644 --- a/MathDisplay/MathAtom/LaTeXDefaultMaps.fs +++ b/MathDisplay/MathAtom/LaTeXDefaultMaps.fs @@ -4,7 +4,7 @@ open MathDisplay.DataTypes //Use (Alt+Left mouse) drag to create multiple cursors so that spaces can be inputted simultaneously [] -let delimiters = +let Delimiters = [".", [], "" // . means no delimiter "(", [], "(" ")", [], ")" @@ -31,7 +31,7 @@ let delimiters = "lfloor", [], "\u230A" "rfloor", [], "\u230B"] - |> AliasMap.ofListWithValueMap Delimiter + |> aliasDictValueMap Delimiter [] let matrixEnvironments = @@ -41,10 +41,9 @@ let matrixEnvironments = "Bmatrix", [], ("{", "}") "vmatrix", [], ("|", "|") "Vmatrix", [], ("||", "||")] - |> AliasMap.ofListWithValueMap (fun (l, r) -> (Option.get delimiters.[l], Option.get delimiters.[r])) - -[] -let charToAtom c = + |> aliasDictValueMap (fun (l, r) -> (Delimiters.[l], Delimiters.[r])) + +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 +57,11 @@ 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 + +open MathDisplay.MathAtom.LaTeXCommand + +let Commands = + [@"\frac", [], Fraction (Argument 1, Argument 2, Center, Center, ValueNone) + @"\1", [], Ordinary "1"] + |> aliasDict \ 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..586b583 100644 --- a/MathDisplay/MathAtom/MathAtom.fs +++ b/MathDisplay/MathAtom/MathAtom.fs @@ -8,8 +8,10 @@ type Style = class end [] type mu +[] type Direction = Forwards | Backwards type MathAtom = - | TestResult___ of string + | Argument of id:int + | Argument_AllAtoms of Direction * id:int | Row of MathAtom list (*| Ordinary = Number | Variable | UnaryOperator*) | Number of string diff --git a/MathDisplay/MathDisplay.fsproj b/MathDisplay/MathDisplay.fsproj index b196373..c4384ef 100644 --- a/MathDisplay/MathDisplay.fsproj +++ b/MathDisplay/MathDisplay.fsproj @@ -12,9 +12,10 @@ - + + From c22da950d9a46ebc153abb84d87506090b2e7421 Mon Sep 17 00:00:00 2001 From: Happypig375 Date: Sun, 10 Feb 2019 20:31:26 +0800 Subject: [PATCH 02/18] Still not buildable yet... --- MathDisplay/MathAtom/LaTeX.fs | 64 +++++++++++++++++++++++++++++++- MathDisplay/MathAtom/MathAtom.fs | 2 +- 2 files changed, 63 insertions(+), 3 deletions(-) diff --git a/MathDisplay/MathAtom/LaTeX.fs b/MathDisplay/MathAtom/LaTeX.fs index d1f6d3a..0dd7304 100644 --- a/MathDisplay/MathAtom/LaTeX.fs +++ b/MathDisplay/MathAtom/LaTeX.fs @@ -1,5 +1,6 @@ module MathDisplay.MathAtom.LaTeX +open System.Collections.Generic open MathDisplay.DataTypes type Options = { @@ -82,8 +83,67 @@ let toAtom (settings: Options) latex = let processCommand cmd cs = match settings.Commands.TryGetValueFSharp cmd with | true, atom -> - let replaceArguments atom args = - + let rec readArgUntil id argMax (argDict:Dictionary) cs = + if id <= argMax + then Ok cs + else + match read tableEnv OneArgument cs [] with + | Ok (tableEnv, cs, atoms) -> + let argMax = argMax + 1 + let atom = collapse atoms + argDict.Add(argMax, atom) + readArgUntil id argMax argDict cs + | Error e -> Error e + let rec replaceArguments atom argMax argDict cs = + match atom with + | Argument id -> + if id <= argMax + then argDict.[id] + else + match readArgUntil id argMax argDict cs with + | Ok cs -> Ok (id, argDict.[id], cs) + | Argument_AllAtoms dir -> + //WIP!!!!!!!!!!!!!!!!!!!!! + match dir with + | Backwards -> List.rev list + | Forwards -> + match readBlock until collapse (fun cs atom -> Ok (cs, atom)) cs with + | Ok tup -> Ok tup + | Error e -> Error e + | Row list -> List. (fun item -> replaceArguments item argMax argDict cs) + (*| Ordinary = Number | Variable | UnaryOperator*) + | Number of string + | Variable of char + | UnaryOperator of char + | Ordinary of string + /// sin/cos, integral, etc. + | LargeOperator of Operator * lowerLimit:MathAtom voption * upperLimit:MathAtom voption + | 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 + | Punctuation of char + | PlaceholderInput + //Scripts of previous atom + | Superscript of MathAtom + | Subscript of MathAtom + | Offsetted of x:float * y:float + | Delimited of left:Delimiter * atom:MathAtom * right:Delimiter + | Underlined of MathAtom + | Overlined of MathAtom + | Accented of MathAtom * Accent + | Primes of count:int + //| Boundary (changed to Delimiter) + | Space of float + ///Style changes during rendering + | Styled of Style * MathAtom + | Text of string + | Colored of System.Drawing.Color * MathAtom + ///A table. Not part of TeX. + | Table of MathAtom list list * interColumnSpacing:float * interRowAdditionalSpacing:float * columnAlignments: Alignment list | false, _ -> @"Unrecognized command: " + cmd |> Error //* No calls to read in this function after this point or you risk ImplementationHasUnreadCharactersException * diff --git a/MathDisplay/MathAtom/MathAtom.fs b/MathDisplay/MathAtom/MathAtom.fs index 586b583..b5c9f7a 100644 --- a/MathDisplay/MathAtom/MathAtom.fs +++ b/MathDisplay/MathAtom/MathAtom.fs @@ -11,7 +11,7 @@ type Style = class end [] type Direction = Forwards | Backwards type MathAtom = | Argument of id:int - | Argument_AllAtoms of Direction * id:int + | Argument_AllAtoms of Direction | Row of MathAtom list (*| Ordinary = Number | Variable | UnaryOperator*) | Number of string From c92ea5bbc929980f7da6838f1b371d8a712e66da Mon Sep 17 00:00:00 2001 From: Hadrian Tang Date: Thu, 14 Feb 2019 19:38:37 +0800 Subject: [PATCH 03/18] More arguments that can now be replaced --- MathDisplay/MathAtom/LaTeX.fs | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/MathDisplay/MathAtom/LaTeX.fs b/MathDisplay/MathAtom/LaTeX.fs index 0dd7304..bcba536 100644 --- a/MathDisplay/MathAtom/LaTeX.fs +++ b/MathDisplay/MathAtom/LaTeX.fs @@ -94,9 +94,10 @@ let toAtom (settings: Options) latex = argDict.Add(argMax, atom) readArgUntil id argMax argDict cs | Error e -> Error e - let rec replaceArguments atom argMax argDict cs = + let rec replaceArguments atom state = match atom with | Argument id -> + let argMax, argDict, cs = state if id <= argMax then argDict.[id] else @@ -110,20 +111,22 @@ let toAtom (settings: Options) latex = match readBlock until collapse (fun cs atom -> Ok (cs, atom)) cs with | Ok tup -> Ok tup | Error e -> Error e - | Row list -> List. (fun item -> replaceArguments item argMax argDict cs) - (*| Ordinary = Number | Variable | UnaryOperator*) - | Number of string - | Variable of char - | UnaryOperator of char - | Ordinary of string - /// sin/cos, integral, etc. - | LargeOperator of Operator * lowerLimit:MathAtom voption * upperLimit:MathAtom voption - | 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 + | Row list -> List.unfold (function + | item::items -> match replaceArguments item state with + | Success _ as res -> Some (res, items) + | Error _ as res -> Some (res, []) + | _ -> None) list + | Number _ | Variable _ | UnaryOperator _ | Ordinary _ + | BinaryOperator _ | BinaryRelationalOperator _ | OpenBracket _ | CloseBracket _ as atom -> Ok atom + | LargeOperator (op, lower, upper) -> + match lower with + | ValueSome lower -> + match upper with + | ValueSome upper -> + match replaceArguments lower state with + | + LargeOperator (op, ValueOption.map (fun low -> replaceArguments low state) lower, ValueOption.map (fun up -> replaceArguments up state) upper) + | Fraction (num, den, nAlign, dAlign, thickness) -> | Radical of degree:MathAtom voption * radicand:MathAtom | Punctuation of char | PlaceholderInput From da0d631899a30326208ffdddd7eb46546f8963ea Mon Sep 17 00:00:00 2001 From: Hadrian Tang Date: Fri, 15 Feb 2019 19:43:47 +0800 Subject: [PATCH 04/18] Actual progress!!! --- MathDisplay/MathAtom/LaTeX.fs | 93 +++++++++++-------- .../MathAtom/LaTeXArgumentDictionary.fs | 11 +++ MathDisplay/MathAtom/MathAtom.fs | 14 +-- MathDisplay/MathDisplay.fsproj | 1 + 4 files changed, 72 insertions(+), 47 deletions(-) create mode 100644 MathDisplay/MathAtom/LaTeXArgumentDictionary.fs diff --git a/MathDisplay/MathAtom/LaTeX.fs b/MathDisplay/MathAtom/LaTeX.fs index bcba536..05c2255 100644 --- a/MathDisplay/MathAtom/LaTeX.fs +++ b/MathDisplay/MathAtom/LaTeX.fs @@ -83,53 +83,67 @@ let toAtom (settings: Options) latex = let processCommand cmd cs = match settings.Commands.TryGetValueFSharp cmd with | true, atom -> - let rec readArgUntil id argMax (argDict:Dictionary) cs = - if id <= argMax - then Ok cs - else - match read tableEnv OneArgument cs [] with - | Ok (tableEnv, cs, atoms) -> - let argMax = argMax + 1 - let atom = collapse atoms - argDict.Add(argMax, atom) - readArgUntil id argMax argDict cs - | Error e -> Error e + let inline readArgUntil' readArgUntil id until argDict addToArgDict tableEnv cs = //Inline for tail recursive optimizations + match read tableEnv until cs [] with + | Ok (tableEnv, cs, atoms) -> + collapse atoms |> addToArgDict + readArgUntil id tableEnv argDict cs + | Error e -> Error e + let rec readArgUntil id tableEnv (argDict:LaTeXArgumentDictionary) cs = + match argDict.Required id with + | ValueSome arg -> Ok (tableEnv, arg) + | ValueNone -> + match cs with + | '['::cs -> readArgUntil' readArgUntil id (Until ']') argDict argDict.AddRequired tableEnv cs + | _ -> readArgUntil' readArgUntil id OneArgument argDict argDict.AddRequired tableEnv cs + let rec readOptionalArgUntil id tableEnv (argDict:LaTeXArgumentDictionary) cs = + match argDict.Optional id with + | ValueSome arg -> Ok (tableEnv, ValueSome arg) + | ValueNone -> + match cs with + | '['::cs -> readArgUntil' readOptionalArgUntil id (Until ']') argDict argDict.AddOptional tableEnv cs + | _ -> Ok (tableEnv, ValueNone) + let rec replaceArguments atom state = + let replace1 atomMaker atom = + match replaceArguments atom state with + | Ok (tableEnv, atom, cs) -> Ok (tableEnv, atom) match atom with | Argument id -> - let argMax, argDict, cs = state - if id <= argMax - then argDict.[id] - else - match readArgUntil id argMax argDict cs with - | Ok cs -> Ok (id, argDict.[id], cs) + let tableEnv, argDict, cs = state + match readArgUntil id tableEnv argDict cs with + | Ok (tableEnv, atom) -> Ok (tableEnv, atom, cs) + | Error e -> Error e + | Argument_Optional (id, defaultValue) -> + let tableEnv, argDict, cs = state + match readOptionalArgUntil id tableEnv argDict cs with + | Ok (tableEnv, ValueSome atom) -> Ok (tableEnv, atom, cs) + | Ok (tableEnv, ValueNone) -> Ok (tableEnv, defaultValue, cs) + | Error e -> Error e | Argument_AllAtoms dir -> - //WIP!!!!!!!!!!!!!!!!!!!!! match dir with - | Backwards -> List.rev list + | Backwards -> Ok (tableEnv, List.rev list |> collapse, cs) | Forwards -> match readBlock until collapse (fun cs atom -> Ok (cs, atom)) cs with - | Ok tup -> Ok tup + | Ok (cs, atom) -> Ok (tableEnv, atom, cs) | Error e -> Error e - | Row list -> List.unfold (function - | item::items -> match replaceArguments item state with - | Success _ as res -> Some (res, items) - | Error _ as res -> Some (res, []) - | _ -> None) list + | Row list -> + //WIP!!! + match List.unfold (function + | tableEnv, item::items, cs -> match replaceArguments item state with + | Ok (tableEnv, atom, cs) -> Some (Ok atom, (tableEnv, items, cs)) + | Error e -> Some (Error e, (tableEnv, [], cs)) + | _ -> None) (tableEnv, list, cs) + with + | (Error e)::_ -> Error e + | list -> Ok (tableEnv, List.map (function + | Ok value -> value + | Error _ -> failwith "Impossible at case Row at replaceArguments in LaTeX.ToAtom") list |> Row, cs) | Number _ | Variable _ | UnaryOperator _ | Ordinary _ - | BinaryOperator _ | BinaryRelationalOperator _ | OpenBracket _ | CloseBracket _ as atom -> Ok atom - | LargeOperator (op, lower, upper) -> - match lower with - | ValueSome lower -> - match upper with - | ValueSome upper -> - match replaceArguments lower state with - | - LargeOperator (op, ValueOption.map (fun low -> replaceArguments low state) lower, ValueOption.map (fun up -> replaceArguments up state) upper) + | BinaryOperator _ | BinaryRelationalOperator _ | OpenBracket _ | CloseBracket _ + | LargeOperator _ | Punctuation _ | PlaceholderInput | Primes _ | Space _ as atom -> Ok (tableEnv, atom, cs) | Fraction (num, den, nAlign, dAlign, thickness) -> - | Radical of degree:MathAtom voption * radicand:MathAtom - | Punctuation of char - | PlaceholderInput + | Radical (degree, radicand) -> match replaceArguments degree state with //Scripts of previous atom | Superscript of MathAtom | Subscript of MathAtom @@ -138,15 +152,12 @@ let toAtom (settings: Options) latex = | Underlined of MathAtom | Overlined of MathAtom | Accented of MathAtom * Accent - | Primes of count:int - //| Boundary (changed to Delimiter) - | Space of float ///Style changes during rendering | Styled of Style * MathAtom - | Text of string | Colored of System.Drawing.Color * MathAtom ///A table. Not part of TeX. | Table of MathAtom list list * interColumnSpacing:float * interRowAdditionalSpacing:float * columnAlignments: Alignment list + replaceArguments atom (tableEnv, LaTeXArgumentDictionary(), cs) | false, _ -> @"Unrecognized command: " + cmd |> Error //* No calls to read in this function after this point or you risk ImplementationHasUnreadCharactersException * diff --git a/MathDisplay/MathAtom/LaTeXArgumentDictionary.fs b/MathDisplay/MathAtom/LaTeXArgumentDictionary.fs new file mode 100644 index 0000000..cdf4ce5 --- /dev/null +++ b/MathDisplay/MathAtom/LaTeXArgumentDictionary.fs @@ -0,0 +1,11 @@ +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 + member __.Optional with get id = if id < optional.Count then ValueSome optional.[id] else ValueNone + member __.Required with get id = if id < required.Count then ValueSome required.[id] else ValueNone \ No newline at end of file diff --git a/MathDisplay/MathAtom/MathAtom.fs b/MathDisplay/MathAtom/MathAtom.fs index b5c9f7a..3081719 100644 --- a/MathDisplay/MathAtom/MathAtom.fs +++ b/MathDisplay/MathAtom/MathAtom.fs @@ -11,6 +11,7 @@ type Style = class end [] type Direction = Forwards | Backwards type MathAtom = | Argument of id:int + | Argument_Optional of id:int * defaultValue:MathAtom | Argument_AllAtoms of Direction | Row of MathAtom list (*| Ordinary = Number | Variable | UnaryOperator*) @@ -19,20 +20,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 @@ -42,7 +44,7 @@ type MathAtom = | Space of float ///Style changes during rendering | Styled of Style * MathAtom - | Text of string + //| Text of string -> | Ordinary of string | Colored of System.Drawing.Color * MathAtom ///A table. Not part of TeX. | Table of MathAtom list list * interColumnSpacing:float * interRowAdditionalSpacing:float * columnAlignments: Alignment list \ No newline at end of file diff --git a/MathDisplay/MathDisplay.fsproj b/MathDisplay/MathDisplay.fsproj index c4384ef..023b6c8 100644 --- a/MathDisplay/MathDisplay.fsproj +++ b/MathDisplay/MathDisplay.fsproj @@ -15,6 +15,7 @@ + From 37f5512deac55284f9cf7af74dcd58c241f212d7 Mon Sep 17 00:00:00 2001 From: Hadrian Tang Date: Mon, 18 Feb 2019 19:50:16 +0800 Subject: [PATCH 05/18] Buildable again...! --- MathDisplay.Tests/UnitTests.fs | 2 +- MathDisplay/DataTypes/ListExtensions.fs | 29 ++++++++- MathDisplay/MathAtom/LaTeX.fs | 82 +++++++++++++----------- MathDisplay/MathAtom/LaTeXDefaultMaps.fs | 4 +- MathDisplay/MathAtom/MathAtom.fs | 4 +- 5 files changed, 75 insertions(+), 46 deletions(-) diff --git a/MathDisplay.Tests/UnitTests.fs b/MathDisplay.Tests/UnitTests.fs index 2678db1..c2511ce 100644 --- a/MathDisplay.Tests/UnitTests.fs +++ b/MathDisplay.Tests/UnitTests.fs @@ -17,7 +17,7 @@ type TestClass () = member __.``Gather output`` () = let fff = MathDisplay.DataTypes.List.partitionWhile ((=) 'a') ['a'; 'a'; 'a'; 'a'; 'b'; 'c'] let x = - @"123" + @"\frac23" |> 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/ListExtensions.fs b/MathDisplay/DataTypes/ListExtensions.fs index 306a0c2..51a1c07 100644 --- a/MathDisplay/DataTypes/ListExtensions.fs +++ b/MathDisplay/DataTypes/ListExtensions.fs @@ -4,8 +4,33 @@ 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 [] + + let result list = + let rec loop acc = function + | [] -> List.rev acc |> Ok + | (Ok value)::rest -> loop (value::acc) rest + | (Error err)::_ -> Error err + loop [] list + + let mapResult (f: 'T -> Result<'Result, 'Error>) list = + let rec loop acc = function + | [] -> List.rev acc |> Ok + | x::xs -> + match f x with + | Ok value -> loop (value::acc) xs + | Error e -> Error e + loop [] list + + 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 05c2255..743f2c9 100644 --- a/MathDisplay/MathAtom/LaTeX.fs +++ b/MathDisplay/MathAtom/LaTeX.fs @@ -20,7 +20,7 @@ exception ImplementationHasUnreadCharactersException of InputLaTeX:string * Unre + "\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 @@ -37,14 +37,14 @@ 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.TryGetValueFSharp cmd with + | true, v -> Ok (v, cs) + | false, _ -> 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.TryGetValueFSharp c with + | true, v -> Ok (v, cs) + | false, _ -> errorDelimMissing c ///Reads an environment let readEnvironment cs = match cs with @@ -105,9 +105,16 @@ let toAtom (settings: Options) latex = | _ -> Ok (tableEnv, ValueNone) let rec replaceArguments atom state = - let replace1 atomMaker atom = - match replaceArguments atom state with - | Ok (tableEnv, atom, cs) -> Ok (tableEnv, atom) + //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 -> match replaceArguments arg (tableEnv, argDict, cs) with + | Ok (tableEnv, result, cs) -> Ok (result, struct(tableEnv, cs)) + | Error e -> Error e) match atom with | Argument id -> let tableEnv, argDict, cs = state @@ -128,35 +135,29 @@ let toAtom (settings: Options) latex = | Ok (cs, atom) -> Ok (tableEnv, atom, cs) | Error e -> Error e | Row list -> - //WIP!!! - match List.unfold (function - | tableEnv, item::items, cs -> match replaceArguments item state with - | Ok (tableEnv, atom, cs) -> Some (Ok atom, (tableEnv, items, cs)) - | Error e -> Some (Error e, (tableEnv, [], cs)) - | _ -> None) (tableEnv, list, cs) - with - | (Error e)::_ -> Error e - | list -> Ok (tableEnv, List.map (function - | Ok value -> value - | Error _ -> failwith "Impossible at case Row at replaceArguments in LaTeX.ToAtom") list |> Row, cs) + let tableEnv, argDict, cs = state + match replaceList argDict struct(tableEnv, cs) list with + | Ok (list, struct(tableEnv, cs)) -> Ok (tableEnv, Row list, cs) + | Error e -> Error e | 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) -> - | Radical (degree, radicand) -> match replaceArguments degree state with - //Scripts of previous atom - | Superscript of MathAtom - | Subscript of MathAtom - | Offsetted of x:float * y:float - | Delimited of left:Delimiter * atom:MathAtom * right:Delimiter - | Underlined of MathAtom - | Overlined of MathAtom - | Accented of MathAtom * Accent - ///Style changes during rendering - | Styled of Style * MathAtom - | Colored of System.Drawing.Color * MathAtom - ///A table. Not part of TeX. - | Table of MathAtom list list * interColumnSpacing:float * interRowAdditionalSpacing:float * columnAlignments: Alignment list + | 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 + match List.mapFoldResult (replaceList argDict) struct(tableEnv, cs) atomss with + | Ok(atomss, struct(tableEnv, cs)) -> Ok(tableEnv, Table(atomss, interColumnSpacing, interRowAdditionalSpacing, columnAlignments), cs) + | Error e -> Error e replaceArguments atom (tableEnv, LaTeXArgumentDictionary(), cs) | false, _ -> @"Unrecognized command: " + cmd |> Error @@ -172,9 +173,12 @@ let toAtom (settings: Options) latex = | 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) -> processCommand (@"\" + cmd) - | '^'::cs -> arg1 cs Superscript - | '_'::cs -> arg1 cs Subscript + | '\\'::CommandName (cmd, cs) -> + match processCommand cmd cs with + | Ok (tableEnv, atom, cs) -> arg0 cs atom + | Error e -> Error e + | '^'::cs -> arg1 cs Superscripted + | '_'::cs -> arg1 cs Subscripted | '{'::cs -> readBlock (Until '}') Row arg0 cs | '}'::_ -> Error "Missing opening brace" //| '&'::cs -> diff --git a/MathDisplay/MathAtom/LaTeXDefaultMaps.fs b/MathDisplay/MathAtom/LaTeXDefaultMaps.fs index c942893..0071baa 100644 --- a/MathDisplay/MathAtom/LaTeXDefaultMaps.fs +++ b/MathDisplay/MathAtom/LaTeXDefaultMaps.fs @@ -62,6 +62,6 @@ let ``(charToAtom) <--- Unused for now....`` c = open MathDisplay.MathAtom.LaTeXCommand let Commands = - [@"\frac", [], Fraction (Argument 1, Argument 2, Center, Center, ValueNone) - @"\1", [], Ordinary "1"] + [@"frac", [], Fraction (Argument 1, Argument 2, Center, Center, ValueNone) + @"1", [], Ordinary "1"] |> aliasDict \ No newline at end of file diff --git a/MathDisplay/MathAtom/MathAtom.fs b/MathDisplay/MathAtom/MathAtom.fs index 3081719..82f69f3 100644 --- a/MathDisplay/MathAtom/MathAtom.fs +++ b/MathDisplay/MathAtom/MathAtom.fs @@ -43,8 +43,8 @@ type MathAtom = //| Boundary (changed to Delimiter) | Space of float ///Style changes during rendering - | Styled of Style * MathAtom + | Styled of MathAtom * Style //| Text of string -> | Ordinary of string - | Colored of System.Drawing.Color * MathAtom + | 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 From ca212781c00a2c988ef0387d37bc3839ae6a770a Mon Sep 17 00:00:00 2001 From: Hadrian Tang Date: Wed, 20 Feb 2019 19:40:59 +0800 Subject: [PATCH 06/18] \frac23 successful --- MathDisplay.Tests/UnitTests.fs | 3 +-- MathDisplay/MathAtom/LaTeX.fs | 13 +++++++------ MathDisplay/MathAtom/LaTeXArgumentDictionary.fs | 6 ++++-- MathDisplay/MathAtom/LaTeXDefaultMaps.fs | 5 +++-- 4 files changed, 15 insertions(+), 12 deletions(-) diff --git a/MathDisplay.Tests/UnitTests.fs b/MathDisplay.Tests/UnitTests.fs index c2511ce..0c1a36e 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 = - @"\frac23" + @"\frac\sqrt234" |> 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/MathAtom/LaTeX.fs b/MathDisplay/MathAtom/LaTeX.fs index 743f2c9..355d053 100644 --- a/MathDisplay/MathAtom/LaTeX.fs +++ b/MathDisplay/MathAtom/LaTeX.fs @@ -91,18 +91,19 @@ let ToAtom (settings: Options) latex = | Error e -> Error e let rec readArgUntil id tableEnv (argDict:LaTeXArgumentDictionary) cs = match argDict.Required id with - | ValueSome arg -> Ok (tableEnv, arg) + | ValueSome arg -> Ok (tableEnv, arg, cs) | ValueNone -> match cs with | '['::cs -> readArgUntil' readArgUntil id (Until ']') argDict argDict.AddRequired tableEnv cs + | [] -> Error "Unexpected end of text, argument missing" | _ -> readArgUntil' readArgUntil id OneArgument argDict argDict.AddRequired tableEnv cs let rec readOptionalArgUntil id tableEnv (argDict:LaTeXArgumentDictionary) cs = match argDict.Optional id with - | ValueSome arg -> Ok (tableEnv, ValueSome arg) + | ValueSome arg -> Ok (tableEnv, ValueSome arg, cs) | ValueNone -> match cs with | '['::cs -> readArgUntil' readOptionalArgUntil id (Until ']') argDict argDict.AddOptional tableEnv cs - | _ -> Ok (tableEnv, ValueNone) + | _ -> Ok (tableEnv, ValueNone, cs) let rec replaceArguments atom state = //Not working... @@ -119,13 +120,13 @@ let ToAtom (settings: Options) latex = | Argument id -> let tableEnv, argDict, cs = state match readArgUntil id tableEnv argDict cs with - | Ok (tableEnv, atom) -> Ok (tableEnv, atom, cs) + | Ok (tableEnv, atom, cs) -> Ok (tableEnv, atom, cs) | Error e -> Error e | Argument_Optional (id, defaultValue) -> let tableEnv, argDict, cs = state match readOptionalArgUntil id tableEnv argDict cs with - | Ok (tableEnv, ValueSome atom) -> Ok (tableEnv, atom, cs) - | Ok (tableEnv, ValueNone) -> Ok (tableEnv, defaultValue, cs) + | Ok (tableEnv, ValueSome atom, cs) -> Ok (tableEnv, atom, cs) + | Ok (tableEnv, ValueNone, cs) -> Ok (tableEnv, defaultValue, cs) | Error e -> Error e | Argument_AllAtoms dir -> match dir with diff --git a/MathDisplay/MathAtom/LaTeXArgumentDictionary.fs b/MathDisplay/MathAtom/LaTeXArgumentDictionary.fs index cdf4ce5..38a9931 100644 --- a/MathDisplay/MathAtom/LaTeXArgumentDictionary.fs +++ b/MathDisplay/MathAtom/LaTeXArgumentDictionary.fs @@ -7,5 +7,7 @@ type LaTeXArgumentDictionary() = let optional = new List() member __.AddOptional atom = optional.Add atom member __.AddRequired atom = required.Add atom - member __.Optional with get id = if id < optional.Count then ValueSome optional.[id] else ValueNone - member __.Required with get id = if id < required.Count then ValueSome required.[id] else ValueNone \ No newline at end of file + ///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 0071baa..5150a5b 100644 --- a/MathDisplay/MathAtom/LaTeXDefaultMaps.fs +++ b/MathDisplay/MathAtom/LaTeXDefaultMaps.fs @@ -62,6 +62,7 @@ let ``(charToAtom) <--- Unused for now....`` c = open MathDisplay.MathAtom.LaTeXCommand let Commands = - [@"frac", [], Fraction (Argument 1, Argument 2, Center, Center, ValueNone) - @"1", [], Ordinary "1"] + ["frac", [], Fraction (Argument 1, Argument 2, Center, Center, ValueNone) + "sqrt", [], Radical (Argument_Optional (1, Row []), Argument 1) + "1", [], Ordinary "1"] |> aliasDict \ No newline at end of file From f3d011d0690e0a771f8283b853ffde8582b7f380 Mon Sep 17 00:00:00 2001 From: Hadrian Tang Date: Mon, 25 Feb 2019 18:47:39 +0800 Subject: [PATCH 07/18] LaTeX Rewrite - commit! --- MathDisplay.Tests.Benchmarks/AliasMap.fs | 2 +- MathDisplay/MathAtom/LaTeX.fs | 151 +++++++++--------- .../MathAtom/LaTeXArgumentDictionary.fs | 2 +- MathDisplay/MathAtom/LaTeXCommand.fs | 10 -- MathDisplay/MathAtom/LaTeXDefaultMaps.fs | 4 +- MathDisplay/MathAtom/MathAtom.fs | 2 - MathDisplay/MathDisplay.fsproj | 1 - 7 files changed, 76 insertions(+), 96 deletions(-) delete mode 100644 MathDisplay/MathAtom/LaTeXCommand.fs diff --git a/MathDisplay.Tests.Benchmarks/AliasMap.fs b/MathDisplay.Tests.Benchmarks/AliasMap.fs index a51ba06..b29d8a7 100644 --- a/MathDisplay.Tests.Benchmarks/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 diff --git a/MathDisplay/MathAtom/LaTeX.fs b/MathDisplay/MathAtom/LaTeX.fs index 355d053..748c687 100644 --- a/MathDisplay/MathAtom/LaTeX.fs +++ b/MathDisplay/MathAtom/LaTeX.fs @@ -81,86 +81,81 @@ let ToAtom (settings: Options) latex = let arg2 = argPlus1 arg1 let processCommand cmd cs = - match settings.Commands.TryGetValueFSharp cmd with - | true, atom -> - let inline readArgUntil' readArgUntil id until argDict addToArgDict tableEnv cs = //Inline for tail recursive optimizations - match read tableEnv until cs [] with - | Ok (tableEnv, cs, atoms) -> - collapse atoms |> addToArgDict - readArgUntil id tableEnv argDict cs - | Error e -> Error e - let rec readArgUntil id tableEnv (argDict:LaTeXArgumentDictionary) cs = - match argDict.Required id with - | ValueSome arg -> Ok (tableEnv, arg, cs) - | ValueNone -> - match cs with - | '['::cs -> readArgUntil' readArgUntil id (Until ']') argDict argDict.AddRequired tableEnv cs - | [] -> Error "Unexpected end of text, argument missing" - | _ -> readArgUntil' readArgUntil id OneArgument argDict argDict.AddRequired tableEnv cs - let rec readOptionalArgUntil id tableEnv (argDict:LaTeXArgumentDictionary) cs = - match argDict.Optional id with - | ValueSome arg -> Ok (tableEnv, ValueSome arg, cs) - | ValueNone -> - match cs with - | '['::cs -> readArgUntil' readOptionalArgUntil id (Until ']') argDict argDict.AddOptional tableEnv cs - | _ -> Ok (tableEnv, ValueNone, cs) - - 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 -> match replaceArguments arg (tableEnv, argDict, cs) with - | Ok (tableEnv, result, cs) -> Ok (result, struct(tableEnv, cs)) - | Error e -> Error e) - match atom with - | Argument id -> - let tableEnv, argDict, cs = state - match readArgUntil id tableEnv argDict cs with - | Ok (tableEnv, atom, cs) -> Ok (tableEnv, atom, cs) - | Error e -> Error e - | Argument_Optional (id, defaultValue) -> - let tableEnv, argDict, cs = state - match readOptionalArgUntil id tableEnv argDict cs with - | Ok (tableEnv, ValueSome atom, cs) -> Ok (tableEnv, atom, cs) - | Ok (tableEnv, ValueNone, cs) -> Ok (tableEnv, defaultValue, cs) + match cmd with + | _ -> + match settings.Commands.TryGetValueFSharp cmd with + | true, atom -> + let inline readArgUntil' readArgUntil id until argDict addToArgDict tableEnv cs = //Inline for tail recursive optimizations + match read tableEnv until cs [] with + | Ok (tableEnv, cs, atoms) -> + collapse atoms |> addToArgDict + readArgUntil id tableEnv argDict cs | Error e -> Error e - | Argument_AllAtoms dir -> - match dir with - | Backwards -> Ok (tableEnv, List.rev list |> collapse, cs) - | Forwards -> - match readBlock until collapse (fun cs atom -> Ok (cs, atom)) cs with - | Ok (cs, atom) -> Ok (tableEnv, atom, cs) + let rec readArgUntil id tableEnv (argDict:LaTeXArgumentDictionary) cs = + match argDict.Required id with + | ValueSome arg -> Ok (tableEnv, arg, cs) + | ValueNone -> + match cs with + | '['::cs -> readArgUntil' readArgUntil id (Until ']') argDict argDict.AddRequired tableEnv cs + | [] -> Error "Unexpected end of text, argument missing" + | _ -> readArgUntil' readArgUntil id OneArgument argDict argDict.AddRequired tableEnv cs + let rec readOptionalArgUntil id tableEnv (argDict:LaTeXArgumentDictionary) cs = + match argDict.Optional id with + | ValueSome arg -> Ok (tableEnv, ValueSome arg, cs) + | ValueNone -> + match cs with + | '['::cs -> readArgUntil' readOptionalArgUntil id (Until ']') argDict argDict.AddOptional tableEnv cs + | _ -> Ok (tableEnv, ValueNone, cs) + + 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 -> match replaceArguments arg (tableEnv, argDict, cs) with + | Ok (tableEnv, result, cs) -> Ok (result, struct(tableEnv, cs)) + | Error e -> Error e) + match atom with + | Argument id -> + let tableEnv, argDict, cs = state + match readArgUntil id tableEnv argDict cs with + | Ok (tableEnv, atom, cs) -> Ok (tableEnv, atom, cs) | Error e -> Error e - | Row list -> - let tableEnv, argDict, cs = state - match replaceList argDict struct(tableEnv, cs) list with - | Ok (list, struct(tableEnv, cs)) -> Ok (tableEnv, Row list, cs) - | Error e -> Error e - | 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 - match List.mapFoldResult (replaceList argDict) struct(tableEnv, cs) atomss with - | Ok(atomss, struct(tableEnv, cs)) -> Ok(tableEnv, Table(atomss, interColumnSpacing, interRowAdditionalSpacing, columnAlignments), cs) - | Error e -> Error e - replaceArguments atom (tableEnv, LaTeXArgumentDictionary(), cs) - | false, _ -> @"Unrecognized command: " + cmd |> Error + | Argument_Optional (id, defaultValue) -> + let tableEnv, argDict, cs = state + match readOptionalArgUntil 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 + match replaceList argDict struct(tableEnv, cs) list with + | Ok (list, struct(tableEnv, cs)) -> Ok (tableEnv, Row list, cs) + | Error e -> Error e + | 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 + match List.mapFoldResult (replaceList argDict) struct(tableEnv, cs) atomss with + | Ok(atomss, struct(tableEnv, cs)) -> Ok(tableEnv, Table(atomss, interColumnSpacing, interRowAdditionalSpacing, columnAlignments), cs) + | Error e -> Error e + replaceArguments atom (tableEnv, LaTeXArgumentDictionary(), cs) + | false, _ -> @"Unrecognized command: " + cmd |> Error //* No calls to read in this function after this point or you risk ImplementationHasUnreadCharactersException * //* Use the arg functions! diff --git a/MathDisplay/MathAtom/LaTeXArgumentDictionary.fs b/MathDisplay/MathAtom/LaTeXArgumentDictionary.fs index 38a9931..baa9593 100644 --- a/MathDisplay/MathAtom/LaTeXArgumentDictionary.fs +++ b/MathDisplay/MathAtom/LaTeXArgumentDictionary.fs @@ -10,4 +10,4 @@ type LaTeXArgumentDictionary() = ///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 + 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/LaTeXCommand.fs b/MathDisplay/MathAtom/LaTeXCommand.fs deleted file mode 100644 index bbbfcc7..0000000 --- a/MathDisplay/MathAtom/LaTeXCommand.fs +++ /dev/null @@ -1,10 +0,0 @@ -module MathDisplay.MathAtom.LaTeXCommand - -[] -type LaTeXArgument = - Normal | AllBefore | AllAfter | Delimiter | String | Comment -[] type LaTeXCommand = { Name:string; Args:LaTeXArgument list } -let Normal name nargs = - { Name = name; Args = List.replicate nargs Normal } -let Symbol name = Normal name 0 -let Custom name args = { Name = name; Args = args } \ No newline at end of file diff --git a/MathDisplay/MathAtom/LaTeXDefaultMaps.fs b/MathDisplay/MathAtom/LaTeXDefaultMaps.fs index 5150a5b..3b5a6f1 100644 --- a/MathDisplay/MathAtom/LaTeXDefaultMaps.fs +++ b/MathDisplay/MathAtom/LaTeXDefaultMaps.fs @@ -58,9 +58,7 @@ let ``(charToAtom) <--- Unused for now....`` c = | '-' | '\u2212' -> BinaryOperator '\u2212' |> ValueSome // use the math minus sign | '.' -> string c |> Number |> ValueSome | '"' | '/' | '@' | '`' | '|' | _ -> string c |> Ordinary |> ValueSome - -open MathDisplay.MathAtom.LaTeXCommand - + let Commands = ["frac", [], Fraction (Argument 1, Argument 2, Center, Center, ValueNone) "sqrt", [], Radical (Argument_Optional (1, Row []), Argument 1) diff --git a/MathDisplay/MathAtom/MathAtom.fs b/MathDisplay/MathAtom/MathAtom.fs index 82f69f3..2722e2c 100644 --- a/MathDisplay/MathAtom/MathAtom.fs +++ b/MathDisplay/MathAtom/MathAtom.fs @@ -8,11 +8,9 @@ type Style = class end [] type mu -[] type Direction = Forwards | Backwards type MathAtom = | Argument of id:int | Argument_Optional of id:int * defaultValue:MathAtom - | Argument_AllAtoms of Direction | Row of MathAtom list (*| Ordinary = Number | Variable | UnaryOperator*) | Number of string diff --git a/MathDisplay/MathDisplay.fsproj b/MathDisplay/MathDisplay.fsproj index 023b6c8..61d71ae 100644 --- a/MathDisplay/MathDisplay.fsproj +++ b/MathDisplay/MathDisplay.fsproj @@ -16,7 +16,6 @@ - From 3d3702bd1f3fefdcd459ad9e4ebb18a860fd34dc Mon Sep 17 00:00:00 2001 From: Hadrian Tang Date: Mon, 25 Feb 2019 18:49:35 +0800 Subject: [PATCH 08/18] Remove unused functions --- MathDisplay/DataTypes/ListExtensions.fs | 18 +----------------- 1 file changed, 1 insertion(+), 17 deletions(-) diff --git a/MathDisplay/DataTypes/ListExtensions.fs b/MathDisplay/DataTypes/ListExtensions.fs index 51a1c07..ecad6c3 100644 --- a/MathDisplay/DataTypes/ListExtensions.fs +++ b/MathDisplay/DataTypes/ListExtensions.fs @@ -9,23 +9,7 @@ module MathDisplay.DataTypes.List | x::xs when f x -> loop (x::acc) xs | xs -> List.rev acc, xs loop [] - - let result list = - let rec loop acc = function - | [] -> List.rev acc |> Ok - | (Ok value)::rest -> loop (value::acc) rest - | (Error err)::_ -> Error err - loop [] list - - let mapResult (f: 'T -> Result<'Result, 'Error>) list = - let rec loop acc = function - | [] -> List.rev acc |> Ok - | x::xs -> - match f x with - | Ok value -> loop (value::acc) xs - | Error e -> Error e - loop [] list - + let mapFoldResult f (state:'State) (list: 'T list) : Result<'Result list * 'State, 'Error> = let rec loop acc state = function | [] -> (List.rev acc, state) |> Ok From 3867c0ae459ad9495808c73bac448022a7f50050 Mon Sep 17 00:00:00 2001 From: Hadrian Tang Date: Thu, 28 Feb 2019 19:56:25 +0800 Subject: [PATCH 09/18] Simplification --- MathDisplay/MathAtom/LaTeX.fs | 192 ++++++++++++++++------------------ 1 file changed, 89 insertions(+), 103 deletions(-) diff --git a/MathDisplay/MathAtom/LaTeX.fs b/MathDisplay/MathAtom/LaTeX.fs index 748c687..3995c3c 100644 --- a/MathDisplay/MathAtom/LaTeX.fs +++ b/MathDisplay/MathAtom/LaTeX.fs @@ -51,14 +51,6 @@ let ToAtom (settings: Options) latex = | '{'::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 @@ -67,96 +59,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 processCommandAtom 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) -> + collapse 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) -> + collapse 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) -> + collapse 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 processCommand cmd cs = + match settings.Commands.TryGetValueFSharp cmd with + | true, atom -> processCommandAtom atom cs + | false, _ -> @"Unrecognized command: " + cmd |> Error + + 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 - - let processCommand cmd cs = - match cmd with - | _ -> - match settings.Commands.TryGetValueFSharp cmd with - | true, atom -> - let inline readArgUntil' readArgUntil id until argDict addToArgDict tableEnv cs = //Inline for tail recursive optimizations - match read tableEnv until cs [] with - | Ok (tableEnv, cs, atoms) -> - collapse atoms |> addToArgDict - readArgUntil id tableEnv argDict cs - | Error e -> Error e - let rec readArgUntil id tableEnv (argDict:LaTeXArgumentDictionary) cs = - match argDict.Required id with - | ValueSome arg -> Ok (tableEnv, arg, cs) - | ValueNone -> - match cs with - | '['::cs -> readArgUntil' readArgUntil id (Until ']') argDict argDict.AddRequired tableEnv cs - | [] -> Error "Unexpected end of text, argument missing" - | _ -> readArgUntil' readArgUntil id OneArgument argDict argDict.AddRequired tableEnv cs - let rec readOptionalArgUntil id tableEnv (argDict:LaTeXArgumentDictionary) cs = - match argDict.Optional id with - | ValueSome arg -> Ok (tableEnv, ValueSome arg, cs) - | ValueNone -> - match cs with - | '['::cs -> readArgUntil' readOptionalArgUntil id (Until ']') argDict argDict.AddOptional tableEnv cs - | _ -> Ok (tableEnv, ValueNone, cs) - - 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 -> match replaceArguments arg (tableEnv, argDict, cs) with - | Ok (tableEnv, result, cs) -> Ok (result, struct(tableEnv, cs)) - | Error e -> Error e) - match atom with - | Argument id -> - let tableEnv, argDict, cs = state - match readArgUntil id tableEnv argDict cs with - | Ok (tableEnv, atom, cs) -> Ok (tableEnv, atom, cs) - | Error e -> Error e - | Argument_Optional (id, defaultValue) -> - let tableEnv, argDict, cs = state - match readOptionalArgUntil 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 - match replaceList argDict struct(tableEnv, cs) list with - | Ok (list, struct(tableEnv, cs)) -> Ok (tableEnv, Row list, cs) - | Error e -> Error e - | 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 - match List.mapFoldResult (replaceList argDict) struct(tableEnv, cs) atomss with - | Ok(atomss, struct(tableEnv, cs)) -> Ok(tableEnv, Table(atomss, interColumnSpacing, interRowAdditionalSpacing, columnAlignments), cs) - | Error e -> Error e - replaceArguments atom (tableEnv, LaTeXArgumentDictionary(), cs) - | false, _ -> @"Unrecognized command: " + cmd |> Error - //* No calls to read in this function after this point or you risk ImplementationHasUnreadCharactersException * //* Use the arg functions! @@ -169,19 +158,16 @@ let ToAtom (settings: Options) latex = | 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) -> - match processCommand cmd cs with - | Ok (tableEnv, atom, cs) -> arg0 cs atom - | Error e -> Error e - | '^'::cs -> arg1 cs Superscripted - | '_'::cs -> arg1 cs Subscripted - | '{'::cs -> readBlock (Until '}') Row arg0 cs + | '\\'::CommandName (cmd, cs) -> processCommand cmd cs |> Result.bind continueReading + | '^'::cs -> processCommandAtom (Superscripted (Argument 1)) cs |> Result.bind continueReading + | '_'::cs -> processCommandAtom (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) -> From 4356592f399fe61aee914fe3b7acbd4bc9d3ac94 Mon Sep 17 00:00:00 2001 From: Hadrian Tang Date: Fri, 1 Mar 2019 14:00:56 +0800 Subject: [PATCH 10/18] Added \left and \right --- MathDisplay.Tests/UnitTests.fs | 2 +- MathDisplay/MathAtom/LaTeX.fs | 33 ++++++++++++++++++++++++--------- 2 files changed, 25 insertions(+), 10 deletions(-) diff --git a/MathDisplay.Tests/UnitTests.fs b/MathDisplay.Tests/UnitTests.fs index 0c1a36e..750178e 100644 --- a/MathDisplay.Tests/UnitTests.fs +++ b/MathDisplay.Tests/UnitTests.fs @@ -16,7 +16,7 @@ type TestClass () = [] member __.``Gather output`` () = let x = - @"\frac\sqrt234" + @"\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/MathAtom/LaTeX.fs b/MathDisplay/MathAtom/LaTeX.fs index 3995c3c..42a7707 100644 --- a/MathDisplay/MathAtom/LaTeX.fs +++ b/MathDisplay/MathAtom/LaTeX.fs @@ -60,7 +60,7 @@ let ToAtom (settings: Options) latex = // | '&'::cs -> innerReadTable //) - let processCommandAtom atom cs = + let processAtom atom cs = let rec readArgsUntilId id tableEnv (argDict:LaTeXArgumentDictionary) cs = match argDict.Required id with | ValueSome arg -> Ok (tableEnv, arg, cs) @@ -136,16 +136,17 @@ let ToAtom (settings: Options) latex = |> Result.map (fun (atomss, struct(tableEnv, cs)) -> tableEnv, Table(atomss, interColumnSpacing, interRowAdditionalSpacing, columnAlignments), cs) replaceArguments atom (tableEnv, LaTeXArgumentDictionary(), cs) - let processCommand cmd cs = - match settings.Commands.TryGetValueFSharp cmd with - | true, atom -> processCommandAtom atom cs - | false, _ -> @"Unrecognized command: " + cmd |> Error - let continueReading (tableEnv, atom, cs) = let list = atom::list match until with | OneArgument -> (tableEnv, cs, list) |> Ok | _ -> read tableEnv until cs list + + let processAtomCommand cmd cs = + match settings.Commands.TryGetValueFSharp cmd with + | true, atom -> processAtom atom cs + | false, _ -> @"Unrecognized command: " + cmd |> Error + //* No calls to read in this function after this point or you risk ImplementationHasUnreadCharactersException * //* Use the arg functions! @@ -158,9 +159,23 @@ let ToAtom (settings: Options) latex = | 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) -> processCommand cmd cs |> Result.bind continueReading - | '^'::cs -> processCommandAtom (Superscripted (Argument 1)) cs |> Result.bind continueReading - | '_'::cs -> processCommandAtom (Subscripted (Argument 1)) cs |> Result.bind continueReading + | '\\'::CommandName (cmd, cs) -> + match cmd with + | "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, collapse 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 -> From 85ce10629a3e8a35f66c8fd8050f59502122ffe5 Mon Sep 17 00:00:00 2001 From: Charles Roddie Date: Sun, 3 Mar 2019 12:43:43 +0000 Subject: [PATCH 11/18] documented and simplified AliasDictionary Delimiter to DU --- MathDisplay/DataTypes/AliasDictionary.fs | 154 ++++++++--------------- MathDisplay/MathAtom/LaTeXDefaultMaps.fs | 78 ++++++------ MathDisplay/MathAtom/MathAtom.fs | 53 +++++++- 3 files changed, 141 insertions(+), 144 deletions(-) diff --git a/MathDisplay/DataTypes/AliasDictionary.fs b/MathDisplay/DataTypes/AliasDictionary.fs index 4a7208c..5efd4cf 100644 --- a/MathDisplay/DataTypes/AliasDictionary.fs +++ b/MathDisplay/DataTypes/AliasDictionary.fs @@ -2,108 +2,56 @@ open System.Collections.Generic -type AliasDictionary<'Key, 'Value when 'Key : equality and 'Value : equality> private(k2v, v2k) = - new() = AliasDictionary(Dictionary<'Key, 'Value>(), Dictionary<'Value, 'Key>()) - new(valueComparer) = AliasDictionary(Dictionary<_, _>(), Dictionary<_, _>(comparer = valueComparer)) +/// 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>()) + /// 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) + | [] -> () + member __.TryGetValueFSharp key = d.TryGetValue key + member __.TryGetKeyFSharp value = e.TryGetValue value + //TODO: fix conflicting naming of Item + member __.Item with get key = d.[key] and set key value = d.[key] <- value; e.[value] <- key + member __.Item with get value = e.[value] and set value key = d.[key] <- value; e.[value] <- key + member private t.D = d + member private d.E = e - member __.Add(primaryKey, value) = - k2v.Add(primaryKey, value) - v2k.Add(value, primaryKey) - member this.Add(primaryKey, key1, value) = - this.Add(primaryKey, value) - k2v.Add(key1, value) - member this.Add(primaryKey, key1 : 'Key, key2, value) = - this.Add(primaryKey, key1, value) - k2v.Add(key2, value) - member this.Add(primaryKey, key1, key2, key3, value) = - this.Add(primaryKey, key1, key2, value) - k2v.Add(key3, value) - member this.Add(primaryKey, keys : seq<_>, value) = - k2v.Add(primaryKey, value) - v2k.Add(value, primaryKey) - this.AddMoreKeys keys value - member __.AddMoreKeys keys value = for key in keys do k2v.Add(key, value) - member __.Contains key value = - match k2v.TryGetValue key with - | true, value' -> value = value' - | false, _ -> false - member __.ContainsKey key = k2v.ContainsKey key - member __.ContainsValue value = v2k.ContainsKey value - member __.CopyTo array arrayIndex = (k2v :> ICollection<_>).CopyTo(array, arrayIndex) - member __.Count = k2v.Count - member __.Clear() = k2v.Clear(); v2k.Clear() - member __.Keys = k2v.Keys - member __.Values = k2v.Values - member __.TryGetValue(key, value : byref<_>) = k2v.TryGetValue(key, &value) - member __.TryGetKey(value, key : byref<_>) = v2k.TryGetValue(value, &key) - member __.TryGetValueFSharp key = k2v.TryGetValue key - member __.TryGetKeyFSharp value = v2k.TryGetValue value - member __.Item with get key = k2v.[key] and set key value = k2v.[key] <- value; v2k.[value] <- key - member __.Item with get value = v2k.[value] and set value key = k2v.[key] <- value; v2k.[value] <- key - member __.Remove key value = - match [ for pair in k2v do if value = pair.Value then yield pair ] with - | [] -> false - | [KeyValue (key', _)] -> - if key = key' then - k2v.Remove(key) |> ignore - v2k.Remove(value) |> ignore - true - else false - | pairs -> - if List.forall (fun (KeyValue (key', _)) -> key <> key') pairs then false - else - k2v.Remove(key) |> ignore - if v2k.[value] = key then - v2k.[value] <- (List.find (fun (KeyValue (key', _)) -> key <> key') pairs).Key - true - member this.RemoveKey key = this.Remove key k2v.[key] - member __.RemoveValue value = - if v2k.Remove value then - for KeyValue (key, value') in k2v do - if value = value' then k2v.Remove(key) |> ignore - true - else false - member __.GetEnumerator() = k2v.GetEnumerator() - interface System.Collections.IEnumerable with - member this.GetEnumerator() = this.GetEnumerator() :> System.Collections.IEnumerator - interface IEnumerable> with - member this.GetEnumerator() = this.GetEnumerator() :> IEnumerator<_> - interface IReadOnlyCollection> with - member this.Count = this.Count - interface IReadOnlyDictionary<'Key, 'Value> with - member this.ContainsKey key = this.ContainsKey key - member this.Item with get(key) = this.[key] - member this.Keys = this.Keys :> seq<_> - member this.Values = this.Values :> seq<_> - member this.TryGetValue(key, value) = this.TryGetValue(key, &value) - interface ICollection> with - member this.Add (KeyValue (key, value)) = this.Add(key, value) - member this.Clear() = this.Clear() - member this.Contains (KeyValue (key, value)) = this.Contains key value - member this.CopyTo(array, arrayIndex) = this.CopyTo array arrayIndex - member this.Count = this.Count - member __.IsReadOnly = false - member this.Remove (KeyValue (key, value)) = this.Remove key value - interface IDictionary<'Key, 'Value> with - member this.Add(key, value) = this.Add(key, value) - member this.ContainsKey key = this.ContainsKey key - member this.Item with get key = this.[key] and set key value = this.[key] <- value - member this.Keys = this.Keys :> ICollection<_> - member this.Remove key = this.RemoveKey key - member this.TryGetValue(key, value : byref<_>) = this.TryGetValue(key, &value) - member this.Values = this.Values :> ICollection<_> + new(pairs:('X * ('X list) * 'Y) list) = + let dict = AliasDictionary<'X, 'Y>() + pairs |> List.iter (fun (primaryKey, secondaryKeys, value) -> + dict.Add(primaryKey, secondaryKeys, value)) + AliasDictionary(dict.D, dict.E) + /// The first of any 'X list is primary. + new(pairs:('X list * 'Y) list) = + let dict = AliasDictionary<'X, 'Y>() + pairs |> List.iter (fun (keys, value) -> + match keys with + | primaryKey::secondaryKeys -> + dict.Add(primaryKey, secondaryKeys, value) + | [] -> ()) + AliasDictionary(dict.D, dict.E) -[] -module internal AliasDictionary = - let aliasDict pairs = - let dict = AliasDictionary<_, _>() - for primaryKey, keys, value in pairs do dict.Add(primaryKey, keys = keys, value = value) - dict - let aliasDictValueMap map pairs = - let dict = AliasDictionary<_, _>() - for primaryKey, keys, value in pairs do dict.Add(primaryKey, keys = keys, value = map value) - dict - let aliasDictValueComparer valueComparer pairs = - let dict = AliasDictionary<_, _>(valueComparer) - for primaryKey, keys, value in pairs do dict.Add(primaryKey, keys = keys, value = value) - dict \ No newline at end of file + //new(map:'Y->'Z, pairs:seq<'X * seq<'X> * 'Y>) = + // let dict = AliasDictionary<'X, 'Z>() + // pairs |> Seq.iter (fun (primaryKey, secondaryKeys, value) -> + // dict.Add(primaryKey, secondaryKeys, map value)) + // AliasDictionary(dict.D, dict.E) \ No newline at end of file diff --git a/MathDisplay/MathAtom/LaTeXDefaultMaps.fs b/MathDisplay/MathAtom/LaTeXDefaultMaps.fs index 3b5a6f1..3253bd0 100644 --- a/MathDisplay/MathAtom/LaTeXDefaultMaps.fs +++ b/MathDisplay/MathAtom/LaTeXDefaultMaps.fs @@ -3,45 +3,43 @@ 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"] + [ ["."], 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] - |> aliasDictValueMap Delimiter + |> AliasDictionary -[] -let matrixEnvironments = - ["matrix", [], (".", ".") - "pmatrix", [], ("(", ")") - "bmatrix", [], ("[", "]") - "Bmatrix", [], ("{", "}") - "vmatrix", [], ("|", "|") - "Vmatrix", [], ("||", "||")] - |> aliasDictValueMap (fun (l, r) -> (Delimiters.[l], Delimiters.[r])) +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 @@ -60,7 +58,7 @@ let ``(charToAtom) <--- Unused for now....`` c = | '"' | '/' | '@' | '`' | '|' | _ -> 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"] - |> aliasDict \ No newline at end of file + [["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/MathAtom.fs b/MathDisplay/MathAtom/MathAtom.fs index 2722e2c..0d4b50a 100644 --- a/MathDisplay/MathAtom/MathAtom.fs +++ b/MathDisplay/MathAtom/MathAtom.fs @@ -4,7 +4,58 @@ 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 From bd84e27ea8a8fa0edf6d0cfb35195c98b64f1028 Mon Sep 17 00:00:00 2001 From: Charles Roddie Date: Sun, 3 Mar 2019 12:50:27 +0000 Subject: [PATCH 12/18] finish tidying AliasDictionary --- MathDisplay/DataTypes/AliasDictionary.fs | 22 +++++++++------------- MathDisplay/MathAtom/LaTeX.fs | 18 +++++++++--------- 2 files changed, 18 insertions(+), 22 deletions(-) diff --git a/MathDisplay/DataTypes/AliasDictionary.fs b/MathDisplay/DataTypes/AliasDictionary.fs index 5efd4cf..a741029 100644 --- a/MathDisplay/DataTypes/AliasDictionary.fs +++ b/MathDisplay/DataTypes/AliasDictionary.fs @@ -27,14 +27,16 @@ type AliasDictionary<'X, 'Y when 'X : equality and 'Y : equality> private(d:Dict e.Add(value, primaryAlias) this.AddMore(secondaryAliases, value) | [] -> () - member __.TryGetValueFSharp key = d.TryGetValue key - member __.TryGetKeyFSharp value = e.TryGetValue value - //TODO: fix conflicting naming of Item - member __.Item with get key = d.[key] and set key value = d.[key] <- value; e.[value] <- key - member __.Item with get value = e.[value] and set value key = d.[key] <- value; e.[value] <- key + member __.TryGetValue key = + match d.TryGetValue key with + | (true, v) -> Some v + | (false, _) -> None + member __.TryGetKey value = + match d.TryGetValue value with + | (true, v) -> Some v + | (false, _) -> None member private t.D = d member private d.E = e - new(pairs:('X * ('X list) * 'Y) list) = let dict = AliasDictionary<'X, 'Y>() pairs |> List.iter (fun (primaryKey, secondaryKeys, value) -> @@ -48,10 +50,4 @@ type AliasDictionary<'X, 'Y when 'X : equality and 'Y : equality> private(d:Dict | primaryKey::secondaryKeys -> dict.Add(primaryKey, secondaryKeys, value) | [] -> ()) - AliasDictionary(dict.D, dict.E) - - //new(map:'Y->'Z, pairs:seq<'X * seq<'X> * 'Y>) = - // let dict = AliasDictionary<'X, 'Z>() - // pairs |> Seq.iter (fun (primaryKey, secondaryKeys, value) -> - // dict.Add(primaryKey, secondaryKeys, map value)) - // AliasDictionary(dict.D, dict.E) \ No newline at end of file + AliasDictionary(dict.D, dict.E) \ No newline at end of file diff --git a/MathDisplay/MathAtom/LaTeX.fs b/MathDisplay/MathAtom/LaTeX.fs index 42a7707..9b2dce3 100644 --- a/MathDisplay/MathAtom/LaTeX.fs +++ b/MathDisplay/MathAtom/LaTeX.fs @@ -37,14 +37,14 @@ let ToAtom (settings: Options) latex = | [] -> errorArgMissing | '\\'::CommandName(cmd, cs) -> let cmd = match cmd with "|" -> "||" | _ -> cmd - match settings.Delimiters.TryGetValueFSharp cmd with - | true, v -> Ok (v, cs) - | false, _ -> errorDelimMissing cmd + match settings.Delimiters.TryGetValue cmd with + | Some v -> Ok (v, cs) + | None -> errorDelimMissing cmd | c::cs -> let c = string c - match settings.Delimiters.TryGetValueFSharp c with - | true, v -> Ok (v, cs) - | false, _ -> errorDelimMissing c + match settings.Delimiters.TryGetValue c with + | Some v -> Ok (v, cs) + | None -> errorDelimMissing c ///Reads an environment let readEnvironment cs = match cs with @@ -143,9 +143,9 @@ let ToAtom (settings: Options) latex = | _ -> read tableEnv until cs list let processAtomCommand cmd cs = - match settings.Commands.TryGetValueFSharp cmd with - | true, atom -> processAtom atom cs - | false, _ -> @"Unrecognized command: " + cmd |> Error + match settings.Commands.TryGetValue cmd with + | Some atom -> processAtom atom cs + | None -> @"Unrecognized command: " + cmd |> Error //* No calls to read in this function after this point or you risk ImplementationHasUnreadCharactersException * //* Use the arg functions! From 9640f159eddb40c98394e5f32022e9fae98e375f Mon Sep 17 00:00:00 2001 From: Charles Roddie Date: Sun, 3 Mar 2019 12:52:04 +0000 Subject: [PATCH 13/18] finish tidy of AliasDictionary --- MathDisplay/DataTypes/AliasDictionary.fs | 5 ----- MathDisplay/MathAtom/LaTeXDefaultMaps.fs | 18 +++++++++--------- 2 files changed, 9 insertions(+), 14 deletions(-) diff --git a/MathDisplay/DataTypes/AliasDictionary.fs b/MathDisplay/DataTypes/AliasDictionary.fs index a741029..7dd709a 100644 --- a/MathDisplay/DataTypes/AliasDictionary.fs +++ b/MathDisplay/DataTypes/AliasDictionary.fs @@ -37,11 +37,6 @@ type AliasDictionary<'X, 'Y when 'X : equality and 'Y : equality> private(d:Dict | (false, _) -> None member private t.D = d member private d.E = e - new(pairs:('X * ('X list) * 'Y) list) = - let dict = AliasDictionary<'X, 'Y>() - pairs |> List.iter (fun (primaryKey, secondaryKeys, value) -> - dict.Add(primaryKey, secondaryKeys, value)) - AliasDictionary(dict.D, dict.E) /// The first of any 'X list is primary. new(pairs:('X list * 'Y) list) = let dict = AliasDictionary<'X, 'Y>() diff --git a/MathDisplay/MathAtom/LaTeXDefaultMaps.fs b/MathDisplay/MathAtom/LaTeXDefaultMaps.fs index 3253bd0..ab3690a 100644 --- a/MathDisplay/MathAtom/LaTeXDefaultMaps.fs +++ b/MathDisplay/MathAtom/LaTeXDefaultMaps.fs @@ -33,12 +33,12 @@ let Delimiters = |> AliasDictionary 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)] + [ ["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 = @@ -58,7 +58,7 @@ let ``(charToAtom) <--- Unused for now....`` c = | '"' | '/' | '@' | '`' | '|' | _ -> 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"] + [ ["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 From acae9747525cc6939807244b88a389c11ee3fcdd Mon Sep 17 00:00:00 2001 From: Charles Roddie Date: Sun, 3 Mar 2019 12:56:02 +0000 Subject: [PATCH 14/18] rename collapseRow --- MathDisplay/MathAtom/LaTeX.fs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/MathDisplay/MathAtom/LaTeX.fs b/MathDisplay/MathAtom/LaTeX.fs index 9b2dce3..bb8ea32 100644 --- a/MathDisplay/MathAtom/LaTeX.fs +++ b/MathDisplay/MathAtom/LaTeX.fs @@ -23,7 +23,8 @@ exception ImplementationHasUnreadCharactersException of InputLaTeX:string * Unre 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 + /// 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 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 @@ -69,13 +70,13 @@ let ToAtom (settings: Options) latex = | '['::cs -> read tableEnv (Until ']') cs [] |> Result.bind (fun (tableEnv, cs, atoms) -> - collapse atoms |> argDict.AddOptional + 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) -> - collapse atoms |> argDict.AddRequired + collapseRow atoms |> argDict.AddRequired readArgsUntilId id tableEnv argDict cs) let rec readOptionalArgsUntilId id tableEnv (argDict:LaTeXArgumentDictionary) cs = match argDict.Optional id with @@ -85,7 +86,7 @@ let ToAtom (settings: Options) latex = | '['::cs -> read tableEnv (Until ']') cs [] |> Result.bind (fun (tableEnv, cs, atoms) -> - collapse atoms |> argDict.AddOptional + collapseRow atoms |> argDict.AddOptional readOptionalArgsUntilId id tableEnv argDict cs) | _ -> Ok (tableEnv, ValueNone, cs) @@ -168,7 +169,7 @@ let ToAtom (settings: Options) latex = |> Result.bind (fun (tableEnv, cs, list) -> readDelimiter cs |> Result.bind (fun (right, cs) -> - continueReading (tableEnv, Delimited (left, collapse list, right), cs)))) + continueReading (tableEnv, Delimited (left, collapseRow list, right), cs)))) | "right" -> match until with | UntilRightDelimiter -> (tableEnv, cs, List.rev list) |> Ok @@ -186,7 +187,7 @@ let ToAtom (settings: Options) latex = 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 From efc8bef964478c7953efd767473d6e80b0585def Mon Sep 17 00:00:00 2001 From: Charles Roddie Date: Sun, 3 Mar 2019 12:58:06 +0000 Subject: [PATCH 15/18] tidy --- MathDisplay/DataTypes/ListExtensions.fs | 1 + MathDisplay/MathAtom/LaTeX.fs | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/MathDisplay/DataTypes/ListExtensions.fs b/MathDisplay/DataTypes/ListExtensions.fs index ecad6c3..1081177 100644 --- a/MathDisplay/DataTypes/ListExtensions.fs +++ b/MathDisplay/DataTypes/ListExtensions.fs @@ -10,6 +10,7 @@ module MathDisplay.DataTypes.List | xs -> List.rev acc, xs 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 diff --git a/MathDisplay/MathAtom/LaTeX.fs b/MathDisplay/MathAtom/LaTeX.fs index bb8ea32..9106b22 100644 --- a/MathDisplay/MathAtom/LaTeX.fs +++ b/MathDisplay/MathAtom/LaTeX.fs @@ -25,7 +25,7 @@ let ToAtom (settings: Options) latex = let errorDelimMissing cmd = Error (cmd + " was not found in delimiter map") /// 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 cs = List.skipWhile System.Char.IsWhiteSpace cs + 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 From dc67af6b17125ae54fc41415a9014d9ca4558746 Mon Sep 17 00:00:00 2001 From: Charles Roddie Date: Sun, 3 Mar 2019 14:38:17 +0000 Subject: [PATCH 16/18] add Aliases property to AliasDictionary --- MathDisplay/DataTypes/AliasDictionary.fs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/MathDisplay/DataTypes/AliasDictionary.fs b/MathDisplay/DataTypes/AliasDictionary.fs index 7dd709a..ad1ed1d 100644 --- a/MathDisplay/DataTypes/AliasDictionary.fs +++ b/MathDisplay/DataTypes/AliasDictionary.fs @@ -45,4 +45,5 @@ type AliasDictionary<'X, 'Y when 'X : equality and 'Y : equality> private(d:Dict | primaryKey::secondaryKeys -> dict.Add(primaryKey, secondaryKeys, value) | [] -> ()) - AliasDictionary(dict.D, dict.E) \ No newline at end of file + AliasDictionary(dict.D, dict.E) + member __.Aliases = d.Keys \ No newline at end of file From 4004ec96b8301c07bc30cad98c7deb77d8509bbf Mon Sep 17 00:00:00 2001 From: Hadrian Tang Date: Wed, 6 Mar 2019 20:05:58 +0800 Subject: [PATCH 17/18] Simplified AliasDictionary --- MathDisplay/DataTypes/AliasDictionary.fs | 34 +++++++++++++----------- MathDisplay/MathAtom/LaTeX.fs | 18 ++++++------- MathDisplay/MathAtom/MathAtom.fs | 5 ++-- 3 files changed, 30 insertions(+), 27 deletions(-) diff --git a/MathDisplay/DataTypes/AliasDictionary.fs b/MathDisplay/DataTypes/AliasDictionary.fs index ad1ed1d..c4d1b51 100644 --- a/MathDisplay/DataTypes/AliasDictionary.fs +++ b/MathDisplay/DataTypes/AliasDictionary.fs @@ -8,6 +8,7 @@ open System.Collections.Generic /// 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) @@ -27,23 +28,26 @@ type AliasDictionary<'X, 'Y when 'X : equality and 'Y : equality> private(d:Dict e.Add(value, primaryAlias) this.AddMore(secondaryAliases, value) | [] -> () - member __.TryGetValue key = - match d.TryGetValue key with - | (true, v) -> Some v - | (false, _) -> None - member __.TryGetKey value = - match d.TryGetValue value with - | (true, v) -> Some v - | (false, _) -> None - member private t.D = d - member private d.E = e /// The first of any 'X list is primary. - new(pairs:('X list * 'Y) list) = - let dict = AliasDictionary<'X, 'Y>() + member this.AddList(pairs:('X list * 'Y) list) = pairs |> List.iter (fun (keys, value) -> match keys with | primaryKey::secondaryKeys -> - dict.Add(primaryKey, secondaryKeys, value) + this.Add(primaryKey, secondaryKeys, value) | [] -> ()) - AliasDictionary(dict.D, dict.E) - member __.Aliases = d.Keys \ No newline at end of file + /// 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/MathAtom/LaTeX.fs b/MathDisplay/MathAtom/LaTeX.fs index 9106b22..7ddc0a7 100644 --- a/MathDisplay/MathAtom/LaTeX.fs +++ b/MathDisplay/MathAtom/LaTeX.fs @@ -39,13 +39,13 @@ let ToAtom (settings: Options) latex = | '\\'::CommandName(cmd, cs) -> let cmd = match cmd with "|" -> "||" | _ -> cmd match settings.Delimiters.TryGetValue cmd with - | Some v -> Ok (v, cs) - | None -> errorDelimMissing cmd + | ValueSome v -> Ok (v, cs) + | ValueNone -> errorDelimMissing cmd | c::cs -> let c = string c match settings.Delimiters.TryGetValue c with - | Some v -> Ok (v, cs) - | None -> errorDelimMissing c + | ValueSome v -> Ok (v, cs) + | ValueNone -> errorDelimMissing c ///Reads an environment let readEnvironment cs = match cs with @@ -145,11 +145,8 @@ let ToAtom (settings: Options) latex = let processAtomCommand cmd cs = match settings.Commands.TryGetValue cmd with - | Some atom -> processAtom atom cs - | None -> @"Unrecognized command: " + cmd |> Error - - //* No calls to read in this function after this point or you risk ImplementationHasUnreadCharactersException * - //* Use the arg functions! + | ValueSome atom -> processAtom atom cs + | ValueNone -> @"Unrecognized command: " + cmd |> Error match skipSpaces cs with | [] -> @@ -191,4 +188,5 @@ let ToAtom (settings: Options) latex = | 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/MathAtom.fs b/MathDisplay/MathAtom/MathAtom.fs index 0d4b50a..c626eee 100644 --- a/MathDisplay/MathAtom/MathAtom.fs +++ b/MathDisplay/MathAtom/MathAtom.fs @@ -4,7 +4,7 @@ open MathDisplay.DataTypes [] type Accent = Accent of char [] type Operator = Operator of char type Style = class end -[][] +[] type Delimiter = | Empty | LBracket @@ -96,4 +96,5 @@ type MathAtom = //| 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 + \ No newline at end of file From 8fa8bd212130edd1dafdcf7d58714adea25e24a4 Mon Sep 17 00:00:00 2001 From: Hadrian Tang Date: Fri, 8 Mar 2019 18:24:55 +0800 Subject: [PATCH 18/18] [WIP] Working on FromAtom --- MathDisplay/DataTypes/AliasDictionary.fs | 8 ++++---- MathDisplay/MathAtom/MathAtom.fs | 16 +++++++++++++++- 2 files changed, 19 insertions(+), 5 deletions(-) diff --git a/MathDisplay/DataTypes/AliasDictionary.fs b/MathDisplay/DataTypes/AliasDictionary.fs index c4d1b51..4f2b901 100644 --- a/MathDisplay/DataTypes/AliasDictionary.fs +++ b/MathDisplay/DataTypes/AliasDictionary.fs @@ -45,9 +45,9 @@ type AliasDictionary<'X, 'Y when 'X : equality and 'Y : equality> private(d:Dict this.AddList pairs member __.TryGetKey value = match e.TryGetValue value with - | (true, v) -> ValueSome v - | (false, _) -> ValueNone + | 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 + | true, v -> ValueSome v + | false, _ -> ValueNone \ No newline at end of file diff --git a/MathDisplay/MathAtom/MathAtom.fs b/MathDisplay/MathAtom/MathAtom.fs index c626eee..7cf46af 100644 --- a/MathDisplay/MathAtom/MathAtom.fs +++ b/MathDisplay/MathAtom/MathAtom.fs @@ -97,4 +97,18 @@ type MathAtom = | 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 + +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