[Haskell-cafe] warning - Euler problem spoiler enclosed
Barbara Shirtcliff
barcs at gmx.com
Wed May 4 15:13:07 CEST 2011
Hi,
In the following solution to problem 24, why is nub ignored?
I.e. if you do lexOrder of "0012," you get twice as many permutations as with "012," even though I have used nub.
puzzled,
Bar
-- file Euler.hs
module Euler where
import Data.List
{-
problem 24
A permutation is an ordered arrangement of objects. For example, 3124
is one possible permutation of the digits 1, 2, 3 and 4. If all of the
permutations are listed numerically or alphabetically, we call it
lexicographic order. The lexicographic permutations of 0, 1 and 2 are:
012 021 102 120 201 210
What is the millionth lexicographic permutation of the digits 0, 1, 2,
3, 4, 5, 6, 7, 8 and 9?
-}
lexI :: Char -> String -> Int
lexI c s = maybe 1 (id) $ elemIndex c s
lexOrder :: [Char] -> [[Char]]
lexOrder s
| length s == 1 = [s]
| length s == 2 = z : [reverse z]
| otherwise = concat $ map (\n -> h n) [0..((length s) - 1)]
where z = sort $ nub s -- why is the nub ignored here?
h :: Int -> [String]
h n = map (z!!n :) $ lexOrder $ filter (\c -> lexI c z /= n) z
p24 = (lexOrder "1234567890")!!999999
main :: IO()
main =
do
putStrLn $ show $ p24
More information about the Haskell-Cafe
mailing list