I'm implementing a little program that does exponentiation ciphers. Some of the computations might fail, for instance, computing a modular inverse. I've used Maybe to deal with these sorts of failures. But now I'm stuck, as I need to "inject" the value inside of a maybe into another partially applied function. I know that if I had a function that took one argument, I'd use bind to do this.
import Data.Char
import Math.NumberTheory.Powers
extendedGcd::Integer->Integer->(Integer, Integer)
extendedGcd a b | r == 0 = (0, 1)
| otherwise = (y, x - (y * d))
where
(d, r) = a `divMod` b
(x, y) = extendedGcd b r
modularInverse::Integer->Integer->Maybe Integer
modularInverse n b | relativelyPrime n b = Just . fst $ extGcd n b
| otherwise = Nothing
where
extGcd = extendedGcd
relativelyPrime::Integer->Integer->Bool
relativelyPrime m n | gcd m n == 1 = True
| otherwise = False
textToDigits::String->[Integer]
textToDigits p = map (\x->toInteger (ord x - 97)) p
digitsToText::[Integer]->String
digitsToText d = map (\x->chr ((fromIntegral x) + 97)) d
exptEncipher::Integer->Integer->Integer->Maybe Integer
exptEncipher m k p | relativelyPrime k (p - 1) = Just $ powerMod p k m
| otherwise = Nothing
exptDecipher::Integer->Integer->Integer->Integer
exptDecipher m q c = powerMod c q m
exptEncipherString::Integer->Integer->String->[Maybe Integer]
exptEncipherString m k p = map (exptEncipher m k) plaintext
where
plaintext = textToDigits p
exptDecipherString::Integer->Integer->[Maybe Integer]->Maybe String
exptDecipherString m k c = (fmap digitsToText) plaintext
where
q = modularInverse k (m - 1)
plaintext = map (fmap $ exptDecipher m q) c
Specifically, my problem is in the function exptDecipherString, where I needed to inject the value encapsulated by the monad in q into the function exptDecipher, which I will then lift to work on c. What's the right way to do this? Also, I'm worried that I'll end up with a list of [Maybe Char] instead of the Maybe String that I want. I'm having problems reasoning through all of this. Can someone enlighten me?
You can use sequence and ap to get the types to work out. First for their signatures:
ap :: Monad m => m (a -> b) -> m a -> m b
sequence :: Monad m => [m a] -> m [a]
Notice that sequence directly addresses your worry about having a [Maybe Char] instead of a Maybe String. Both are in Control.Monad (note that you'll have to import ap). We can use them as follows:
exptDecipherString :: Integer -> Integer -> [Maybe Integer] -> Maybe String
exptDecipherString m k c = fmap digitsToText plaintext
where
q = modularInverse k (m - 1)
plaintext = sequence $ map (ap $ fmap (exptDecipher m) q) c
We can get to this point by working through the types. First we appy exptDecipher to m, which gives us a function of type Integer -> Integer -> Integer. We want to apply this to q, but it's a Maybe Integer, so we have to use fmap (exptDecipher m) q, which then has type Maybe (Integer -> Integer). We can then pop ap on the front and get something of type Maybe Integer -> Maybe Integer. We then map this over c, which gives us a [Maybe Integer], which we can turn inside out using sequence.
This might not work—if there are bugs in the logic, etc.—but at least it compiles.
A couple of side notes: you can use the infix operators <$> and <*> from Control.Applicative in place of fmap and ap, respectively, for slightly nicer syntax, and your relativelyPrime can be written much more simply as relativelyPrime m n = gcd m n == 1.
Related
I'm trying to write some self-defined type Martix a, which is basically list of lists [[a]]. When I tried to implement a function named colAt, which should give the vertical elements of a matrix, I firstly used the list comprehension:
colAt :: Int -> Matrix a -> [a]
colAt c m = [ e | r <- m, e <- r !! c ]
But Ghci told me
Occurs check: cannot construct the infinite type: a ~ [a]
In the expression: r !! c
While the do notation worked perfectly with
colAt :: Int -> Matrix a -> [a]
colAt c m = do
r <- m
return (r !! c)
What caused this error? I thought that basically list comprehension is a syntax sugar of list do notations, but given this error my understanding is wrong?
Your understanding is entirely correct: list comprehensions are indeed just syntax sugar for do notation! The issue is that you have not desugared your list comprehension correctly.
To start, let’s repeat the list comprehension for reference:
colAt :: Int -> Matrix a -> [a]
colAt c m = [ e | r <- m, e <- r !! c ]
Now, I’ll desugar it partially, to move the r <- m bit outside the comprehension:
colAt :: Int -> Matrix a -> [a]
colAt c m = do
r <- m
[e | e <- r !! c]
And this is simple to desugar fully:
colAt :: Int -> Matrix a -> [a]
colAt c m = do
r <- m
e <- r !! c
e
Compare to the correct implementation:
colAt :: Int -> Matrix a -> [a]
colAt c m = do
r <- m
return (r !! c)
The issue here is now obvious. In the correct implementation takes m, then for each item r <- m in turn, finds the element r !! c :: a, wraps it in a list, and then returns it. By contrast, your implementation extracts each item r <- m correctly, but then tries to extract each ‘element’ of the ‘list’ r !! c :: a — which is in fact not necessarily a list, giving the type error you see. The fix is easy: as in the correct implementation, simply add a return, giving [ e | r <- m, e <- return (r !! c) ]. Or, more simply, using the fact that [x | x <- return l] is just the same as [l], you can rewrite this more simply as [ r !! c | r <- m ].
If you write e <- r !! c, it expects r !! c to be a list, since you are enumerating over that list, but r !! c is an item (of type a), hence that would only work if you use for example a Matrix [a].
You do not need to enumerate here, you can move the r !! c to the "yield" part:
colAt :: Int -> Matrix a -> [a]
colAt c m = [ r !! c | r <- m ]
but what you here do is a mapping, so you can use map :: (a -> b) -> [a] -> [b]:
colAt :: Int -> Matrix a -> [a]
colAt c = map (!! c)
I just got into Monads and have been trying to convert a simple fibonacci function into a new one using Monads. In addition to getting the fibonacci number, I also want to get the number of recursions. So basically I am looking to combine the two functions
rec :: Int -> Int
rec n
| n == 0 = 0
| n == 1 = 0
| otherwise = fib (n-1) + fib (n-2) + 2
fib :: Int -> Int
fib n
| n == 0 = 0
| n == 1 = 1
| otherwise = fib (n-1) + fib (n-2)
to something like this
import Control.Monad
newtype Test a b = Test { getTest :: (b, a -> a) }
deriving Functor
gett :: Test a b -> (b, a -> a)
gett = getTest
instance Applicative (Test a) where
pure = return
(<*>) = liftM2 ($)
instance Monad (Test a) where
return :: b -> Test a b
--something like ?: return b = Test $ (b,\a -> a)
(>>=) :: Test a b -> (b -> Test a c) -> Test a c
--something like ?: Test b >>= f = Test $ \a -> gett(f a)
add :: (a -> a) -> Test a ()
-- something like ?: add a = Test a ()
getFib :: Test a b -> b --getFib (fib 10) -> 55
getFib = fst . getTest
getRec :: Test a b -> a -> a --getRec (fib 10) 0 -> 176
getRec = snd . getTest
fib :: Int -> Test Int Int
fib n
| n == 0 = return 0
| n == 1 = return 1
| otherwise = do
a <- fib (n-1)
add (+2)
b <- fib (n-2)
return (a+b)
I have been stuck on the implementation of return bind of the newType Test and add. My idea is that the Test Monad will accumulate the test function and focus on the computation of b. Any pointer is appreciated.
Your monad is essentially the Writer (Endo a) monad, up to isomorphism.
Your proposed definitions are mostly correct:
instance Monad (Test a) where
return :: b -> Test a b
--something like ?:
return b = Test $ (b,\a -> a)
Yes, that's correct. The identity is the neutral element of the endo monoid.
(>>=) :: Test a b -> (b -> Test a c) -> Test a c
--something like ?:
Test b >>= f = Test $ \a -> gett(f a)
No, this is not correct since you discard value b, and do not produce a pair. You want something like
Test (x, f) >>= g = Test (x', f' . f) -- or f . f'
where Test (x', f') = g x
Instead,
add :: (a -> a) -> Test a ()
-- something like ?:
add a = Test a ()
looks correct.
That being said, here's a few suggestions:
For your fib example, using your monad seem to be overkill. You are using Writer (Endo a) when Writer (Sum Int) would suffice. Instead of storing a function a -> a in your monadic type, you could simply store an Int and sum it in >>= to achieve the right count.
You could reuse the monads from the libraries. Right now, you are reinventing them. Still, what you are doing right now is a great exercise to understand how the libraries work, so it's not pointless at all!
I have a function that pattern matches on its arguments to produce a computation in StateT () Maybe (). This computation can fail when run, in which case I want the current pattern match branch to fail, so to speak.
I highly doubt it's possible to have something like
compute :: Int -> StateT () Maybe Int
compute = return
f :: Maybe Int -> Maybe Int -> StateT () Maybe ()
f (Just n1) (Just n2) = do
m <- compute (n1 + n2)
guard (m == 42)
f (Just n) _ = do
m <- compute n
guard (m == 42)
f _ (Just n) = do
m <- compute n
guard (m == 42)
behave in the way I want it to: When the first computation fails due to the guard or somewhere in compute, I want f to try the next pattern.
Obviously the above can't work, because StateT (as any other monad might) involves an additional parameter when expanded, so I probably can't formulate this as simple pattern guards.
The following does what I want, but it's ugly:
f' :: Maybe Int -> Maybe Int -> StateT () Maybe ()
f' a b = asum (map (\f -> f a b) [f1, f2, f3])
where
f1 a b = do
Just n1 <- pure a
Just n2 <- pure b
m <- compute (n1 + n2)
guard (m == 42)
f2 a _ = do
Just n <- pure a
m <- compute n
guard (m == 42)
f3 _ b = do
Just n <- pure b
m <- compute n
guard (m == 42)
A call like execStateT (f (Just 42) (Just 1)) () would fail for f but return Just () for f', because it matches f2.
How do I get the behavior of f' while having elegant pattern matching with as little auxiliary definitions as possible like in f? Are there other, more elegant ways to formulate this?
Complete runnable example:
#! /usr/bin/env stack
-- stack --resolver=lts-11.1 script
import Control.Monad.Trans.State
import Control.Applicative
import Control.Monad
import Data.Foldable
compute :: Int -> StateT () Maybe Int
compute = return
f :: Maybe Int -> Maybe Int -> StateT () Maybe ()
f (Just n1) (Just n2) = do
m <- compute (n1 + n2)
guard (m == 42)
f (Just n) _ = do
m <- compute n
guard (m == 42)
f _ (Just n) = do
m <- compute n
guard (m == 42)
f' :: Maybe Int -> Maybe Int -> StateT () Maybe ()
f' a b = asum (map (\f -> f a b) [f1, f2, f3])
where
f1 a b = do
Just n1 <- pure a
Just n2 <- pure b
m <- compute (n1 + n2)
guard (m == 42)
f2 a _ = do
Just n <- pure a
m <- compute n
guard (m == 42)
f3 _ b = do
Just n <- pure b
m <- compute n
guard (m == 42)
main = do
print $ execStateT (f (Just 42) (Just 1)) () -- Nothing
print $ execStateT (f' (Just 42) (Just 1)) () -- Just (), because `f2` succeeded
Edit: I elicited quite some clever answers with this question so far, thanks! Unfortunately, they mostly suffer from overfitting to the particular code example I've given. In reality, I need something like this for unifying two expressions (let-bindings, to be precise), where I want to try unifying the RHS of two simultaneous lets if possible and fall through to the cases where I handle let bindings one side at a time by floating them. So, actually there's no clever structure on Maybe arguments to exploit and I'm not computeing on Int actually.
The answers so far might benefit others beyond the enlightenment they brought me though, so thanks!
Edit 2: Here's some compiling example code with probably bogus semantics:
module Unify (unify) where
import Control.Applicative
import Control.Monad.Trans.State.Strict
data Expr
= Var String -- meta, free an bound vars
| Let String Expr Expr
-- ... more cases
-- no Eq instance, fwiw
-- | If the two terms unify, return the most general unifier, e.g.
-- a substitution (`Map`) of meta variables for terms as association
-- list.
unify :: [String] -> Expr -> Expr -> Maybe [(String, Expr)]
unify metaVars l r = execStateT (go [] [] l r) [] -- threads the current substitution as state
where
go locals floats (Var x) (Var y)
| x == y = return ()
go locals floats (Var x) (Var y)
| lookup x locals == Just y = return ()
go locals floats (Var x) e
| x `elem` metaVars = tryAddSubstitution locals floats x e
go locals floats e (Var y)
| y `elem` metaVars = tryAddSubstitution locals floats y e
-- case in point:
go locals floats (Let x lrhs lbody) (Let y rrhs rbody) = do
go locals floats lrhs rrhs -- try this one, fail current pattern branch if rhss don't unify
-- if we get past the last statement, commit to this branch, no matter
-- the next statement fails or not
go ((x,y):locals) floats lbody rbody
-- try to float the let binding. terms mentioning a floated var might still
-- unify with a meta var
go locals floats (Let x rhs body) e = do
go locals (Left (x,rhs):floats) body e
go locals floats e (Let y rhs body) = do
go locals (Right (y,rhs):floats) body e
go _ _ _ _ = empty
tryAddSubstitution = undefined -- magic
When I need something like this, I just use asum with the blocks inlined. Here I also condensed the multiple patterns Just n1 <- pure a; Just n2 <- pure b into one, (Just n1, Just n2) <- pure (a, b).
f :: Maybe Int -> Maybe Int -> StateT () Maybe ()
f a b = asum
[ do
(Just n1, Just n2) <- pure (a, b)
m <- compute (n1 + n2)
guard (m == 42)
, do
Just n <- pure a
m <- compute n
guard (m == 42)
, do
Just n <- pure b
m <- compute n
guard (m == 42)
]
You can also use chains of <|>, if you prefer:
f :: Maybe Int -> Maybe Int -> StateT () Maybe ()
f a b
= do
(Just n1, Just n2) <- pure (a, b)
m <- compute (n1 + n2)
guard (m == 42)
<|> do
Just n <- pure a
m <- compute n
guard (m == 42)
<|> do
Just n <- pure b
m <- compute n
guard (m == 42)
This is about as minimal as you can get for this kind of “fallthrough”.
If you were using Maybe alone, you would be able to do this with pattern guards:
import Control.Monad
import Control.Applicative
ensure :: Alternative f => (a -> Bool) -> a -> f a
ensure p a = a <$ guard (p a)
compute :: Int -> Maybe Int
compute = return
f :: Maybe Int -> Maybe Int -> Maybe Int
f (Just m) (Just n)
| Just x <- ensure (== 42) =<< compute (m + n)
= return x
f (Just m) _
| Just x <- ensure (== 42) =<< compute m
= return x
f _ (Just n)
| Just x <- ensure (== 42) =<< compute n
= return x
f _ _ = empty
(ensure is a general purpose combinator. Cf. Lift to Maybe using a predicate)
As you have StateT on the top, though, you would have to supply a state in order to pattern match on Maybe, which would foul up everything. That being so, you are probably better off with something in the vein of your "ugly" solution. Here is a whimsical attempt at improving its looks:
import Control.Monad
import Control.Applicative
import Control.Monad.State
import Control.Monad.Trans
import Data.Foldable
ensure :: Alternative f => (a -> Bool) -> a -> f a
ensure p a = a <$ guard (p a)
compute :: Int -> StateT () Maybe Int
compute = return
f :: Maybe Int -> Maybe Int -> StateT () Maybe Int
f a b = asum (map (\c -> f' (c a b)) [liftA2 (+), const, flip const])
where
f' = ensure (== 42) <=< compute <=< lift
While this is an answer specific to the snippet I've given, the refactorings only apply limited to the code I was facing.
Perhaps it's not that far-fetched of an idea to extract the skeleton of the asum expression above to a more general combinator:
-- A better name would be welcome.
selector :: Alternative f => (a -> a -> a) -> (a -> f b) -> a -> a -> f b
selector g k x y = asum (fmap (\sel -> k (sel x y)) [g, const, flip const])
f :: Maybe Int -> Maybe Int -> StateT () Maybe Int
f = selector (liftA2 (+)) (ensure (== 42) <=< compute <=< lift)
Though it is perhaps a bit awkward of a combinator, selector does show the approach is more general than it might appear at first: the only significant restriction is that k has to produce results in some Alternative context.
P.S.: While writing selector with (<|>) instead of asum is arguably more tasteful...
selector g k x y = k (g x y) <|> k x <|> k y
... the asum version straightforwardly generalises to an arbitrary number of pseudo-patterns:
selector :: Alternative f => [a -> a -> a] -> (a -> f b) -> a -> a -> f b
selector gs k x y = asum (fmap (\g -> k (g x y)) gs)
It looks like you could get rid of the whole pattern match by relying on the fact that Int forms a Monoid with addition and 0 as the identity element, and that Maybe a forms a Monoid if a does. Then your function becomes:
f :: Maybe Int -> Maybe Int -> StateT () Maybe Int
f a b = pure $ a <> b >>= compute >>= pure . mfilter (== 42)
You could generalise by passing the predicate as an argument:
f :: Monoid a => (a -> Bool) -> Maybe a -> Maybe a -> StateT () Maybe a
f p a b = pure $ a <> b >>= compute >>= pure . mfilter p
The only thing is that compute is now taking a Maybe Int as input, but that is just a matter of calling traverse inside that function with whatever computation you need to do.
Edit: Taking into account your last edit, I find that if you spread your pattern matches into separate computations that may fail, then you can just write
f a b = f1 a b <|> f2 a b <|> f3 a b
where f1 (Just a) (Just b) = compute (a + b) >>= check
f1 _ _ = empty
f2 (Just a) _ = compute a >>= check
f2 _ _ = empty
f3 _ (Just b) = compute b >>= check
f3 _ _ = empty
check x = guard (x == 42)
I have a recursive function f that takes two parameters x and y. The function is uniquely determined by the first parameter; the second one merely makes things easier.
I now want to memoise that function w.r.t. it's first parameter while ignoring the second one. (I.e. f is evaluated at most one for every value of x)
What is the easiest way to do that? At the moment, I simply define an array containing all values recursively, but that is a somewhat ad-hoc solution. I would prefer some kind of memoisation combinator that I can just throw at my function.
EDIT: to clarify, the function f takes a pair of integers and a list. The first integer is some parameter value, the second one denotes the index of an element in some global list xs to consume.
To avoid indexing the list, I pass the partially consumed list to f as well, but obviously, the invariant is that if the first parameter is (m, n), the second one will always be drop n xs, so the result is uniquely determined by the first parameter.
Just using a memoisation combinator on the partially applied function will not work, since that will leave an unevaluated thunk \xs -> … lying around. I could probably wrap the two parameters in a datatype whose Eq instance ignores the second value (and similarly for other instances), but that seems like a very ad-hoc solution. Is there not an easier way?
EDIT2: The concrete function I want to memoise:
g :: [(Int, Int)] -> Int -> Int
g xs n = f 0 n
where f :: Int -> Int -> Int
f _ 0 = 0
f m n
| m == length xs = 0
| w > n = f (m + 1) n
| otherwise = maximum [f (m + 1) n, v + f (m + 1) (n - w)]
where (w, v) = xs !! m
To avoid the expensive indexing operation, I instead pass the partially-consumed list to f as well:
g' :: [(Int, Int)] -> Int -> Int
g' xs n = f xs 0 n
where f :: [(Int, Int)] -> Int -> Int -> Int
f [] _ _ = 0
f _ _ 0 = 0
f ((w,v) : xs) m n
| w > n = f xs (m + 1) n
| otherwise = maximum [f xs (m + 1) n, v + f xs (m + 1) (n - w)]
Memoisation of f w.r.t. the list parameter is, of course, unnecessary, since the list does not (morally) influence the result. I would therefore like the memoisation to simply ignore the list parameter.
Your function is unnecessarily complicated. You don't need the index m at all:
foo :: [(Int, Int)] -> Int -> Int
foo [] _ = 0
foo _ 0 = 0
foo ((w,v):xs) n
| w > n = foo xs n
| otherwise = foo xs n `max` foo xs (n - w) + v
Now if you want to memoize foo then both the arguments must be considered (as it should be).
We'll use the monadic memoization mixin method to memoize foo:
First, we create an uncurried version of foo (because we want to memoize both arguments):
foo' :: ([(Int, Int)], Int) -> Int
foo' ([], _) = 0
foo' (_, 0) = 0
foo' ((w,v):xs, n)
| w > n = foo' (xs, n)
| otherwise = foo' (xs, n) `max` foo' (xs, n - w) + v
Next, we monadify the function foo' (because we want to thread a memo table in the function):
foo' :: Monad m => ([(Int, Int)], Int) -> m Int
foo' ([], _) = return 0
foo' (_, 0) = return 0
foo' ((w,v):xs, n)
| w > n = foo' (xs, n)
| otherwise = do
a <- foo' (xs, n)
b <- foo' (xs, n - w)
return (a `max` b + v)
Then, we open the self-reference in foo' (because we want to call the memoized function):
type Endo a = a -> a
foo' :: Monad m => Endo (([(Int, Int)], Int) -> Int)
foo' _ ([], _) = return 0
foo' _ (_, 0) = return 0
foo' self ((w,v):xs, n)
| w > n = foo' (xs, n)
| otherwise = do
a <- self (xs, n)
b <- self (xs, n - w)
return (a `max` b + v)
We'll use the following memoization mixin to memoize our function foo':
type Dict a b m = (a -> m (Maybe b), a -> b -> m ())
memo :: Monad m => Dict a b m -> Endo (a -> m b)
memo (check, store) super a = do
b <- check a
case b of
Just b -> return b
Nothing -> do
b <- super a
store a b
return b
Our dictionary (memo table) will use the State monad and a Map data structure:
import Prelude hiding (lookup)
import Control.Monad.State
import Data.Map.Strict
mapDict :: Ord a => Dict a b (State (Map a b))
mapDict = (check, store) where
check a = gets (lookup a)
store a b = modify (insert a b)
Finally, we combine everything to create a memoized function memoFoo:
import Data.Function (fix)
type MapMemoized a b = a -> State (Map a b) b
memoFoo :: MapMemoized ([(Int, Int)], Int) Int
memoFoo = fix (memo mapDict . foo')
We can recover the original function foo as follows:
foo :: [(Int, Int)] -> Int -> Int
foo xs n = evalState (memoFoo (xs, n)) empty
Hope that helps.
I have a program which produces a series of functions f and g which looks like the following:
step (f,g) = (newF f g, newG f g)
newF f g x = r (f x) (g x)
newG f g x = s (f x) (g x)
foo = iterate step (f0,g0)
Where r and s are some uninteresting functions of f x and g x. I naively hoped that having foo be a list would mean that when I call the n'th f it will not recompute the (n-1)th f if it has already computed it (as would have happened if f and g weren't functions). Is there any way to memoize this without ripping the whole program apart (e.g. evaluating f0 and g0 on all relevant arguments and then working upward)?
You may find Data.MemoCombinators useful (in the data-memocombinators package).
You don't say what argument types your f and g take --- if they both takes integral values then you would use it like this:
import qualified Data.MemoCombinators as Memo
foo = iterate step (Memo.integral f0, Memo.integral g0)
If required, you could memoise the output of each step as well
step (f,g) = (Memo.integral (newF f g), Memo.integral (newG f g))
I hope you don't see this as ripping the whole program apart.
In reply to your comment:
This is the best I can come up with. It's untested, but should be working along the right lines.
I worry that converting between Double and Rational is needlessly inefficient --- if there was a Bits instance for Double we could use Memo.bits instead. So this might not ultimately be of any practical use to you.
import Control.Arrow ((&&&))
import Data.Ratio (numerator, denominator, (%))
memoV :: Memo.Memo a -> Memo.Memo (V a)
memoV m f = \(V x y z) -> table x y z
where g x y z = f (V x y z)
table = Memo.memo3 m m m g
memoRealFrac :: RealFrac a => Memo.Memo a
memoRealFrac f = Memo.wrap (fromRational . uncurry (%))
((numerator &&& denominator) . toRational)
Memo.integral
A different approach.
You have
step :: (V Double -> V Double, V Double -> V Double)
-> (V Double -> V Double, V Double -> V Double)
How about you change that to
step :: (V Double -> (V Double, V Double))
-> (V Double -> (V Double, V Double))
step h x = (r fx gx, s fx gx)
where (fx, gx) = h x
And also change
foo = (fst . bar, snd . bar)
where bar = iterate step (f0 &&& g0)
Hopefully the shared fx and gx should result in a bit of a speed-up.
Is there any way to memoize this without ripping the whole program apart (e.g. evaluating f0 and g0 on all relevant arguments and then working upward)?
This may be what you mean by "ripping the whole program apart", but here is a solution in which (I believe but can't test ATM) fooX can be shared.
nthFooOnX :: Integer -> Int -> (Integer, Integer)
nthFooOnX x =
let fooX = iterate step' (f0 x, g0 x)
in \n-> fooX !! n
step' (fx,gx) = (r fx gx, s fx gx)
-- testing definitions:
r = (+)
s = (*)
f0 = (+1)
g0 = (+1)
I don't know if that preserves the spirit of your original implementation.