I'm trying to write a Haskell function that automatically distributes a binary operation over a list, kind of how arithmetic operations work in the J language.
You can think of it as a "deep zipWith" that works on nested lists of any depth, including non-lists and lists of different depths.
For example:
distr (+) 1 10 === 11 -- Non-list values are added together
distr (+) [1,2] 10 === [11,12] -- Non-list values distribute over lists
distr (+) [1,2] [10,20] === [11,22] -- Two lists get zipped
distr (+) [[1,2],[3,4]] [[10,20],[30,40]] === [[11,22],[33,44]] -- Nested lists get zipped
Lists of different lengths get truncated, like with zipWith, but this is not important.
Now, I have already written this:
{-# LANGUAGE
MultiParamTypeClasses,
FunctionalDependencies,
UndecidableInstances,
FlexibleInstances
#-}
class Distr a b c x y z | a b c x y -> z
where distr :: (a -> b -> c) -> (x -> y -> z)
instance Distr a b c a b c where distr = id
instance {-# OVERLAPPING #-}
(Distr a b c x y z) => Distr a b c [x] [y] [z]
where distr = zipWith . distr
instance (Distr a b c x y z) => Distr a b c [x] y [z]
where distr f xs y = map (\x -> distr f x y) xs
instance (Distr a b c x y z) => Distr a b c x [y] [z]
where distr f x ys = map (\y -> distr f x y) ys
This defines a 6-parameter typeclass Distr with a function distr :: (Distr a b c x y z) => (a -> b -> c) -> (x -> y -> z), and some instances of Distr on nested lists.
It works well on the examples above, but its behavior on lists of unequal nesting depth is not exactly what I want.
It does this (which works if you add type annotations to (+) and both lists):
distr (+) [[1,2],[3,4]] [10,20] === [[11,12],[23,24]] -- Zip and distribute
Try it here.
What I want is this:
distr (+) [[1,2],[3,4]] [10,20] === [[11,22],[13,24]] -- Distribute and zip
The current implementation applies zipWith until one of its arguments is a non-list value, which is then distributed over the other list.
I would prefer it to distribute one argument (the one with fewer list layers) over the other until it reaches equal nesting depth, and then use zipWith to reduce them to non-list values.
My question is: Can I achieve the second kind of behavior?
I'm happy with a solution that requires me to explicitly tell Haskell the types of the operator and each argument, as my current solution does.
I will not call distr on an operator that takes lists as inputs, so that case need not be handled.
However, I don't want to give extra arguments to distr that serve as type hints, or have several different versions of distr for different use cases.
I know my problem could be solved this way, but I'd prefer a solution where it isn't necessary.
(As a gist in Literate Haskell)
{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances,
TypeFamilies, MultiParamTypeClasses, UndecidableInstances,
RankNTypes, ScopedTypeVariables, FunctionalDependencies, TypeOperators #-}
module Zip where
import Data.Proxy
import GHC.TypeLits
Let's first assume that the two nested lists have the same depth. E.g., depth 2:
zipDeep0 ((+) :: Int -> Int -> Int) [[1,2],[3,4,5]] [[10,20],[30,40]] :: [[Int]]
[[11,22],[33,44]]
Implementation:
zipDeep0
:: forall n a b c x y z
. (ZipDeep0 n a b c x y z, n ~ Levels a x, n ~ Levels b y, n ~ Levels c z)
=> (a -> b -> c) -> (x -> y -> z)
zipDeep0 = zipDeep0_ (Proxy :: Proxy n)
Levels a x computes the depth of a in the nested list type x.
Closed type families allow us to do some non-linear type-level pattern matching
(where a occurs twice in a clause).
type family Levels a x :: Nat where
Levels a a = 0
Levels a [x] = 1 + Levels a x
We use that depth to select the ZipDeep0 instance implementing the zip,
This way is neater than relying only on the six other ordinary type parameters,
as it avoids a problem with type inference and overlapping instances when some list is empty (so
we can't infer its actual type from itself), or when a, b, c are also
list types.
class ZipDeep0 (n :: Nat) a b c x y z where
zipDeep0_ :: proxy n -> (a -> b -> c) -> x -> y -> z
-- Moving the equality constraints into the context helps type inference.
instance {-# OVERLAPPING #-} (a ~ x, b ~ y, c ~ z) => ZipDeep0 0 a b c x y z where
zipDeep0_ _ = id
instance (ZipDeep0 (n - 1) a b c x y z, xs ~ [x], ys ~ [y], zs ~ [z])
=> ZipDeep0 n a b c xs ys zs where
zipDeep0_ _ f = zipWith (zipDeep0_ (Proxy :: Proxy (n - 1)) f)
When the two lists are not of the same depth, let's first assume the second one
is deeper, so we must distribute over it.
We start losing some type inference, we must know at least Levels a x (and
thus a and x) and either Levels b y or Levels c z before this function
can be applied.
Example:
zipDeep1 (+) [10,20 :: Int] [[1,2],[3,4]] :: [[Int]]
[[11,22],[13,24]]
Implementation:
zipDeep1
:: forall n m a b c x y z
. (n ~ Levels a x, m ~ Levels b y, m ~ Levels c z, ZipDeep1 (m - n) a b c x y z)
=> (a -> b -> c) -> x -> y -> z
zipDeep1 = zipDeep1_ (Proxy :: Proxy (m - n))
The difference between levels (m - n) tells us how many layers we must "distribute"
through before falling back to zipDeep0.
class ZipDeep1 (n :: Nat) a b c x y z where
zipDeep1_ :: proxy n -> (a -> b -> c) -> x -> y -> z
instance {-# OVERLAPPING #-} ZipDeep0 (Levels a x) a b c x y z => ZipDeep1 0 a b c x y z where
zipDeep1_ _ = zipDeep0_ (Proxy :: Proxy (Levels a x))
instance (ZipDeep1 (n - 1) a b c x y z, ys ~ [y], zs ~ [z]) => ZipDeep1 n a b c x ys zs where
zipDeep1_ proxy f xs = fmap (zipDeep1_ (Proxy :: Proxy (n - 1)) f xs)
Finally, we can do a type-level comparison when either list may be the deeper
one. We lose all type inference though.
Example:
zipDeep ((+) :: Int -> Int -> Int) [[1,2 :: Int],[3,4]] [10 :: Int,20] :: [[Int]]
[[11,22],[13,24]]
Some type inference is recovered by instead specifying the expected depth of
each list with TypeApplications.
zipDeep #2 #1 ((+) :: Int -> Int -> Int) [[1,2],[3,4]] [10,20]
[[11,22],[13,24]]
Implementation:
zipDeep
:: forall n m a b c x y z
. (ZipDeep2 (CmpNat n m) n m a b c x y z, n ~ Levels a x, m ~ Levels b y)
=> (a -> b -> c) -> x -> y -> z
zipDeep = zipDeep2_ (Proxy :: Proxy '(CmpNat n m, n, m))
class ZipDeep2 (cmp :: Ordering) (n :: Nat) (m :: Nat) a b c x y z where
zipDeep2_ :: proxy '(cmp, n, m) -> (a -> b -> c) -> x -> y -> z
instance {-# OVERLAPPING #-} (n ~ Levels a x, m ~ Levels b y, m ~ Levels c z, ZipDeep1 (m - n) a b c x y z)
=> ZipDeep2 'LT n m a b c x y z where
zipDeep2_ _ = zipDeep1
instance (n ~ Levels a x, m ~ Levels b y, n ~ Levels c z, ZipDeep1 (n - m) b a c y x z)
=> ZipDeep2 cmp n m a b c x y z where
zipDeep2_ _ = flip . zipDeep1 . flip
Related
I'm trying to write a reverse vector function in agda, and am running into the following stumbling block
Goal: Vec Nat (suc n)
Have: Vec Nat (n +N 1)
If I understand correctly, these values aren't definionally equal. Here is the reverse function.
vReverse : {X : Set} {n : Nat} → Vec X n → Vec X n
vReverse [] = []
vReverse (x ,- x₁) = {!(vReverse x₁) +V (x ,- [])!}
How can I overcome this, if possilbe, without refactoring the code. If a refactor is necessary, how can one generally avoid these pitfalls a priori? Here is the rest of the code.
data Nat : Set where
zero : Nat
suc : Nat -> Nat -- recursive data type
{-# BUILTIN NATURAL Nat #-}
_+N_ : Nat -> Nat -> Nat
zero +N y = y
suc x +N y = suc (x +N y) -- there are other choices
data Vec (X : Set) : Nat -> Set where -- like lists, but length-indexed
[] : Vec X zero
_,-_ : {n : Nat} -> X -> Vec X n -> Vec X (suc n)
infixr 4 _,-_ -- the "cons" operator associates to the right
_+V_ : {X : Set}{m n : Nat} -> Vec X m -> Vec X n -> Vec X (m +N n)
[] +V xs = xs
(x ,- xs) +V [] = x ,- xs +V []
(x ,- xs) +V x₁ ,- ys = x ,- xs +V x₁ ,- ys
The idea is that you can transform an element of type P x into an element of type P y provided you can prove x ≡ y. Let me guide you through this process step by step. Here is the base code you provided, which I have not refactored as you requested.
data Nat : Set where
zero : Nat
suc : Nat -> Nat -- recursive data type
{-# BUILTIN NATURAL Nat #-}
_+N_ : Nat -> Nat -> Nat
zero +N y = y
suc x +N y = suc (x +N y) -- there are other choices
infixl 5 _+N_
data Vec (X : Set) : Nat -> Set where -- like lists, but length-indexed
[] : Vec X zero
_,-_ : {n : Nat} -> X -> Vec X n -> Vec X (suc n)
infixr 4 _,-_ -- the "cons" operator associates to the right
However, your concatenation function was incorrect and it didn't terminate so here is the corrected version.
_+V_ : {X : Set}{m n : Nat} -> Vec X m -> Vec X n -> Vec X (m +N n)
[] +V vs = vs
(x ,- xs) +V vs = x ,- (xs +V vs)
The reason why we don't need to do any substitution in this function is because suc n + m is definitionally equal to suc (n + m).
Since you've defined your own naturals and your own addition, I'm assuming you want to redefine everything by yourself. According to this assumption, you'll need to define propositional equality, which is done as follows:
data _≡_ {a} {A : Set a} (x : A) : A → Set a where
refl : x ≡ x
infix 1 _≡_
From this definition, we can define the substitution that was mentioned in the preamble of this answer, as well as in a comment of your question:
subst : ∀ {a b} {A : Set a} {x y : A} (P : A → Set b) → x ≡ y → P x → P y
subst _ refl p = p
In your reverse function, the problem lies in the fact that n + 1 is not definitionally equal to suc n. Which is why we need a property to establish this fact, which we can then feed to our substitution mechanism. This proof requires the congruence of the propositional equality we defined, as follows:
cong : ∀ {a b} {A : Set a} {B : Set b} (f : A → B) {x y} → x ≡ y → f x ≡ f y
cong _ refl = refl
n+1≡sn : ∀ {n} → n +N 1 ≡ suc n
n+1≡sn {zero} = refl
n+1≡sn {suc _} = cong suc n+1≡sn
We now have all the required elements to write your vReverse function:
vReverse : ∀ {X n} → Vec X n → Vec X n
vReverse [] = []
vReverse (x ,- x₁) = subst (Vec _) n+1≡sn ((vReverse x₁) +V (x ,- []))
To go Further, you can use the same process to build the usual reverse function which is more efficient (linear complexity). I took the liberty to do this for you, since it shows more examples of usage of subst.
n+sm≡sn+m : ∀ {n m} → n +N suc m ≡ suc (n +N m)
n+sm≡sn+m {zero} = refl
n+sm≡sn+m {suc _} = cong suc n+sm≡sn+m
reverse-better-aux : ∀ {X n m} → Vec X n → Vec X m → Vec X (n +N m)
reverse-better-aux [] v₂ = v₂
reverse-better-aux (x ,- v₁) v₂ = subst (Vec _) n+sm≡sn+m (reverse-better-aux v₁ (x ,- v₂))
n+0≡n : ∀ {n} → n +N 0 ≡ n
n+0≡n {zero} = refl
n+0≡n {suc _} = cong suc n+0≡n
reverse-better : ∀ {X n} → Vec X n → Vec X n
reverse-better v = subst (Vec _) n+0≡n (reverse-better-aux v [])
So what I have so far is something like this:
combs :: [[Char]]
combs = [[i] ++ [j] ++ [k] ++ [l] | i <- x, j <- x, k <- x, l <- x]
where x = "abc"
So this is the working function for n = 4, is there any way to make this work for an arbitrary number of generators? I could program in for n = 1, 2, 3 etc.. but ideally need it to work for any given n. For reference, x is just an arbitrary string of unique characters. I'm struggling to think of a way to somehow extract it to work for n generators.
You can use replicateM:
replicateM :: Applicative m => Int -> m a -> m [a]
E.g.:
generate :: Num a => Int -> [[a]]
generate = flip replicateM [1,2,3]
to generate all possiible lists of a given length and consisting of elements 1..3.
As far as I know, you can not construct list comprehension with an arbitrary number of generators, but usually if you do something with arbitrary depth, recursion is the way to do it.
So we have to think of solving this, in terms of itself. If you want all possible strings that can be generated with the characters in x. In case n = 0, we can generate exactly one string: the empty string.
combs 0 = [""]
so a list with one element [].
Now in case we want to generate strings with one characters, we can of course simply return x:
combs 1 = x
and now the question is what to do in case n > 1. In that case we can obtain all the strings with length n-1, and and for each such string, and each such character in x, produce a new string. Like:
combs n = [ (c:cs) | c <- x, cs <- combs (n-1) ]
Note that this makes the second case (n = 1) redundant. We can pick a character c from x, and prepend that to the empty string. So a basic implementation is:
combs :: Int -> [[Char]]
combs 0 = [""]
combs n = [(c:cs) | c <- x, cs <- combs (n-1)]
where x = "abc"
Now we can still look for improvements. List comprehensions are basically syntactical sugar for the list monad. So we can use liftA2 here:
import Control.Applicative(liftA2)
combs :: Int -> [[Char]]
combs 0 = [""]
combs n = liftA2 (:) x (combs (n-1))
where x = "abc"
we probably also want to make the set of characters a parameter:
import Control.Applicative(liftA2)
combs :: [Char] -> Int -> [[Char]]
combs _ 0 = [""]
combs x n = liftA2 (:) x (combs (n-1))
and we do not have to restrict us to characters, we can produce a certesian power for all possible types:
import Control.Applicative(liftA2)
combs :: [a] -> Int -> [[a]]
combs _ 0 = [[]]
combs x n = liftA2 (:) x (combs (n-1))
First I would translate the comprehension as a monadic expression.
x >>= \i -> x >>= \j -> x >>= \k -> x >>= \l -> return [i,j,k,l]
With n = 4 we see we have 4 x's, and generally will have n x's. Therefore, I am thinking about a list of x's of length n.
[x,x,x,x] :: [[a]]
How might we go from [x,x,x,x] to the monadic expression? A first good guess is foldr, since we want to do something with each element of the list. Particularly, we want to take an element from each x and form a list with these elements.
foldr :: (a -> b -> b) -> b -> [a] -> b
-- Or more accurately for our scenario:
foldr :: ([a] -> [[a]] -> [[a]]) -> [[a]] -> [[a]] -> [[a]]
There are two terms to come up with for foldr, which I will call f :: [a] -> [[a]] -> [[a]] and z :: [[a]]. We know what foldr f z [x,x,x,x] is:
foldr f z [x,x,x,x] = f x (f x (f x (f x z)))
If we add parentheses to the earlier monadic expression, we have this:
x >>= \i -> (x >>= \j -> (x >>= \k -> (x >>= \l -> return [i,j,k,l])))
You can see how the two expressions are looking similar. We should be able to find an f and z to make them the same. If we choose f = \x a -> x >>= \x' -> a >>= \a' -> return (x' : a') we get:
f x (f x (f x (f x z)))
= (\x a -> a >>= \a' -> x >>= \x' -> return (x' : a')) x (f x (f x (f x z)))
= f x (f x (f x z)) >>= \a' -> x >>= \x' -> return (x' : a')
= f x (f x (f x z)) >>= \a' -> x >>= \l -> return (l : a')
= (f x (f x z) >>= \a' -> x >>= \k -> return (k : a')) >>= \a' -> x >>= \l -> return (l : a')
= f x (f x z) >>= \a' -> x >>= \k -> x >>= \l -> return (l : k : a')
Note that I have reversed the order of i,j,k,l to l,k,j,i but in context of finding combinations, this should be irrelevant. We could try a' ++ [x'] instead if it was really of concern.
The last step is because (a >>= \b -> c) >>= \d -> e is the same as a >>= \b -> c >>= \d -> e (when accounting for variable hygiene) and return a >>= \b -> c is the same as (\b -> c) a.
If we keep unfolding this expression, eventually we will reach z >>= \a' -> … on the front. The only choice that makes sense here then is z = [[]]. This means that foldr f z [] = [[]] which may not be desirable (preferring [] instead). Instead, we might use foldr1 (for non-empty lists, and we might use Data.NonEmpty) or we might add a separate clause for empty lists to combs.
Looking at f = \x a -> x >>= \x' -> a >>= \a' -> return (x' : a') we might realise this helpful equivalence: a >>= \b -> return (c b) = c <$> a. Therefore, f = \x a -> x >>= \x' -> (x' :) <$> a. Then also, a >>= \b -> c (g b) = g <$> a >>= \b -> c and so f = (:) <$> x >>= \x' -> x' <$> a. Finally, a <*> b = a >>= \x -> x <$> b and so f = (:) <$> x <*> a.
The official implementation of sequenceA for lists is foldr (\x a -> (:) <$> x <*> a) (pure []), exactly what we came up with here too. This can be further shortened as foldr (liftA2 (:)) (pure []) but there is possibly some optimisation difference that made the implementors not choose this.
Last step is to merely come up with a list of n x's. This is just replicate replicate n x. There happens to be a function which does both replication and sequencing, called replicateM replicateM n x.
Using Haskell:
Let's say I have list: [1,3,4,2,3]
And I want to modify all 3's in the list. I know that I can apply this to select the 3's in this case:
map (\x -> if p x then f x else x) xs
However, the functions being applied to the threes is dependent on their index within the list.
So for example if the index was added to the desired number the output of the function I'm going for would be: [1,4,4,2,7].
You can use zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] for this:
zipWith (\i x -> if p x then f i x else x) [0..] xs
where f thus takes i (the index) and x (the element) both into account.
For example:
zipWith (\i x -> if x == 3 then (i+x) else x) [0..] xs
Which generates the desired output:
Prelude> let xs = [1,3,4,2,3]
Prelude> zipWith (\i x -> if x == 3 then (i+x) else x) [0..] xs
[1,4,4,2,7]
You can encapsulate this logic into a separate function, for instance imap :: (Enum n, Num n) => (n -> a -> b) -> [a] -> b:
imap :: (Enum n, Num n) => (n -> a -> b) -> [a] -> b
imap = flip zipWith [0..]
This will work with any type that is an instance of Num and Enum (so Integer, Int, Float,...).
While zipWith is probably the right way, just for a variety you may go recursive as follows;
tpi :: [Int] -> [Int]
tpi = runner 0
where runner _ [] = []
runner n (x:xs) | x == 3 = (n + x) : runner (n+1) xs
| otherwise = x : runner (n+1) xs
How should one convert a list with a known length into nested pairs? In other words, what is the most convenient way to fill the type holes below?
_ [1,2] :: (Int,Int)
_ [1,2,3] :: ((Int,Int),Int)
_ [1,2,3,4] :: (((Int,Int),Int),Int)
_ [1,2,3,4,5] :: ((((Int,Int),Int),Int),Int)
EDIT: note that the type holes need not be the same function, I'm looking for a convenient pattern (if a convenient pattern exists) to fill the holes.
Perhaps like this:
step f xs = (f (init xs), last xs)
len1 = head
len2 = step len1
len3 = step len2
len4 = step len3
In ghci:
*Main> len4 [1..4]
(((1,2),3),4)
One may of course also directly implement one of these functions with pattern matching:
len4' [a,b,c,d] = (((a,b),c),d)
This will also not traverse the list as many times as there are elements, which is nice.
Chiming in with a dependently typed version. First, let's get done with the boilerplate:
{-# LANGUAGE
TemplateHaskell, DataKinds, ScopedTypeVariables,
FlexibleInstances, PolyKinds, TypeOperators,
TypeFamilies, GADTs, UndecidableInstances #-}
import Data.Singletons.TH
import qualified GHC.TypeLits as Lit
$(singletons [d| data Nat = Z | S Nat deriving (Eq, Show) |])
The use of TH here is purely for boilerplate reduction and we won't use TH in our actual code. In fact, the above could be (and should be) factored out in a package somewhere (at the time of writing this answer there isn't such a package with up-to-date singletons dependency).
tuplify becomes a function whose return type depends on a Nat parameter.
type family NTup n a where
NTup (S (S Z)) a = (a, a)
NTup (S (S (S n))) a = (NTup (S (S n)) a, a)
tuplify :: Sing n -> [a] -> NTup n a
tuplify n as = go n (reverse as) where
go :: Sing n -> [a] -> NTup n a
go (SS (SS SZ)) [a, b] = (b, a)
go (SS (SS (SS n))) (a:as) = (go (SS (SS n)) as, a)
go _ _ = error "tuplify: length mismatch"
Trying it out:
tuplify (SS (SS (SS SZ))) [1, 2, 3] -- ((1, 2), 3)
Writing out the naturals is quite arduous now, so let's introduce some syntactic sugar:
type family N n where
N 0 = Z
N n = S (N (n Lit.- 1))
type SN n = Sing (N n)
Now:
tuplify (sing:: SN 10) [1..10] -- (((((((((1,2),3),4),5),6),7),8),9),10)
As a side note, if we convert the empty list to () (and thereby also allow one-element nested tuples) our definitions become much more natural:
type family NTup n a where
NTup Z a = ()
NTup (S n) a = (NTup n a, a)
tuplify :: Sing n -> [a] -> NTup n a
tuplify n = go n . reverse where
go :: Sing n -> [a] -> NTup n a
go SZ [] = ()
go (SS n) (a:as) = (go n as, a)
go _ _ = error "tuplify: length mismatch"
tuplify (sing:: SN 5) [1..5] -- ((((((),1),2),3),4),5)
This would be a nice exercise in Agda with dependent types. In Haskell you can achieve something close with (also inspired from Daniel Wagner's solution)
class C a b where
listToTuple :: [a] -> b
instance C a a where
listToTuple [x] = x
instance C a b => C a (b,a) where
listToTuple xs = (listToTuple (init xs), last xs)
Some tests:
> listToTuple [1..3::Int] :: ((Int,Int),Int)
((1,2),3)
> listToTuple [0..3::Int] :: (((Int,Int),Int),Int)
(((0,1),2),3)
Note that the return type annotation is mandatory, otherwise Haskell can not deduce how many elements the return tuple must have. If there is a mismatch between the tuple and list length, a run-time error occurs. This is pretty much unavoidable since lists do not carry their length in their type, so the compiler can not check this earlier (unlike using a vector GADT).
In order to have such a generic and type-safe function, you'd need dependent types so that the number of nested tuples in the result could depend on the length of the input list.
However it's possible to get close to that with polymorphic recursion.
Let's define a data type as follows:
data TupleList' r a = Value r | Tuple (TupleList' (r, a) a)
deriving (Show, Read, Eq, Ord)
type TupleList = TupleList' ()
So a value of type TupleList a is isomorphic to (), ((), a), (((), a), a) etc, depending on how many Tuple constructors wrap the final Value.
Now we can convert a list into such a tuple as follows:
fromList :: [a] -> TupleList a
fromList = loop ()
where
loop :: r -> [a] -> TupleList' r a
loop r [] = Value r
loop r (x:xs) = Tuple (loop (r, x) xs)
Notice that loop uses polymorphic recursion (as any function that operates on TupleList' - its recursive call has signature (r, a) -> [a] -> TupleList' (r, a) a.
Example: mapM_ (print . fromList) (inits [1..4]) yields
Value ()
Tuple (Value ((),1))
Tuple (Tuple (Value (((),1),2)))
Tuple (Tuple (Tuple (Value ((((),1),2),3))))
Tuple (Tuple (Tuple (Tuple (Value (((((),1),2),3),4)))))
The simplest way is
z (x:xs) = x
s r (x:xs) = (x, r xs)
toTuples n xs = n xs
But toTuples returns pairs in the reverse order:
toTuples (s (s (s z))) [1..] == (1,(2,(3,4)))
We can use CPS to fix this:
z f xs = f ()
s r f (x:xs) = r (\p -> (f p, x)) xs
toTuples n (x:xs) = n (const x) xs
Then
toTuples (s (s (s z))) [1..] == (((1,2),3),4)
And we can define some syntactic sugar (I'm mostly stealing from András Kovács' answer):
{-# LANGUAGE TemplateHaskell, UndecidableInstances, DataKinds, GADTs, TypeFamilies, TypeOperators #-}
import Data.Singletons.TH
import GHC.TypeLits
$(singletons [d| data Nat = Z | S Nat deriving (Eq, Show) |])
z f xs = f ()
s r f (x:xs) = r (\p -> (f p, x)) xs
toTuples n (x:xs) = n (const x) xs
type family Result n r a where
Result Z r a = r
Result (S n) r a = Result n (r, a) a
run :: Sing n -> (() -> r) -> [a] -> Result n r a
run SZ = z
run (SS sn) = s (run sn)
toTuplesN :: Sing n -> [a] -> Result n a a
toTuplesN sn (x:xs) = run sn (const x) xs
type family N n where
N 0 = Z
N n = S (N (n - 1))
type SN n = Sing (N (n - 1))
main = print $ toTuplesN (sing :: SN 6) [1..] -- (((((1,2),3),4),5),6)
Note that the code works for infinite lists too, since there is no reversing.
How would I combine the following 2 functions:
replaceNth n newVal (x:xs)
| n == 0 = newVal:xs
| otherwise = x:replaceNth (n-1) newVal xs
replaceMthNth m n v arg = replaceNth m (replaceNth n v (arg !! m)) arg
into a single function?
Is it possible?
This is pretty hideous but it does the job:
replacemn 0 0 z ((x : xs) : xss) = (z : xs) : xss
replacemn 0 n z ((x : xs) : xss) =
let (ys : yss) = replacemn 0 (n-1) z (xs : xss)
in ((x : ys) : yss)
replacemn m n z (xs:xss) = xs : replacemn (m-1) n z xss
Function composition
Functions in Haskell may be composed at no cost. E.g. given two functions, f and g, you can compose them into a new function: f . g, which applies g to an argument, then applies f to the result. You should be able to use composition in the same way here.
Ok, here it is with no other named functions in the global namespace, or using any where or let clauses or any other global functions.
{-# LANGUAGE ScopedTypeVariables,RankNTypes #-}
module Temp where
newtype Mu a = Mu (Mu a -> a)
replaceMthNth :: Int -> Int -> a -> [[a]] -> [[a]]
replaceMthNth = (\h (f :: Int -> forall b . b -> [b] -> [b]) -> h f f)
( \replaceNth replaceNth' ->
-- definition of replaceMthNth in terms of some replaceNth and replaceNth'
\m n v arg -> replaceNth m (replaceNth' n v (arg !! m)) arg
)
$
-- y combinator
((\f -> (\h -> h $ Mu h) $ \x -> f $ (\(Mu g) -> g) x $ x) :: (a -> a) -> a) $
(\replaceNth ->
-- definition of replaceNth given a recursive definition
(\(n::Int) newVal xs -> case xs of
[] -> []
(x:xs) -> if n == 0 then newVal:xs else x:replaceNth (n-1) newVal xs
)
)
I don't understand what the question is at all :), but here is how I would implement it:
modifyNth :: Int -> (a -> a) -> [a] -> [a]
modifyNth n f (x:xs)
| n == 0 = f x : xs
| otherwise = x : modifyNth (n-1) f xs
replaceNthMth :: Int -> Int -> a -> [[a]] -> [[a]]
replaceNthMth m n v = modifyNth m (modifyNth n (const v))
This way you don't need to traverse the list twice (first time with !!, second time with replaceNth)
Here's a grotesque implementation that rebuilds the 2d list structure with nested list comprehensions over zips with infinite lists:
replaceMthNth :: Int -> Int -> a -> [[a]] -> [[a]]
replaceMthNth m n v ass = [[if (x,y) == (m,n) then v else a
| (y, a) <- zip [0..] as]
| (x, as) <- zip [0..] ass]