diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2019-02-19 11:39:51 +0100 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2019-02-19 11:39:51 +0100 |
commit | 8afbe1f7df24034dd16fdf2e89b0665b2318ae2a (patch) | |
tree | 095be830c34c4aa9682a7047f4b0e412178ab24b | |
parent | 46ae60eaca841b554ba20c6a2b7a15b43c12b4df (diff) | |
download | incremental-dfsts-8afbe1f7df24034dd16fdf2e89b0665b2318ae2a.tar incremental-dfsts-8afbe1f7df24034dd16fdf2e89b0665b2318ae2a.tar.gz incremental-dfsts-8afbe1f7df24034dd16fdf2e89b0665b2318ae2a.tar.bz2 incremental-dfsts-8afbe1f7df24034dd16fdf2e89b0665b2318ae2a.tar.xz incremental-dfsts-8afbe1f7df24034dd16fdf2e89b0665b2318ae2a.zip |
Stuff...
-rw-r--r-- | edit-lens/package.yaml | 2 | ||||
-rw-r--r-- | edit-lens/src/Control/DFST.lhs | 27 | ||||
-rw-r--r-- | edit-lens/src/Control/DFST/Lens.lhs | 345 | ||||
-rw-r--r-- | edit-lens/src/Control/FST.lhs | 161 | ||||
-rw-r--r-- | edit-lens/src/Control/FST/Lens.tex | 29 | ||||
-rw-r--r-- | edit-lens/src/Control/Lens/Edit.lhs | 2 | ||||
-rw-r--r-- | interactive-edit-lens/package.yaml | 1 | ||||
-rw-r--r-- | interactive-edit-lens/src/Interact.hs | 4 | ||||
-rw-r--r-- | interactive-edit-lens/src/Main.hs | 185 | ||||
-rw-r--r-- | stack.yaml | 3 | ||||
-rw-r--r-- | thesis.tex | 5 |
11 files changed, 541 insertions, 223 deletions
diff --git a/edit-lens/package.yaml b/edit-lens/package.yaml index 88a35ca..7455dcc 100644 --- a/edit-lens/package.yaml +++ b/edit-lens/package.yaml | |||
@@ -36,6 +36,8 @@ dependencies: | |||
36 | - mtl | 36 | - mtl |
37 | - wl-pprint | 37 | - wl-pprint |
38 | - intervals | 38 | - intervals |
39 | - universe | ||
40 | - dotgen | ||
39 | 41 | ||
40 | # ghc-options: [ -O2 ] | 42 | # ghc-options: [ -O2 ] |
41 | 43 | ||
diff --git a/edit-lens/src/Control/DFST.lhs b/edit-lens/src/Control/DFST.lhs index 6e16c74..271a13e 100644 --- a/edit-lens/src/Control/DFST.lhs +++ b/edit-lens/src/Control/DFST.lhs | |||
@@ -10,9 +10,10 @@ module Control.DFST | |||
10 | ( DFST(..) | 10 | ( DFST(..) |
11 | , runDFST, runDFST' | 11 | , runDFST, runDFST' |
12 | , toFST | 12 | , toFST |
13 | , dotDFST | ||
13 | ) where | 14 | ) where |
14 | 15 | ||
15 | import Data.Map.Lazy (Map, (!?)) | 16 | import Data.Map.Lazy (Map, (!?), (!)) |
16 | import qualified Data.Map.Lazy as Map | 17 | import qualified Data.Map.Lazy as Map |
17 | 18 | ||
18 | import Data.Set (Set) | 19 | import Data.Set (Set) |
@@ -21,6 +22,8 @@ import qualified Data.Set as Set | |||
21 | import Data.Sequence (Seq(..)) | 22 | import Data.Sequence (Seq(..)) |
22 | import qualified Data.Sequence as Seq | 23 | import qualified Data.Sequence as Seq |
23 | 24 | ||
25 | import Data.Bool (bool) | ||
26 | |||
24 | import Data.Monoid | 27 | import Data.Monoid |
25 | 28 | ||
26 | import Numeric.Natural | 29 | import Numeric.Natural |
@@ -30,6 +33,8 @@ import Control.Monad.State | |||
30 | 33 | ||
31 | import Control.FST (FST(FST)) | 34 | import Control.FST (FST(FST)) |
32 | import qualified Control.FST as FST | 35 | import qualified Control.FST as FST |
36 | |||
37 | import Text.Dot | ||
33 | \end{code} | 38 | \end{code} |
34 | \end{comment} | 39 | \end{comment} |
35 | 40 | ||
@@ -39,6 +44,10 @@ import qualified Control.FST as FST | |||
39 | Zusätzlich ändern wir die Darstellung indem wir $\epsilon$-Transitionen kontrahieren. | 44 | Zusätzlich ändern wir die Darstellung indem wir $\epsilon$-Transitionen kontrahieren. |
40 | Wir erweitern hierfür die Ausgabe pro Transition von einem einzelnen Zeichen zu einem Wort beliebiger Länge und fügen, bei jeder Kontraktion einer $\epsilon$-Transition $A \rightarrow B$, die Ausgabe der Transition vorne an die Ausgabe aller Transitionen $B \rightarrow \ast$ von $B$ an. | 45 | Wir erweitern hierfür die Ausgabe pro Transition von einem einzelnen Zeichen zu einem Wort beliebiger Länge und fügen, bei jeder Kontraktion einer $\epsilon$-Transition $A \rightarrow B$, die Ausgabe der Transition vorne an die Ausgabe aller Transitionen $B \rightarrow \ast$ von $B$ an. |
41 | \end{defn} | 46 | \end{defn} |
47 | |||
48 | \begin{rem} | ||
49 | Die FSTs aus den bisherigen Beispielen \ref{eg:linebreak}, \ref{eg:w100}, \ref{eg:l80timesw100} sind deterministisch. | ||
50 | \end{rem} | ||
42 | 51 | ||
43 | \begin{code} | 52 | \begin{code} |
44 | data DFST state input output = DFST | 53 | data DFST state input output = DFST |
@@ -105,5 +114,21 @@ runDFST' _ st Empty acc = (acc, Just st) | |||
105 | runDFST' dfst@DFST{..} st (c :<| cs) acc = case stTransition !? (st, c) of | 114 | runDFST' dfst@DFST{..} st (c :<| cs) acc = case stTransition !? (st, c) of |
106 | Just (st', mc') -> runDFST' dfst st' cs $ acc <> mc' | 115 | Just (st', mc') -> runDFST' dfst st' cs $ acc <> mc' |
107 | Nothing -> (acc, Nothing) | 116 | Nothing -> (acc, Nothing) |
117 | |||
118 | dotDFST :: forall state input output. (Ord state, Ord input, Ord output, Show state, Show input, Show output) => DFST state input output -> Dot () | ||
119 | dotDFST DFST{..} = do | ||
120 | let | ||
121 | stTransition' = Map.toList stTransition | ||
122 | states = Set.singleton stInitial <> stAccept <> foldMap (Set.singleton . fst . fst) stTransition' <> foldMap (Set.singleton . fst . snd) stTransition' | ||
123 | stateIds <- sequence . (flip Map.fromSet) states $ \st -> node | ||
124 | [ ("label", show st) | ||
125 | , ("peripheries", bool "1" "2" $ st `Set.member` stAccept) | ||
126 | ] | ||
127 | init <- node [ ("label", ""), ("shape", "none") ] | ||
128 | init .->. (stateIds ! stInitial) | ||
129 | forM_ stTransition' $ \((f, inS), (t, outS)) -> do | ||
130 | edge (stateIds ! f) (stateIds ! t) | ||
131 | [ ("label", show (inS, outS)) | ||
132 | ] | ||
108 | \end{code} | 133 | \end{code} |
109 | \end{comment} | 134 | \end{comment} |
diff --git a/edit-lens/src/Control/DFST/Lens.lhs b/edit-lens/src/Control/DFST/Lens.lhs index fe33bd6..1e5bbb1 100644 --- a/edit-lens/src/Control/DFST/Lens.lhs +++ b/edit-lens/src/Control/DFST/Lens.lhs | |||
@@ -37,6 +37,9 @@ import qualified Data.Set as Set | |||
37 | import Data.Map.Lazy (Map) | 37 | import Data.Map.Lazy (Map) |
38 | import qualified Data.Map.Lazy as Map | 38 | import qualified Data.Map.Lazy as Map |
39 | 39 | ||
40 | import qualified Data.Map as Strict (Map) | ||
41 | import qualified Data.Map.Strict as Strict.Map | ||
42 | |||
40 | import Data.Compositions (Compositions) | 43 | import Data.Compositions (Compositions) |
41 | import qualified Data.Compositions as Comp | 44 | import qualified Data.Compositions as Comp |
42 | 45 | ||
@@ -45,23 +48,26 @@ import qualified Data.Algorithm.Diff as Diff | |||
45 | 48 | ||
46 | import Data.Monoid | 49 | import Data.Monoid |
47 | import Data.Bool (bool) | 50 | import Data.Bool (bool) |
48 | import Data.Maybe (fromMaybe, maybeToList, listToMaybe, catMaybes, isNothing, isJust) | 51 | import Data.Maybe (fromMaybe, maybeToList, listToMaybe, catMaybes, isNothing, isJust, mapMaybe) |
49 | import Data.Function (on) | 52 | import Data.Function (on) |
50 | import Data.Foldable (toList) | 53 | import Data.Foldable (toList) |
51 | import Data.List (partition) | 54 | import Data.List (partition, isPrefixOf) |
52 | 55 | ||
53 | import Control.Exception (assert) | 56 | import Control.Exception (assert) |
54 | 57 | ||
58 | import System.IO (Handle, hPutStrLn, IOMode(AppendMode), withFile) | ||
55 | import System.IO.Unsafe | 59 | import System.IO.Unsafe |
56 | import Text.PrettyPrint.Leijen (Pretty(..)) | 60 | import Text.PrettyPrint.Leijen (Pretty(..)) |
57 | 61 | ||
62 | import Data.Universe (Finite(..)) | ||
63 | |||
58 | \end{code} | 64 | \end{code} |
59 | \end{comment} | 65 | \end{comment} |
60 | 66 | ||
61 | 67 | ||
62 | Wir betrachten, zur Einfachheit, ein minimiales Set von Edits auf Strings\footnote{Wie in der Konstruktion zum Longest Common Subsequence Problem}: | ||
63 | |||
64 | \begin{defn}[Atomare edits of strings] | 68 | \begin{defn}[Atomare edits of strings] |
69 | Wir betrachten, zur Einfachheit, ein minimiales Set von Edits auf Strings\footnote{Wie in der Konstruktion zum Longest Common Subsequence Problem}, bestehend nur aus Einfügung eines einzelnen Zeichens und löschen des Zeichens an einer einzelnen Position: | ||
70 | |||
65 | \begin{code} | 71 | \begin{code} |
66 | data StringEdit pos char = Insert { _sePos :: pos, _seInsertion :: char } | 72 | data StringEdit pos char = Insert { _sePos :: pos, _seInsertion :: char } |
67 | | Delete { _sePos :: pos } | 73 | | Delete { _sePos :: pos } |
@@ -73,7 +79,6 @@ data StringEdit pos char = Insert { _sePos :: pos, _seInsertion :: char } | |||
73 | -- @seInsertion :: Traversal' (StringEdits pos char) char@ | 79 | -- @seInsertion :: Traversal' (StringEdits pos char) char@ |
74 | makeLenses ''StringEdit | 80 | makeLenses ''StringEdit |
75 | \end{code} | 81 | \end{code} |
76 | \end{defn} | ||
77 | 82 | ||
78 | Atomare edits werden, als Liste, zu edits komponiert. | 83 | Atomare edits werden, als Liste, zu edits komponiert. |
79 | Wir führen einen speziellen edit ein, der nicht-Anwendbarkeit der edits repräsentiert: | 84 | Wir führen einen speziellen edit ein, der nicht-Anwendbarkeit der edits repräsentiert: |
@@ -86,32 +91,19 @@ makePrisms ''StringEdits | |||
86 | 91 | ||
87 | stringEdits :: Traversal (StringEdits pos char) (StringEdits pos' char') (StringEdit pos char) (StringEdit pos' char') | 92 | stringEdits :: Traversal (StringEdits pos char) (StringEdits pos' char') (StringEdit pos char) (StringEdit pos' char') |
88 | \end{code} | 93 | \end{code} |
94 | \end{defn} | ||
95 | |||
89 | \begin{comment} | 96 | \begin{comment} |
90 | \begin{code} | 97 | \begin{code} |
91 | stringEdits = _StringEdits . traverse | 98 | stringEdits = _StringEdits . traverse |
92 | \end{code} | 99 | |
93 | \end{comment} | ||
94 | \begin{code} | ||
95 | insert :: pos -> char -> StringEdits pos char | 100 | insert :: pos -> char -> StringEdits pos char |
96 | \end{code} | ||
97 | \begin{comment} | ||
98 | \begin{code} | ||
99 | insert n c = StringEdits . Seq.singleton $ Insert n c | 101 | insert n c = StringEdits . Seq.singleton $ Insert n c |
100 | \end{code} | 102 | |
101 | \end{comment} | ||
102 | \begin{code} | ||
103 | delete :: pos -> StringEdits pos char | 103 | delete :: pos -> StringEdits pos char |
104 | \end{code} | ||
105 | \begin{comment} | ||
106 | \begin{code} | ||
107 | delete n = StringEdits . Seq.singleton $ Delete n | 104 | delete n = StringEdits . Seq.singleton $ Delete n |
108 | \end{code} | 105 | |
109 | \end{comment} | ||
110 | \begin{code} | ||
111 | replace :: Eq pos => pos -> char -> StringEdits pos char | 106 | replace :: Eq pos => pos -> char -> StringEdits pos char |
112 | \end{code} | ||
113 | \begin{comment} | ||
114 | \begin{code} | ||
115 | replace n c = insert n c <> delete n | 107 | replace n c = insert n c <> delete n |
116 | 108 | ||
117 | -- | Rudimentarily optimize edit composition | 109 | -- | Rudimentarily optimize edit composition |
@@ -130,7 +122,7 @@ instance Eq pos => Monoid (StringEdits pos char) where | |||
130 | \end{code} | 122 | \end{code} |
131 | \end{comment} | 123 | \end{comment} |
132 | 124 | ||
133 | Da wir ein minimales set an atomaren edits gewählt haben, ist die Definiton der Modulnstruktur über Strings des passenden Alphabets recht einfach: | 125 | Da wir ein minimales Set an atomaren edits gewählt haben, ist die Definiton der Modulnstruktur über Strings des passenden Alphabets recht einfach: |
134 | \begin{code} | 126 | \begin{code} |
135 | instance Module (StringEdits Natural char) where | 127 | instance Module (StringEdits Natural char) where |
136 | type Domain (StringEdits Natural char) = Seq char | 128 | type Domain (StringEdits Natural char) = Seq char |
@@ -159,12 +151,6 @@ instance Module (StringEdits Natural char) where | |||
159 | 151 | ||
160 | \end{code} | 152 | \end{code} |
161 | 153 | ||
162 | % TODO Make notation mathy | ||
163 | |||
164 | Um zunächst eine asymmetrische edit-lens \texttt{StringEdits -> StringEdits} mit akzeptabler Komplexität für einen bestimmten DFST (entlang der \emph{Richtung} des DFSTs) zu konstruieren möchten wir folgendes Verfahren anwenden: | ||
165 | |||
166 | Gegeben eine Sequenz von zu übersetzenden Änderungen genügt es die Übersetzung eines einzelnen \texttt{StringEdit}s in eine womöglich längere Sequenz von \texttt{StringEdits} anzugeben, alle \texttt{StringEdits} aus der Sequenz derart zu übersetzen (hierbei muss auf die korrekte Handhabung des Komplements geachtet werden) und jene Übersetzungen dann zu concatenieren. | ||
167 | |||
168 | Wir definieren zunächst die \emph{Wirkung} eines DFST auf einen festen String als eine Abbildung \texttt{state -> (Seq output, Maybe state)}, die den aktuellen Zustand vor dem Parsen des Strings auf den Zustand danach und die (womöglich leere) Ausgabe schickt. | 154 | Wir definieren zunächst die \emph{Wirkung} eines DFST auf einen festen String als eine Abbildung \texttt{state -> (Seq output, Maybe state)}, die den aktuellen Zustand vor dem Parsen des Strings auf den Zustand danach und die (womöglich leere) Ausgabe schickt. |
169 | Wir annotieren Wirkungen zudem mit dem konsumierten String. | 155 | Wir annotieren Wirkungen zudem mit dem konsumierten String. |
170 | Diese Wirkungen bilden einen Monoiden analog zu Endomorphismen, wobei die Resultat-Strings concateniert werden. | 156 | Diese Wirkungen bilden einen Monoiden analog zu Endomorphismen, wobei die Resultat-Strings concateniert werden. |
@@ -189,10 +175,30 @@ instance Monoid (DFSTAction state input output) where | |||
189 | } | 175 | } |
190 | \end{code} | 176 | \end{code} |
191 | \end{comment} | 177 | \end{comment} |
178 | |||
192 | \begin{code} | 179 | \begin{code} |
180 | dfstAction :: forall state input output. (Finite state, Ord state, Ord input) => DFST state input output -> input -> DFSTAction state input output | ||
181 | -- | Smart constructor of `DFSTAction` ensuring that `Seq.length . dfstaConsumes == const 1` and that `runDFSTAction` has constant complexity | ||
182 | \end{code} | ||
183 | \begin{comment} | ||
184 | \begin{code} | ||
185 | dfstAction dfst (Seq.singleton -> dfstaConsumes) = DFSTAction{..} | ||
186 | where | ||
187 | runDFSTAction :: state -> (Seq output, Maybe state) | ||
188 | runDFSTAction = (actionMap Strict.Map.!) | ||
189 | |||
190 | actionMap :: Strict.Map state (Seq output, Maybe state) | ||
191 | actionMap = Strict.Map.fromSet (\st -> runDFST' dfst st dfstaConsumes Seq.empty) $ Set.fromList universeF | ||
192 | \end{code} | ||
193 | \end{comment} | ||
193 | 194 | ||
195 | Wir halten im Komplement der edit-lens einen Cache der monoidalen Summen aller kontinuirlichen Teillisten. | ||
196 | \texttt{Compositions} ist ein balancierter Binärbaum, dessen innere Knoten mit der monoidalen Summe der Annotationen aller Blätter annotiert sind. | ||
197 | \begin{code} | ||
194 | type DFSTComplement state input output = Compositions (DFSTAction state input output) | 198 | type DFSTComplement state input output = Compositions (DFSTAction state input output) |
199 | \end{code} | ||
195 | 200 | ||
201 | \begin{code} | ||
196 | runDFSTAction' :: DFSTComplement state input output -> state -> (Seq output, Maybe state) | 202 | runDFSTAction' :: DFSTComplement state input output -> state -> (Seq output, Maybe state) |
197 | runDFSTAction' = runDFSTAction . Comp.composed | 203 | runDFSTAction' = runDFSTAction . Comp.composed |
198 | 204 | ||
@@ -203,28 +209,22 @@ dfstaProduces :: DFSTComplement state input output -> state -> Seq output | |||
203 | dfstaProduces = fmap fst . runDFSTAction' | 209 | dfstaProduces = fmap fst . runDFSTAction' |
204 | \end{code} | 210 | \end{code} |
205 | 211 | ||
206 | Die Unterliegende Idee von $\Rrightarrow$ ist nun im Komplement der edit-lens eine Liste von Wirkungen (eine für jedes Zeichen der Eingabe des DFSTs) und einen Cache der monoidalen Summen aller kontinuirlichen Teillisten zu halten. | 212 | Für $\Rrightarrow$ können wir die alte DFST-Wirkung zunächst anhand des Intervalls indem der input-String von allen gegebenen edits betroffen ist (\texttt{affected}) in einen unveränderten Prefix und einen womöglich betroffenen Suffix unterteilen. |
207 | |||
208 | Wir können die alte DFST-Wirkung zunächst anhand des Intervalls indem der input-String von allen gegebenen edits betroffen ist in einen unveränderten Prefix und einen womöglich betroffenen Suffix unterteilen. | ||
209 | 213 | ||
210 | Da wir wissen welche Stelle im input-String vom ersten gegebenen edit betroffen ist können wir, anhand der Wirkung des Teilstücks bis zu jener Stelle, den betroffenen Suffix wiederum teilen. | 214 | Da wir wissen welche Stelle im input-String vom ersten gegebenen edit betroffen ist können wir, anhand der Wirkung des Teilstücks bis zu jener Stelle, den betroffenen Suffix wiederum teilen. |
211 | Die Wirkung ab der betroffenen Stelle im input-String können wir als Komposition der Wirkung der durch den edit betroffenen Stelle und derer aller Zeichen danach bestimmen. | 215 | Die Wirkung ab der betroffenen Stelle im input-String können wir als Komposition der Wirkung der durch den edit betroffenen Stelle und derer aller Zeichen danach bestimmen. |
212 | Nun gilt es nur noch die Differenz (als `StringEdits`) des vorherigen Suffixes im output-String und des aus der gerade berechneten Wirkung zu bestimmen, wir bedienen uns hierzu dem Unix Standard-Diff-Algorithmus zwischen der ursprünglichen Ausgabe und dem Ergebnis der Iteration des Verfahrens auf alle gegebenen edits. | 216 | Nun gilt es nur noch die Differenz (als `StringEdits`) des vorherigen Suffixes im output-String und des aus der gerade berechneten Wirkung zu bestimmen, wir bedienen uns hierzu dem Unix Standard-Diff-Algorithmus zwischen der ursprünglichen Ausgabe und dem Ergebnis der Iteration des Verfahrens auf alle gegebenen edits. |
213 | 217 | ||
214 | Für die asymmetrische edit-lens entgegen der DFST-Richtung $\Lleftarrow$ verwenden wir Breitensuche über die Zustände des DFST innerhalb eines iterative vergrößerten Intervalls: | 218 | Für die asymmetrische edit-lens entgegen der DFST-Richtung $\Lleftarrow$ verwenden wir Breitensuche über die Zustände des DFST innerhalb des von allen gegeben edits betroffenen Intervalls: |
215 | |||
216 | Wir bestimmen zunächst (`affected`) eine obere Schranke an das Intervall in dem der Ausgabe-String vom edit betroffen ist und generieren eine von dort quadratisch wachsende Serie von Intervallen. | ||
217 | 219 | ||
218 | Für jedes Intervall ("lokalere" Änderungen werden präferiert) schränken wir zunächst den DFST (zur einfachereren Implementierung in seiner Darstellung als FST) vermöge \texttt{restrictOutput} derart ein, dass nur die gewünschte Ausgabe produziert werden kann. | 220 | Wir unterteilen zunächst das Komplement an den Grenzen des betroffenen Intervalls im output-String in drei Teile (durch Akkumulation der Elemente des Komplements bis die gewünschte Länge erreicht ist). |
219 | 221 | ||
220 | Wir betrachten dann in jedem Schritt (beginnend mit dem initialen Zustand des DFST) alle ausgehenden Transitionen und ziehen hierbei jene vor, die im vorherigen Lauf (gespeichert im Komplement der edit-lens), ebenfalls genommen wurden. | 222 | Wir transformieren dann den DFST in einen FST, dessen Ausgabe wir mit \texttt{restrictOutput} auf das gewünschte Fragment einschränken, setzen als initialen Zustand des FST den Zustand am linken Rand des von den edits betroffenen Intervalls und akzeptieren jene Zustände, von denen aus das Komplement-Fragment ab dem rechten Rand des betroffenen Intervalls zu einem im ursprünglichen DFST akzeptierten Zustand führt. |
221 | Abweichungen vom im Komplement gespeicherten Lauf lassen wir nur innerhalb des betrachteten Intervalls zu und wählen in diesem Fall einen Edit auf der Eingabe, der die gewählte Abweichung produziert. | ||
222 | Es wird zudem, wie für Breitensuche üblich, jeder besuchte Zustand markiert und ausgehende Transitionen nicht ein zweites mal betrachtet. | ||
223 | 223 | ||
224 | Erreichen wir einen finalen Zustand (wegen der Einschränkung des DFSTs wurde dann auch genau die gewünschte Ausgabe produziert), so fügen wir an die gesammelten Eingabe-edits eine Serie von deletions an, die den noch nicht konsumierten suffix der Eingabe verwerfen und brechen die Suche unter Rückgabe der Eingabe-edits und des neuen Laufs ab. | 224 | Wir verwenden dann gewöhnliche Breitensuche über die Zustände und Transitionen des soeben konstruierten FSTs um einen Lauf-Fragment zu bestimmen, dass wir in das betroffene Intervall einsetzen können. |
225 | Hierbei sind sämtliche Randbedingungen (korrekte Ausgabe, Übereinstimmung an den Intervallgrenzen) bereits in den FST kodiert sodass wir nur noch prüfen müssen, dass der gefunde Lauf in einem akzeptierten Zustand endet. | ||
225 | 226 | ||
226 | In Haskell formulieren wir das vorzeitige Abbrechen der Suche indem wir eine vollständige Liste von Rückgabe-Kandidaten konstruieren und dann immer ihr erstes Element zurück geben. | 227 | Die input-edits können nun wiederum, unter Beachtung der Verschiebung der indices um die Länge der Eingabe vor der linken Intervallgrenze, mit dem Unix Standard-Diff-Algorithmus berechnet werden. |
227 | Wegen der verzögerten Auswertungsstrategie von Haskell wird auch tatsächlich nur der erste Rückgabe-Kandidat konstruiert. | ||
228 | 228 | ||
229 | \begin{comment} | 229 | \begin{comment} |
230 | \begin{code} | 230 | \begin{code} |
@@ -232,7 +232,7 @@ type LState state input output = (Natural, (state, Maybe (input, Natural))) | |||
232 | \end{code} | 232 | \end{code} |
233 | \end{comment} | 233 | \end{comment} |
234 | \begin{code} | 234 | \begin{code} |
235 | dfstLens :: forall state input output. (Ord state, Ord input, Ord output, Show state, Show input, Show output) => DFST state input output -> EditLens (DFSTComplement state input output) (StringEdits Natural input) (StringEdits Natural output) | 235 | dfstLens :: forall state input output. (Ord state, Ord input, Ord output, Show state, Show input, Show output, Finite state) => DFST state input output -> EditLens (DFSTComplement state input output) (StringEdits Natural input) (StringEdits Natural output) |
236 | \end{code} | 236 | \end{code} |
237 | \begin{comment} | 237 | \begin{comment} |
238 | \begin{code} | 238 | \begin{code} |
@@ -244,166 +244,108 @@ dfstLens dfst@DFST{..} = EditLens ground propR propL | |||
244 | propR :: (DFSTComplement state input output, StringEdits Natural input) -> (DFSTComplement state input output, StringEdits Natural output) | 244 | propR :: (DFSTComplement state input output, StringEdits Natural input) -> (DFSTComplement state input output, StringEdits Natural output) |
245 | propR (c, SEFail) = (c, SEFail) | 245 | propR (c, SEFail) = (c, SEFail) |
246 | propR (c, StringEdits Seq.Empty) = (c, mempty) | 246 | propR (c, StringEdits Seq.Empty) = (c, mempty) |
247 | propR (c, es'@(StringEdits (es :> e))) | 247 | propR (c, lEs@(StringEdits (es :> e))) |
248 | | (_, Just final) <- runDFSTAction' c' stInitial | 248 | | (_, Just final) <- runDFSTAction' c' stInitial |
249 | , final `Set.member` stAccept | 249 | , final `Set.member` stAccept |
250 | = (c', rEs) | 250 | = (c', rEs) |
251 | | otherwise | 251 | | otherwise |
252 | = (c, SEFail) | 252 | = (c, SEFail) |
253 | where | 253 | where |
254 | Just int = affected es' | 254 | Just int = affected lEs |
255 | (cAffSuffix, cAffPrefix) = Comp.splitAt (Comp.length c - fromIntegral (Int.inf int)) c | 255 | (cAffSuffix, cAffPrefix) = Comp.splitAt (Comp.length c - fromIntegral (Int.inf int)) c |
256 | (cSuffix, cPrefix) = Comp.splitAt (Comp.length c - (e ^. sePos . from enum)) c | 256 | (cSuffix, cPrefix) = Comp.splitAt (Comp.length c - (e ^. sePos . from enum)) c |
257 | cSuffix' | 257 | cSuffix' |
258 | | Delete _ <- e | 258 | | Delete _ <- e |
259 | , Comp.length cSuffix > 0 = Comp.take (pred $ Comp.length cSuffix) cSuffix | 259 | , Comp.length cSuffix > 0 = Comp.take (pred $ Comp.length cSuffix) cSuffix |
260 | | Insert _ nChar <- e = cSuffix <> Comp.singleton (DFSTAction (\x -> runDFST' dfst x (pure nChar) Seq.empty) (Seq.singleton nChar)) | 260 | | Insert _ nChar <- e = cSuffix <> Comp.singleton (dfstAction dfst nChar) |
261 | | otherwise = Comp.singleton $ DFSTAction (\_ -> (Seq.empty, Nothing)) Seq.empty | 261 | | otherwise = Comp.singleton $ DFSTAction (\_ -> (Seq.empty, Nothing)) Seq.empty |
262 | (c', _) = propR (cSuffix' <> cPrefix, StringEdits es) | 262 | (c', _) = propR (cSuffix' <> cPrefix, StringEdits es) |
263 | (cAffSuffix', _) = Comp.splitAt (Comp.length c' - Comp.length cAffPrefix) c' | 263 | (cAffSuffix', _) = Comp.splitAt (Comp.length c' - Comp.length cAffPrefix) c' |
264 | (_, Just pFinal) = runDFSTAction' cPrefix stInitial | 264 | (_, Just pFinal) = runDFSTAction' cAffPrefix stInitial |
265 | rEs = strDiff (fst $ runDFSTAction' cAffSuffix pFinal) (fst $ runDFSTAction' cAffSuffix' pFinal) & stringEdits . sePos . from enum +~ length (dfstaProduces cAffPrefix stInitial) | 265 | rEs = strDiff (dfstaProduces cAffSuffix pFinal) (dfstaProduces cAffSuffix' pFinal) & stringEdits . sePos . from enum +~ length (dfstaProduces cAffPrefix stInitial) |
266 | 266 | ||
267 | 267 | ||
268 | propL :: (DFSTComplement state input output, StringEdits Natural output) -> (DFSTComplement state input output, StringEdits Natural input) | 268 | propL :: (DFSTComplement state input output, StringEdits Natural output) -> (DFSTComplement state input output, StringEdits Natural input) |
269 | propL (c, StringEdits Seq.Empty) = (c, mempty) | 269 | propL (c, StringEdits Seq.Empty) = (c, mempty) |
270 | propL (c, es) = fromMaybe (c, SEFail) $ do | 270 | propL (c, es) = fromMaybe (c, SEFail) $ do |
271 | let prevOut = dfstaProduces c stInitial | 271 | -- Determine states @(iState, fState)@ at the boundary of the region affected by @es@ |
272 | newOut <- prevOut `apply` es | 272 | ((,) <$> Int.inf <*> Int.sup -> (minAff, maxAff)) <- affected es |
273 | affected' <- affected es | 273 | trace (show (minAff, maxAff)) $ Just () |
274 | let | ||
275 | prevTrans :: Natural -> Maybe ( DFSTComplement state input output -- ^ Run after chosen transition to accepting state | ||
276 | , (state, input, Seq output, state) | ||
277 | , DFSTComplement state input output -- ^ Run from `stInitial` up to chosen transition | ||
278 | ) | ||
279 | -- ^ Given an index in the output, find the associated transition in @c@ | ||
280 | prevTrans needle = do | ||
281 | let (after, before) = prevTrans' (c, mempty) | ||
282 | transSt <- view _2 $ runDFSTAction (Comp.composed before) stInitial | ||
283 | trace ("transSt = " ++ show transSt) $ Just () | ||
284 | let (after', trans) = Comp.splitAt (pred $ Comp.length after) after | ||
285 | DFSTAction{..} = Comp.composed trans | ||
286 | [inS] <- return $ toList dfstaConsumes | ||
287 | (outSs , Just postTransSt) <- return $ runDFSTAction transSt | ||
288 | return (after', (transSt, inS, outSs, postTransSt), before) | ||
289 | where | ||
290 | -- | Move monoid summands from @after@ to @before@ until first transition of @after@ produces @needle@ or @after@ is a singleton | ||
291 | prevTrans' (after, before) | ||
292 | | producedNext > needle = (after, before) | ||
293 | | Comp.length after == 1 = (after, before) | ||
294 | | otherwise = prevTrans' (after', before') | ||
295 | where | ||
296 | producedNext = fromIntegral . Seq.length . traceShowId $ dfstaProduces before' stInitial | ||
297 | (after', nextTrans) = Comp.splitAt (pred $ Comp.length after) after | ||
298 | before' = nextTrans `mappend` before | ||
299 | (_, (iState, _, _, _), prefix) <- prevTrans minAff | ||
300 | trace (show (iState, Comp.length prefix)) $ Just () | ||
301 | (suffix, (pfState, _, _, fState), _) <- prevTrans maxAff | ||
302 | trace (show (pfState, fState, Comp.length suffix)) $ Just () | ||
303 | |||
304 | newOut <- dfstaProduces c stInitial `apply` es | ||
305 | let affNewOut = (\s -> Seq.take (Seq.length s - Seq.length (dfstaProduces suffix fState)) s) $ Seq.drop (Seq.length $ dfstaProduces prefix stInitial) newOut | ||
306 | trace (show (iState, fState, affNewOut)) $ Just () | ||
307 | |||
274 | let outFST :: FST (LState state input output) input output | 308 | let outFST :: FST (LState state input output) input output |
275 | -- outFST = wordFST newOut `productFST` toFST dfst | 309 | outFST = restrictOutput affNewOut $ toFST DFST |
276 | outFST = restrictOutput newOut $ toFST dfst | 310 | { stInitial = iState |
277 | 311 | , stTransition | |
278 | trace x y = flip seq y . unsafePerformIO $ appendFile "lens.log" (x <> "\n\n") | 312 | , stAccept = Set.fromList $ do |
279 | 313 | fin <- Set.toList $ stAccept `Set.union` Set.map fst (Map.keysSet stTransition) | |
280 | inflate by int | 314 | (suffOut, Just fin') <- return $ runDFSTAction' suffix fin |
281 | | Int.null int = Int.empty | 315 | guard $ Set.member fin' stAccept |
282 | | inf >= by = inf - by Int.... sup + by | 316 | guard $ suffOut == dfstaProduces suffix fState |
283 | | otherwise = 0 Int.... sup + by | 317 | return fin |
284 | where | 318 | } |
285 | (inf, sup) = (,) <$> Int.inf <*> Int.sup $ int | 319 | trace (show $ pretty outFST) $ Just () |
286 | fragmentIntervals = (++ [all]) . takeWhile (not . Int.isSubsetOf (0 Int.... max)) $ inflate <$> 0 : [ 2^n | n <- [0..ceiling (logBase 2.0 max)] ] <*> pure affected' | 320 | |
287 | where | 321 | newPath <- |
288 | max :: Num a => a | 322 | let |
289 | max = fromIntegral $ Seq.length newOut | 323 | FST{ .. } = outFST |
290 | all = 0 Int.... max | 324 | detOutgoing :: Maybe (LState state input output) -> [(LState state input output, (Maybe input, Maybe output))] |
291 | runCandidates :: Interval Natural -- ^ Departure from complement-run only permitted within interval (to guarantee locality) | 325 | detOutgoing Nothing = concatMap detOutgoing . map Just $ toList stInitial |
292 | -> [ ( Seq (LState state input output, Maybe output) -- ^ Computed run | 326 | detOutgoing (Just st) = concatMap (\((_, inS), outs) -> map (\(st', outS) -> (st', (inS, outS))) $ toList outs) . Map.toList $ Map.filterWithKey (\(st', _) _ -> st == st') stTransition |
293 | , StringEdits Natural input | 327 | predicate :: [(LState state input output, (Maybe input, Maybe output))] -> Maybe Bool |
294 | , DFSTComplement state input output | 328 | predicate [] |
295 | ) | 329 | | not . Set.null $ Set.intersection stInitial stAccept = Just True |
296 | ] | 330 | | otherwise = Nothing |
297 | runCandidates focus = map ((,,) <$> view _1 <*> view _2 <*> view (_3 . _2)) $ go Set.empty [(Seq.empty, mempty, (c, mempty), 0)] | 331 | predicate ((lastSt, _) : _) |
298 | where | 332 | | Set.member lastSt stAccept = Just True |
299 | go _ [] = [] | 333 | | otherwise = Nothing |
300 | go visited (args@(run, edits, compZipper, inP) : alts) = | 334 | in bfs detOutgoing predicate |
301 | [ (run', finalizeEdits remC inP' edits', compZipper', inP') | (run', edits', compZipper'@(remC, _), inP') <- args : conts, isFinal run' ] | 335 | |
302 | ++ go visited' (alts ++ conts) | 336 | trace (show newPath) $ Just () |
303 | where | 337 | |
304 | conts | 338 | let oldIn = dfstaConsumes' . Comp.drop (Comp.length suffix) $ Comp.take (Comp.length c - Comp.length prefix) c |
305 | | lastSt <- view _1 <$> Seq.lookup (pred $ Seq.length run) run | 339 | newIn = Seq.fromList . mapMaybe (\(_st, (inS, _outS)) -> inS) $ reverse newPath |
306 | , lastSt `Set.member` visited = [] | 340 | inDiff = oldIn `strDiff` newIn |
307 | | otherwise = continueRun edits compZipper inP run | 341 | diffOffset = fromIntegral . Seq.length $ dfstaConsumes' prefix |
308 | visited' = Set.insert (view _1 <$> Seq.lookup (pred $ Seq.length run) run) visited | 342 | inDiff' = inDiff & stringEdits . sePos +~ diffOffset |
309 | 343 | ||
310 | isFinal :: Seq (LState state input output, Maybe output) -> Bool | 344 | trace (show (oldIn, newIn, inDiff')) $ Just () |
311 | -- ^ Is the final state of the run a final state of the DFST? | 345 | |
312 | isFinal Seq.Empty = (0, (stInitial, Nothing)) `Set.member` FST.stAccept outFST | 346 | let affComp = Comp.fromList [ dfstAction dfst inS | (_st, (Just inS, _outS)) <- newPath ] |
313 | && (0 Int.... fromIntegral (Seq.length newOut)) `Int.isSubsetOf` focus | 347 | |
314 | isFinal (_ :> (lastSt, _)) = lastSt `Set.member` FST.stAccept outFST | 348 | return (suffix <> affComp <> prefix, inDiff') |
315 | |||
316 | finalizeEdits :: DFSTComplement state input output -- ^ Remaining complement | ||
317 | -> Natural -- ^ Input position | ||
318 | -> StringEdits Natural input -> StringEdits Natural input | ||
319 | finalizeEdits remC inP = mappend . mconcat . replicate (Seq.length $ dfstaConsumes' remC) $ delete inP | ||
320 | |||
321 | continueRun :: StringEdits Natural input | ||
322 | -> (DFSTComplement state input output, DFSTComplement state input output) -- ^ Zipper into complement | ||
323 | -> Natural -- ^ Input position | ||
324 | -> Seq (LState state input output, Maybe output) | ||
325 | -> [ ( Seq (LState state input output, Maybe output) | ||
326 | , StringEdits Natural input | ||
327 | , (DFSTComplement state input output, DFSTComplement state input output) | ||
328 | , Natural | ||
329 | ) | ||
330 | ] | ||
331 | -- ^ Nondeterministically make a single further step, continueing a given run | ||
332 | continueRun inEdits (c', remC) inP run = do | ||
333 | let | ||
334 | pos :: Natural | ||
335 | -- pos = fromIntegral $ Comp.length c - Comp.length c' -- FIXME: should use length of dfstaProduces | ||
336 | pos = fromIntegral . Seq.length $ dfstaProduces remC stInitial | ||
337 | (c'', step) = Comp.splitAt (pred $ Comp.length c') c' -- TODO: unsafe? | ||
338 | current :: LState state input output | ||
339 | current | ||
340 | | Seq.Empty <- run = (0, (stInitial, Nothing)) | ||
341 | | (_ :> (st, _)) <- run = st | ||
342 | current' :: state | ||
343 | oldIn :: Maybe input | ||
344 | (current', oldIn) | ||
345 | | (_ :> ((_, (st, _)), _)) <- rest | ||
346 | , (_ :> ((_, (_, Just (partialIn, _))), _)) <- partial = (st, Just partialIn) | ||
347 | | (_ :> ((_, (_, Just (partialIn, _))), _)) <- partial = (stInitial, Just partialIn) | ||
348 | | Seq.Empty <- rest = (stInitial, Seq.lookup 0 $ dfstaConsumes' step) | ||
349 | | (_ :> ((_, (st, _)), _)) <- rest = (st, Seq.lookup 0 $ dfstaConsumes' step) | ||
350 | where | ||
351 | (partial, rest) = Seq.spanr (\((_, (_, inp)), _) -> isJust inp) run | ||
352 | next' <- trace (show ("next'", pos, focus, run, (current', oldIn), current, dfstaConsumes' step, runDFST' dfst current' (maybe Seq.empty Seq.singleton oldIn) Seq.empty)) . maybeToList . snd $ runDFST' dfst current' (maybe Seq.empty Seq.singleton oldIn) Seq.empty | ||
353 | let | ||
354 | outgoing :: LState state input output -> [(LState state input output, Maybe input, Maybe output)] | ||
355 | outgoing current = let go (st, minS) outs acc | ||
356 | | st == current = Set.foldr (\(st', moutS) -> ((st', minS, moutS) :)) acc outs | ||
357 | | otherwise = acc | ||
358 | in Map.foldrWithKey go [] $ FST.stTransition outFST | ||
359 | isPreferred :: (LState state input output, Maybe input, Maybe output) -> Bool | ||
360 | isPreferred ((_, (st, Nothing)), _, _) = st == next' | ||
361 | isPreferred (st@(_, (_, Just (inS , _))), _, _) = maybe True (== inS) oldIn && any isPreferred (outgoing st) -- By construction of `outFST`, `outgoing st` is a singleton in this case | ||
362 | (preferred, alternate) = partition isPreferred $ outgoing current | ||
363 | assocEdit :: (LState state input output, Maybe input, Maybe output) -- ^ Transition | ||
364 | -> [ ( (DFSTComplement state input output, DFSTComplement state input output) -- ^ new `(c', remC)`, i.e. complement-zipper `(c', remC)` but with edit applied | ||
365 | , StringEdits Natural input | ||
366 | , Natural | ||
367 | ) | ||
368 | ] | ||
369 | assocEdit (_, Just inS, _) | ||
370 | | oldIn == Just inS = [ ((c'', step <> remC), mempty, succ inP) ] | ||
371 | | isJust oldIn = [ ((c', altStep inS <> remC), insert inP inS, succ inP) | ||
372 | , ((c'', altStep inS <> remC), replace inP inS, succ inP) | ||
373 | ] | ||
374 | | otherwise = [ ((c', altStep inS <> remC), insert inP inS, succ inP) ] | ||
375 | assocEdit (_, Nothing, _) = [((c', remC), mempty, inP)] | ||
376 | altStep :: input -> DFSTComplement state input output | ||
377 | altStep inS = Comp.singleton DFSTAction{..} | ||
378 | where | ||
379 | dfstaConsumes = Seq.singleton inS | ||
380 | runDFSTAction x = runDFST' dfst x (pure inS) Seq.empty | ||
381 | options | ||
382 | | pos `Int.member` focus = preferred ++ alternate | ||
383 | | otherwise = preferred | ||
384 | choice@(next, inS, outS) <- trace (unlines $ show (pretty outFST) : map show options) options | ||
385 | ((c3, remC'), inEdits', inP') <- assocEdit choice | ||
386 | -- let | ||
387 | -- -- | Replace prefix of old complement to reflect current candidate | ||
388 | -- -- TODO: smarter? | ||
389 | -- (_, ((c3 <>) -> newComplement')) = Comp.splitAt (Comp.length c') c -- TODO: unsafe? | ||
390 | -- acc = (run :> (next, outS), inEdits' <> inEdits, newComplement') | ||
391 | -- dropSuffix = mconcat (replicate (Seq.length $ dfstaConsumes' c3) $ delete inP') | ||
392 | -- fin | ||
393 | -- | (trans, inEs, newComplement) <- acc = (trans, dropSuffix <> inEs, newComplement) | ||
394 | let | ||
395 | trans = run :> (next, outS) | ||
396 | inEs = inEdits' <> inEdits | ||
397 | -- dropSuffix = mconcat (replicate (Seq.length $ dfstaConsumes' c3) $ delete inP') | ||
398 | -- fin | ||
399 | -- | (trans, inEs) <- acc = (trans, dropSuffix <> inEs, remC') | ||
400 | -- bool id (over _BFS $ cons fin) (next `Set.member` FST.stAccept outFST) $ continueRun acc (c3, remC') inP' | ||
401 | return (trans, inEs, (c3, remC'), inP') | ||
402 | |||
403 | -- Properties of the edits computed are determined mostly by the order candidates are generated below | ||
404 | -- (_, inEs, c') <- (\xs -> foldr (\x f -> x `seq` f) listToMaybe xs $ xs) $ traceShowId fragmentIntervals >>= (\x -> (\y@(y1, y2, _) -> traceShow (y1, y2) y) <$> runCandidates x) | ||
405 | |||
406 | fmap ((,) <$> view _3 <*> view _2) . listToMaybe $ runCandidates =<< fragmentIntervals | ||
407 | 349 | ||
408 | strDiff :: forall sym pos. (Eq sym, Integral pos) => Seq sym -> Seq sym -> StringEdits pos sym | 350 | strDiff :: forall sym pos. (Eq sym, Integral pos) => Seq sym -> Seq sym -> StringEdits pos sym |
409 | -- ^ @strDiff a b@ calculates a set of edits, which, when applied to @a@, produce @b@ | 351 | -- ^ @strDiff a b@ calculates a set of edits, which, when applied to @a@, produce @b@ |
@@ -413,6 +355,29 @@ strDiff a b = snd . foldl toEdit (0, mempty) $ (getDiff `on` toList) a b | |||
413 | toEdit (n, es) (Diff.Both _ _) = (succ n, es) | 355 | toEdit (n, es) (Diff.Both _ _) = (succ n, es) |
414 | toEdit (n, es) (Diff.First _ ) = (n, delete n <> es) | 356 | toEdit (n, es) (Diff.First _ ) = (n, delete n <> es) |
415 | toEdit (n, es) (Diff.Second c) = (succ n, insert n c <> es) | 357 | toEdit (n, es) (Diff.Second c) = (succ n, insert n c <> es) |
358 | |||
359 | -- | Generic breadth-first search | ||
360 | bfs :: forall state transition. Ord state | ||
361 | => (Maybe state -> [(state, transition)]) -- ^ Find outgoing edges | ||
362 | -> ([(state, transition)] {- ^ Reverse path -} -> Maybe Bool {- ^ Continue search, finish successfully, or abort search on this branch -}) -- ^ Search predicate | ||
363 | -> Maybe [(state, transition)] -- ^ Reverse path | ||
364 | bfs outgoing predicate | ||
365 | | Just True <- emptyRes = Just [] | ||
366 | | Just False <- emptyRes = Nothing | ||
367 | | otherwise = bfs' Set.empty . Seq.fromList . map pure $ outgoing Nothing | ||
368 | where | ||
369 | emptyRes = predicate [] | ||
370 | |||
371 | bfs' :: Set state -- ^ Visited states, not to be checked again | ||
372 | -> Seq [(state, transition)] -- ^ Search queue of paths to continue | ||
373 | -> Maybe [(state, transition)] | ||
374 | bfs' _ Seq.Empty = Nothing | ||
375 | bfs' visited (c@((lastSt, _) : _) :< cs) = case predicate c of | ||
376 | Just True -> Just c | ||
377 | Just False -> bfs' visited cs | ||
378 | Nothing -> bfs' visited' $ cs <> Seq.fromList (map (: c) . filter (\(st, _) -> not $ Set.member st visited) . outgoing $ Just lastSt) | ||
379 | where | ||
380 | visited' = Set.insert lastSt visited | ||
416 | \end{code} | 381 | \end{code} |
417 | \end{comment} | 382 | \end{comment} |
418 | 383 | ||
@@ -457,5 +422,15 @@ affected (StringEdits es) = Just . toInterval $ go es Map.empty | |||
457 | myOffset | 422 | myOffset |
458 | | Insert _ _ <- e = pred | 423 | | Insert _ _ <- e = pred |
459 | | Delete _ <- e = succ | 424 | | Delete _ <- e = succ |
425 | |||
426 | trace :: String -> a -> a | ||
427 | {-# NOINLINE trace #-} | ||
428 | trace str y = flip seq y . unsafePerformIO . withFile "lens.log" AppendMode $ \h -> | ||
429 | hPutStrLn h str | ||
430 | |||
431 | traceShowId :: Show a => a -> a | ||
432 | traceShowId x = trace (show x) x | ||
433 | |||
434 | |||
460 | \end{code} | 435 | \end{code} |
461 | \end{comment} | 436 | \end{comment} |
diff --git a/edit-lens/src/Control/FST.lhs b/edit-lens/src/Control/FST.lhs index 9aa5341..9357da7 100644 --- a/edit-lens/src/Control/FST.lhs +++ b/edit-lens/src/Control/FST.lhs | |||
@@ -15,7 +15,7 @@ module Control.FST | |||
15 | -- * Operations on FSTs | 15 | -- * Operations on FSTs |
16 | , productFST, restrictOutput, restrictFST | 16 | , productFST, restrictOutput, restrictFST |
17 | -- * Debugging Utilities | 17 | -- * Debugging Utilities |
18 | , liveFST | 18 | , liveFST, dotFST |
19 | ) where | 19 | ) where |
20 | 20 | ||
21 | import Data.Map.Lazy (Map, (!?), (!)) | 21 | import Data.Map.Lazy (Map, (!?), (!)) |
@@ -38,6 +38,11 @@ import Control.Monad.State.Strict | |||
38 | import Text.PrettyPrint.Leijen (Pretty(..)) | 38 | import Text.PrettyPrint.Leijen (Pretty(..)) |
39 | import qualified Text.PrettyPrint.Leijen as PP | 39 | import qualified Text.PrettyPrint.Leijen as PP |
40 | 40 | ||
41 | import Data.Bool (bool) | ||
42 | import Data.Monoid ((<>)) | ||
43 | |||
44 | import Text.Dot | ||
45 | |||
41 | \end{code} | 46 | \end{code} |
42 | \end{comment} | 47 | \end{comment} |
43 | 48 | ||
@@ -50,7 +55,7 @@ In Haskell lockern wir die Anforderung, dass die Ein- und Ausgabe-Alphabete endl | |||
50 | Zudem speichern wir die Transitionsrelation als multimap um effiziente lookups von Zustand-Eingabe-Paaren zu ermöglichen. | 55 | Zudem speichern wir die Transitionsrelation als multimap um effiziente lookups von Zustand-Eingabe-Paaren zu ermöglichen. |
51 | 56 | ||
52 | \begin{code} | 57 | \begin{code} |
53 | dFSeata FST state input output = FST | 58 | data FST state input output = FST |
54 | { stInitial :: Set state | 59 | { stInitial :: Set state |
55 | , stTransition :: Map (state, Maybe input) (Set (state, Maybe output)) | 60 | , stTransition :: Map (state, Maybe input) (Set (state, Maybe output)) |
56 | , stAccept :: Set state | 61 | , stAccept :: Set state |
@@ -58,13 +63,56 @@ dFSeata FST state input output = FST | |||
58 | \end{code} | 63 | \end{code} |
59 | \end{defn} | 64 | \end{defn} |
60 | 65 | ||
66 | \begin{eg} \label{eg:linebreak} | ||
67 | Als wiederkehrendes Beispiel betrachten wir einen Transducer $L_{80} = (\Sigma, \Delta, Q, I, F, E)$, der für ein beliebiges Alphabet $\Sigma \supseteq \{ \text{\tt ' '}, \text{\tt \textbackslash n} \}$ durch Umwandlung zwischen Leerzeichen und Zeilenumbrüchen sicherstellt, dass jede Zeile des Ausgabetextes mindestens 80 Zeichen enthält, jedoch nur an Wortgrenzen umbricht: | ||
68 | |||
69 | \begin{align*} | ||
70 | \Delta & = \Sigma \\ | ||
71 | Q & = \{ 0, 1, \ldots, 80 \} \\ | ||
72 | I & = \{ 0 \} \\ | ||
73 | F & = Q \\ | ||
74 | E & = \{ (q, \sigma, \sigma, q + 1) \mid q \in Q \mysetminus \{ 80 \}, \sigma \in \Sigma \mysetminus \{ \text{\tt \textbackslash n} \} \} \\ | ||
75 | & \cup \{ (q, \text{\tt \textbackslash n}, \text{\tt ' '}, q + 1) \mid q \in Q \mysetminus \{ 80 \}, \sigma \in \Sigma \} \\ | ||
76 | & \cup \{ (80, \text{\tt ' '}, \text{\tt \textbackslash n}, 0), (80, \text{\tt \textbackslash n}, \text{\tt \textbackslash n}, 0) \} \\ | ||
77 | & \cup \{ (80, \sigma, \sigma, 80) \mid \sigma \in \Sigma \mysetminus \{ \text{\tt ' '}, \text{\tt \textbackslash n} \} \} | ||
78 | \end{align*} | ||
79 | |||
80 | \begin{figure}[p] | ||
81 | \centering | ||
82 | \begin{tikzpicture}[->,auto,node distance=5cm] | ||
83 | \node[initial,state,accepting] (0) {$0$}; | ||
84 | \node[state,accepting] (1) [right of=0] {$1$}; | ||
85 | \node[] (rest) [below of=1] {$\ldots$}; | ||
86 | \node[state,accepting] (i) [right of=rest,xshift=-2cm] {$i$}; | ||
87 | \node[state,accepting] (si) [below of=rest,yshift=2cm] {$i + 1$}; | ||
88 | \node[state,accepting] (80) [left of=rest] {$80$}; | ||
89 | |||
90 | \path (0) edge node {$\{ (\sigma, \sigma) \mid \sigma \in \Sigma, \sigma \neq \text{\tt \textbackslash n} \}$} (1) | ||
91 | (1) edge [bend left=20] node {$\{ (\sigma, \sigma) \mid \sigma \in \Sigma, \sigma \neq \text{\tt \textbackslash n} \}$} (rest) | ||
92 | edge [bend right=20] node [left] {$(\text{\tt \textbackslash n}, \text{\tt ' '})$} (rest) | ||
93 | (rest) edge node [below] {$\{ (\sigma, \sigma) \mid \sigma \in \Sigma, \sigma \neq \text{\tt \textbackslash n} \}$} (80) | ||
94 | edge [bend right=20] node [above] {$(\text{\tt \textbackslash n}, \text{\tt ' '})$} (80) | ||
95 | (i) edge [bend left=45] node {$\{ (\sigma, \sigma) \mid \sigma \in \Sigma, \sigma \neq \text{\tt \textbackslash n} \}$} (si) | ||
96 | edge [bend left=10] node [left] {$(\text{\tt \textbackslash n}, \text{\tt ' '})$} (si) | ||
97 | (80) edge [loop below] node [below] {$\{ (\sigma, \sigma) \mid \sigma \in \Sigma, \sigma \neq \text{\tt \textbackslash n}, \sigma \neq \text{\tt ' '} \}$} (80) | ||
98 | edge [bend left=20] node {$(\text{\tt \textbackslash n}, \text{\tt \textbackslash n})$} (0) | ||
99 | edge [bend right=20] node [right] {$(\text{\tt ' '}, \text{\tt \textbackslash n})$} (0); | ||
100 | |||
101 | \draw[-] (rest)--(i.north); | ||
102 | \draw[-] (rest)--(si.west); | ||
103 | \end{tikzpicture} | ||
104 | \caption{Beispiel \ref{eg:linebreak} dargestellt als Graph} | ||
105 | \end{figure} | ||
106 | \end{eg} | ||
107 | |||
61 | \begin{comment} | 108 | \begin{comment} |
62 | \begin{code} | 109 | \begin{code} |
63 | instance (Show state, Show input, Show output) => Pretty (FST state input output) where | 110 | instance (Show state, Show input, Show output, Ord state, Ord input, Ord output) => Pretty (FST state input output) where |
64 | pretty FST{..} = PP.vsep | 111 | pretty fst@FST{..} = PP.vsep |
65 | [ PP.text "Initial states:" PP.</> PP.hang 2 (list . map (PP.text . show) $ Set.toAscList stInitial) | 112 | [ PP.text "Initial states:" PP.</> PP.hang 2 (list . map (PP.text . show) $ Set.toAscList stInitial) |
66 | , PP.text "State transitions:" PP.<$> PP.indent 2 (PP.vsep | 113 | , PP.text "State transitions:" PP.<$> PP.indent 2 (PP.vsep |
67 | [ PP.text (show st) | 114 | [ PP.text (bool " " "#" $ Set.member st live) |
115 | PP.<+> PP.text (show st) | ||
68 | PP.<+> (PP.text "-" PP.<> PP.tupled [label inS, label outS] PP.<> PP.text "→") | 116 | PP.<+> (PP.text "-" PP.<> PP.tupled [label inS, label outS] PP.<> PP.text "→") |
69 | PP.<+> PP.text (show st') | 117 | PP.<+> PP.text (show st') |
70 | | ((st, inS), to) <- Map.toList stTransition | 118 | | ((st, inS), to) <- Map.toList stTransition |
@@ -77,9 +125,11 @@ instance (Show state, Show input, Show output) => Pretty (FST state input output | |||
77 | label = PP.text . maybe "ɛ" show | 125 | label = PP.text . maybe "ɛ" show |
78 | list :: [PP.Doc] -> PP.Doc | 126 | list :: [PP.Doc] -> PP.Doc |
79 | list = PP.encloseSep (PP.lbracket PP.<> PP.space) (PP.space PP.<> PP.rbracket) (PP.comma PP.<> PP.space) | 127 | list = PP.encloseSep (PP.lbracket PP.<> PP.space) (PP.space PP.<> PP.rbracket) (PP.comma PP.<> PP.space) |
128 | live = liveFST fst | ||
80 | \end{code} | 129 | \end{code} |
81 | \end{comment} | 130 | \end{comment} |
82 | 131 | ||
132 | \begin{defn}[Auswertung von FSTs] | ||
83 | Wir definieren die Auswertung von finite state transducers induktiv indem wir zunächst angeben wie ein einzelner Auswertungs-Schritt erfolgt. | 133 | Wir definieren die Auswertung von finite state transducers induktiv indem wir zunächst angeben wie ein einzelner Auswertungs-Schritt erfolgt. |
84 | 134 | ||
85 | Hierzu kommentieren wir die Haskell-Implementierung eines Auswertungs-Schritts. | 135 | Hierzu kommentieren wir die Haskell-Implementierung eines Auswertungs-Schritts. |
@@ -145,6 +195,7 @@ akzeptierenden Endzustände liegt. | |||
145 | go (initial, nPath) ncs | 195 | go (initial, nPath) ncs |
146 | \end{code} | 196 | \end{code} |
147 | \end{comment} | 197 | \end{comment} |
198 | \end{defn} | ||
148 | 199 | ||
149 | Es ist gelegentlich nützlich nur die möglichen Ausgaben eines FST auf gegebener | 200 | Es ist gelegentlich nützlich nur die möglichen Ausgaben eines FST auf gegebener |
150 | Eingabe zu bestimmen, wir führen eine Hilfsfunktion auf Basis von | 201 | Eingabe zu bestimmen, wir führen eine Hilfsfunktion auf Basis von |
@@ -163,7 +214,7 @@ runFST = fmap (map $ catMaybes . fmap (view _2) . view _2) . runFST' | |||
163 | \end{comment} | 214 | \end{comment} |
164 | 215 | ||
165 | Wir können das Produkt zweier FSTs definieren. | 216 | Wir können das Produkt zweier FSTs definieren. |
166 | Intuitiv wollen wir beide FSTs gleichzeitig ausführen und dabei sicherstellen, dass Ein- und Ausgabe der FSTs übereinstimmen\footnote{Da wir $\epsilon$-Transitionen in FSTs erlauben müssen wir uns festlegen wann eine $\epsilon$-Transition übereinstimmt mit einer anderen Transition. Wir definieren, dass $\epsilon$ als Eingabe mit jeder anderen Eingabe (inkl. einem weiteren $\epsilon$) übereinstimmt.}. | 217 | Intuitiv wollen wir beide FSTs gleichzeitig ausführen und dabei sicherstellen, dass Ein- und Ausgabe der FSTs übereinstimmen\footnote{Da wir $\epsilon$-Transitionen in FSTs erlauben müssen wir uns festlegen wann eine $\epsilon$-Transition übereinstimmt mit einer anderen Transition. Wir definieren, dass $\epsilon$ als Eingabe ausschließlich mit $\epsilon$ übereinstimmt.}. |
167 | 218 | ||
168 | Hierfür berechnen wir das Graphen-Produkt der FSTs: | 219 | Hierfür berechnen wir das Graphen-Produkt der FSTs: |
169 | 220 | ||
@@ -221,7 +272,7 @@ Hierzu nehmen wir das FST-Produkt mit einem FST, der, ungeachtet der Eingabe, im | |||
221 | Da die Ausgaben der beiden FSTs übereinstimmen müssen produziert das Produkt mit einem derartigen FST (solange dessen Ausgabe in keinem Sinne von der Eingabe abhängt) die gewünschte Ausgabe. | 272 | Da die Ausgaben der beiden FSTs übereinstimmen müssen produziert das Produkt mit einem derartigen FST (solange dessen Ausgabe in keinem Sinne von der Eingabe abhängt) die gewünschte Ausgabe. |
222 | 273 | ||
223 | Zur Konstruktion eines derartigen \emph{Wort-FST}s nehmen wir Indizes im Ausgabe-Wort (natürliche Zahlen) als Zustände. | 274 | Zur Konstruktion eines derartigen \emph{Wort-FST}s nehmen wir Indizes im Ausgabe-Wort (natürliche Zahlen) als Zustände. |
224 | Übergänge sind immer entweder der Form $n \rightarrow \text{succ}(n)$, konsumieren keine Eingabe ($\epsilon$) und produzieren als Ausgabe das Zeichen am Index $n$ im Ausgabe-Wort, oder der Form $n \overset{(i, \epsilon)}{\rightarrow} n$, für jedes Eingabesymbol $i$ (um die Unabhängigkeit von der Eingabe sicherzustellen). | 275 | Übergänge sind immer entweder der Form $n \rightarrow \text{succ}(n)$, konsumieren keine Eingabe ($\epsilon$) und produzieren als Ausgabe das Zeichen am Index $n$ im Ausgabe-Wort, oder der Form $n \overset{(\sigma, \epsilon)}{\rightarrow} n$, für jedes Eingabesymbol $\sigma$ (um die Unabhängigkeit von der Eingabe sicherzustellen). |
225 | Weiter ist $0$ initial und $\text{length}(\text{Ausgabe})$ der einzige akzeptierende Endzustand. | 276 | Weiter ist $0$ initial und $\text{length}(\text{Ausgabe})$ der einzige akzeptierende Endzustand. |
226 | 277 | ||
227 | \begin{code} | 278 | \begin{code} |
@@ -251,6 +302,35 @@ wordFST inps outs = FST | |||
251 | \end{code} | 302 | \end{code} |
252 | \end{comment} | 303 | \end{comment} |
253 | 304 | ||
305 | \begin{eg} \label{eg:w100} | ||
306 | Der zum Wort $w = 1\, 2\, \ldots\, 80\, \text{\tt \textbackslash n}\, 81\, \ldots\, 98$ gehörige Wort-FST $W_w = ( \Sigma, \Delta, Q, I, F, E)$ für ein beliebiges Eingabe-Alphabet $\Sigma$ ist: | ||
307 | |||
308 | \begin{align*} | ||
309 | \Delta & = \{ 1, 2, \ldots, 98, \text{\tt \textbackslash n} \} \\ | ||
310 | Q & = \{ 0, 1, \ldots, 99 \} \\ | ||
311 | I & = \{ 0 \} \\ | ||
312 | F & = \{ 99 \} \\ | ||
313 | E & = \{ (i, \sigma, w_i, i + 1) \mid \sigma \in \Sigma \cup \{ \epsilon \}, i \in Q \mysetminus \{ 99 \} \} \\ | ||
314 | & \cup \{ (i, \sigma, \epsilon, i) \mid \sigma \in \Sigma \cup \{ \epsilon \}, i \in Q \mysetminus \{ 99 \} \} | ||
315 | \end{align*} | ||
316 | |||
317 | \begin{figure}[p] | ||
318 | \centering | ||
319 | \begin{tikzpicture}[->,auto,node distance=5cm] | ||
320 | \node[initial,state] (0) {$0$}; | ||
321 | \node[] (rest) [right of=0] {$\ldots$}; | ||
322 | \node[state,accepting] (99) [right of=rest] {$99$}; | ||
323 | |||
324 | \path (0) edge [loop above] node {$\{(\sigma, \epsilon) \mid \sigma \in \Sigma \cup \{ \epsilon \} \}$} (0) | ||
325 | edge node {$\{ (\sigma, 1) \mid \sigma \in \Sigma \cup \{ \epsilon \} \}$} (rest) | ||
326 | (rest) edge node {$\{ \sigma, 100 \} \mid \sigma \in \Sigma \cup \{ \epsilon \}$} (99) | ||
327 | (99) edge [loop above] node {$\{(\sigma, \epsilon) \mid \sigma \in \Sigma \}$} (99); | ||
328 | \end{tikzpicture} | ||
329 | |||
330 | \caption{Beispiel \ref{eg:w100} dargestellt als Graph} | ||
331 | \end{figure} | ||
332 | \end{eg} | ||
333 | |||
254 | Da \texttt{wordFST} zur Konstruktion eine komprehensive Menge aller Eingabesymbole benötigt verwenden wir im folgenden eine optimierte Variante des Produkts mit einem Wort-FST. | 334 | Da \texttt{wordFST} zur Konstruktion eine komprehensive Menge aller Eingabesymbole benötigt verwenden wir im folgenden eine optimierte Variante des Produkts mit einem Wort-FST. |
255 | 335 | ||
256 | \begin{code} | 336 | \begin{code} |
@@ -258,6 +338,46 @@ restrictOutput :: forall state input output. (Ord state, Ord input, Ord output) | |||
258 | -- ^ @restrictOutput out@ is equivalent to @productFST (wordFST inps out)@ where @inps@ is a comprehensive set of all input symbols @inp :: input@ | 338 | -- ^ @restrictOutput out@ is equivalent to @productFST (wordFST inps out)@ where @inps@ is a comprehensive set of all input symbols @inp :: input@ |
259 | \end{code} | 339 | \end{code} |
260 | 340 | ||
341 | \begin{eg} \label{eg:l80timesw100} | ||
342 | Der FST $L_{80}$ aus Beispiel \autoref{eg:linebreak} eingeschränkt auf das Wort $w$ aus Beispiel \autoref{eg:w100} (also $W_w \times L_{80}$) ist: | ||
343 | |||
344 | \begin{align*} | ||
345 | \Sigma^\times & = \{1, 2, \ldots, 99, \text{\tt \textbackslash n}, \text{\tt ' '} \} \\ | ||
346 | \Delta^\times & = \{1, 2, \ldots, 99, \text{\tt \textbackslash n} \} \\ | ||
347 | Q^\times & = \{ (\sigma, p) \mid \sigma \in \{ 0_{W_w}, \ldots, 99_{W_w} \}, p \in \{ 0_{L_{80}}, \ldots, 80_{L_{80}} \} \} \\ | ||
348 | I^\times & = \{ (0_{W_w}, 0_{L_{80}}) \} \\ | ||
349 | F^\times & = \{ (99_{W_w}, p) \mid p \in \{ 0_{L_{80}}, \ldots, 80_{L_{80}} \} \} \\ | ||
350 | E^\times & = \{ ((i, q), w_i, w_i, (i + 1, q + 1)) \mid q \in Q \mysetminus \{ 80 \}, i \in Q \mysetminus \{ 99 \} \} \\ | ||
351 | & \cup \{ ((80, 80), \text{\tt \textbackslash n}, \text{\tt \textbackslash n}, (81, 0)) \} | ||
352 | \end{align*} | ||
353 | |||
354 | \begin{figure}[p] | ||
355 | \centering | ||
356 | \begin{tikzpicture}[->,auto,node distance=5cm] | ||
357 | \node[initial,state] (0) {$0_{W_w}\, 0_{L_{80}}$}; | ||
358 | \node[] (rest1) [right of=0] {$\ldots$}; | ||
359 | \node[state] (80) [right of=rest1] {$80_{W_w}\, 80_{L_{80}}$}; | ||
360 | \node[state] (81) [below of=0] {$81_{W_w}\, 0_{L_{80}}$}; | ||
361 | \node[] (rest2) [right of=81] {$\ldots$}; | ||
362 | \node[state,accepting] (99) [right of=rest2] {$99_{W_w}\, 19_{L_{80}}$}; | ||
363 | |||
364 | \path (0) edge node {$(1, 1)$} (rest1) | ||
365 | (rest1) edge node {$(80, 80)$} (80) | ||
366 | (80) edge node {$(\text{\tt \textbackslash n}, \text{\tt \textbackslash n})$} (81) | ||
367 | (81) edge node {$(81, 81)$} (rest2) | ||
368 | (rest2) edge node {$(98, 98)$} (99); | ||
369 | \end{tikzpicture} | ||
370 | |||
371 | \caption{Beispiel \ref{eg:l80timesw100} dargestellt als Graph} | ||
372 | \end{figure} | ||
373 | \end{eg} | ||
374 | |||
375 | \begin{rem} | ||
376 | Es ist bemerkenswert, dass in Beispiel \ref{eg:l80timesw100} die Zirkuläre Struktur von $L_80$ durch Produkt mit einem Wort verloren geht. | ||
377 | |||
378 | I.\@A.\@ ist das Produkt eines beliebigen FST mit einem Wort-FST zwar nicht azyklisch, erbt jedoch die lineare Struktur des Wort-FST in dem Sinne, dass Fortschritt in Richtung der akzeptierenden Zustände nur möglich ist indem der $(i, \sigma, w_i, i + 1)$-Klasse von Transitionen des Wort-FSTs gefolgt wird. | ||
379 | \end{rem} | ||
380 | |||
261 | \begin{comment} | 381 | \begin{comment} |
262 | \begin{code} | 382 | \begin{code} |
263 | restrictOutput out FST{..} = FST | 383 | restrictOutput out FST{..} = FST |
@@ -302,18 +422,35 @@ liveFST :: forall state input output. (Ord state, Ord input, Ord output, Show st | |||
302 | -- ^ Compute the set of "live" states (with no particular complexity) | 422 | -- ^ Compute the set of "live" states (with no particular complexity) |
303 | -- | 423 | -- |
304 | -- A state is "live" iff there is a path from it to an accepting state and a path from an initial state to it | 424 | -- A state is "live" iff there is a path from it to an accepting state and a path from an initial state to it |
305 | liveFST fst@FST{..} = flip execState Set.empty $ mapM_ (depthSearch Set.empty) stInitial | 425 | liveFST fst@FST{..} = flip execState (Set.empty) . depthSearch Set.empty $ Set.toList stInitial |
306 | where | 426 | where |
307 | stTransition' :: Map state (Set state) | 427 | stTransition' :: Map state (Set state) |
308 | stTransition' = Map.map (Set.map (\(st, _) -> st)) $ Map.mapKeysWith Set.union (\(st, _) -> st) stTransition | 428 | stTransition' = Map.map (Set.map (\(st, _) -> st)) $ Map.mapKeysWith Set.union (\(st, _) -> st) stTransition |
309 | depthSearch :: Set state -> state -> State (Set state) () | 429 | depthSearch :: Set state -> [state] -> State (Set state) () |
310 | depthSearch acc curr = do | 430 | depthSearch acc [] = return () |
431 | depthSearch acc (curr : queue) = do | ||
311 | let acc' = Set.insert curr acc | 432 | let acc' = Set.insert curr acc |
312 | next = fromMaybe Set.empty $ stTransition' !? curr | 433 | next = fromMaybe Set.empty $ stTransition' !? curr |
313 | alreadyLive <- get | 434 | alreadyLive <- get |
314 | when (curr `Set.member` Set.union stAccept alreadyLive) $ | 435 | when (curr `Set.member` Set.union stAccept alreadyLive) $ |
315 | modify $ Set.union acc' | 436 | modify $ Set.union acc' |
316 | alreadyLive <- get | 437 | depthSearch acc' $ filter (not . flip Set.member next) queue ++ Set.toList (next `Set.difference` acc') |
317 | mapM_ (depthSearch acc') $ next `Set.difference` alreadyLive | 438 | |
439 | dotFST :: forall state input output. (Ord state, Ord input, Ord output, Show state, Show input, Show output) => FST state input output -> Dot () | ||
440 | dotFST FST{..} = do | ||
441 | let | ||
442 | stTransition' = concatMap (\(f, ts) -> (f,) <$> Set.toList ts) $ Map.toList stTransition | ||
443 | states = stInitial <> stAccept <> foldMap (Set.singleton . fst . fst) stTransition' <> foldMap (Set.singleton . fst . snd) stTransition' | ||
444 | stateIds <- sequence . (flip Map.fromSet) states $ \st -> node | ||
445 | [ ("label", show st) | ||
446 | , ("peripheries", bool "1" "2" $ st `Set.member` stAccept) | ||
447 | ] | ||
448 | forM_ stInitial $ \st -> do | ||
449 | init <- node [ ("label", ""), ("shape", "none") ] | ||
450 | init .->. (stateIds ! st) | ||
451 | forM_ stTransition' $ \((f, inS), (t, outS)) -> do | ||
452 | edge (stateIds ! f) (stateIds ! t) | ||
453 | [ ("label", show (inS, outS)) | ||
454 | ] | ||
318 | \end{code} | 455 | \end{code} |
319 | \end{comment} | 456 | \end{comment} |
diff --git a/edit-lens/src/Control/FST/Lens.tex b/edit-lens/src/Control/FST/Lens.tex new file mode 100644 index 0000000..dc44e10 --- /dev/null +++ b/edit-lens/src/Control/FST/Lens.tex | |||
@@ -0,0 +1,29 @@ | |||
1 | Es stellt sich die Frage, ob das obig beschriebene Verfahren zur Konstruktion einer edit-lens sich auch auf nondeterminische finite state transducers anwenden lässt. | ||
2 | |||
3 | Eine natürlich Erweiterung von \texttt{DFSTAction} wäre: | ||
4 | \begin{lstlisting}[language=Haskell] | ||
5 | data FSTAction state input output = FSTAction | ||
6 | { runFSTAction :: state -> Map state [Seq output] | ||
7 | , fstaConsumes :: Seq input | ||
8 | } | ||
9 | \end{lstlisting} | ||
10 | wobei die Liste aller möglichen output-Strings in der rechten Seite von \texttt{runFSTAction} in aller Regel unendlich ist. | ||
11 | |||
12 | $\Rrightarrow$ würde sich notwendigerweise arbiträr auf einen der möglichen output-Strings festlegen aber ansonsten wohl identisch zum DFST-Fall implementieren lassen. | ||
13 | |||
14 | $\Lleftarrow$ basiert fundamental darauf im Komplement anhand der erzeugten output-Strings zu suchen (um das betroffene Intervall im output-String auf das Komplement zu übertragen). | ||
15 | Um sicher zu stellen, dass jene Suche immer terminiert, müsste die Aufzählung der i.A. unendlich vielen zulässigen output-Strings in \texttt{FSTAction} geschickt gewählt sein. | ||
16 | Quellen von Serien unendlich vieler output-Strings sind notwendigerweise Zykel im betrachteten FST. | ||
17 | Wir könnten nun für jeden Zykel im betrachteten FST eine Kante arbiträr wählen und dem Folgen jener Kante Kosten zuweisen. | ||
18 | Wenn wir nun sicherstellen, dass output-Strings in Reihenfolge aufsteigender Kosten aufgezählt werden, lässt sich jeder endliche output-String in endlicher Zeit finden. | ||
19 | |||
20 | Das obig beschriebene Verfahren weißt eine Asymmetrie auf, die im unterliegenden FST nicht vorhanden ist (sowohl Eingabe- als auch Ausgabe-Symbole sind Annotationen vom gleichen Typ an die Transitionen des FST). | ||
21 | Diese Asymmetrie ergibt sich ausschließlich aus der Wahl des Komplements. | ||
22 | |||
23 | Wählen wir stattdessen ein Komplement, dass Eingabe und Ausgabe symmetrisch behandelt: | ||
24 | \begin{lstlisting}[language=Haskell] | ||
25 | newtype FSTAction' state input output = FSTAction' | ||
26 | { runFSTAction' :: state -> Map state [Seq input, Seq output] | ||
27 | } | ||
28 | \end{lstlisting} | ||
29 | So lassen sich $\Rrightarrow^\prime$ und $\Lleftarrow^\prime$ ebenfalls symmetrisch, analog zu $\Lleftarrow$, konstruieren. | ||
diff --git a/edit-lens/src/Control/Lens/Edit.lhs b/edit-lens/src/Control/Lens/Edit.lhs index 5a106c8..96b2114 100644 --- a/edit-lens/src/Control/Lens/Edit.lhs +++ b/edit-lens/src/Control/Lens/Edit.lhs | |||
@@ -71,7 +71,7 @@ instance (Module m, Module n) => HasEditLens (EditLens c m n) m n where | |||
71 | 71 | ||
72 | Das einschlägige bestehende lens framework \cite{lens} konstruiert seine Linsen alá \citeauthor{laarhoven} wie folgt: | 72 | Das einschlägige bestehende lens framework \cite{lens} konstruiert seine Linsen alá \citeauthor{laarhoven} wie folgt: |
73 | 73 | ||
74 | \begin{defn}[lenses alá \citeauthor{laarhoven}] | 74 | \begin{defn}[lenses alá laarhoven] |
75 | Für Typen $n$ und $m$ ist eine \emph{lens} $\ell$ von $n$ in $m$ eine Abbildung\footnote{Gdw. die betrachtete Linse einen Isomorphismus kodiert wird auch über den verwendeten Profunktor anstatt $\to$ quantifiziert} folgender Struktur: | 75 | Für Typen $n$ und $m$ ist eine \emph{lens} $\ell$ von $n$ in $m$ eine Abbildung\footnote{Gdw. die betrachtete Linse einen Isomorphismus kodiert wird auch über den verwendeten Profunktor anstatt $\to$ quantifiziert} folgender Struktur: |
76 | 76 | ||
77 | $$ \forall f \, \text{Funktor} \colon \left ( \ell \colon \left ( m \to f(m) \right ) \to \left ( n \to f(n) \right ) \right )$$ | 77 | $$ \forall f \, \text{Funktor} \colon \left ( \ell \colon \left ( m \to f(m) \right ) \to \left ( n \to f(n) \right ) \right )$$ |
diff --git a/interactive-edit-lens/package.yaml b/interactive-edit-lens/package.yaml index 9bc3ead..95e2464 100644 --- a/interactive-edit-lens/package.yaml +++ b/interactive-edit-lens/package.yaml | |||
@@ -37,6 +37,7 @@ dependencies: | |||
37 | - dyre | 37 | - dyre |
38 | - mtl | 38 | - mtl |
39 | - transformers | 39 | - transformers |
40 | - universe | ||
40 | 41 | ||
41 | # ghc-options: [ -O2 ] | 42 | # ghc-options: [ -O2 ] |
42 | 43 | ||
diff --git a/interactive-edit-lens/src/Interact.hs b/interactive-edit-lens/src/Interact.hs index 3aab5c2..0074e86 100644 --- a/interactive-edit-lens/src/Interact.hs +++ b/interactive-edit-lens/src/Interact.hs | |||
@@ -146,9 +146,9 @@ interactiveEditLens' cfg@InteractConfig{..} | |||
146 | (moveSplit isSpace $ \(c, (l, _)) -> if any isSpace (c l) || Seq.null (c l) then (pred l, 0) else (l - 2, 0)) | 146 | (moveSplit isSpace $ \(c, (l, _)) -> if any isSpace (c l) || Seq.null (c l) then (pred l, 0) else (l - 2, 0)) |
147 | EvKey KRight [MCtrl] -> continue $ st &?~ doMove | 147 | EvKey KRight [MCtrl] -> continue $ st &?~ doMove |
148 | (moveSplit isSpace $ \(c, (l, _)) -> if any isSpace $ c l then (succ l, 0) else (l + 2, 0)) | 148 | (moveSplit isSpace $ \(c, (l, _)) -> if any isSpace $ c l then (succ l, 0) else (l + 2, 0)) |
149 | EvKey KUp [MCtrl] -> continue $ st &?~ doMove | 149 | EvKey KUp [] -> continue $ st &?~ doMove |
150 | (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) || Seq.null (c l) then (pred l, p) else (l - 2, p)) | 150 | (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) || Seq.null (c l) then (pred l, p) else (l - 2, p)) |
151 | EvKey KDown [MCtrl] -> continue $ st &?~ doMove | 151 | EvKey KDown [] -> continue $ st &?~ doMove |
152 | (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) then (succ l, p) else (l + 2, p)) | 152 | (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) then (succ l, p) else (l + 2, p)) |
153 | EvKey KLeft [] -> continue $ st &?~ doMove moveLeft | 153 | EvKey KLeft [] -> continue $ st &?~ doMove moveLeft |
154 | EvKey KRight [] -> continue $ st &?~ doMove moveRight | 154 | EvKey KRight [] -> continue $ st &?~ doMove moveRight |
diff --git a/interactive-edit-lens/src/Main.hs b/interactive-edit-lens/src/Main.hs index f7bc806..83c9725 100644 --- a/interactive-edit-lens/src/Main.hs +++ b/interactive-edit-lens/src/Main.hs | |||
@@ -8,6 +8,8 @@ import Interact | |||
8 | import Control.DFST.Lens | 8 | import Control.DFST.Lens |
9 | import Control.DFST | 9 | import Control.DFST |
10 | 10 | ||
11 | import Control.Arrow ((&&&)) | ||
12 | |||
11 | import Data.Map (Map) | 13 | import Data.Map (Map) |
12 | import qualified Data.Map as Map | 14 | import qualified Data.Map as Map |
13 | 15 | ||
@@ -17,6 +19,8 @@ import qualified Data.Set as Set | |||
17 | import Data.Sequence (Seq) | 19 | import Data.Sequence (Seq) |
18 | import qualified Data.Sequence as Seq | 20 | import qualified Data.Sequence as Seq |
19 | 21 | ||
22 | import Data.List ((\\), inits, tails) | ||
23 | |||
20 | import Data.Char | 24 | import Data.Char |
21 | 25 | ||
22 | import System.Environment | 26 | import System.Environment |
@@ -24,10 +28,60 @@ import System.Exit | |||
24 | 28 | ||
25 | import Debug.Trace | 29 | import Debug.Trace |
26 | 30 | ||
27 | data SomeDFST = forall state. (Ord state, Show state) => SomeDFST { someDFST :: DFST state Char Char } | 31 | import Data.Universe |
32 | |||
33 | data SomeDFST = forall state. (Ord state, Show state, Finite state) => SomeDFST { someDFST :: DFST state Char Char } | ||
34 | |||
35 | data JsonContext = JCInDet | JCDict | JCDictKey | JCDictVal | JCArray | JCArrayVal | JCTop | ||
36 | deriving (Eq, Ord, Show, Read, Enum, Bounded) | ||
37 | instance Universe JsonContext | ||
38 | instance Finite JsonContext | ||
28 | 39 | ||
29 | data JsonNewlState = JNUndeterminedStructure | JNOutsideStructure | JNInsideStructure | JNInsideString | JNEscape | 40 | data JsonNewlState = JNElement JsonContext |
41 | | JNTrue String JsonContext | JNFalse String JsonContext | JNNull String JsonContext | JNLitEnd JsonContext | ||
42 | | JNString JsonContext | JNStringEsc Int JsonContext | JNStringEnd JsonContext | ||
43 | | JNNumberDigits Bool JsonContext | JNNumberDecimal JsonContext | JNNumberDecimalDigits Bool JsonContext | JNNumberExpSign JsonContext | JNNumberExpDigits Bool JsonContext | JNNumberEnd JsonContext | ||
30 | deriving (Eq, Ord, Show, Read) | 44 | deriving (Eq, Ord, Show, Read) |
45 | instance Universe JsonNewlState where | ||
46 | universe = concat | ||
47 | [ JNElement <$> universeF | ||
48 | , JNTrue <$> inits' "true" <*> universeF | ||
49 | , JNFalse <$> inits' "false" <*> universeF | ||
50 | , JNNull <$> inits' "null" <*> universeF | ||
51 | , JNLitEnd <$> universeF | ||
52 | , JNString <$> universeF | ||
53 | , JNStringEsc <$> [0..4] <*> universeF | ||
54 | , JNStringEnd <$> universeF | ||
55 | , JNNumberDigits <$> universeF <*> universeF | ||
56 | , JNNumberDecimal <$> universeF | ||
57 | , JNNumberDecimalDigits <$> universeF <*> universeF | ||
58 | , JNNumberExpSign <$> universeF | ||
59 | , JNNumberExpDigits <$> universeF <*> universeF | ||
60 | , JNNumberEnd <$> universeF | ||
61 | ] | ||
62 | where | ||
63 | inits' xs = inits xs \\ [""] | ||
64 | instance Finite JsonNewlState | ||
65 | |||
66 | jsonStrEscapes :: [(Char, Seq Char)] | ||
67 | jsonStrEscapes = [ ('"', "\\\"") | ||
68 | , ('\\', "\\\\") | ||
69 | , ('/', "/") | ||
70 | , ('b', "\\b") | ||
71 | , ('f', "\\f") | ||
72 | , ('n', "\\n") | ||
73 | , ('r', "\\r") | ||
74 | , ('t', "\\t") | ||
75 | ] | ||
76 | |||
77 | hexDigits :: [Char] | ||
78 | hexDigits = ['0'..'9'] ++ ['a'..'f'] | ||
79 | |||
80 | data LineBreakState = LineBreak Int | ||
81 | deriving (Eq, Ord, Show, Read) | ||
82 | instance Universe LineBreakState where | ||
83 | universe = [ LineBreak n | n <- [0..80] ] | ||
84 | instance Finite LineBreakState | ||
31 | 85 | ||
32 | dfstMap :: String -> Maybe SomeDFST | 86 | dfstMap :: String -> Maybe SomeDFST |
33 | dfstMap "double" = Just . SomeDFST $ DFST | 87 | dfstMap "double" = Just . SomeDFST $ DFST |
@@ -46,32 +100,125 @@ dfstMap "id" = Just . SomeDFST $ DFST | |||
46 | , stAccept = Set.singleton () | 100 | , stAccept = Set.singleton () |
47 | } | 101 | } |
48 | dfstMap "alternate" = Just . SomeDFST $ DFST | 102 | dfstMap "alternate" = Just . SomeDFST $ DFST |
49 | { stInitial = 0 :: Int | 103 | { stInitial = False |
50 | , stTransition = mconcat | 104 | , stTransition = mconcat |
51 | [ Map.fromList [((0, sym), (1, Seq.singleton sym)) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ['!', ' ']] -- sym <- [minBound..maxBound], isPrint sym] | 105 | [ Map.fromList [((False, sym), (True, Seq.singleton sym)) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ['!', ' ']] -- sym <- [minBound..maxBound], isPrint sym] |
52 | , Map.fromList [((1, sym), (0, Seq.fromList [toUpper sym, toUpper sym])) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ['!', ' ']] -- sym <- [minBound..maxBound], isPrint sym] | 106 | , Map.fromList [((True, sym), (False, Seq.fromList [toUpper sym, toUpper sym])) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ['!', ' ']] -- sym <- [minBound..maxBound], isPrint sym] |
53 | ] | 107 | ] |
54 | , stAccept = Set.fromList [0] | 108 | , stAccept = Set.fromList [False] |
55 | } | 109 | } |
56 | dfstMap "json-newl" = Just . SomeDFST $ DFST | 110 | dfstMap "json-newl" = Just . SomeDFST $ DFST |
57 | { stInitial = JNOutsideStructure | 111 | { stInitial = JNElement JCTop |
58 | , stTransition = mconcat | 112 | , stTransition = mconcat |
59 | [ Map.fromList [((jnOutside, sym), (jnOutside, Seq.empty)) | sym <- whitespace, jnOutside <- [JNOutsideStructure, JNUndeterminedStructure]] | 113 | [ Map.fromList [ ((st, sym), (st, Seq.empty)) |
60 | , Map.fromList [((jnOutside, sym), (JNInsideStructure, Seq.fromList [sym, ' '])) | sym <- "[{", jnOutside <- [JNOutsideStructure, JNInsideStructure, JNUndeterminedStructure]] | 114 | | sym <- whitespace |
61 | , Map.fromList [((JNInsideStructure, sym), (JNInsideStructure, Seq.empty)) | sym <- whitespace] | 115 | , st <- [JNElement, JNStringEnd, JNNumberEnd, JNLitEnd] <*> universeF |
62 | , Map.fromList [((jnInside, sym), (JNUndeterminedStructure, Seq.fromList ['\n', sym])) | sym <- "]}", jnInside <- [JNInsideStructure, JNUndeterminedStructure]] | 116 | ] |
63 | , Map.fromList [((jnInside, ','), (JNInsideStructure, Seq.fromList "\n, ")) | jnInside <- [JNInsideStructure, JNUndeterminedStructure] ] | 117 | , Map.fromList [ ((JNElement ctx, '{'), (JNElement JCDict, "{ ")) | ctx <- universeF ] |
64 | , Map.fromList [((jnInside, ':'), (JNInsideStructure, Seq.fromList " : ")) | jnInside <- [JNInsideStructure, JNUndeterminedStructure] ] | 118 | , Map.fromList [ ((JNElement ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDict, JCInDet] ] |
65 | , Map.fromList [((jn, '"'), (JNInsideString, Seq.singleton '"')) | jn <- [JNUndeterminedStructure, JNInsideStructure]] | 119 | , Map.fromList [ ((JNElement ctx, '['), (JNElement JCArray, "[ ")) | ctx <- universeF ] |
66 | , Map.fromList [((JNInsideString, sym), (JNInsideString, Seq.singleton sym)) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ",.!?: "] | 120 | , Map.fromList [ ((JNElement ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArray, JCInDet] ] |
67 | , Map.singleton (JNInsideString, '"') (JNUndeterminedStructure, Seq.singleton '"') | 121 | , Map.singleton (JNElement JCInDet, ',') (JNElement JCInDet, "\n, ") |
68 | , Map.singleton (JNInsideString, '\\') (JNEscape, Seq.singleton '\\') | 122 | , Map.fromList [ ((JNElement ctx, '"'), (JNString ctx', "\"")) | (ctx, ctx') <- startElemCtxs ] |
69 | , Map.singleton (JNEscape, '"') (JNInsideString, Seq.singleton '"') | 123 | , Map.fromList [ ((JNString ctx, c), (JNString ctx, Seq.singleton c)) | ctx <- universeF, c <- map toEnum [0..255], isPrint c, c /= '"', c /= '\\' ] |
124 | , Map.fromList [ ((JNString ctx, '"'), (JNStringEnd ctx, "\"")) | ctx <- universeF ] | ||
125 | , Map.fromList [ ((JNStringEnd ctx, ':'), (JNElement JCDictVal, " : ")) | ctx <- [JCDictKey, JCInDet] ] | ||
126 | , Map.singleton (JNStringEnd JCArrayVal, ',') (JNElement JCArrayVal, "\n, ") | ||
127 | , Map.singleton (JNStringEnd JCDictVal, ',') (JNElement JCDictKey, "\n, ") | ||
128 | , Map.singleton (JNStringEnd JCInDet, ',') (JNElement JCInDet, "\n, ") | ||
129 | , Map.fromList [ ((JNStringEnd ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ] | ||
130 | , Map.fromList [ ((JNStringEnd ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ] | ||
131 | , Map.fromList [ ((JNString ctx, '\\'), (JNStringEsc 0 ctx, mempty)) | ctx <- universeF ] | ||
132 | , Map.fromList [ ((JNStringEsc 0 ctx, c), (JNString ctx, res)) | ctx <- universeF, (c, res) <- jsonStrEscapes ] | ||
133 | , Map.fromList [ ((JNStringEsc 0 ctx, 'u'), (JNStringEsc 1 ctx, "\\u")) | ctx <- universeF ] | ||
134 | , Map.fromList [ ((JNStringEsc n ctx, c'), (JNStringEsc (succ n) ctx, Seq.singleton c)) | ctx <- universeF, c <- hexDigits, c' <- [toLower c, toUpper c], n <- [1..3] ] | ||
135 | , Map.fromList [ ((JNStringEsc 4 ctx, c'), (JNString ctx, Seq.singleton c)) | ctx <- universeF, c <- hexDigits, c' <- [toLower c, toUpper c]] | ||
136 | , mconcat $ do | ||
137 | (lit@(l:_), st) <- literals | ||
138 | id | ||
139 | [ Map.fromList [ ((JNElement ctx, l'), (st (pure l) ctx', Seq.singleton l)) | ||
140 | | l' <- [toLower l, toUpper l] | ||
141 | , (ctx, ctx') <- startElemCtxs | ||
142 | ] | ||
143 | , Map.fromList [ ((st i ctx, r'), (st (i ++ [r]) ctx, Seq.singleton r)) | ||
144 | | (i, t@(r:rs)) <- uncurry zip $ (inits &&& tails) lit | ||
145 | , i /= [] | ||
146 | , r' <- [toLower r, toUpper r] | ||
147 | , ctx <- [JCInDet, JCDictKey, JCDictVal, JCArrayVal, JCTop] | ||
148 | ] | ||
149 | , Map.fromList [ ((st lit ctx, ':'), (JNElement JCDictVal, " : ")) | ||
150 | | ctx <- [JCDictKey, JCInDet] | ||
151 | ] | ||
152 | , Map.fromList [ ((st lit ctx, ','), (JNElement JCArrayVal, "\n, ")) | ||
153 | | ctx <- [JCArrayVal, JCInDet] | ||
154 | ] | ||
155 | , Map.fromList [ ((st lit ctx, ','), (JNElement JCDictKey, "\n, ")) | ||
156 | | ctx <- [JCDictVal, JCInDet] | ||
157 | ] | ||
158 | , Map.singleton (st lit JCInDet, ',') (JNElement JCInDet, "\n, ") | ||
159 | , Map.fromList [ ((st lit ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ] | ||
160 | , Map.fromList [ ((st lit ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ] | ||
161 | , Map.fromList [ ((st lit ctx, sym), (JNLitEnd ctx, Seq.empty)) | ctx <- universeF, sym <- whitespace ] | ||
162 | ] | ||
163 | , Map.fromList [ ((JNLitEnd ctx, ':'), (JNElement JCDictVal, " : ")) | ctx <- [JCDictKey, JCInDet] ] | ||
164 | , Map.fromList [ ((JNLitEnd ctx, ','), (JNElement JCArrayVal, "\n, ")) | ctx <- [JCArrayVal, JCInDet] ] | ||
165 | , Map.fromList [ ((JNLitEnd ctx, ','), (JNElement JCDictKey, "\n, ")) | ctx <- [JCDictVal, JCInDet] ] | ||
166 | , Map.fromList [ ((JNLitEnd ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ] | ||
167 | , Map.fromList [ ((JNLitEnd ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ] | ||
168 | , Map.fromList [ ((JNElement ctx, '-'), (JNNumberDigits False ctx', "-")) | (ctx, ctx') <- startElemCtxs ] | ||
169 | , Map.fromList [ ((JNElement ctx, '0'), (JNNumberDecimal ctx', "0")) | (ctx, ctx') <- startElemCtxs ] | ||
170 | , Map.fromList [ ((JNElement ctx, dgt), (JNNumberDigits True ctx', Seq.singleton dgt)) | (ctx, ctx') <- startElemCtxs, dgt <- ['1'..'9'] ] | ||
171 | , Map.fromList [ ((JNNumberDigits True ctx, '0'), (JNNumberDigits True ctx, "0")) | ctx <- universeF ] | ||
172 | , Map.fromList [ ((JNNumberDigits b ctx, dgt), (JNNumberDigits True ctx, Seq.singleton dgt)) | ctx <- universeF, dgt <- ['1'..'9'], b <- universeF ] | ||
173 | , Map.fromList [ ((JNNumberDigits True ctx, '.'), (JNNumberDecimalDigits False ctx, ".")) | ctx <- universeF ] | ||
174 | , Map.fromList [ ((JNNumberDecimal ctx, '.'), (JNNumberDecimalDigits False ctx, ".")) | ctx <- universeF ] | ||
175 | , Map.fromList [ ((JNNumberDecimalDigits b ctx, dgt), (JNNumberDecimalDigits True ctx, Seq.singleton dgt)) | ctx <- universeF, dgt <- ['0'..'9'], b <- universeF ] | ||
176 | , Map.fromList [ ((JNNumberDecimalDigits True ctx, e), (JNNumberExpSign ctx, "e")) | ctx <- universeF, e <- "eE" ] | ||
177 | , Map.fromList [ ((JNNumberDigits True ctx, e), (JNNumberExpSign ctx, "e")) | ctx <- universeF, e <- "eE" ] | ||
178 | , Map.fromList [ ((JNNumberDecimal ctx, e), (JNNumberExpSign ctx, "e")) | ctx <- universeF, e <- "eE" ] | ||
179 | , Map.fromList [ ((JNNumberExpSign ctx, sgn), (JNNumberExpDigits False ctx, Seq.singleton sgn)) | ctx <- universeF, sgn <- "+-" ] | ||
180 | , Map.fromList [ ((JNNumberExpSign ctx, dgt), (JNNumberExpDigits True ctx, Seq.singleton dgt)) | ctx <- universeF, dgt <- ['0'..'9'] ] | ||
181 | , Map.fromList [ ((JNNumberExpDigits b ctx, dgt), (JNNumberExpDigits True ctx, Seq.singleton dgt)) | ctx <- universeF, dgt <- ['0'..'9'], b <- universeF ] | ||
182 | , mconcat $ do | ||
183 | end <- [ JNNumberExpDigits True, JNNumberDecimal, JNNumberDigits True, JNNumberDecimalDigits True ] | ||
184 | id | ||
185 | [ Map.fromList [ ((end ctx, ':'), (JNElement JCDictVal, " : ")) | ctx <- [JCDictKey, JCInDet] ] | ||
186 | , Map.singleton (end JCArrayVal, ',') (JNElement JCArrayVal, "\n, ") | ||
187 | , Map.singleton (end JCDictVal, ',') (JNElement JCDictKey, "\n, ") | ||
188 | , Map.singleton (end JCInDet, ',') (JNElement JCInDet, "\n, ") | ||
189 | , Map.fromList [ ((end ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ] | ||
190 | , Map.fromList [ ((end ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ] | ||
191 | , Map.fromList [ ((end ctx, sym), (JNNumberEnd ctx, Seq.empty)) | ctx <- universeF, sym <- whitespace ] | ||
192 | ] | ||
193 | , Map.fromList [ ((JNNumberEnd ctx, ':'), (JNElement JCDictVal, " : ")) | ctx <- [JCDictKey, JCInDet] ] | ||
194 | , Map.singleton (JNNumberEnd JCArrayVal, ',') (JNElement JCArrayVal, "\n, ") | ||
195 | , Map.singleton (JNNumberEnd JCDictVal, ',') (JNElement JCDictKey, "\n, ") | ||
196 | , Map.singleton (JNNumberEnd JCInDet, ',') (JNElement JCInDet, "\n, ") | ||
197 | , Map.fromList [ ((JNNumberEnd ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ] | ||
198 | , Map.fromList [ ((JNNumberEnd ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ] | ||
70 | ] | 199 | ] |
71 | , stAccept = Set.fromList [JNOutsideStructure, JNUndeterminedStructure] | 200 | , stAccept = Set.fromList $ do |
201 | end <- endStates | ||
202 | ctx <- [JCTop, JCInDet] | ||
203 | return $ end ctx | ||
72 | } | 204 | } |
73 | where | 205 | where |
206 | startElemCtxs = map (\x -> (x, x)) [JCInDet, JCDictKey, JCDictVal, JCArrayVal, JCTop] ++ [(JCArray, JCArrayVal), (JCDict, JCDictKey)] | ||
207 | literals = [ ("true", JNTrue), ("false", JNFalse), ("null", JNNull) ] | ||
74 | whitespace = toEnum <$> [0x0020, 0x0009, 0x000a, 0x000d] | 208 | whitespace = toEnum <$> [0x0020, 0x0009, 0x000a, 0x000d] |
209 | |||
210 | endStates = [JNElement, JNStringEnd, JNNumberExpDigits True, JNNumberDecimal, JNNumberDigits True, JNNumberDecimalDigits True] ++ [ st lit | (lit, st) <- literals] | ||
211 | dfstMap "linebreak" = Just . SomeDFST $ DFST | ||
212 | { stInitial = LineBreak 0 | ||
213 | , stTransition = mconcat | ||
214 | [ Map.fromList [ ((LineBreak n, sym), (LineBreak $ succ n, Seq.singleton sym)) | n <- [0..79], sym <- map toEnum [0..255], isPrint sym, sym /= '\n' ] | ||
215 | , Map.fromList [ ((LineBreak n, '\n'), (LineBreak $ succ n, Seq.singleton ' ')) | n <- [0..79] ] | ||
216 | , Map.singleton (LineBreak 80, ' ') (LineBreak 0, Seq.singleton '\n') | ||
217 | , Map.singleton (LineBreak 80, '\n') (LineBreak 0, Seq.singleton '\n') | ||
218 | , Map.fromList [ ((LineBreak 80, sym), (LineBreak 80, Seq.singleton sym)) | sym <- map toEnum [0..255], isPrint sym, sym /= ' ', sym /= '\n' ] | ||
219 | ] | ||
220 | , stAccept = Set.fromList universeF | ||
221 | } | ||
75 | dfstMap _ = Nothing | 222 | dfstMap _ = Nothing |
76 | 223 | ||
77 | main :: IO () | 224 | main :: IO () |
@@ -13,3 +13,6 @@ nix: | |||
13 | build: | 13 | build: |
14 | library-profiling: true | 14 | library-profiling: true |
15 | executable-profiling: true | 15 | executable-profiling: true |
16 | |||
17 | extra-deps: | ||
18 | - dotgen-0.4.2 | ||
@@ -14,6 +14,5 @@ Dabei werden wir die Definitionen aus \cite{hofmann2012edit} sowohl in natürlic | |||
14 | \subsection{Edit-lenses für deterministic finite state transducers} | 14 | \subsection{Edit-lenses für deterministic finite state transducers} |
15 | \input{./edit-lens/src/Control/DFST/Lens.lhs} | 15 | \input{./edit-lens/src/Control/DFST/Lens.lhs} |
16 | 16 | ||
17 | % \section{Container} | 17 | \subsection{Ausblick: Edit-lenses für non-determinische finite state transducers} |
18 | 18 | \input{./edit-lens/src/Control/FST/Lens.tex} | |
19 | % TODO: recover from git | ||