problem29.lhs

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Module      : problem29
%% Copyright   : (c) 2010 David M. Rosenberg
%% License     : BSD3
%% 
%% Maintainer  : David Rosenberg <rosenbergdm@uchicago.edu>
%% Stability   : experimental
%% Portability : portable
%% Created     : Sat Mar 27 08:58:25 CDT 2010
%% 
%% Description :
%%    Project euler problem solution.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\documentclass{article}
%include colorcode.fmt
\usepackage{graphicx}
\usepackage{color}
\usepackage{pgf}

\begin{document}

\section{Problem}


Consider all integer combinations of $a^b$ for $2 \leq a \leq 5$ 
and $2 \leq b \leq 5$:

\begin{tabular}{llll}
    $2^2=4$ &$2^3=8$ &$2^4=16$ &$2^5=32$ \\
    $3^2=9$ &$3^3=27$ &$3^4=81$ &$3^5=243$ \\
    $4^2=16$ &$4^3=64$ &$4^4=256$ &$4^5=1024$ \\
    $5^2=25$ &$5^3=125$ &$5^4=625$ &$5^5=3125$
\end{tabular}

If they are then placed in numerical order, with any repeats removed, we get
the following sequence of 15 distinct terms:

\begin{displaymath}
4, 8, 9, 16, 25, 27, 32, 64, 81, 125, 243, 256, 625, 1024, 3125
\end{displaymath}

How many distinct terms are in the sequence generated by $a^b$ for 
$2 \leq a \leq 100$ and $2 \leq b \leq 100$?


\section{Solution}

\colorhs
\begin{code}

import Data.List
import qualified Data.Map as Map
import Data.Maybe
import System.Environment
import Data.Numbers
import qualified Data.Set as Set

isPerfectPower :: Integer -> Bool
isPerfectPower x = 
  let pf          = group $ primeFactors x
      pl          = max 2 (length $ maximumBy (\a b -> compare (length a) (length b)) pf)
      unitFactors = filter (\z -> length z /= pl) pf
  in unitFactors == []

getPerfectExponent :: Integer -> Int
getPerfectExponent x = (length . head . group . primeFactors) x

numUniqueEntries a b
  | not $ isPerfectPower a    = b - 1
  | otherwise                 = unEls
    where pexp      = getPerfectExponent a
          fset      = Set.fromList [pexp * i | i <- [2..b]]
          nonUnique = Set.fromList [i * j | i <- [2..b], j <- [1..(pexp-1)] ]  
          unEls     = Set.size $ Set.difference fset nonUnique
  



main = do
  let nUnique = sum $ map (\a -> numUniqueEntries a 100) [2..100]
  putStrLn $ "There are a total of " ++ show nUnique ++ 
    " distinct elements in the set {a^b | 2 <= a <= 100, 2 <= b <= 100}."


\end{code}

\section{Result}

\begin{verbatim}

runhaskell problem29.lhs
There are a total of 9183 distinct elements in the set {a^b | 2 <= a <= 100, 2 <= b <= 100}.

\end{verbatim}

There are a total of 9183 distinct elements in the set 
$$
  \{ a^b : 2 \leq a \leq 100, 2 \leq b \leq 100 \}
$$


\end{document}

% vim: ft=lhaskell softtabstop=2 shiftwidth=2