diff options
Diffstat (limited to 'edit-lens/src/Control/DFST/Lens.lhs')
-rw-r--r-- | edit-lens/src/Control/DFST/Lens.lhs | 405 |
1 files changed, 137 insertions, 268 deletions
diff --git a/edit-lens/src/Control/DFST/Lens.lhs b/edit-lens/src/Control/DFST/Lens.lhs index 1e5bbb1..8222db2 100644 --- a/edit-lens/src/Control/DFST/Lens.lhs +++ b/edit-lens/src/Control/DFST/Lens.lhs | |||
@@ -7,11 +7,9 @@ | |||
7 | #-} | 7 | #-} |
8 | 8 | ||
9 | module Control.DFST.Lens | 9 | module Control.DFST.Lens |
10 | ( StringEdit(..), sePos, seInsertion | 10 | ( DFSTAction(..), DFSTComplement |
11 | , StringEdits(..), _StringEdits, _SEFail, stringEdits | ||
12 | , insert, delete, replace | ||
13 | , DFSTAction(..), DFSTComplement | ||
14 | , dfstLens | 11 | , dfstLens |
12 | , module Control.Edit.String | ||
15 | , module Control.DFST | 13 | , module Control.DFST |
16 | , module Control.Lens.Edit | 14 | , module Control.Lens.Edit |
17 | ) where | 15 | ) where |
@@ -20,9 +18,12 @@ import Control.DFST | |||
20 | import Control.FST hiding (stInitial, stTransition, stAccept) | 18 | import Control.FST hiding (stInitial, stTransition, stAccept) |
21 | import qualified Control.FST as FST (stInitial, stTransition, stAccept, step) | 19 | import qualified Control.FST as FST (stInitial, stTransition, stAccept, step) |
22 | import Control.Lens.Edit | 20 | import Control.Lens.Edit |
21 | import Control.Lens.Edit.ActionTree | ||
23 | import Control.Lens | 22 | import Control.Lens |
24 | import Control.Lens.TH | 23 | import Control.Lens.TH |
25 | import Control.Edit | 24 | import Control.Edit |
25 | import Control.Edit.String | ||
26 | import Control.Edit.String.Affected | ||
26 | 27 | ||
27 | import Control.Monad | 28 | import Control.Monad |
28 | 29 | ||
@@ -64,94 +65,8 @@ import Data.Universe (Finite(..)) | |||
64 | \end{code} | 65 | \end{code} |
65 | \end{comment} | 66 | \end{comment} |
66 | 67 | ||
67 | 68 | \begin{defn}[Ausgabe-Wirkung von DFSTs] | |
68 | \begin{defn}[Atomare edits of strings] | 69 | Wir definieren zunächst die \emph{Ausgabe-Wirkung}\footnote{Wir schreiben im Folgenden auch nur \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. |
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 | |||
71 | \begin{code} | ||
72 | data StringEdit pos char = Insert { _sePos :: pos, _seInsertion :: char } | ||
73 | | Delete { _sePos :: pos } | ||
74 | deriving (Eq, Ord, Show, Read) | ||
75 | |||
76 | -- Automatically derive van-leerhoven-lenses: | ||
77 | -- | ||
78 | -- @sePos :: Lens' (StringEdits pos char) pos@ | ||
79 | -- @seInsertion :: Traversal' (StringEdits pos char) char@ | ||
80 | makeLenses ''StringEdit | ||
81 | \end{code} | ||
82 | |||
83 | Atomare edits werden, als Liste, zu edits komponiert. | ||
84 | Wir führen einen speziellen edit ein, der nicht-Anwendbarkeit der edits repräsentiert: | ||
85 | \begin{code} | ||
86 | data StringEdits pos char = StringEdits (Seq (StringEdit pos char)) | ||
87 | | SEFail | ||
88 | deriving (Eq, Ord, Show, Read) | ||
89 | |||
90 | makePrisms ''StringEdits | ||
91 | |||
92 | stringEdits :: Traversal (StringEdits pos char) (StringEdits pos' char') (StringEdit pos char) (StringEdit pos' char') | ||
93 | \end{code} | ||
94 | \end{defn} | ||
95 | |||
96 | \begin{comment} | ||
97 | \begin{code} | ||
98 | stringEdits = _StringEdits . traverse | ||
99 | |||
100 | insert :: pos -> char -> StringEdits pos char | ||
101 | insert n c = StringEdits . Seq.singleton $ Insert n c | ||
102 | |||
103 | delete :: pos -> StringEdits pos char | ||
104 | delete n = StringEdits . Seq.singleton $ Delete n | ||
105 | |||
106 | replace :: Eq pos => pos -> char -> StringEdits pos char | ||
107 | replace n c = insert n c <> delete n | ||
108 | |||
109 | -- | Rudimentarily optimize edit composition | ||
110 | instance Eq pos => Monoid (StringEdits pos char) where | ||
111 | mempty = StringEdits Seq.empty | ||
112 | SEFail `mappend` _ = SEFail | ||
113 | _ `mappend` SEFail = SEFail | ||
114 | (StringEdits Seq.Empty) `mappend` x = x | ||
115 | x `mappend` (StringEdits Seq.Empty) = x | ||
116 | (StringEdits x@(bs :|> b)) `mappend` (StringEdits y@(a :<| as)) | ||
117 | | (Insert n _) <- a | ||
118 | , (Delete n') <- b | ||
119 | , n == n' | ||
120 | = StringEdits bs `mappend` StringEdits as | ||
121 | | otherwise = StringEdits $ x `mappend` y | ||
122 | \end{code} | ||
123 | \end{comment} | ||
124 | |||
125 | Da wir ein minimales Set an atomaren edits gewählt haben, ist die Definiton der Modulnstruktur über Strings des passenden Alphabets recht einfach: | ||
126 | \begin{code} | ||
127 | instance Module (StringEdits Natural char) where | ||
128 | type Domain (StringEdits Natural char) = Seq char | ||
129 | apply str SEFail = Nothing | ||
130 | apply str (StringEdits Seq.Empty) = Just str | ||
131 | apply str (StringEdits (es :|> Insert n c)) = flip apply (StringEdits es) =<< go str n c | ||
132 | where | ||
133 | go Seq.Empty n c | ||
134 | | n == 0 = Just $ Seq.singleton c | ||
135 | | otherwise = Nothing | ||
136 | go str@(x :<| xs) n c | ||
137 | | n == 0 = Just $ c <| str | ||
138 | | otherwise = (x <|) <$> go xs (pred n) c | ||
139 | apply str (StringEdits (es :|> Delete n)) = flip apply (StringEdits es) =<< go str n | ||
140 | where | ||
141 | go Seq.Empty _ = Nothing | ||
142 | go (x :<| xs) n | ||
143 | | n == 0 = Just xs | ||
144 | | otherwise = (x <|) <$> go xs (pred n) | ||
145 | |||
146 | init = Seq.empty | ||
147 | divInit = StringEdits . Seq.unfoldl go . (0,) | ||
148 | where | ||
149 | go (_, Seq.Empty) = Nothing | ||
150 | go (n, c :<| cs ) = Just ((succ n, cs), Insert n c) | ||
151 | |||
152 | \end{code} | ||
153 | |||
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. | ||
155 | Wir annotieren Wirkungen zudem mit dem konsumierten String. | 70 | Wir annotieren Wirkungen zudem mit dem konsumierten String. |
156 | Diese Wirkungen bilden einen Monoiden analog zu Endomorphismen, wobei die Resultat-Strings concateniert werden. | 71 | Diese Wirkungen bilden einen Monoiden analog zu Endomorphismen, wobei die Resultat-Strings concateniert werden. |
157 | 72 | ||
@@ -175,13 +90,24 @@ instance Monoid (DFSTAction state input output) where | |||
175 | } | 90 | } |
176 | \end{code} | 91 | \end{code} |
177 | \end{comment} | 92 | \end{comment} |
93 | \end{defn} | ||
178 | 94 | ||
95 | \begin{eg} \label{eg:linebreakonw100} | ||
96 | Die Wirkung des DFST aus Beispiel~\ref{eg:linebreak} auf das Wort $w$ aus Beispiel~\ref{eg:w100} ist: | ||
97 | |||
98 | \begin{align*} | ||
99 | \text{act} & \colon Q \to \Delta^\star \times \{ \bot \} \cup Q \\ | ||
100 | 0 & \mapsto (0\, 1\, \ldots\, 80\, \text{\tt \textbackslash n}\, 81\, \ldots\, 98, 19) \\ | ||
101 | 1 & \mapsto (0\, 1\, \ldots\, 79\, \text{\tt \textbackslash n}\, 80\, \ldots\, 98, 18) \\ | ||
102 | & \vdots | ||
103 | \end{align*} | ||
104 | \end{eg} | ||
105 | |||
106 | |||
107 | \begin{comment} | ||
179 | \begin{code} | 108 | \begin{code} |
180 | dfstAction :: forall state input output. (Finite state, Ord state, Ord input) => DFST state input output -> input -> DFSTAction state input output | 109 | 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 | 110 | -- | 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{..} | 111 | dfstAction dfst (Seq.singleton -> dfstaConsumes) = DFSTAction{..} |
186 | where | 112 | where |
187 | runDFSTAction :: state -> (Seq output, Maybe state) | 113 | runDFSTAction :: state -> (Seq output, Maybe state) |
@@ -193,11 +119,35 @@ dfstAction dfst (Seq.singleton -> dfstaConsumes) = DFSTAction{..} | |||
193 | \end{comment} | 119 | \end{comment} |
194 | 120 | ||
195 | Wir halten im Komplement der edit-lens einen Cache der monoidalen Summen aller kontinuirlichen Teillisten. | 121 | 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. | 122 | \texttt{Compositions} ist hierbei ein balancierter Binärbaum, dessen innere Knoten mit der monoidalen Summe der Annotationen aller Blätter des jeweiligen Teilbaums annotiert sind. |
197 | \begin{code} | 123 | \begin{code} |
198 | type DFSTComplement state input output = Compositions (DFSTAction state input output) | 124 | type DFSTComplement state input output = Compositions (DFSTAction state input output) |
199 | \end{code} | 125 | \end{code} |
200 | 126 | ||
127 | Wir bedienen uns hierbei einer bestehenden Programmbibliothek \cite{composition-tree} um das Balancieren bei Modifikation des Baums nicht implementieren zu müssen. | ||
128 | |||
129 | \begin{eg} | ||
130 | Wir definieren zunächst einen weiteren, sehr einfachen, DFST: | ||
131 | |||
132 | \begin{figure}[H] | ||
133 | \centering | ||
134 | \pinclude{presentation/switchdfst.tex} | ||
135 | \caption{\label{fig:switchdfst} Ein einfacher DFST, der zwischen zwei Zustanden wechselt und Ausgabe abhängig vom aktuellen Zustand erzeugt} | ||
136 | \end{figure} | ||
137 | |||
138 | Auf $s$ wechselt der DFST seinen Zustand, auf $p$ produziert er, abhängig vom aktuellen Zustand, genau ein Zeichen. | ||
139 | |||
140 | Wir stellen die Wirkung des DFST auf den Eingabe-String $spp$ grafisch analog zur Baumstruktur von \texttt{Compositions} dar. | ||
141 | Wir bedienen uns hier der Darstellung von Automaten-Wirkungen als \emph{Schaltboxen} aus \cite{hofmann2011automatentheorie}, angepasst für DFSTs indem wir die Ausgabe des Automaten an den Pfaden innerhalb der Schaltbox annotieren. | ||
142 | |||
143 | \begin{figure}[H] | ||
144 | \centering | ||
145 | \pinclude{presentation/comptree.tex} | ||
146 | \caption{Die Wirkung der Eingabe $spp$ auf den Automaten aus Abbildung \ref{fig:switchdfst}} | ||
147 | \end{figure} | ||
148 | \end{eg} | ||
149 | |||
150 | \begin{comment} | ||
201 | \begin{code} | 151 | \begin{code} |
202 | runDFSTAction' :: DFSTComplement state input output -> state -> (Seq output, Maybe state) | 152 | runDFSTAction' :: DFSTComplement state input output -> state -> (Seq output, Maybe state) |
203 | runDFSTAction' = runDFSTAction . Comp.composed | 153 | runDFSTAction' = runDFSTAction . Comp.composed |
@@ -208,6 +158,7 @@ dfstaConsumes' = dfstaConsumes . Comp.composed | |||
208 | dfstaProduces :: DFSTComplement state input output -> state -> Seq output | 158 | dfstaProduces :: DFSTComplement state input output -> state -> Seq output |
209 | dfstaProduces = fmap fst . runDFSTAction' | 159 | dfstaProduces = fmap fst . runDFSTAction' |
210 | \end{code} | 160 | \end{code} |
161 | \end{comment} | ||
211 | 162 | ||
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. | 163 | 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. |
213 | 164 | ||
@@ -229,6 +180,55 @@ Die input-edits können nun wiederum, unter Beachtung der Verschiebung der indic | |||
229 | \begin{comment} | 180 | \begin{comment} |
230 | \begin{code} | 181 | \begin{code} |
231 | type LState state input output = (Natural, (state, Maybe (input, Natural))) | 182 | type LState state input output = (Natural, (state, Maybe (input, Natural))) |
183 | |||
184 | instance (Ord state, Ord input, Ord output, Show state, Show input, Show output, Finite state) => Action (DFSTAction state input output) input output where | ||
185 | type ActionParam (DFSTAction state input output) = DFST state input output | ||
186 | type ActionState (DFSTAction state input output) = state | ||
187 | |||
188 | actionFail = DFSTAction (\_ -> (Seq.empty, Nothing)) Seq.empty | ||
189 | |||
190 | actionSingleInput = dfstAction | ||
191 | |||
192 | actionGroundState = stInitial | ||
193 | actionStateFinal DFST{..} final = final `Set.member` stAccept | ||
194 | actionState _ act st = view _2 $ runDFSTAction' act st | ||
195 | actionProduces _ act st = dfstaProduces act st | ||
196 | |||
197 | actionConsumes _ = dfstaConsumes' | ||
198 | |||
199 | actionFindPath DFST{..} iState affNewOut fState suffix = do | ||
200 | let | ||
201 | outFST :: FST (LState state input output) input output | ||
202 | outFST = restrictOutput affNewOut $ toFST DFST | ||
203 | { stInitial = iState | ||
204 | , stTransition | ||
205 | , stAccept = Set.fromList $ do | ||
206 | fin <- Set.toList $ stAccept `Set.union` Set.map fst (Map.keysSet stTransition) | ||
207 | (suffOut, Just fin') <- return $ runDFSTAction' suffix fin | ||
208 | guard $ Set.member fin' stAccept | ||
209 | guard $ suffOut == dfstaProduces suffix fState | ||
210 | return fin | ||
211 | } | ||
212 | -- trace (show $ pretty outFST) $ Just () | ||
213 | |||
214 | newPath <- | ||
215 | let | ||
216 | FST{..} = outFST | ||
217 | detOutgoing :: Maybe (LState state input output) -> [(LState state input output, (Maybe input, Maybe output))] | ||
218 | detOutgoing Nothing = concatMap detOutgoing . map Just $ toList stInitial | ||
219 | detOutgoing (Just st) = concatMap (\((_, inS), outs) -> map (\(st', outS) -> (st', (inS, outS))) $ toList outs) . Map.toList $ Map.filterWithKey (\(st', _) _ -> st == st') stTransition | ||
220 | predicate :: [(LState state input output, (Maybe input, Maybe output))] -> Maybe Bool | ||
221 | predicate [] | ||
222 | | not . Set.null $ Set.intersection stInitial stAccept = Just True | ||
223 | | otherwise = Nothing | ||
224 | predicate ((lastSt, _) : _) | ||
225 | | Set.member lastSt stAccept = Just True | ||
226 | | otherwise = Nothing | ||
227 | in bfs detOutgoing predicate | ||
228 | |||
229 | -- trace (show newPath) $ Just () | ||
230 | |||
231 | return . Seq.fromList . mapMaybe (\(_st, (inS, _outS)) -> inS) $ reverse newPath | ||
232 | \end{code} | 232 | \end{code} |
233 | \end{comment} | 233 | \end{comment} |
234 | \begin{code} | 234 | \begin{code} |
@@ -236,130 +236,12 @@ dfstLens :: forall state input output. (Ord state, Ord input, Ord output, Show s | |||
236 | \end{code} | 236 | \end{code} |
237 | \begin{comment} | 237 | \begin{comment} |
238 | \begin{code} | 238 | \begin{code} |
239 | dfstLens dfst@DFST{..} = EditLens ground propR propL | 239 | dfstLens = treeLens |
240 | where | ||
241 | ground :: DFSTComplement state input output | ||
242 | ground = mempty | ||
243 | |||
244 | propR :: (DFSTComplement state input output, StringEdits Natural input) -> (DFSTComplement state input output, StringEdits Natural output) | ||
245 | propR (c, SEFail) = (c, SEFail) | ||
246 | propR (c, StringEdits Seq.Empty) = (c, mempty) | ||
247 | propR (c, lEs@(StringEdits (es :> e))) | ||
248 | | (_, Just final) <- runDFSTAction' c' stInitial | ||
249 | , final `Set.member` stAccept | ||
250 | = (c', rEs) | ||
251 | | otherwise | ||
252 | = (c, SEFail) | ||
253 | where | ||
254 | Just int = affected lEs | ||
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 | ||
257 | cSuffix' | ||
258 | | Delete _ <- e | ||
259 | , Comp.length cSuffix > 0 = Comp.take (pred $ Comp.length cSuffix) cSuffix | ||
260 | | Insert _ nChar <- e = cSuffix <> Comp.singleton (dfstAction dfst nChar) | ||
261 | | otherwise = Comp.singleton $ DFSTAction (\_ -> (Seq.empty, Nothing)) Seq.empty | ||
262 | (c', _) = propR (cSuffix' <> cPrefix, StringEdits es) | ||
263 | (cAffSuffix', _) = Comp.splitAt (Comp.length c' - Comp.length cAffPrefix) c' | ||
264 | (_, Just pFinal) = runDFSTAction' cAffPrefix stInitial | ||
265 | rEs = strDiff (dfstaProduces cAffSuffix pFinal) (dfstaProduces cAffSuffix' pFinal) & stringEdits . sePos . from enum +~ length (dfstaProduces cAffPrefix stInitial) | ||
266 | |||
267 | |||
268 | propL :: (DFSTComplement state input output, StringEdits Natural output) -> (DFSTComplement state input output, StringEdits Natural input) | ||
269 | propL (c, StringEdits Seq.Empty) = (c, mempty) | ||
270 | propL (c, es) = fromMaybe (c, SEFail) $ do | ||
271 | -- Determine states @(iState, fState)@ at the boundary of the region affected by @es@ | ||
272 | ((,) <$> Int.inf <*> Int.sup -> (minAff, maxAff)) <- 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 | |||
308 | let outFST :: FST (LState state input output) input output | ||
309 | outFST = restrictOutput affNewOut $ toFST DFST | ||
310 | { stInitial = iState | ||
311 | , stTransition | ||
312 | , stAccept = Set.fromList $ do | ||
313 | fin <- Set.toList $ stAccept `Set.union` Set.map fst (Map.keysSet stTransition) | ||
314 | (suffOut, Just fin') <- return $ runDFSTAction' suffix fin | ||
315 | guard $ Set.member fin' stAccept | ||
316 | guard $ suffOut == dfstaProduces suffix fState | ||
317 | return fin | ||
318 | } | ||
319 | trace (show $ pretty outFST) $ Just () | ||
320 | |||
321 | newPath <- | ||
322 | let | ||
323 | FST{ .. } = outFST | ||
324 | detOutgoing :: Maybe (LState state input output) -> [(LState state input output, (Maybe input, Maybe output))] | ||
325 | detOutgoing Nothing = concatMap detOutgoing . map Just $ toList stInitial | ||
326 | detOutgoing (Just st) = concatMap (\((_, inS), outs) -> map (\(st', outS) -> (st', (inS, outS))) $ toList outs) . Map.toList $ Map.filterWithKey (\(st', _) _ -> st == st') stTransition | ||
327 | predicate :: [(LState state input output, (Maybe input, Maybe output))] -> Maybe Bool | ||
328 | predicate [] | ||
329 | | not . Set.null $ Set.intersection stInitial stAccept = Just True | ||
330 | | otherwise = Nothing | ||
331 | predicate ((lastSt, _) : _) | ||
332 | | Set.member lastSt stAccept = Just True | ||
333 | | otherwise = Nothing | ||
334 | in bfs detOutgoing predicate | ||
335 | |||
336 | trace (show newPath) $ Just () | ||
337 | |||
338 | let oldIn = dfstaConsumes' . Comp.drop (Comp.length suffix) $ Comp.take (Comp.length c - Comp.length prefix) c | ||
339 | newIn = Seq.fromList . mapMaybe (\(_st, (inS, _outS)) -> inS) $ reverse newPath | ||
340 | inDiff = oldIn `strDiff` newIn | ||
341 | diffOffset = fromIntegral . Seq.length $ dfstaConsumes' prefix | ||
342 | inDiff' = inDiff & stringEdits . sePos +~ diffOffset | ||
343 | |||
344 | trace (show (oldIn, newIn, inDiff')) $ Just () | ||
345 | |||
346 | let affComp = Comp.fromList [ dfstAction dfst inS | (_st, (Just inS, _outS)) <- newPath ] | ||
347 | |||
348 | return (suffix <> affComp <> prefix, inDiff') | ||
349 | |||
350 | strDiff :: forall sym pos. (Eq sym, Integral pos) => Seq sym -> Seq sym -> StringEdits pos sym | ||
351 | -- ^ @strDiff a b@ calculates a set of edits, which, when applied to @a@, produce @b@ | ||
352 | strDiff a b = snd . foldl toEdit (0, mempty) $ (getDiff `on` toList) a b | ||
353 | where | ||
354 | toEdit :: (pos, StringEdits pos sym) -> Diff sym -> (pos, StringEdits pos sym) | ||
355 | toEdit (n, es) (Diff.Both _ _) = (succ n, es) | ||
356 | toEdit (n, es) (Diff.First _ ) = (n, delete n <> es) | ||
357 | toEdit (n, es) (Diff.Second c) = (succ n, insert n c <> es) | ||
358 | 240 | ||
359 | -- | Generic breadth-first search | 241 | -- | Generic breadth-first search |
360 | bfs :: forall state transition. Ord state | 242 | bfs :: forall state transition. Ord state |
361 | => (Maybe state -> [(state, transition)]) -- ^ Find outgoing edges | 243 | => (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 | 244 | -> ([(state, transition)] {- Reverse path -} -> Maybe Bool {- Continue search, finish successfully, or abort search on this branch -}) -- ^ Search predicate |
363 | -> Maybe [(state, transition)] -- ^ Reverse path | 245 | -> Maybe [(state, transition)] -- ^ Reverse path |
364 | bfs outgoing predicate | 246 | bfs outgoing predicate |
365 | | Just True <- emptyRes = Just [] | 247 | | Just True <- emptyRes = Just [] |
@@ -378,59 +260,46 @@ bfs outgoing predicate | |||
378 | Nothing -> bfs' visited' $ cs <> Seq.fromList (map (: c) . filter (\(st, _) -> not $ Set.member st visited) . outgoing $ Just lastSt) | 260 | Nothing -> bfs' visited' $ cs <> Seq.fromList (map (: c) . filter (\(st, _) -> not $ Set.member st visited) . outgoing $ Just lastSt) |
379 | where | 261 | where |
380 | visited' = Set.insert lastSt visited | 262 | visited' = Set.insert lastSt visited |
381 | \end{code} | ||
382 | \end{comment} | ||
383 | 263 | ||
384 | Um eine obere Schranke an das von einer Serie von edits betroffene Intervall zu bestimmen ordnen wir zunächst jeder von mindestens einem atomaren edit betroffenen Position $n$ im Eingabe-Wort einen $\text{offset}_n = \text{\# deletions} - \text{\# inserts}$ zu. | 264 | -- trace :: String -> a -> a |
385 | Das gesuchte Intervall ist nun $(\text{minK}, \text{maxK})$, mit $\text{minK}$ der Position im Eingabe-Wort mit niedrigstem $\text{offset}$ und $\text{maxK}$ die Position im Eingabe-Wort mit höchstem $\text{offset}$, $\text{maxK}^\prime$, modifiziert um das Maximum aus $\{ 0 \} \cup \{ \text{maxK}_n \colon n \in \{ 0 \ldots \text{maxK}^\prime \} \}$ wobei $\text{maxK}_n = -1 \cdot (n + \text{offset}_n)$ an Position $n$ ist. | 265 | -- {-# NOINLINE trace #-} |
266 | -- trace str y = flip seq y . unsafePerformIO . withFile "lens.log" AppendMode $ \h -> | ||
267 | -- hPutStrLn h str | ||
386 | 268 | ||
387 | \begin{code} | 269 | -- traceShowId :: Show a => a -> a |
388 | affected :: forall char. StringEdits Natural char -> Maybe (Interval Natural) | 270 | -- traceShowId x = trace (show x) x |
389 | -- ^ For a given set of edits @es@ return the interval @i = a ... b@ such that for any given string @str@ of sufficient length the following holds: | ||
390 | -- | ||
391 | -- - For all @n :: Natural@: @n < a ==> str ! n == (str `apply` es) ! n@ | ||
392 | -- - There exists a @k :: Integer@ such that for all @n :: Integer@: @n > b ==> str ! (n + k) == (str `apply` es) ! n@ | ||
393 | -- | ||
394 | -- Intuitively: for any character @c@ of the new string @str `apply` es@ there exists a corresponding character in @str@ (offset by either 0 or a constant shift @k@) if the index of @c@ is /not/ contained in @affected es@. | ||
395 | \end{code} | ||
396 | \begin{comment} | ||
397 | \begin{code} | ||
398 | affected SEFail = Nothing | ||
399 | affected (StringEdits es) = Just . toInterval $ go es Map.empty | ||
400 | where | ||
401 | toInterval :: Map Natural Integer -> Interval Natural | ||
402 | toInterval map | ||
403 | | Just (((minK, _), _), ((maxK, _), _)) <- (,) <$> Map.minViewWithKey map <*> Map.maxViewWithKey map | ||
404 | = let | ||
405 | maxV' = maximum . (0 :) $ do | ||
406 | offset <- [0..maxK] | ||
407 | v <- maybeToList $ Map.lookup (maxK - offset) map | ||
408 | v' <- maybeToList . fmap fromInteger $ negate v <$ guard (v <= 0) | ||
409 | guard $ v' >= succ offset | ||
410 | return $ v' - offset | ||
411 | in (minK Int.... maxK + maxV') | ||
412 | | otherwise | ||
413 | = Int.empty | ||
414 | go :: Seq (StringEdit Natural char) -> Map Natural Integer -> Map Natural Integer | ||
415 | go Seq.Empty offsets = offsets | ||
416 | go (es :> e) offsets = go es offsets' | ||
417 | where | ||
418 | p = e ^. sePos | ||
419 | -- p' = fromIntegral $ Map.foldrWithKey (\k o p -> bool (fromIntegral p) (o + p) $ k < fromIntegral p) (fromIntegral p) offsets | ||
420 | offsets' = Map.alter (Just . myOffset . fromMaybe 0) p offsets | ||
421 | myOffset :: Integer -> Integer | ||
422 | myOffset | ||
423 | | Insert _ _ <- e = pred | ||
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 | |||
435 | \end{code} | 271 | \end{code} |
436 | \end{comment} | 272 | \end{comment} |
273 | |||
274 | \begin{eg} | ||
275 | Wir wollen einen edit $e^\prime = \rho_{80}$ anwenden auf das Ergebnis $w^\prime$ der Ausführung des Zeilenumbruch-DFST aus Beispiel \ref{eg:linebreak} auf das Wort $w = 0\, 1\, \ldots\, 80\, \text{\tt \textbackslash n}\, 81\, \ldots\, 98$ aus Beispiel \ref{eg:w100} und dabei $e^\prime$ mittels $\Lleftarrow$ nach links propagieren und den assoziierten edit $e$ auf $w$ konstruieren. | ||
276 | |||
277 | \begin{equation*} | ||
278 | w^\prime = w = 0\, 1\, \ldots\, 80\, \text{\textbackslash n}\, 81\, \ldots\, 98 | ||
279 | \end{equation*} | ||
280 | |||
281 | Das von $e$ betroffene Intervall von $w^\prime$ ist $(80, 80)$. | ||
282 | |||
283 | Das Komplement nach Anwendung des DFST auf $w$ ist, wie in Beispiel \ref{eg:linebreakonw100} dargelegt: | ||
284 | |||
285 | \begin{align*} | ||
286 | \text{act} & \colon Q \to \Delta^\star \times \{ \bot \} \cup Q \\ | ||
287 | 0 & \mapsto (0\, 1\, \ldots\, 80\, \text{\tt \textbackslash n}\, 81\, \ldots\, 98, 19) \\ | ||
288 | 1 & \mapsto (0\, 1\, \ldots\, 79\, \text{\tt \textbackslash n}\, 80\, \ldots\, 98, 18) \\ | ||
289 | & \vdots | ||
290 | \end{align*} | ||
291 | |||
292 | Wir unterteilen $\text{act}$ an $(80, 80)$ in $\text{act}_\text{R} \circ \text{act}_e \circ \text{act}_\text{L}$: | ||
293 | |||
294 | \begin{align*} | ||
295 | \text{act}_\text{R} & \colon Q \to \Delta^\star \times \{ \bot \} \cup Q \\ | ||
296 | n & \mapsto (81\, \ldots\, 98, \min ( 80, n + 19 ) ) \\ | ||
297 | & \\ | ||
298 | \text{act}_e & \colon Q \to \Delta^\star \times \{ \bot \} \cup Q \\ | ||
299 | n & \mapsto ( \text{\tt \textbackslash n}, 0 ) \\ | ||
300 | & \\ | ||
301 | \text{act}_\text{L} & \colon Q \to \Delta^\star \times \{ \bot \} \cup Q \\ | ||
302 | n & \mapsto (0\, 1\, \ldots\, 80, 80) \\ | ||
303 | \text{other} & \mapsto (\epsilon, \bot) | ||
304 | \end{align*} | ||
305 | \end{eg} | ||