Euler problems/181 to 190

Problem 181

Investigating in how many ways objects of two different colours can be grouped.

Problem 182

RSA encryption.

Solution:

fun a1 b1 = sum [ e | e <- [2..a*b-1],
                      gcd e (a*b) == 1,
                      gcd (e-1) a == 2,
                      gcd (e-1) b == 2 ]
  where a = a1-1
        b = b1-1

problem_182 = fun 1009 3643

Problem 183

Maximum product of parts.

Solution:

-- Does the decimal expansion of p/q terminate?
terminating p q = 1 == reduce [2,5] (q `div` gcd p q)
        where reduce   []   n = n
              reduce (x:xs) n | n `mod` x == 0 = reduce (x:xs) (n `div` x)
                              | otherwise      = reduce xs n

-- The expression (round $ fromIntegral n / e) computes the integer k
-- for which (n/k)^k is at a maximum. Also note that, given a rational number
-- r and a natural number k, the decimal expansion of r^k terminates if
-- and only if the decimal expansion of r does.
answer = sum [if terminating n (round $ fromIntegral n / e) then -n else n
                | n <- [5 .. 10^4]]
        where e = exp 1

main = print answer

Problem 184

Triangles containing the origin.

Solution:

problem_184 = undefined

Problem 185

Number Mind

Solution:

This approach does NOT solve the problem in under a minute, unless of course you are extremely lucky. The best time I've seen so far has been about 76 seconds. Before I came up with this code, I tried to search for the solution by generating a list of all possible solutions based on the information given in the guesses. This was feasible with the 5 digit problem, but completely intractable with the 16 digit problem. The approach here, simple yet effective, is to make a random guess, and then vary each digit in the guess from [0..9], generating a score of how well the guess matched the given numbermind clues. You then improve the guess by selecting those digits that had a unique low score. It turns out this approach converges rather quickly, but can often be stuck in cycles, so we test for this and try a differenct random first guess if a cycle is detected. Once you run the program, you might have time for a cup of coffee, or maybe even a dinner. HenryLaxen 2008-03-12

import Data.List
import Control.Monad
import Data.Char
import System.Random

type Mind = [([Char],Int)]

values :: [Char]
values = "0123456789"


score :: [Char] -> [Char] -> Int
score guess answer = foldr (\(a,b) y -> if a == b then y+1 else y) 0 
      (zip guess answer)

scores :: Mind -> [Char] -> [Int]
scores m g = map (\x -> abs ((snd x) - score (fst x) g)) m

scoreMind :: Mind -> [Char] -> Int
scoreMind m g = sum $ scores m g


ex1 :: Mind
ex1 = 
  [("90342",2),
   ("39458",2),
   ("51545",2),
   ("34109",1),
   ("12531",1),
   ("70794",0)]
   
ex2 :: Mind   
ex2 = 
  [
   ("5616185650518293",2),
   ("3847439647293047",1),
   ("5855462940810587",3),
   ("9742855507068353",3),
   ("4296849643607543",3),
   ("3174248439465858",1),
   ("4513559094146117",2),
   ("7890971548908067",3),
   ("8157356344118483",1),
   ("2615250744386899",2),
   ("8690095851526254",3),
   ("6375711915077050",1),
   ("6913859173121360",1),
   ("6442889055042768",2),
   ("2321386104303845",0),
   ("2326509471271448",2),
   ("5251583379644322",2),
   ("1748270476758276",3),
   ("4895722652190306",1),
   ("3041631117224635",3),
   ("1841236454324589",3),
   ("2659862637316867",2)]


guesses :: [Char] -> Int -> [[Char]]
guesses str pos = [ left ++ n:(tail right) | n<-values]
  where (left,right) = splitAt pos str

bestGuess :: Mind -> [[Char]] -> [Int]
bestGuess mind guesses =
  let scores = map (scoreMind mind) guesses
      bestScore = minimum scores
      bestGuesses = findIndices (==bestScore) scores
  in bestGuesses

iterateGuesses :: Mind -> [Char] -> [Char]
iterateGuesses mind value = 
   let allguesses = map (guesses value) [0..(length value)-1]
       mins = map (bestGuess mind) allguesses
   in nextguess value mins

nextguess :: [Char] -> [[Int]] -> [Char]
nextguess prev mins = 
  let choose x = if length (snd x) == 1 then intToDigit ((snd x)!!0) else fst x
      both = zip prev mins
  in  foldr (\x y -> (choose x) : y) "" both


iterateMind :: Mind -> [Char] -> [([Char], Int)]
iterateMind mind n =
  let a = drop 2 $ inits $ iterate (iterateGuesses mind) n
      b = last $ takeWhile (\x -> (last x) `notElem` (init x)) a
      c = map (scoreMind mind) b
  in zip b c      
  
  
randomStart :: (Num a, Enum a) => a -> IO [Char]
randomStart n = mapM (\_ -> getStdRandom (randomR ('0','9'))) [1..n]

main :: IO ()
main = do
  let ex = ex1
  x <- randomStart (length (fst (head ex)))
  let y = iterateMind ex x
  let done = (snd (last  y) == 0)
  when done (putStrLn $ (fst.last) y)
  unless done main