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 hiding (parse)
import Prelude hiding ((.), sum, product, maximum, minimum,
foldl, foldr, foldl1, foldr1, concat, concatMap, and, or, any, all, elem)
import Data.List (transpose, sort, elemIndex, tails, inits, group, elemIndices, groupBy,
(\\), sortBy, nub)
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
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 n [] = []
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 [x] = 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,b) -> a.f)
filter_snd f = filter(\(a,b) -> b.f)
only_fst = map(\(a,b) -> a)
only_snd = map(\(a,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' [] q r = r
collapse' (x:xs) q r = collapse' xs (q+1) (r + x * 10^q)
collapse xs = collapse' (xs.reverse) 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,w) -> [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,c)-> [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 ys = [[]]
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
]
trace' x = trace (x.show) x
markdown = from_utf8 >>> readMarkdown defaultParserState >>> writeHtml defaultWriterOptions
markdown' = from_utf8 >>> readMarkdown defaultParserState >>> writeHtmlString defaultWriterOptions >>> to_utf8
a <^> b = a .liftM b
infixl 4 <^>
a <.> b = a .liftM b
infixl 9 <.>
lower = map toLower
upper = map toUpper
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
from_utf8 = Codec.decodeString
to_utf8 = Codec.encodeString