module MPS.Snippets where
import Control.Arrow ((&&&), (>>>))
import Control.Monad hiding (join)
import Control.Parallel
import Data.Char
import Data.Maybe
import Data.Time.Calendar
import Numeric
import MPS.Hack.Dot
import Test.QuickCheck
import Text.RegexPR
import qualified Data.Array as A
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Graph as G
import qualified Data.Map as M
import Data.Graph.Inductive (Gr, mkGraph)
import qualified System.IO.Unsafe as Unsafe
import qualified Text.ParserCombinators.Parsec as P
import Data.Foldable
import Debug.Trace
import Text.Pandoc
import qualified Codec.Binary.UTF8.String as Codec
import System.Directory
import Text.ParserCombinators.Parsec (many, char, many1, digit, (<|>), Parser, anyChar)
import qualified Prelude as Prelude
import Prelude hiding ((.), sum, product, maximum, minimum,
foldl, foldr, foldl1, foldr1, concat, concatMap, and, or, any, all, elem, (^))
import Data.List (transpose, sort, group, (\\), sortBy)
import Text.InterpolatedString.QQ
join x xs = L.intercalate x xs
join' xs = xs.concat
first = head
unique xs = xs.to_set.to_list
is_unique xs = xs.unique.length == xs.length
same xs = xs.unique.length == 1
times = flip replicate
upto m n = flip enumFromTo m n
downto m n = [n, n1.. m]
remove_at n xs = xs.take n ++ xs.drop (n+1)
insert_at n x xs = splitted.fst ++ [x] ++ splitted.snd where splitted = xs.splitAt n
replace_at n x xs = xs.take n ++ [x] ++ xs.drop (n+1)
at i xs = xs !! i
slice l r xs = xs.take r.drop l
cherry_pick ids xs = ids.map(xs !!)
reduce f xs = foldl1 f xs
reduce' f (x:xs) = inject' x f xs
reduce' _ _ = error "reduce' takes a list of at least 2 elements"
inject init f xs = foldl f init xs
inject' init f xs = foldl' f init xs
none_of f xs = not $ any f xs
select = filter
reject f = filter(not ... f)
lookup' i xs = xs.lookup i .fromJust
inner_map f xs = xs.map(map f)
inner_reduce f xs = xs.map(reduce f)
inner_inject init f xs = xs.map(inject init f)
label_by f xs = xs.map(f &&& id)
labeling f xs = xs.map(id &&& f)
in_group_of _ [] = []
in_group_of n xs = h : t.in_group_of(n) where (h, t) = xs.splitAt(n)
split_to n xs = xs.in_group_of(size) where
l = xs.length
size = if l < n then 1 else l `div` n
apply x f = f x
send_to = apply
let_receive f s = flip f s
map_send_to x fs = fs.map(send_to(x))
belongs_to xs x = xs.elem x
has xs x = flip belongs_to xs x
indexed xs = xs.zip([0..])
map_with_index f xs = xs.indexed.map(f)
ljust n x xs
| n < xs.length = xs
| otherwise = ( n.times x ++ xs ).reverse.take n.reverse
rjust n x xs
| n < xs.length = xs
| otherwise = ( xs ++ n.times x ).take n
ub = takeWhile
lb f = dropWhile ( not ... f )
between a b xs = xs.lb a .ub b
not_null xs = xs.null.not
powerslice xs = [ xs.slice j (j+i) |
i <- l.downto 1,
j <- [0..l i]
]
where l = xs.length
common _ [] = []
common [] _ = []
common a@(x:xs) b@(y:ys)
| x .is y = y : common xs b
| x < y = common xs b
| otherwise = common a ys
rsort xs = xs.L.sortBy(\a b -> b `compare` a)
encode xs = xs.group.map (length &&& head)
decode xs = xs.map(\(l,x) -> l.times x).join'
only_one [_] = True
only_one _ = False
concat_map f xs = concatMap f xs
to_h xs = xs.M.fromList
quick_check prop = quickCheck prop
qc prop = quick_check prop
on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
(*) `on` f = \x y -> f x * f y
compare_by f = on compare f
eq b a = (==) a b
is a b = eq a b
is_not a b = not (is a b)
swap (x,y) = (y,x)
tuple2 xs = (xs.first, xs.last)
tuple3 xs = (xs.first, xs.tail.first, xs.last)
list2 (x,y) = [x,y]
list3 (x,y,z) = [x,y,z]
filter_fst f = filter(\(a,_) -> a.f)
filter_snd f = filter(\(_,b) -> b.f)
only_fst = map(\(a,_) -> a)
only_snd = map(\(_,b) -> b)
map_fst f = map(\(a,b) -> (a.f, b))
map_snd f = map(\(a,b) -> (a, b.f))
pair f a b = f (a,b)
triple f a b c = f (a,b,c)
splash f (a,b) = f a b
splash3 f (a,b,c) = f a b c
twin x = (x,x)
merge f = map (pair f)
purify = Unsafe.unsafePerformIO
read_pure x = x.readFile.purify
write_pure file c = writeFile file c
p_eval xs = xs.par(xs.reduce(par))
p_reduce op xs = xs.p_eval.reduce(op)
p_map op xs = xs.map(op).p_eval
p_eval' xs = xs.pseq( xs.reduce par )
p_reduce' op xs = xs.p_eval'.reduce op
p_map' op xs = xs.map op .p_eval'
p_split_to n xs = xs.in_group_of(n).L.transpose
p_map_reduce_to n m r xs = xs.split_to n .map m .p_reduce' r
p_map_reduce m r xs = p_map_reduce_to 16 m r xs
row n i = i `div` n
col n i = i `mod` n
m !!! i = m.at(row n i) .at(col n i)
where n = m.first.length
date = fromGregorian
splash_date = toGregorian
split re xs
| xs.match re .isJust = splitRegexPR re xs .reject empty
| otherwise = [xs]
split' s = s.lines.reject empty
sub = subRegexPR
gsub = gsubRegexPR
match = matchRegexPR
strip s = s.sub "^\\s*" "" .reverse .sub "^\\s*" "" .reverse
empty s = case s.match("\\S") of
Just _ -> False
Nothing -> True
to_s x = x.show
is_palindrom s = s.reverse.is(s)
collapse' [] _ r = r
collapse' (x:xs) q r = collapse' xs (q+1) (r + x * 10 <^> q)
collapse xs = collapse' (xs.reverse.map from_i) 0 0 .fromIntegral
explode n = n.show.map digitToInt
base p n = showIntAtBase p intToDigit n ""
from_i n = fromIntegral n
int_square n = n.fromIntegral.sqrt.round :: Integer
to_list xs = toList xs
to_set xs = xs.S.fromList
to_a xs = xs.A.listArray (0, xs.length 1)
to_a' i xs = A.listArray i xs
hist bnds ns = A.accumArray (+) 0 bnds [(n, 1) | n <- ns, A.inRange bnds n]
to_g'' = G.buildG
type GType = Int
to_g_with :: Real a => (GType -> c) -> [(GType, GType, a)] -> Gr c a
to_g_with mapper xs = mkGraph (xs.label_nodes) xs where
node_pair x = (x, mapper x)
label_nodes xs = xs.map(\(a,b,_) -> [a,b]) .join' .unique .map node_pair
to_g xs = to_g_with id xs
graph_map xs = (edges, vertex_map) where
vertices = xs.map(\(a,b,_)-> [a,b]).join'.unique.sort
vertex_map = vertices.indexed
r_vertex_map = vertex_map.map(swap)
edges = xs.map(\(a,b,c) -> (r_vertex_map.lookup' a, r_vertex_map.lookup' b, c))
to_g' xs = let (edges, vertex_map) = graph_map xs in
edges.to_g_with (vertex_map.flip lookup')
parse p s = case (P.parse p "" s) of
Left err -> err.show.error
Right x -> x
cache f xs = a.to_list where
a = xs.g.to_a
g ys = f a ys
greedy_count x xs = greedy x xs .length
greedy x xs = greedy' x (xs.rsort) where
greedy' x _ | x < 0 = [[]]
greedy' 0 _ = [[]]
greedy' x [y] = if (x `mod` y) .is 0 then [ (x `div` y).from_i .times y ] else [[]]
greedy' s (a:as) = [ h ++ t |
n <- [0..(div s a)].reverse,
let h = n.from_i.times a,
t <- greedy' (s n * a) as,
let c = h ++ t,
c.sum == s
]
greedy' _ _ = error "argument type"
trace' x = trace (x.show) x
markdown = b2u >>> readMarkdown defaultParserState >>> writeHtml defaultWriterOptions
markdown' = b2u >>> readMarkdown defaultParserState >>> writeHtmlString defaultWriterOptions >>> u2b
a ^ b = a .liftM b
infixl 9 ^
(<^>) = (Prelude.^)
infixr 8 <^>
a <.> b = a .liftM b
infixl 9 <.>
lower = map toLower
upper = map toUpper
starts_with [] _ = True
starts_with _ [] = False
starts_with (x:xs) (y:ys) | x == y = starts_with xs ys
| otherwise = False
ends_with x y = starts_with (x.reverse) (y.reverse)
capitalize [] = []
capitalize (x:xs) = [x].upper ++ xs.lower
camel_case = split "_" >>> map capitalize >>> join'
snake_case = gsub "\\B[A-Z]" "_\\&" >>> lower
unicode_char :: Parser Char
unicode_char = do
char '&'
char '#'
word <- many1 digit
char ';'
return $ chr (read word)
unescape_parser :: Parser String
unescape_parser = many (unicode_char <|> anyChar)
unescape_unicode_xml s = parse unescape_parser s
ls s = getDirectoryContents s <.> (\\ [".", ".."])
filter_comment = lines >>> map strip >>> reject null >>> reject (head >>> (== '#')) >>> unlines
b2u = Codec.decodeString
u2b = Codec.encodeString
here = istr