module Autolib.Util.Edit.LP where


import Autolib.Util.Zufall
import Control.Monad

import Autolib.Util.Zufall ( eins )
import Data.List (sort)

-- | length-preserving edits
editsM :: RandomC m => Int -> [a] -> m [a]    
editsM :: forall (m :: * -> *) a. RandomC m => Int -> [a] -> m [a]
editsM Int
max_edit [a]
w = do
  k <- (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (m :: * -> *) a. (RandomC m, Random a) => (a, a) -> m a
randomRIO (Int
1, Int
max_edit)
  foldM ( \ [a]
u ()
_ -> [a] -> m [a]
forall {m :: * -> *} {a}. RandomC m => [a] -> m [a]
edit [a]
u ) w $ replicate k ()

edits :: [a] -> m [a]
edits [a]
w = Int -> [a] -> m [a]
forall (m :: * -> *) a. RandomC m => Int -> [a] -> m [a]
editsM Int
max_edit [a]
w

max_edit :: Int
max_edit = Int
10 :: Int

edit :: [a] -> m [a]
edit [] = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
edit [a]
w = do
  f <- [[a] -> m [a]] -> m ([a] -> m [a])
forall (m :: * -> *) a. RandomC m => [a] -> m a
eins [ [a] -> m [a]
forall {m :: * -> *} {a}. RandomC m => [a] -> m [a]
change_letter, [a] -> m [a]
forall {m :: * -> *} {a}. RandomC m => [a] -> m [a]
swap_block, [a] -> m [a]
forall {m :: * -> *} {a}. RandomC m => [a] -> m [a]
mirror_block, [a] -> m [a]
forall {m :: * -> *} {a}. RandomC m => [a] -> m [a]
rotate ]
  f w

change_letter :: [a] -> m [a]
change_letter [] = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
change_letter [a]
w = do
  i <- (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (m :: * -> *) a. (RandomC m, Random a) => (a, a) -> m a
randomRIO (Int
0, [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  j <- randomRIO (0, length w - 1)
  let (pre, p : ost) = splitAt j w
  return $ pre <> [ w !! i ] <> ost

swap_block :: [a] -> m [a]
swap_block [a]
w = do
  ~[p,q,r,s,t] <- Int -> [a] -> m [[a]]
forall {m :: * -> *} {a}. RandomC m => Int -> [a] -> m [[a]]
chops Int
4 [a]
w
  return $ p <> s <> r <> q <> t

mirror_block :: [a] -> m [a]
mirror_block [a]
w = do
  ~[p,q,r] <- Int -> [a] -> m [[a]]
forall {m :: * -> *} {a}. RandomC m => Int -> [a] -> m [[a]]
chops Int
2 [a]
w
  return $ p <> reverse q <> r

rotate :: [a] -> m [a]
rotate [a]
w = do
  ~[p,q] <- Int -> [a] -> m [[a]]
forall {m :: * -> *} {a}. RandomC m => Int -> [a] -> m [[a]]
chops Int
1 [a]
w
  return $ q <> p

chops :: Int -> [a] -> m [[a]]
chops Int
k [a]
w = do
  ps <- Int -> [a] -> m [Int]
forall {f :: * -> *} {t :: * -> *} {a}.
(RandomC f, Foldable t) =>
Int -> t a -> f [Int]
indices Int
k [a]
w
  return $ splitsAt ps w

indices :: Int -> t a -> f [Int]
indices Int
k t a
w =
  ([Int] -> [Int]) -> f [Int] -> f [Int]
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort (f [Int] -> f [Int]) -> f [Int] -> f [Int]
forall a b. (a -> b) -> a -> b
$ Int -> f Int -> f [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
k (f Int -> f [Int]) -> f Int -> f [Int]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> f Int
forall a. Random a => (a, a) -> f a
forall (m :: * -> *) a. (RandomC m, Random a) => (a, a) -> m a
randomRIO (Int
0, t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

splitsAt :: [Int] -> [a] -> [[a]]
splitsAt [] [a]
w = [[a]
w]
splitsAt (Int
p:[Int]
ps) [a]
w =
  let ([a]
x,[a]
y) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
p [a]
w
  in  [a]
x [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [Int] -> [a] -> [[a]]
splitsAt ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> Int
forall a. Num a => a -> a
negate Int
p)) [Int]
ps) [a]
y