Programming challenge: wildcard exclusion in cartesian products

[Tomasz Zielonka]

Dan Piponi wrote:
> Is this Haskell implementation what you want? It does the wildcard
> matching through a state machine and it essentially threads the
> state machine through the cartesian product, switching to the
> ordinary cartesian product when possible as an optimisation.
> The execution of the state machine is shared by strings with the
> same prefix making it reasonably efficient even though the state
> machine itself isn't optimised.

I've implemented the same concept yesterday evening:

----8<--------8<--------8<--------8<--------8<--------8<--------8<--------8<----
module WildCartesian where

import List

data Pat a = All | Lit a deriving (Show, Eq)

advancePattern :: Eq a => a -> [Pat a] -> [[Pat a]]
advancePattern y (Lit x : ps)
    | x == y    = [ps]
    | otherwise = []
advancePattern y (All : ps) = [All : ps] ++ [ps] ++ advancePattern y ps
advancePattern _ [] = []

generateNotMatching :: Eq a => [a] -> Int -> [[Pat a]] -> [[a]]
generateNotMatching alphabet = gen []
  where
    gen _   n pats
        | any (\ps -> all (== All) ps && (not (null ps) || n == 0)) pats = []
    gen acc 0 _
        = [reverse acc]
    gen acc n pats
        = [ w | x <- alphabet
              , let pats' = [ p' | p <- pats, p' <- advancePattern x p ]
              , w <- gen (x : acc) (n - 1) pats' ]

test :: IO ()
test = do
    t [1,2] 3 [[Lit 1, All, Lit 2]]
    t ['a','b'] 3 [[Lit 'a', All, Lit 'b'], [Lit 'b', All, Lit 'a']]
    t [1,2] 3 [[Lit 1, All, Lit 2], [Lit 2, All, Lit 1]]
  where
    t a b c = do
        putStrLn (concat (intersperse " " ["generateNotMatching", show a, show b, show c]))
        mapM_ (putStrLn . ("  "++) . show) (generateNotMatching a b c)
----8<--------8<--------8<--------8<--------8<--------8<--------8<--------8<----

Best regards
Tomasz

-- 
I am searching for programmers who are good at least in
(Haskell || ML) && (Linux || FreeBSD || math)
for work in Warsaw, Poland