r_haskell.hs

{-
https://www.reddit.com/r/haskell/comments/g6kc33/intersection_of_infinite_lists/
-}
import qualified Data.Set as Set

-------- Original and Step 1 --------

intersection :: (Eq a) => [[a]] -> [[a]] -> Int -> [([a], [a])]
intersection l1 l2 i =
  [(x, y) | x <- (take i l1), y <- (take i l2), not (common x y == [])]

intersection' :: (Eq a) => [[a]] -> [[a]] -> Int -> [([a], [a])]
intersection' l1 l2 n =
     [ (x,y) | let x = l1 !! (n-1), y <- take (n-1) l2,  common x y /= [] ]
  ++ [ (x,y) | x <- take (n-1) l1,  let y = l2 !! (n-1), common x y /= [] ]
  ++ [ (x,y) | let x = l1 !! (n-1), let y = l2 !! (n-1), common x y /= [] ] 

common :: (Eq a) => [a] -> [a] -> [a]
common l1 l2 = filter (`elem` l2) l1

getElement, getElement' :: (Eq a) => [[a]] -> [[a]] -> Int
getElement l1 l2 = head $ filter (\i -> intersection l1 l2 i /= []) [1..]
getElement' l1 l2 = head $ filter (\i -> intersection' l1 l2 i /= []) [1..]

-------- Step 2 --------

type Pos a = ([a], a)

-- positions [1..] = [ ([], 1), ([1], 2), ([2,1], 3), ... ]
positions :: [a] -> [Pos a]
positions = loop []
  where
    loop _    []          = []
    loop prev (here:next) = (prev, here) : loop (here : prev) next

intersection'' :: (Eq a) => Pos [a] -> Pos [a] -> [([a], [a])]
intersection'' (l1', xHere) (l2', yHere) =
     [ (xHere,y) | y <- l2', common xHere y /= [] ]
  ++ [ (x,yHere) | x <- l1', common x yHere /= [] ]
  ++ [ (xHere,yHere) | common xHere yHere /= [] ]

getElement'' :: (Eq a) => [[a]] -> [[a]] -> Int
getElement'' l1 l2 =
  head [ i | (i, p1, p2) <- zip3 [1..] (positions l1) (positions l2)
           , intersection'' p1 p2 /= [] ]

-------- Step 3 (Use Data.Set) --------

initSets :: (Ord a) => [[a]] -> [Set.Set a]
initSets = drop 1 . scanl step Set.empty
  where
    step acc x = Set.union acc (Set.fromList x)

getElementOrd :: (Ord a) => [[a]] -> [[a]] -> Int
getElementOrd l1 l2 =
  head [ i | (i, s1, s2) <- zip3 [1..] (initSets l1) (initSets l2)
           , not (Set.disjoint s1 s2) ]

-------- Step 4 (Use Data.Set + "difference only" tech) --------

type P a = (Set.Set a, Set.Set a)

initSets' :: (Ord a) => [[a]] -> [P a]
initSets' = drop 1 . scanl step (Set.empty, Set.empty)
  where
    step (acc, x) y =
      let acc' = Set.union acc x
      in acc' `seq` Set.fromList y Set.\\ acc'

intersectionOrd' :: (Ord a) => P a -> P a -> Bool
intersectionOrd' (acc1, s1) (acc2, s2) =
  not $ Set.disjoint acc1 s2 &&
        Set.disjoint acc2 s1 &&
        Set.disjoint s1 s2

getElementOrd' :: (Ord a) => [[a]] -> [[a]] -> Int
getElementOrd' l1 l2 =
  head [ i | (i, s1, s2) <- zip3 [1..] (initSets' l1) (initSets' l2)
           , intersectionOrd' s1 s2 ]

-------- Test inputs --------

s, t2, t3, t4 :: [[Int]]
s = [ [0,i] | i <- [2,4 ..] ]
t2 = cycle $ [ [i] | i <- [1, 3 .. 101] ++ [0] ]
t3 = cycle $ [ [i] | i <- [1, 3 .. 1001] ++ [0] ]
t4 = cycle $ [ [i] | i <- [1, 3 .. 10001] ++ [0] ]