CODEWITHSUNDEEP
listhaskellpermutation
Tiziano Coroneo
Tiziano Coroneo

Reputation: 660

Single char permutations

I've been experimenting with Haskell for quite a while now, and I've found an interesting problem:

I've got to generate all permutations of a string in a very particular way:

Let's say I've got this string:

let input = "_h_i_"

I want to get all the permutations of underscores in input keeping the actual order of the other chars, like this:

let results = ["hi___", "h_i__", "h__i_", "h___i", "_hi__", "_h_i_", "_h__i", "__hi_", "__h_i", "___hi"]

and I've no idea on how to do that.

Upvotes: 0

Views: 93

Answers (3)

karakfa
karakfa

Reputation: 67507

here is another solution

u='_'

perms :: String -> Int -> [String]
perms x 0 = [x]
perms [x] n = rotations $ x: (replicate n u)
perms (x:xs) n = (map (x:) $ perms xs n) ++ if(x/=u) then perms (u:x:xs) (n-1) else []

rotate xs n = zipWith const (drop n (cycle xs)) xs
rotations x = map (rotate x) [1..length x]

I changed the input signature, use as

> perms "hi" 3
["h___i","h__i_","h_i__","hi___","_h__i","_h_i_","_hi__","__h_i","__hi_","___hi"]

I think there is a simpler solution hiding there but don't have enough time now.

Upvotes: 1

Free_D
Free_D

Reputation: 577

so :: String -> [String]
so = takeWhile' notDone . iterate shift . preproccess
  where    
    preproccess xs = (replicate (uCount xs) '_') ++ (letters xs)
    uCount = length . filter (=='_')
    letters = filter (/='_')
    notDone = not . and . map (== '_') . dropWhile (/='_')

takeWhile' :: (a -> Bool) -> [a] -> [a]
takeWhile' _ [] = []
takeWhile' f (x:xs) 
  | f x = x:(takeWhile' f xs)
  | otherwise = [x]

shift :: String -> String
shift [] = []
shift (x:xs)
  | x /= '_' = roll lead [] rest
  | otherwise = roll [] [] (x:xs)
  where     
    (lead,rest) = span (/='_') (x:xs)
    roll _ acc [] = acc
    roll _ acc [a] = acc++[a]
    roll ins acc (a:b:bs)
      | (a == '_') && (b /= '_') = acc++ins++(b:a:bs)
      | otherwise = roll ins (acc++[a]) (b:bs)

Probably not the prettiest code, but it seems to work. The algorithm is essentially the same as the one you used to do it by hand, except in reverse.

shift works by rolling across the string and shifting the leftmost non-underscore character to the left. This is repeated until all non-underscore characters are on the left.

The preprocess is just to get all of the underscores on he left and all other characters on the right.

Upvotes: 1

Chad Gilbert
Chad Gilbert

Reputation: 36375

One way to perform this is to generate all permutations but only keep those that retain the order of non-underscore characters.

import Data.List

orderedPermutationsOf :: Char -> String -> [String]
orderedPermutationsOf c s =
  let except = filter (/= c)
  in nub $ filter (\x -> except s == except x) $ permutations s

It isn't very performant, but it gets the job done.

Upvotes: 1

Related Questions