gemstrings.hs

module Main where

import Data.List
import Data.Char
import qualified Data.Set as Set

type Gem = Int
gems = "abbbbcddddeefggg"
princess = "eagcdfbe"

main = putStrLn $ show $ gem_index (gems2ints gems) (gems2ints princess)
  where
    gems2ints = map ord

gem_index :: [Gem] -> [Gem] -> Int
gem_index gstk gptn = gem_index' (minimum gstk) gstk gptn where
  gem_index' :: Gem -> [Gem] -> [Gem] -> Int
  gem_index' _ _ [] = 0
  gem_index' gnext gstk gptn@(p:ps)
    | not (gnext `elem` gstk) = gem_index' (gnext+1) gstk gptn
    | gnext == p  = gem_index' (minimum removed) removed ps + 1
    | otherwise   = (gem_pattern_count removed + 1) + gem_index' (gnext+1) gstk gptn
    where
      removed = delete gnext gstk

      gem_pattern_count :: (Ord a) => [a] -> Int
      gem_pattern_count = sum . map nub_perm_count . filter (/= []) . nubOrd . subsequences
        where
          nub_perm_count :: (Ord a) => [a] -> Int
          nub_perm_count xs = perms `div` reps where
            perms = fact $ length xs
            reps  = product $ map (fact.length) $ group xs

--------------------
-- Utils
--------------------

-- O(n log n)
nubOrd :: (Ord a) => [a] -> [a]
nubOrd = nubWith Set.empty
  where
    nubWith _ [] = []
    nubWith t (x : xs)
      | Set.member x t = nubWith t xs
      | otherwise = x : nubWith (Set.insert x t) xs

-- Factorial
fact :: Int -> Int
fact x = product [1..x]