import Data.List
import Data.Function
import Data.Array
import Data.Maybe
-- все множители данного числа
factors:: Int -> [Int]

factors n = [x | x <- [2..n], n `mod` x==0]

-- сколько раз в разложении на множители участвует данный множитель
count_factors:: Int -> Int -> Int

count_factors n m
   | n `mod` m /= 0 = 0
   | otherwise = 1 + (count_factors (n `div` m) m)

-- разложение на простые множители
prime_factor:: Int -> [(Int,Int)]

prime_factor 1 = []

-- неоптимально, надо бы переделать
prime_factor n = [(x,y)] ++ prime_factor (n `div` (x^y))
   where x = head (factors n)
         y = count_factors n x

-- получаем вторые элементы кортежей списка
get_seconds = map snd
get_first   = map fst

-- последовательность всех возможных степеней
get_seq  list = [first] ++ next_seq first list
   where first = map (\_ -> 0) list

-- следующая последовательность (надо как-то оптимизировать через
-- произведение множеств)
next_seq::[Int]->[Int]->[[Int]]
next_seq first list
   | first == list = []
   | head first < head list = [([(head first)+1] ++ (tail first))] ++ next_seq ([(head first)+1] ++ (tail first)) list
   | otherwise = [([0] ++ head (next_seq (tail first) (tail list)))] ++
       (next_seq ([0] ++ head (next_seq (tail first) (tail list))) list)

-- все разложение перебираются без повторений
divisors:: [Int]->Int->[[[Int]]]
divisors n 1 = [[n]]
divisors n m = filter (\x -> head x<=head (tail x)) [[x]++y|x <- get_seq n,y<-divisors (n `minus` x) (m-1)]

-- вычитание последовательностей
minus::[Int]->[Int]->[Int]
minus [n] [x] = [n-x]
minus (n:n1) (x:x1) = [n-x] ++ (minus n1 x1)

powerlist [] [] = 1
powerlist (n:n1) (m:m1)  = (n^m)*(powerlist  n1 m1)

-- разбиение на множители числа n на m множителей
factor n m =  map (map (\(x,y) -> powerlist x y)) $ map (map (\x -> (primes,x))) (divisors powers m)
   where factors = prime_factor n
         powers  = get_seconds factors
         primes  = get_first factors

search_repeat [] = False
search_repeat [_] = False
search_repeat (n:n1)
      | n==(head n1) = True
      | otherwise = search_repeat n1

-- заменяем сортировку на массив

array_count2  [] start = start
array_count2 (n:n1) start = array_count2 n1 (start//[(snd n,x++[fst n])])
      where x=start!(snd n)


array_count list =
         array_count2 list start

    where m = maximum $ map snd list
          start = array (1,m) [(i,[])|i<-[1..m]]



exper n m = find (\x -> (length x)>1) $ elems $ array_count (map (\x -> (x,sum x)) $ factor n m)

exper_big n m = filter (\x -> (all (\y -> (all (\z -> z/=1) y)) x)) $ map fromJust $ filter (\x -> isJust x) [exper x m | x<-[2..n]]