[Haskell-cafe] Re: Review request for my permutations implementation
Maciej Piechotka
uzytkownik2 at gmail.com
Thu Jan 7 08:04:20 EST 2010
On Thu, 2010-01-07 at 00:37 -0800, CK Kashyap wrote:
> Hi All,
>
> I've written this piece of code to do permutations -
>
I assume that it's training piece not real code as in such I'd
recommend:
> import Data.List
> perms = permutations
> perms :: String -> [String]
> perms []= []
As pointed out perms [] = [[]]. You can note that:
length . perms == factorial
> perms (x:[])= [[x]]
> perms (x:xs)= concat (f [x] (perms xs))
>
Don't call function f. I'd look into parameters - i.e. map f xs is = ...
ok as f is some user function but f xs does not say what f is (except it
is some function ;) ).
Also pointed out concatMap:
> perms (x:xs) = concatMap spread
> spread :: String -> String -> [String] -- interpolate first string at various positions of second string
> spread str1 str2 = _spread str1 str2 (length str2)
I'd always be careful with (!!) and length. Both have O(n) complexity
and I've seen code in which it shifted from O(n^3) to O(n^6) by
uncareful usage (usually something like O(n) to O(n^2) per function).
> where
> _spread str1 str2 0= [str1 ++ str2]
> _spread str1 str2 n= [(take n str2) ++ str1 ++ (drop n str2)] ++ (_spread str1 str2 (n-1))
Please note that the first list (here list of chars) have always length
1. It would be nice to indicate it by rewriting into:
> spread :: a -> [a] -> [[a]]
> spread a b = _spread a b 0
> where
> _spread a b 0 = [a:b]
> _spread a b n = ((take n b) ++ a:(drop n b)):(_spread a b (n-1))
> perms (x:xs) = concatMap (spread x) (perms xs)
I took the liberty of rewriting [a] ++ b into a:b. In fact (:) is base
constructor as the list [1,2,3,4] is syntax sugar for 1:2:3:4:[]. Hence
it should be marginally more effective w/out optimalizations
Further clarification is
> spread a b = map (\n -> (take n b) ++ a:(drop n b))
Or:
> spread a b = zipWith (\i e -> i ++ a:e) (inits b) (tails b)
(\n -> something) is lambda function and is shorthand of
... f ...
where f n = something
> f xs = map (spread xs)
>
Why make separate function (not in where)
>
> The number of outcomes seem to indicate that correctness of the algo .. however, I'd be very obliged
> if I could get some feedback on the Haskellness etc of this ... also any performance pointers ...
>
Minor difficulty with algorithm - it diverges for:
> head $ head $ perms [1..]
>
> Regards,
> Kashyap
Regards
More information about the Haskell-Cafe
mailing list