Finding number of brackets sequences of length n containing a specific string s

Question

I am trying to solve a problem where I need to find the number of bracket sequences \$p\$ and \$q\$ such that for a given bracket sequence s. I have that \$p + s + q\$ is a valid bracket sequence. Also \$|p+s+q| = 2n\$.

We can use dynamic programming here, i.e. let dp[i][j] = the number of bracket sequences (which are a prefix of a valid bracket sequence) with \$i\$ ('s and \$j\$ )'s. Also \$i\ge j\$.

Now we have

\$\displaystyle dp(i, j)= \begin{cases} 0&i<j\text{ or }i<0\text{ or }j<0\\ 1&j=0\\ dp(i-1, j)+dp(i, j-1)&\text{otherwise} \end{cases}\$

Now let us suppose

• \$p\$ has \$x\$ ('s and \$y\$ )'s
• \$s\$ has \$l\$ ('s and \$r\$ )'s.

Then we must have \$y\ge x\$ for \$p\$ to be valid, \$x+l\ge y+r\$ for \$p+s\$ to be valid and the same must hold for \$p+s_i\$ i.e. in any prefix \$s_i\$ of \$s\$ appended to \$p\$.

So we have \$x+l_i\ge y+r_i\$ or \$x-y+l_i-y_i\ge 0\$. We have \$x-y+l_i-y_i\ge x-y+\min_i\{l_i-r_i\}\ge0\$. So we need to have \$x+\min_i\{l_i-r_i\}\ge y\$

So we can loop over all possible values of \$x,y\$ and see if we can find \$p,q\$. Number of ways of \$p\$ will be dp[x][y]. Now if we reverse all brackets in \$p+s+q\$ (which is also a valid sequence), we can see that \$q\$ has \$n-y-r\$ ('s and \$n-x-l\$ )'s. So the number of ways of that is dp[n-y-r][n-x-l]

Note: I need to find the solution mod \$10^9+7\$. You can find more details here.

This is the solution that I came up with. I am facing high memory usage (i)How can I improve the memory usage? (ii) Also is there a way I can make it more concise?

The only problem could be the \$dp\$ which will hold \$n^2\$ entries of Int64

import           Data.Array
import           Data.Int
import           Data.List
import           Data.Function
import           Control.Monad

main :: IO ()
main = do
    [n', m] <- map read . words <$> getLine -- n'=2n, m=|s|
    s       <- getLine
    print $ solve n' s

solve n' s =
    let
        n   = n' `div` 2 -- number of ( or )
        l   = length $ filter (== '(') s 
        r   = length s - l
        mm  = 10 ^ 9 + 7 :: Int64
        arr = array ((0, 0), (n, n))
                    [ ((i, j), f i j) | i <- [0 .. n], j <- [0 .. n] ] -- the dp array
        f i j
            | j == 0 -- base case dp
            = 1
            | j > i -- invalid sequence
            = 0
            | otherwise
            = let left = if i > 0 then arr ! (i - 1, j) else 0
                  down = if j > 0 then arr ! (i, j - 1) else 0
              in  (left + down) `mod` mm
        minVal =
            minimum $ scanl (\v c -> if c == '(' then v + 1 else v - 1) 0 s -- min li - ri
    in
        (`mod` mm)
        . sum
        $ [ let leftWays  = arr ! (x, y)
                rightWays = arr ! (n - y - r, n - x - l)
            in  (leftWays * rightWays) `mod` mm
          | x <- [0 .. n - l] -- x+l<=n 
          , y <- [0 .. x + l - r] -- y <= x, y + r <= x - l
          , x + minVal >= y -- x + min (li - ri) >= y
          ]