/prog/ - euler — World4ch

Name: Anonymous 2012-01-17 13:33



{-

 - Project euler 51, be happy /prog/

 - Released under the GPLv2 /because i am a hipster

 - time ./eu51 throw 0.037 s

 - this is you to see that even a bad algorithm (if you check this out 

 - it's crap) it is not that verbose

 -}

{-# LANGUAGE BangPatterns #-} 

module Main where



import Data.Numbers.Primes

import qualified Data.Sequence as S

import Data.Int (Int8)

import Data.Tuple (swap)

import Data.List (unfoldr, find)

import Data.Maybe (isJust, fromJust)

import Data.Foldable (foldl')



type Primo = S.Seq Int8



main :: IO ()

main = print $ find eightCombinations rangoPrimosProp 



toPrimo :: Int -> Primo

toPrimo = let listDigit 0 = Nothing  

              listDigit n = Just . swap $ divMod n 10

          in S.fromList . map fromIntegral . reverse . unfoldr listDigit



solucion :: Primo

solucion = toPrimo 121313



mySol :: Primo

mySol = toPrimo 111857



shead :: S.Seq a -> a

shead n | (a S.:< _) <- S.viewl n = a



primoToInt :: Primo -> Int

primoToInt = foldl' (\acc a -> acc*10 + fromIntegral a) 0



eightCombinations :: Primo -> Bool

eightCombinations !n = 

  let digitos = S.elemIndicesL (fromJust $ threeDigitsRepeat n) n

      singleCombination d = foldr (flip S.update d) n digitos

      criterioFiltro = isPrime . primoToInt

      isMinorGenerator a = (length a) == 8 && head a == n 

  in  isMinorGenerator . filter criterioFiltro $ map singleCombination [0..9]



rangoPrimos :: [Int]

rangoPrimos = takeWhile (<10^6) . dropWhile (<10^5) $ primes



rangoPrimosProp :: [Primo] 

rangoPrimosProp = filter criterio $ map toPrimo rangoPrimos

  where 

    criterio a = isJust (threeDigitsRepeat a >>= lastRepeat a >>= goodValues)

  

threeDigitsRepeat :: Primo -> Maybe Int8

threeDigitsRepeat = go . S.unstableSort

  where    

    go :: Primo -> Maybe Int8

    go s | S.null s = Nothing

         | takeEquals s == 3 = Just head'

         | otherwise = go (S.dropWhileL (head' ==) s)

      where 

        head' = shead s

        takeEquals = length . S.elemIndicesL head' 

        

lastRepeat :: Primo -> Int8 -> Maybe Int8

lastRepeat s n = let (_ S.:> final) = S.viewr s

                 in if n == final then Nothing else Just n



goodValues :: Int8 -> Maybe Int8

goodValues n = if elem n [0..2] then Just n else Nothing
euler

1 Name: Anonymous 2012-01-17 13:33

27 Name: Anonymous 2012-01-17 21:00

Name: Anonymous 2012-01-17 13:33

Name: Anonymous 2012-01-17 21:00
