summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2019-02-19 11:39:51 +0100
committerGregor Kleen <gkleen@yggdrasil.li>2019-02-19 11:39:51 +0100
commit8afbe1f7df24034dd16fdf2e89b0665b2318ae2a (patch)
tree095be830c34c4aa9682a7047f4b0e412178ab24b
parent46ae60eaca841b554ba20c6a2b7a15b43c12b4df (diff)
downloadincremental-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.yaml2
-rw-r--r--edit-lens/src/Control/DFST.lhs27
-rw-r--r--edit-lens/src/Control/DFST/Lens.lhs345
-rw-r--r--edit-lens/src/Control/FST.lhs161
-rw-r--r--edit-lens/src/Control/FST/Lens.tex29
-rw-r--r--edit-lens/src/Control/Lens/Edit.lhs2
-rw-r--r--interactive-edit-lens/package.yaml1
-rw-r--r--interactive-edit-lens/src/Interact.hs4
-rw-r--r--interactive-edit-lens/src/Main.hs185
-rw-r--r--stack.yaml3
-rw-r--r--thesis.tex5
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
15import Data.Map.Lazy (Map, (!?)) 16import Data.Map.Lazy (Map, (!?), (!))
16import qualified Data.Map.Lazy as Map 17import qualified Data.Map.Lazy as Map
17 18
18import Data.Set (Set) 19import Data.Set (Set)
@@ -21,6 +22,8 @@ import qualified Data.Set as Set
21import Data.Sequence (Seq(..)) 22import Data.Sequence (Seq(..))
22import qualified Data.Sequence as Seq 23import qualified Data.Sequence as Seq
23 24
25import Data.Bool (bool)
26
24import Data.Monoid 27import Data.Monoid
25 28
26import Numeric.Natural 29import Numeric.Natural
@@ -30,6 +33,8 @@ import Control.Monad.State
30 33
31import Control.FST (FST(FST)) 34import Control.FST (FST(FST))
32import qualified Control.FST as FST 35import qualified Control.FST as FST
36
37import 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}
44data DFST state input output = DFST 53data DFST state input output = DFST
@@ -105,5 +114,21 @@ runDFST' _ st Empty acc = (acc, Just st)
105runDFST' dfst@DFST{..} st (c :<| cs) acc = case stTransition !? (st, c) of 114runDFST' 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
118dotDFST :: forall state input output. (Ord state, Ord input, Ord output, Show state, Show input, Show output) => DFST state input output -> Dot ()
119dotDFST 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
37import Data.Map.Lazy (Map) 37import Data.Map.Lazy (Map)
38import qualified Data.Map.Lazy as Map 38import qualified Data.Map.Lazy as Map
39 39
40import qualified Data.Map as Strict (Map)
41import qualified Data.Map.Strict as Strict.Map
42
40import Data.Compositions (Compositions) 43import Data.Compositions (Compositions)
41import qualified Data.Compositions as Comp 44import qualified Data.Compositions as Comp
42 45
@@ -45,23 +48,26 @@ import qualified Data.Algorithm.Diff as Diff
45 48
46import Data.Monoid 49import Data.Monoid
47import Data.Bool (bool) 50import Data.Bool (bool)
48import Data.Maybe (fromMaybe, maybeToList, listToMaybe, catMaybes, isNothing, isJust) 51import Data.Maybe (fromMaybe, maybeToList, listToMaybe, catMaybes, isNothing, isJust, mapMaybe)
49import Data.Function (on) 52import Data.Function (on)
50import Data.Foldable (toList) 53import Data.Foldable (toList)
51import Data.List (partition) 54import Data.List (partition, isPrefixOf)
52 55
53import Control.Exception (assert) 56import Control.Exception (assert)
54 57
58import System.IO (Handle, hPutStrLn, IOMode(AppendMode), withFile)
55import System.IO.Unsafe 59import System.IO.Unsafe
56import Text.PrettyPrint.Leijen (Pretty(..)) 60import Text.PrettyPrint.Leijen (Pretty(..))
57 61
62import Data.Universe (Finite(..))
63
58\end{code} 64\end{code}
59\end{comment} 65\end{comment}
60 66
61 67
62Wir 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]
69Wir 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}
66data StringEdit pos char = Insert { _sePos :: pos, _seInsertion :: char } 72data 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@
74makeLenses ''StringEdit 80makeLenses ''StringEdit
75\end{code} 81\end{code}
76\end{defn}
77 82
78Atomare edits werden, als Liste, zu edits komponiert. 83Atomare edits werden, als Liste, zu edits komponiert.
79Wir führen einen speziellen edit ein, der nicht-Anwendbarkeit der edits repräsentiert: 84Wir führen einen speziellen edit ein, der nicht-Anwendbarkeit der edits repräsentiert:
@@ -86,32 +91,19 @@ makePrisms ''StringEdits
86 91
87stringEdits :: Traversal (StringEdits pos char) (StringEdits pos' char') (StringEdit pos char) (StringEdit pos' char') 92stringEdits :: 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}
91stringEdits = _StringEdits . traverse 98stringEdits = _StringEdits . traverse
92\end{code} 99
93\end{comment}
94\begin{code}
95insert :: pos -> char -> StringEdits pos char 100insert :: pos -> char -> StringEdits pos char
96\end{code}
97\begin{comment}
98\begin{code}
99insert n c = StringEdits . Seq.singleton $ Insert n c 101insert n c = StringEdits . Seq.singleton $ Insert n c
100\end{code} 102
101\end{comment}
102\begin{code}
103delete :: pos -> StringEdits pos char 103delete :: pos -> StringEdits pos char
104\end{code}
105\begin{comment}
106\begin{code}
107delete n = StringEdits . Seq.singleton $ Delete n 104delete n = StringEdits . Seq.singleton $ Delete n
108\end{code} 105
109\end{comment}
110\begin{code}
111replace :: Eq pos => pos -> char -> StringEdits pos char 106replace :: Eq pos => pos -> char -> StringEdits pos char
112\end{code}
113\begin{comment}
114\begin{code}
115replace n c = insert n c <> delete n 107replace 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
133Da wir ein minimales set an atomaren edits gewählt haben, ist die Definiton der Modulnstruktur über Strings des passenden Alphabets recht einfach: 125Da 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}
135instance Module (StringEdits Natural char) where 127instance 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
164Um 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
166Gegeben 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
168Wir 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. 154Wir 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.
169Wir annotieren Wirkungen zudem mit dem konsumierten String. 155Wir annotieren Wirkungen zudem mit dem konsumierten String.
170Diese Wirkungen bilden einen Monoiden analog zu Endomorphismen, wobei die Resultat-Strings concateniert werden. 156Diese 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}
180dfstAction :: 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}
185dfstAction 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
195Wir 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}
194type DFSTComplement state input output = Compositions (DFSTAction state input output) 198type DFSTComplement state input output = Compositions (DFSTAction state input output)
199\end{code}
195 200
201\begin{code}
196runDFSTAction' :: DFSTComplement state input output -> state -> (Seq output, Maybe state) 202runDFSTAction' :: DFSTComplement state input output -> state -> (Seq output, Maybe state)
197runDFSTAction' = runDFSTAction . Comp.composed 203runDFSTAction' = runDFSTAction . Comp.composed
198 204
@@ -203,28 +209,22 @@ dfstaProduces :: DFSTComplement state input output -> state -> Seq output
203dfstaProduces = fmap fst . runDFSTAction' 209dfstaProduces = fmap fst . runDFSTAction'
204\end{code} 210\end{code}
205 211
206Die 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. 212Fü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
208Wir 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
210Da 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. 214Da 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.
211Die 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. 215Die 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.
212Nun 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. 216Nun 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
214Fü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: 218Fü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
216Wir 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
218Fü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. 220Wir 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
220Wir 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. 222Wir 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.
221Abweichungen 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.
222Es wird zudem, wie für Breitensuche üblich, jeder besuchte Zustand markiert und ausgehende Transitionen nicht ein zweites mal betrachtet.
223 223
224Erreichen 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. 224Wir 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.
225Hierbei 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
226In 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. 227Die 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.
227Wegen 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}
235dfstLens :: 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) 235dfstLens :: 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
408strDiff :: forall sym pos. (Eq sym, Integral pos) => Seq sym -> Seq sym -> StringEdits pos sym 350strDiff :: 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
360bfs :: 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
364bfs 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
426trace :: String -> a -> a
427{-# NOINLINE trace #-}
428trace str y = flip seq y . unsafePerformIO . withFile "lens.log" AppendMode $ \h ->
429 hPutStrLn h str
430
431traceShowId :: Show a => a -> a
432traceShowId 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
21import Data.Map.Lazy (Map, (!?), (!)) 21import Data.Map.Lazy (Map, (!?), (!))
@@ -38,6 +38,11 @@ import Control.Monad.State.Strict
38import Text.PrettyPrint.Leijen (Pretty(..)) 38import Text.PrettyPrint.Leijen (Pretty(..))
39import qualified Text.PrettyPrint.Leijen as PP 39import qualified Text.PrettyPrint.Leijen as PP
40 40
41import Data.Bool (bool)
42import Data.Monoid ((<>))
43
44import 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
50Zudem speichern wir die Transitionsrelation als multimap um effiziente lookups von Zustand-Eingabe-Paaren zu ermöglichen. 55Zudem speichern wir die Transitionsrelation als multimap um effiziente lookups von Zustand-Eingabe-Paaren zu ermöglichen.
51 56
52\begin{code} 57\begin{code}
53dFSeata FST state input output = FST 58data 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}
63instance (Show state, Show input, Show output) => Pretty (FST state input output) where 110instance (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]
83Wir definieren die Auswertung von finite state transducers induktiv indem wir zunächst angeben wie ein einzelner Auswertungs-Schritt erfolgt. 133Wir definieren die Auswertung von finite state transducers induktiv indem wir zunächst angeben wie ein einzelner Auswertungs-Schritt erfolgt.
84 134
85Hierzu kommentieren wir die Haskell-Implementierung eines Auswertungs-Schritts. 135Hierzu 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
149Es ist gelegentlich nützlich nur die möglichen Ausgaben eines FST auf gegebener 200Es ist gelegentlich nützlich nur die möglichen Ausgaben eines FST auf gegebener
150Eingabe zu bestimmen, wir führen eine Hilfsfunktion auf Basis von 201Eingabe 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
165Wir können das Produkt zweier FSTs definieren. 216Wir können das Produkt zweier FSTs definieren.
166Intuitiv 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.}. 217Intuitiv 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
168Hierfür berechnen wir das Graphen-Produkt der FSTs: 219Hierfü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
221Da 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. 272Da 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
223Zur Konstruktion eines derartigen \emph{Wort-FST}s nehmen wir Indizes im Ausgabe-Wort (natürliche Zahlen) als Zustände. 274Zur 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).
225Weiter ist $0$ initial und $\text{length}(\text{Ausgabe})$ der einzige akzeptierende Endzustand. 276Weiter 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
254Da \texttt{wordFST} zur Konstruktion eine komprehensive Menge aller Eingabesymbole benötigt verwenden wir im folgenden eine optimierte Variante des Produkts mit einem Wort-FST. 334Da \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}
263restrictOutput out FST{..} = FST 383restrictOutput 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
305liveFST fst@FST{..} = flip execState Set.empty $ mapM_ (depthSearch Set.empty) stInitial 425liveFST 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
439dotFST :: forall state input output. (Ord state, Ord input, Ord output, Show state, Show input, Show output) => FST state input output -> Dot ()
440dotFST 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 @@
1Es 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
3Eine natürlich Erweiterung von \texttt{DFSTAction} wäre:
4\begin{lstlisting}[language=Haskell]
5data FSTAction state input output = FSTAction
6 { runFSTAction :: state -> Map state [Seq output]
7 , fstaConsumes :: Seq input
8 }
9\end{lstlisting}
10wobei 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).
15Um 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.
16Quellen von Serien unendlich vieler output-Strings sind notwendigerweise Zykel im betrachteten FST.
17Wir könnten nun für jeden Zykel im betrachteten FST eine Kante arbiträr wählen und dem Folgen jener Kante Kosten zuweisen.
18Wenn 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
20Das 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).
21Diese Asymmetrie ergibt sich ausschließlich aus der Wahl des Komplements.
22
23Wählen wir stattdessen ein Komplement, dass Eingabe und Ausgabe symmetrisch behandelt:
24\begin{lstlisting}[language=Haskell]
25newtype FSTAction' state input output = FSTAction'
26 { runFSTAction' :: state -> Map state [Seq input, Seq output]
27 }
28\end{lstlisting}
29So 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
72Das einschlägige bestehende lens framework \cite{lens} konstruiert seine Linsen alá \citeauthor{laarhoven} wie folgt: 72Das 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]
75Fü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: 75Fü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
8import Control.DFST.Lens 8import Control.DFST.Lens
9import Control.DFST 9import Control.DFST
10 10
11import Control.Arrow ((&&&))
12
11import Data.Map (Map) 13import Data.Map (Map)
12import qualified Data.Map as Map 14import qualified Data.Map as Map
13 15
@@ -17,6 +19,8 @@ import qualified Data.Set as Set
17import Data.Sequence (Seq) 19import Data.Sequence (Seq)
18import qualified Data.Sequence as Seq 20import qualified Data.Sequence as Seq
19 21
22import Data.List ((\\), inits, tails)
23
20import Data.Char 24import Data.Char
21 25
22import System.Environment 26import System.Environment
@@ -24,10 +28,60 @@ import System.Exit
24 28
25import Debug.Trace 29import Debug.Trace
26 30
27data SomeDFST = forall state. (Ord state, Show state) => SomeDFST { someDFST :: DFST state Char Char } 31import Data.Universe
32
33data SomeDFST = forall state. (Ord state, Show state, Finite state) => SomeDFST { someDFST :: DFST state Char Char }
34
35data JsonContext = JCInDet | JCDict | JCDictKey | JCDictVal | JCArray | JCArrayVal | JCTop
36 deriving (Eq, Ord, Show, Read, Enum, Bounded)
37instance Universe JsonContext
38instance Finite JsonContext
28 39
29data JsonNewlState = JNUndeterminedStructure | JNOutsideStructure | JNInsideStructure | JNInsideString | JNEscape 40data 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)
45instance 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 \\ [""]
64instance Finite JsonNewlState
65
66jsonStrEscapes :: [(Char, Seq Char)]
67jsonStrEscapes = [ ('"', "\\\"")
68 , ('\\', "\\\\")
69 , ('/', "/")
70 , ('b', "\\b")
71 , ('f', "\\f")
72 , ('n', "\\n")
73 , ('r', "\\r")
74 , ('t', "\\t")
75 ]
76
77hexDigits :: [Char]
78hexDigits = ['0'..'9'] ++ ['a'..'f']
79
80data LineBreakState = LineBreak Int
81 deriving (Eq, Ord, Show, Read)
82instance Universe LineBreakState where
83 universe = [ LineBreak n | n <- [0..80] ]
84instance Finite LineBreakState
31 85
32dfstMap :: String -> Maybe SomeDFST 86dfstMap :: String -> Maybe SomeDFST
33dfstMap "double" = Just . SomeDFST $ DFST 87dfstMap "double" = Just . SomeDFST $ DFST
@@ -46,32 +100,125 @@ dfstMap "id" = Just . SomeDFST $ DFST
46 , stAccept = Set.singleton () 100 , stAccept = Set.singleton ()
47 } 101 }
48dfstMap "alternate" = Just . SomeDFST $ DFST 102dfstMap "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 }
56dfstMap "json-newl" = Just . SomeDFST $ DFST 110dfstMap "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]
211dfstMap "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 }
75dfstMap _ = Nothing 222dfstMap _ = Nothing
76 223
77main :: IO () 224main :: IO ()
diff --git a/stack.yaml b/stack.yaml
index 92dd54f..821983d 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -13,3 +13,6 @@ nix:
13build: 13build:
14 library-profiling: true 14 library-profiling: true
15 executable-profiling: true 15 executable-profiling: true
16
17extra-deps:
18 - dotgen-0.4.2
diff --git a/thesis.tex b/thesis.tex
index cf5c489..4156751 100644
--- a/thesis.tex
+++ b/thesis.tex
@@ -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