## Project Euler 105

At least my brute force solution for problem 103 worked for problem 105 ;). Replaced all the ‘,’ from input file by space. Same code except reading file by standard input . Takes couple of minutes probably 10 or 15.

import Data.List subset::[a] ->[[a]] subset [] = [[]] subset (x:xs) = subset xs ++ map (x:) (subset xs) fun ::(Num a, Ord a ) => [a] -> [[a]] -> Bool fun _ [] = True fun y (x:xs) = case intersect y x == [] of True -> if and[ s_a /= s_b , if l_a > l_b then s_a > s_b else if l_a < l_b then s_a < s_b else True] then fun y xs else False where s_a = sum y s_b = sum x l_a = length y l_b = length x _ -> fun y xs checkOptimum ::(Num a , Ord a ) => [a] -> Bool checkOptimum xs = optimumHelper ( tail.subset $ xs ) where optimumHelper [] = True optimumHelper (y:ys) = if fun y ys then optimumHelper ys else False solve :: [[Integer]] -> Integer solve [] = 0 solve ( x : xs ) = if checkOptimum x then sum x + solve xs else solve xs final ::[[Integer]] -> String final xs = (show.solve $ xs) ++ "\n" main = interact $ final . map ( map read . words ) . lines

Edit: Now with improved algorithm , its almost instant answer. I am keeping the original post just to remind me the power of algorithm and thought. I sorted the subsets based on their sum. Now the check is linear and keep checking two adjacent subsets for given condition in problem.

import Data.List subset::[a] ->[[a]] subset [] = [[]] subset (x:xs) = subset xs ++ map (x:) (subset xs) fun ::(Num a, Ord a ) => [a] -> [a] -> Bool fun y x = case intersect y x == [] of True -> if ( if l_a > l_b then s_a > s_b else if l_a < l_b then s_a < s_b else s_a /= s_b ) then True else False where s_a = sum y s_b = sum x l_a = length y l_b = length x _ -> True checkOptimum ::(Num a , Ord a ) => [a] -> Bool checkOptimum xs = optimumHelper (sortBy (\a b -> compare ( sum a ) ( sum b) ) . tail.subset $ xs ) where optimumHelper [x,y] = if fun x y then True else False optimumHelper (x:y:ys) = if fun x y then optimumHelper (y:ys) else False solve :: [[Integer]] -> Integer solve [] = 0 solve ( x : xs ) = if checkOptimum x then sum x + solve xs else solve xs final ::[[Integer]] -> String final xs = (show.solve $ xs) ++ "\n" main = interact $ final . map ( map read . words ) . lines

Advertisements

No comments yet.

## Leave a Reply