There are times that we want to find an element in a list with a function a -> Bool and replace it using a function a -> a, this may result in a new list:
findr :: (a -> Bool) -> (a -> a) -> [a] -> Maybe [a]
findr _ _ [] = Nothing
findr p f (x:xs)
| p x = Just (f x : xs)
| otherwise = case findr p f xs of Just xs -> Just (x:xs)
_ -> Nothing
Is there any function in the main modules which is similar to this?
Edit: #gallais points out below that you end up only changing the first instance; I thought you were changing every instance.
This is done with break :: (a -> Bool) -> [a] -> ([a], [a]) which gives you the longest prefix which does not satisfy the predicate, followed by the rest of the list.
findr p f list = case break p list of
(xs, y : ys) -> Just (xs ++ f y : ys)
(_, []) -> Nothing
This function is, of course, map, as long as you can combine your predicate function and replacement function the right way.
findr check_f replace_f xs = map (replace_if_needed check_f replace_f) xs
replace_if_needed :: (a -> Bool) -> (a -> a) -> (a -> a)
replace_if_needed check_f replace_f = \x -> if check_f x then replace_f x else x
Now you can do things like findr isAplha toUpper "a123-bc".
Related
Faced next problem while reading great Type Driven Development book and trying to implement some small modifications of tasks in it.
module Main
import Data.Vect
%default total
data Forever = More Forever
partial
forever : Forever
forever = More forever
data StackCmd : Type -> (inputHeight : Nat) -> (outputHeight : Nat) -> Type where
Push : Integer -> StackCmd () height (S height)
Pop : StackCmd Integer (S height) height
Top : StackCmd Integer (S height) (S height)
PutStr : String -> StackCmd () h h
PutStrLn : String -> StackCmd () h h
GetStr : StackCmd String h h
Pure : a -> StackCmd a h h
(>>=) : StackCmd a h1 h2 -> (a -> StackCmd b h2 h3) -> StackCmd b h1 h3
runStack : (stck : Vect inH Integer) -> StackCmd ty inH outH -> IO (ty, Vect outH Integer)
runStack stck (Push x) = pure ((), x :: stck)
runStack (x :: xs) Pop = pure (x, xs)
runStack (x :: xs) Top = pure (x, x :: xs)
runStack xs (PutStr str) = do putStr str; pure ((), xs)
runStack xs (PutStrLn str) = do putStrLn str; pure ((), xs)
runStack xs (GetStr) = do str <- getLine; pure (str, xs)
runStack stck (Pure x) = pure (x, stck)
runStack stck (x >>= f) = do (x', stck') <- runStack stck x
runStack stck' (f x')
data StackIO : Nat -> Type where
Do : StackCmd a h1 h2 -> (a -> Inf (StackIO h2)) -> StackIO h1
QuitCmd : (a : Nat) -> StackIO a
namespace StackDo
(>>=) : StackCmd a h1 h2 -> (a -> Inf (StackIO h2)) -> StackIO h1
(>>=) = Do
data Input : Type where
INumber : Integer -> Input
IAdd : Input
IDuplicate : Input
IDiscard : Input
parseInput : String -> Maybe Input
parseInput str =
case str of
"" => Nothing
"add" => Just IAdd
"duplicte" => Just IDuplicate
"discard" => Just IDiscard
_ => if all isDigit $ unpack str then Just (INumber $ cast str) else Nothing
run : Forever -> Vect n Integer -> StackIO n -> IO ()
run _ _ (QuitCmd a) = pure ()
run (More far) stck (Do sa f) = do (a', stck') <- runStack stck sa
run far stck' (f a')
biOp : (Integer -> Integer -> Integer) -> StackCmd String (S (S height)) (S height)
biOp op = do a <- Pop
b <- Pop
let res = a `op` b
Push res
Pure $ show res
discardUnOp : StackCmd String (S height) height
discardUnOp = do v <- Pop
Pure $ "Discarded: " ++ show v
duplicateUnOp : StackCmd String (S height) (S (S height))
duplicateUnOp = do v <- Top
Push v
Pure $ "Duplicated: " ++ show v
mutual
tryBiOp : String -> (Integer -> Integer -> Integer) -> StackIO hin
tryBiOp _ op {hin=S (S k)} = do res <- biOp op
PutStrLn res
stackCalc
tryBiOp opName _ = do PutStrLn $
"Unable to execute operation " ++ opName ++ ": fewer then two items on stack."
stackCalc
tryUnOp : Show a => String -> StackCmd a hIn hOut -> StackIO hIn
tryUnOp _ op {hIn=S h} = do res <- op
PutStrLn $ show res
stackCalc
tryUnOp opName _ = do PutStrLn $
"Unable to execute " ++ opName ++ " operation: no elements on stack."
stackCalc
stackCalc : StackIO height
stackCalc = do PutStr "> "
inp <- GetStr
case parseInput inp of
Nothing => do PutStrLn "invalid input"; stackCalc
(Just (INumber x)) => do Push x; stackCalc
(Just IAdd) => tryBiOp "add" (+)
(Just IDuplicate) => ?holedup
(Just IDiscard) => ?holedisc -- tryUnOp "discard" discardUnOp
partial
main : IO ()
main = run forever [] stackCalc
Code given above is mostly from TDD book. Sorry that its a bit long: it can be compiled. The code is rather straightforward: this is a stack implemented above vector. Then, user can type numbers in command prompt (one per line) and program pushes the numbers on stack. User is also able to call operations, i.e. add. add pops two elements from stack, adds them and pushes the result back on stack. So, add requires at least two numbers to be on stack when it is called.
Please take a look on tryBiOp function. It takes an Integer -> Integer -> Integer (i.e. (+) or (-)) operation as it's argument and returns sequence of StackCmd operations which implements needed action. As a result programmer can write (Just IAdd) => tryBiOp "add" (+) inside stackCalc. This is very close to what I would like to have.
Question. Next thing I would like to do is very the same wrapper (it named tryUnOp) for operations which require one element on stack. And since these operations are not on integers, but on a stack itself (i.e. "duplicate top of stack" or "discard top element") I would like to pass to wrapper the sequence of StackCmd operations instead of Integer -> Integer -> Integer. So, what I would like to gain is
(Just IDuplicate) => tryUnOp "duplicate" $
(do v <- Top
Push v
Pure $ "Duplicated: " ++ show v)
Problem. If you uncomment code in string (Just IDiscard) => ?holedisc -- tryUnOp "discard" discardUnOp (and remove hole), you will see that code can not be compiled. As I see problem is that when I call tryUnOp "discard" discardUnOp Idris can see that tryUnOp's hIn must be of form (S k) because it follows from discardUnOp's type. But stackCalc does not provide such guarantee.
Working solution. It works, but it is essentially the same thing for unary operation as for binary. So, it is not exactly what I would like to have. There is a function which converts name of operation to sequence of stack commands:
data UnaryOperation : Type where
UODup : UnaryOperation
UODisc : UnaryOperation
UnaryOpOutHeight : UnaryOperation -> Nat -> Nat
UnaryOpOutHeight UODup inheightBase = S (S inheightBase)
UnaryOpOutHeight UODisc inheightBase = inheightBase
unaryStackCmd : (op: UnaryOperation) -> StackCmd String (S h) (UnaryOpOutHeight op h)
unaryStackCmd UODup = duplicateUnOp
unaryStackCmd UODisc = discardUnOp
mutual
tryUnOp' : String -> UnaryOperation -> StackIO height
tryUnOp' _ op {height=S h} = do res <- unaryStackCmd op
PutStrLn res
stackCalc
tryUnOp' opName _ = do PutStrLn $
"Unable to execute " ++ opName ++ " operation: no elements on stack."
stackCalc
Any ideas / comments are wellcome!!!
So I want to partitision a List ItemModel in Elm into List (List ItemModel). List.partition only makes the list into two lists.
I wrote some code that makes the list into the parts I want (code below).
But it's not as nice of a solution as I'd like, and since it seems like an issue many people would have, I wonder are there better examples of doing this?
partition : List (ItemModel -> Bool) -> List ItemModel -> List (List ItemModel)
partition filters models =
let
filterMaybe =
List.head filters
in
case filterMaybe of
Just filter ->
let
part =
Tuple.first (List.partition filter models)
in
part :: (partition (List.drop 1 filters) models)
Nothing ->
[]
The returned list maps directly from the filters parameter, so it's actually pretty straightforward to do this using just List.map and List.filter (which is what you're really doing since you're discarding the remainder list returned from List.partition):
multifilter : List (a -> Bool) -> List a -> List (List a)
multifilter filters values =
filters |> List.map(\filter -> List.filter filter values)
Repeated partitioning needs to use the leftovers from each step as the input for the next step. This is different than simple repeated filtering of the same sequence by several filters.
In Haskell (which this question was initially tagged as, as well),
partitions :: [a -> Bool] -> [a] -> [[a]]
partitions preds xs = go preds xs
where
go [] xs = []
go (p:ps) xs = let { (a,b) = partition p xs } in (a : go ps b)
which is to say,
partitions preds xs = foldr g (const []) preds xs
where
g p r xs = let { (a,b) = partition p xs } in (a : r b)
or
-- mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
partitions preds xs = snd $ mapAccumL (\xs p -> partition (not . p) xs) xs preds
Testing:
> partitions [ (<5), (<10), const True ] [1..15]
[[1,2,3,4],[5,6,7,8,9],[10,11,12,13,14,15]]
unlike the repeated filtering,
> [ filter p xs | let xs = [1..15], p <- [ (<5), (<10), const True ]]
[[1,2,3,4],[1,2,3,4,5,6,7,8,9],[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]]
Let's say we have a function merge that, well, just merges two lists:
Order : Type -> Type
Order a = a -> a -> Bool
merge : (f : Order a) -> (xs : List a) -> (ys : List a) -> List a
merge f xs [] = xs
merge f [] ys = ys
merge f (x :: xs) (y :: ys) = case x `f` y of
True => x :: merge f xs (y :: ys)
False => y :: merge f (x :: xs) ys
and we'd like to prove something clever about it, for instance, that merging two non-empty lists produces a non-empty list:
mergePreservesNonEmpty : (f : Order a) ->
(xs : List a) -> (ys : List a) ->
{auto xsok : NonEmpty xs} -> {auto ysok : NonEmpty ys} ->
NonEmpty (merge f xs ys)
mergePreservesNonEmpty f (x :: xs) (y :: ys) = ?wut
Inspecting the type of the hole wut gives us
wut : NonEmpty (case f x y of True => x :: merge f xs (y :: ys) False => y :: merge f (x :: xs) ys)
Makes sense so far! So let's proceed and case-split as this type suggests:
mergePreservesNonEmpty f (x :: xs) (y :: ys) = case x `f` y of
True => ?wut_1
False => ?wut_2
It seems reasonable to hope that the types of wut_1 and wut_2 would match the corresponding branches of merge's case expression (so wut_1 would be something like NonEmpty (x :: merge f xs (y :: ys)), which can be instantly satisfied), but our hopes fail: the types are the same as for the original wut.
Indeed, the only way seems to be to use a with-clause:
mergePreservesNonEmpty f (x :: xs) (y :: ys) with (x `f` y)
mergePreservesNonEmpty f (x :: xs) (y :: ys) | True = ?wut_1
mergePreservesNonEmpty f (x :: xs) (y :: ys) | False = ?wut_2
In this case the types would be as expected, but this leads to repeating the function arguments for every with branch (and things get worse once with gets nested), plus with doesn't seem to play nice with implicit arguments (but that's probably worth a question on its own).
So, why doesn't case help here, are there any reasons besides purely implementation-wise behind not matching its behaviour with that of with, and are there any other ways to write this proof?
The stuff to the left of the | is only necessary if the new information somehow propagates backwards to the arguments.
mergePreservesNonEmpty : (f : Order a) ->
(xs : List a) -> (ys : List a) ->
{auto xsok : NonEmpty xs} -> {auto ysok : NonEmpty ys} ->
NonEmpty (merge f xs ys)
mergePreservesNonEmpty f (x :: xs) (y :: ys) with (x `f` y)
| True = IsNonEmpty
| False = IsNonEmpty
-- for contrast
sym' : (() -> x = y) -> y = x
sym' {x} {y} prf with (prf ())
-- matching against Refl needs x and y to be the same
-- now we need to write out the full form
sym' {x} {y=x} prf | Refl = Refl
As for why this is the case, I do believe it's just the implementation, but someone who knows better may dispute that.
There's an issue about proving things with case: https://github.com/idris-lang/Idris-dev/issues/4001
Because of this, in idris-bi we ultimately had to remove all cases in such functions and define separate top-level helpers that match on the case condition, e.g., like here.
Let's consider a predicate showing that the elements in the list are in increasing order (and for simplicity let's only deal with non-empty lists):
mutual
data Increasing : List a -> Type where
SingleIncreasing : (x : a) -> Increasing [x]
RecIncreasing : Ord a => (x : a) ->
(rest : Increasing xs) ->
(let prf = increasingIsNonEmpty rest
in x <= head xs = True) ->
Increasing (x :: xs)
%name Increasing xsi, ysi, zsi
increasingIsNonEmpty : Increasing xs -> NonEmpty xs
increasingIsNonEmpty (SingleIncreasing y) = IsNonEmpty
increasingIsNonEmpty (RecIncreasing x rest prf) = IsNonEmpty
Now let's try to write some useful lemmas with this predicate. Let's start with showing that concatenating two increasing lists produces an increasing list, given that the last element of the first list is not greater than the first element of the second list. The type of this lemma would be:
appendIncreasing : Ord a => {xs : List a} ->
(xsi : Increasing xs) ->
(ysi : Increasing ys) ->
{auto leq : let xprf = increasingIsNonEmpty xsi
yprf = increasingIsNonEmpty ysi
in last xs <= head ys = True} ->
Increasing (xs ++ ys)
Let's now try to implement it! A reasonable way seems to be case-splitting on xsi. The base case where xsi is a single element is trivial:
appendIncreasing {leq} (SingleIncreasing x) ysi = RecIncreasing x ysi leq
The other case is more complicated. Given
appendIncreasing {leq} (RecIncreasing x rest prf) ysi = ?wut
it seems reasonable to proceed by recursively proving this for the result of joining rest and ysi by relying on leq and then prepending x using the prf. At this point the leq is actually a proof of last (x :: xs) <= head ys = True, and the recursive call to appendIncreasing would need to have a proof of last xs <= head ys = True. I don't see a good way to directly prove that the former implies the latter, so let's fall back to rewriting and first write a lemma showing that the last element of a list isn't changed by prepending to the front:
lastIsLast : (x : a) -> (xs : List a) -> {auto ok : NonEmpty xs} -> last xs = last (x :: xs)
lastIsLast x' [x] = Refl
lastIsLast x' (x :: y :: xs) = lastIsLast x' (y :: xs)
Now I would expect to be able to write
appendIncreasing {xs = x :: xs} {leq} (RecIncreasing x rest prf) ysi =
let rest' = appendIncreasing {leq = rewrite lastIsLast x xs in leq} rest ysi
in ?wut
but I fail:
When checking right hand side of appendIncreasing with expected type
Increasing ((x :: xs) ++ ys)
When checking argument leq to Sort.appendIncreasing:
rewriting last xs to last (x :: xs) did not change type last xs <= head ys = True
How can I fix this?
And, perhaps, my proof design is suboptimal. Is there a way to express this predicate in a more useful manner?
If rewrite doesn't find the right predicate, try to be explicit with replace.
appendIncreasing {a} {xs = x :: xs} {ys} (RecIncreasing x rest prf) ysi leq =
let rekPrf = replace (sym $ lastIsLast x xs) leq
{P=\T => (T <= (head ys {ok=increasingIsNonEmpty ysi})) = True} in
let rek = appendIncreasing rest ysi rekPrf in
let appPrf = headIsHead xs ys {q = increasingIsNonEmpty rek} in
let extPrf = replace appPrf prf {P=\T => x <= T = True} in
RecIncreasing x rek extPrf
with
headIsHead : (xs : List a) -> (ys : List a) ->
{auto p : NonEmpty xs} -> {auto q : NonEmpty (xs ++ ys)} ->
head xs = head (xs ++ ys)
headIsHead (x :: xs) ys = Refl
Some suggestions:
Use Data.So x instead of x = True, makes run-time functions
easier to write.
Lift Ord a from the constructor to the type, making it
more clear which ordering is used (and you don't have to match on
{a} at appendIncreasing, I guess).
Don't forget that you can
match on variables in constructors, so instead of repeating that Increasing xs has
NonEmpty xs, just use Increasing (x :: xs).
Leading to:
data Increasing : Ord a -> List a -> Type where
SingleIncreasing : (x : a) -> Increasing ord [x]
RecIncreasing : (x : a) -> Increasing ord (y :: ys) ->
So (x <= y) ->
Increasing ord (x :: y :: ys)
appendIncreasing : {ord : Ord a} ->
Increasing ord (x :: xs) -> Increasing ord (y :: ys) ->
So (last (x :: xs) <= y) ->
Increasing ord ((x :: xs) ++ (y :: ys))
Should make proving things a lot easier, especially if you want to include empty lists.
In Elm, if I have an anonymous function
(\f x -> f x)
I can simplify it to
(<|)
Can the same be done for a two-parameter function where the parameters are arguments to another function?
(\x y -> f x y |> g)
I thought I could simply use
(f |> g)
but the compiler complains about the types.
Specifically, in one of the cases for my update function, I have something like this:
let
msgNames = [Foo, Bar]
values = ["f", "b"] // These values are actually derived
// by a more complicated operation
model_ = List.map2 (<|) msgNames values
|> List.foldl (\msg mod -> update msg mod |> Tuple.first)
model
in
( model_, Cmd.none )
I am trying to simplify the anonymous function argument to List.foldl to something like (update |> Tuple.first), but I get the following error from the compiler:
The right side of (|>) is causing a type mismatch.
159| update |> Tuple.first)
^^^^^^^^^^^
(|>) is expecting the right side to be a:
(Msg -> Model -> ( Model, Cmd Msg )) -> a
But the right side is:
(( Model, Cmd Msg )) -> Model
We can follow a few steps to simplify:
(\x y -> f x y |> g)
... can be written as
(\x y -> g (f x y))
... can be written as
(\x -> g << f x)
One more step and things get a little more confusing:
(((<<) g) << f)
This matches what you get from pointfree.io (which is Haskell where function composition is done using the . operator):
(g .) . f
If you are trying to improve readability, you might just want to make your own infix function:
infixr 9 <<<
(<<<) : (c -> d) -> (a -> b -> c) -> (a -> b -> d)
(<<<) g f x y =
g (f x y)
And now you can use it like this:
(g <<< f)