62% in floor?

gistfile1.txt

--        diff_i  = {-# SCC "diff_i" #-} floor2 . logged
--        floor2 = {-# SCC "floor" #-} floor
--        logged p =  {-# SCC "logged" #-} (logBase (fromIntegral p) (fromIntegral no)) - 1

-- full app

{-# LANGUAGE ScopedTypeVariables #-}
-- highest is pretty easy to get - we're always going to end up at the LCM of 1..n
-- if you go in in order, then everyone's unhappy up to n
-- but then all bets are off. damn.

-- so at that point, we need all the common multiples of all our numbers, sorted and uniqed.

-- can't get to primes > n, because no-one would go there anyway.
-- so: all products of the power set of primes < n, raised to an arbitrary power.
import Data.Numbers.Primes
import Data.List
import Debug.Trace
import Data.Array
import Control.Parallel
import Control.Parallel.Strategies
import Data.Array.Repa (fromList, Z(..), (:.)(..), DIM1(..))
import qualified Data.Array.Repa as Repa

-- primes = 2: 3: sieve (tail primes) 3 []
--    where 
--     sieve (p:ps) x fs = [i*2 + x | (i,e) <- assocs a, e] 
--                         ++ sieve ps (p*p) fs'
--      where
--       q     = (p*p-x)`div`2                  
--       fs'   = (p,0) : [(s, rem (y-q) s) | (s,y) <- fs]
--       a     = accumArray (\ b c -> False) True (1,q-1)
--                          [(i,()) | (s,y) <- fs, i <- [y+s,y+s+s..q]]

-- computing all the primes up to our number (540 billion) is not really a goer.
-- why are we trying to do it?
--   really we just want to factorise our number. highest is the number of powers of the factor that fit in,
--   smallest is just the number of prime factors.
solve :: Int -> Int
solve no = diff arr_primes
  where (smallprimes :: [Int]) = {-# SCC "smallprimes" #-} takeWhile (<= (ceiling . sqrt $ fromIntegral no))  primes
        len = length smallprimes
        arr_primes = fromList (Z :. len :: DIM1) (take len smallprimes)
        diff = {-# SCC "diff" #-} (+1) . flip (Repa.!) Z . Repa.fold (\acc -> (+acc) . diff_i) 0
        diff_i  x = {-# SCC "diff_i" #-} x `seq` floor2 (logged x)
        floor2 = {-# SCC "floor" #-} floor
        logged p =  {-# SCC "logged" #-} (logBase (fromIntegral p) (fromIntegral no)) - 1

main = do
  l <- getContents
  putStr . unlines .  format . parMap rseq (solve.read) .  tail $ lines l

format n = map (\(num, s) -> "Case #" ++ show num  ++ ": " ++ show s  ) $ zip [1..] n