Haskell runs incredibly slow compared to C++ - c++

Question

I have an assignment, that I need to solve in Haskell.
It was firstly solved in C++, then I rewrote the code to Haskell.
The algorithm is working correctly but the Haskell version runs slower, compared to the C++ version.
For example, for the input:
110110100011010101010101
010101101001000101010100
Haskell (with GHCI): 20 sec
Haskell (compiled GHC): 3 sec
C++: <1 sec
With a difference this much, I think, I am doing something wrong.
Problem description: We are given 2 arrays(strings) of the same length, containing 0s and 1s. Our task is to find the minimal switches(switch=0->1 or 1->0) to make the source array identical to the target. There is a rule for switching: We can only change the state of i if i+1 is 1 AND i+2->n are 0, except for the last one.
C++ code:
#include <iostream>
#include <string>
#include <vector>
#include <algorithm>
using namespace std;
//flips the i-th char int s to match the i-th char in t
int flip2(int i, string& s, char t){
if(i>=s.length() || s[i]==t) return 0; //if matches, or non-existent index, returns 0 steps
int c=1; // 1 step is switching the character
c+=flip2(i+1,s,'1'); //in order to switch i, i+1 have to be 1
for(int j=i+2;j<s.length();j++) //in order to switch i, i+2->n have to be 0
c+=flip2(j,s,'0');
s[i]=t;
return c;
}
//returns the minimum number of switch steps to make s=t
int ultimateFlip( string s, string t){
int c=0;
for(int i=0;i<s.length();i++){ // switches every character in s to match t
c+=flip2(i,s,t[i]); //adds up the steps
}
return c;
}
int main()
{
string s; // source array (made up of 0s and 1s)
getline(cin, s);
string t; //target array (made up of 0s and 1s)
getline(cin, t);
cout<<ultimateFlip(s,t);
}
Haskell code:
import System.IO
import Control.Monad
main :: IO ()
main = do
hSetBuffering stdout NoBuffering
s <- getLine -- source string
t <- getLine -- target string
let sol = ultimateFlip s t
putStrLn $ show sol
return ()
--returns the minimum number of switch steps to make s=t
ultimateFlip :: [Char] -> [Char] -> Int
ultimateFlip [] [] = 0
ultimateFlip (s:sx) (t:tx) = k + ultimateFlip sxn tx
where
(k,sxn)=flip2 s t sx --snx = new (after) version of sx(the rest of the string)
--flips the s to match t, sx= rest of the source string after s
flip2 :: Char->Char->[Char]->(Int,[Char])
flip2 s t sx
| s == t = (0,sx) --if mathes, no switch needed
| null sx = (1,sx) --if last one, one switch need
| otherwise = (k2+k1+1,'1':nsx2)
where
(sxh:sxt) = sx
(k1,nsx1) = flip2 sxh '1' sxt --switch next to 1
(k2,nsx2) = zeroOut nsx1 --switch everything after the next to 0
--switch everything to 0
zeroOut :: [Char] -> (Int, [Char])
zeroOut [] = (0,[])
zeroOut (s:sx) = (k1+k2,'0':nsx2)
where
(k1,nsx1) = flip2 s '0' sx
(k2,nsx2) = zeroOut nsx1
For Haskell I am using: GHC, version 8.10.2
For C++ I am using: gcc (GCC) 10.2.0

Answer 1

You are spending an awful lot of time allocating and immediately destructuring pairs. That's pretty unnecessary, because you always know what [Char] you're going to get back in the second half of the tuple. Here's one way to eliminate that problem:
ultimateFlip :: [Char] -> [Char] -> Int
ultimateFlip [] [] = 0
ultimateFlip (s:sx) (t:tx)
| s == t = ultimateFlip sx tx
| null sx = 1
| otherwise = ultimateFlip sx tx' + 1 + ultimateFlip tx' tx where
tx' = '1' : ('0'<$drop 1 tx)
With this change, the Haskell performs pretty much the same as the C++ on my machine -- sometimes a few ms faster, sometimes a few ms slower, for inputs slightly longer than the one you proposed.
Of course, as usual, switching to a better algorithm blows microoptimizations like this one out of the water in terms of gains. The following implementation takes less time than the reporting precision of time even for much longer strings.
import Data.Bits
main :: IO ()
main = do
s <- getLine
t <- getLine
print (ultimateFlip s t)
ultimateFlip :: [Char] -> [Char] -> Int
ultimateFlip [] [] = 0
ultimateFlip (s:sx) (t:tx)
| s == t = ultimateFlip sx tx
| otherwise = go '1' pow sx + 1 + go '1' pow tx where
pow = 2^(length sx-1)
go _ _ [] = 0
go s pow (t:tx) = go s' pow' tx + n where
pow' = shiftR pow 1
(s', n) = if s == t then ('0', 0) else ('1', pow)
It also smoothly upgrades to using arbitrary-sized integers for those longer inputs just by switching Int to Integer in the type signature of ultimateFlip.

Answer 2

The biggest problem you're having is with a lack of "strictness". Haskell's lazy evaluation means that even simple calculations like k2+k1+1 generally won't be evaluated until the answer is needed. With recursive functions performing a series of additions like thus, you can sometimes end up building an enormous unevaluated expression that takes up tons of memory before it finally gets evaluated at the end.
Here, by adding a language extension at the top:
{-# LANGUAGE BangPatterns #-}
and adding a single strictness "!" annotation in your flip's "where" clause:
(!k1,nsx1) = flip2 sxh '1' sxt
^
this drops the runtime on my machine from 800ms to 80ms (again, compiled with ghc -O2). That's still slower than the C++ version (20ms), but it's in the right ballpark.
The annotation here has the effect of forcing the expression to be evaluated. Figuring out where strictness annotations are needed is a bit of a dark art. In this case, I suspected your counting was causing the problem, so I threw in "!" before all the places that a count was being returned, and then I deleted them until I found the one that made most of the difference.
The remaining speed difference is probably a result of using a lot of list processing in Haskell (versus arrays in C++), so you could likely do better, though I'm not sure it's worth the trouble.