diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2019-05-30 12:18:08 +0200 |
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2019-05-30 12:18:08 +0200 |
| commit | f4c419b9ddec15bad267a4463f0720d6e28042d2 (patch) | |
| tree | 54a0259116476150247619c4410eae33f8669314 /edit-lens/src/Control/Edit/String/Affected.lhs | |
| parent | 8afbe1f7df24034dd16fdf2e89b0665b2318ae2a (diff) | |
| download | incremental-dfsts-f4c419b9ddec15bad267a4463f0720d6e28042d2.tar incremental-dfsts-f4c419b9ddec15bad267a4463f0720d6e28042d2.tar.gz incremental-dfsts-f4c419b9ddec15bad267a4463f0720d6e28042d2.tar.bz2 incremental-dfsts-f4c419b9ddec15bad267a4463f0720d6e28042d2.tar.xz incremental-dfsts-f4c419b9ddec15bad267a4463f0720d6e28042d2.zip | |
Further work
Diffstat (limited to 'edit-lens/src/Control/Edit/String/Affected.lhs')
| -rw-r--r-- | edit-lens/src/Control/Edit/String/Affected.lhs | 73 |
1 files changed, 73 insertions, 0 deletions
diff --git a/edit-lens/src/Control/Edit/String/Affected.lhs b/edit-lens/src/Control/Edit/String/Affected.lhs new file mode 100644 index 0000000..851267b --- /dev/null +++ b/edit-lens/src/Control/Edit/String/Affected.lhs | |||
| @@ -0,0 +1,73 @@ | |||
| 1 | \begin{comment} | ||
| 2 | \begin{code} | ||
| 3 | module Control.Edit.String.Affected | ||
| 4 | ( affected | ||
| 5 | ) where | ||
| 6 | |||
| 7 | import Control.Lens | ||
| 8 | import Control.Lens.TH | ||
| 9 | |||
| 10 | import Control.Edit | ||
| 11 | import Control.Edit.String | ||
| 12 | |||
| 13 | import Numeric.Natural | ||
| 14 | import Numeric.Interval (Interval, (...)) | ||
| 15 | import qualified Numeric.Interval as Int | ||
| 16 | |||
| 17 | import Data.Sequence (Seq((:<|), (:|>))) | ||
| 18 | import qualified Data.Sequence as Seq | ||
| 19 | |||
| 20 | import Data.Map.Lazy (Map) | ||
| 21 | import qualified Data.Map.Lazy as Map | ||
| 22 | |||
| 23 | import Data.Monoid | ||
| 24 | |||
| 25 | import Control.Monad | ||
| 26 | |||
| 27 | import Data.Maybe (fromMaybe, maybeToList, listToMaybe, catMaybes, isNothing, isJust, mapMaybe) | ||
| 28 | \end{code} | ||
| 29 | \end{comment} | ||
| 30 | |||
| 31 | 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. | ||
| 32 | 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. | ||
| 33 | |||
| 34 | \begin{code} | ||
| 35 | affected :: forall char. StringEdits Natural char -> Maybe (Interval Natural) | ||
| 36 | -- ^ 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: | ||
| 37 | -- | ||
| 38 | -- - For all @n :: Natural@: @n < a ==> str ! n == (str `apply` es) ! n@ | ||
| 39 | -- - There exists a @k :: Integer@ such that for all @n :: Integer@: @n > b ==> str ! (n + k) == (str `apply` es) ! n@ | ||
| 40 | -- | ||
| 41 | -- 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@. | ||
| 42 | \end{code} | ||
| 43 | \begin{comment} | ||
| 44 | \begin{code} | ||
| 45 | affected SEFail = Nothing | ||
| 46 | affected (StringEdits es) = Just . toInterval $ go es Map.empty | ||
| 47 | where | ||
| 48 | toInterval :: Map Natural Integer -> Interval Natural | ||
| 49 | toInterval map | ||
| 50 | | Just (((minK, _), _), ((maxK, _), _)) <- (,) <$> Map.minViewWithKey map <*> Map.maxViewWithKey map | ||
| 51 | = let | ||
| 52 | maxV' = maximum . (0 :) $ do | ||
| 53 | offset <- [0..maxK] | ||
| 54 | v <- maybeToList $ Map.lookup (maxK - offset) map | ||
| 55 | v' <- maybeToList . fmap fromInteger $ negate v <$ guard (v <= 0) | ||
| 56 | guard $ v' >= succ offset | ||
| 57 | return $ v' - offset | ||
| 58 | in (minK Int.... maxK + maxV') | ||
| 59 | | otherwise | ||
| 60 | = Int.empty | ||
| 61 | go :: Seq (StringEdit Natural char) -> Map Natural Integer -> Map Natural Integer | ||
| 62 | go Seq.Empty offsets = offsets | ||
| 63 | go (es :> e) offsets = go es offsets' | ||
| 64 | where | ||
| 65 | p = e ^. sePos | ||
| 66 | -- p' = fromIntegral $ Map.foldrWithKey (\k o p -> bool (fromIntegral p) (o + p) $ k < fromIntegral p) (fromIntegral p) offsets | ||
| 67 | offsets' = Map.alter (Just . myOffset . fromMaybe 0) p offsets | ||
| 68 | myOffset :: Integer -> Integer | ||
| 69 | myOffset | ||
| 70 | | Insert _ _ <- e = pred | ||
| 71 | | Delete _ <- e = succ | ||
| 72 | \end{code} | ||
| 73 | \end{comment} | ||
