[EMAIL PROTECTED] wrote:
> The python code below generates a cartesian product subject to any
> logical combination of wildcard exclusions. For example, suppose I want
> to generate a cartesian product S^n, n>=3, of [a,b,c,d] that excludes
> '*a*b*' and '*c*d*a*'. See below for details.
>
> CHALLENGE: generate an equivalent in ruby, lisp, haskell, ocaml, or in
> a CAS like maple or mathematica.
What is your goal? You want to learn or to cause a flamewar? ;-)
Anyway, I found the problem entertaining, so here you go, here is my
Haskell code. It could be shorter if I didn't care about performance and
wrote in specification style. It's not very efficient either, because it
will generate all lists matching the given patterns.
In GHCi you can test it by:
$ ghci
:l WildCartesian.hs
test
I apologise for the lack of comments.
----8<--------8<--------8<--------8<--------8<--------8<--------8<--------8<----
module WildCartesian where
import Data.Set (Set)
import qualified Data.Set as Set
import Control.Monad
import Control.Exception (assert)
import Maybe
import List
data Pat a = All | Lit a deriving Show
generateMatching :: (Ord a) => Int -> Set a -> [Pat a] -> [[a]]
generateMatching 0 _ [] = [[]]
generateMatching 0 _ (_:_) = []
generateMatching len alphabet (Lit x : ps)
| x `Set.member` alphabet =
[ (x : xs) | xs <- generateMatching (len - 1) alphabet ps ]
| otherwise =
[ ]
generateMatching len alphabet (All : ps) =
[ (x : xs)
| x <- Set.toList alphabet
, xs <- unionSorted
(generateMatching (len - 1) alphabet ps)
(generateMatching (len - 1) alphabet (All : ps)) ]
`unionSorted`
generateMatching len alphabet ps
generateMatching _ _ [] = []
generateNotMatching :: (Ord a) => [a] -> Int -> [[Pat a]] -> [[a]]
generateNotMatching alphabet len patterns =
generateMatching len alphaSet [All]
`subtractSorted`
foldr unionSorted []
(map (generateMatching len alphaSet . simplifyPat) patterns)
where
alphaSet = Set.fromList alphabet
simplifyPat (All : All : ps) = simplifyPat (All : ps)
simplifyPat (p : ps) = p : simplifyPat ps
simplifyPat [] = []
joinSorted :: Ord a => [a] -> [a] -> [(Maybe a, Maybe a)]
joinSorted (x1:x2:_) _ | assert (x1 < x2) False = undefined
joinSorted _ (y1:y2:_) | assert (y1 < y2) False = undefined
joinSorted (x:xs) (y:ys) =
case x `compare` y of
LT -> (Just x, Nothing) : joinSorted xs (y:ys)
EQ -> (Just x, Just y) : joinSorted xs ys
GT -> (Nothing, Just y) : joinSorted (x:xs) ys
joinSorted (x:xs) [] = (Just x, Nothing) : joinSorted xs []
joinSorted [] (y:ys) = (Nothing, Just y) : joinSorted [] ys
joinSorted [] [] = []
unionSorted :: Ord a => [a] -> [a] -> [a]
unionSorted xs ys = catMaybes (map (uncurry mplus) (joinSorted xs ys))
subtractSorted :: Ord a => [a] -> [a] -> [a]
subtractSorted xs ys = catMaybes (map f (joinSorted xs ys))
where
f (Just x, Nothing) = Just x
f _ = Nothing
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 " " ["generateMatching", 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
--
http://mail.python.org/mailman/listinfo/python-list
