Copyright | (c) 2011-2021 Amy de Buitléir |
---|---|
License | BSD-style |
Maintainer | amy@nualeargais.ie |
Stability | experimental |
Portability | portable |
Safe Haskell | None |
Language | Haskell2010 |
Utility functions that don't fit anywhere else.
Synopsis
- ilogBase :: (Integral a, Integral b, Integral c) => a -> b -> c
- isPowerOf :: Integral a => a -> a -> Bool
- isqrt :: (Integral a, Integral b) => a -> b
- perfectSquare :: Integral a => a -> Bool
- cropRect :: (Int, Int) -> (Int, Int) -> [a] -> Int -> [a]
- cropSquare :: Int -> [a] -> [a]
- replaceElement :: [a] -> Int -> a -> [a]
- reverseLookup :: Eq b => b -> [(a, b)] -> Maybe a
- rotate :: [a] -> [a]
- safeReplaceElement :: [a] -> Int -> a -> [a]
- shuffle :: RandomGen g => [a] -> Rand g [a]
- boolsToBits :: [Bool] -> String
- showBin :: (Integral a, Show a) => a -> ShowS
- stateMap :: Monad m => (s -> t) -> (t -> s) -> StateT s m a -> StateT t m a
- fromEither :: a -> Either e a -> a
- catEithers :: [Either e a] -> [a]
- modifyLift :: Monad m => (s -> m s) -> StateT s m ()
- getLift :: Monad m => (s -> m ()) -> StateT s m ()
Integers
ilogBase :: (Integral a, Integral b, Integral c) => a -> b -> c Source #
returns the greatest integer not greater than the log
base n of ilogBase
n mm
.
isPowerOf :: Integral a => a -> a -> Bool Source #
n
returns isPowerOf
mTrue
if n
is a power of m (i.e., if
there exists an _integer_ k such that m^k = n)
isqrt :: (Integral a, Integral b) => a -> b Source #
returns the greatest integer not greater than the square root
of isqrt
nn
.
perfectSquare :: Integral a => a -> Bool Source #
returns perfectSquare
nTrue
if n
is a perfect square (i.e., if
there exists an _integer_ m such that m*m = n)
Arrays
cropRect :: (Int, Int) -> (Int, Int) -> [a] -> Int -> [a] Source #
Assuming xs
is a sequence containing the elements of a matrix with k
columns,
returns the elements of the
submatrix from cropRect
(a,b) (c, d) k xs(a,b)
in the upper left corner to (c,d)
in the lower
right corner).
Note: Matrix indices begin at (0,0)
.
Example: Suppose we have a 4x6 matrix and we want to extract the submatrix from (1,2) to (2,4), as illustrated below.
a b c d e f g h i j k l ---> i j k m n o p q r o p q s t u v w x
We can represent the elements of the original matrix as ['a'..'x']
.
The elements of the submatrix are
['i', 'j', 'k', 'o', 'p', 'q']
, or equivalently,
"ijkopq"
. And that is what
returns.cropRect
(1,2) (2,4) 6 ['a'..'x']
cropSquare :: Int -> [a] -> [a] Source #
Assuming xs
is a sequence containing the elements of a square matrix,
returns the elements of the submatrix of size cropSquare
n xsn
xn
,
centred within the original matrix xs
.
Example: Suppose we have a 5x5 matrix and we want to extract the central 3x3 submatrix, as illustrated below.
a b c d e f g h i j g h i k l m n o ---> l m n p q r s t q r s u v w x y
We can represent the elements of the original matrix as ['a'..'y']
.
The elements of the submatrix are
['g', 'h', 'i', 'l', 'm', 'n', 'q', 'r', 's']
,
or equivalently, "ghilmnqrs"
. And that is what
returns.cropSquare
3 ['a'..'y']
Sequences
replaceElement :: [a] -> Int -> a -> [a] Source #
returns a copy of replaceElement
xs n xxs
in which the n
th
element has been replaced with x
. Causes an exception if xs
has
fewer than n+1
elements. Compare with
.safeReplaceElement
reverseLookup :: Eq b => b -> [(a, b)] -> Maybe a Source #
safeReplaceElement :: [a] -> Int -> a -> [a] Source #
returns a copy of safeReplaceElement
xs n xxs
in which the n
th
element (if it exists) has been replaced with x
.
Bits/Booleans
boolsToBits :: [Bool] -> String Source #
Convert a list of bits to a string of 0
s and 1
s.
Monads
fromEither :: a -> Either e a -> a Source #
The fromEither
function takes a default value and an Either
value. If the Either
is Left
, it returns the default value;
otherwise, it returns the value contained in the Right
.
catEithers :: [Either e a] -> [a] Source #
modifyLift :: Monad m => (s -> m s) -> StateT s m () Source #
Like modify, but the function that maps the old state to the new state operates in the inner monad. For example,
s <- get s' = lift $ f s put s'
can be replaced with
modifyLift f
getLift :: Monad m => (s -> m ()) -> StateT s m () Source #
Invoke a function in the inner monad, and pass the state as a parameter. Similar to modifyLift, but the function being invoked doesn't have a return value, so the state is not modified. For example,
s <- get s' = lift $ f s
can be replaced with
getLift f