Привет.

Решаю задачки на projecteuler.
Возникла проблема с решение задачи 14 на haskell-е (на С++ я её решил без проблем).

The following iterative sequence is defined for the set of positive integers:

n → n/2 (n is even)
n → 3n + 1 (n is odd)

Using the rule above and starting with 13, we generate the following sequence:
13 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1

It can be seen that this sequence (starting at 13 and finishing at 1) contains 10 terms. Although it has not been proved yet (Collatz Problem), it is thought that all starting numbers finish at 1.

Which starting number, under one million, produces the longest chain?

NOTE: Once the chain starts the terms are allowed to go above one million.

Алгоритм решение прост. Бежим по всем числам от 1 до 10^6 и параллельно заполняем таблицу
(число, длина последовательности). Если в процессе вычисления какой-то последовательности
встретилось число из таблицы, тогда берем длину для него.

Вот код. Работает при nnn = 10000.
При nnn = 1000000 думает очень долго.

module Main
    where

import Array

-- Верхний предел для поиска
nnn ::  Int
nnn = 1000000

-- Опредение функции f
f ::  Integer -> Integer
f 1               = 1
f n | even n      = n `div` 2
    | otherwise   = 3 * n + 1

-- Создаем список [(число, длина последовательности)]
seqlen ::  [(Int, Int)]
seqlen = assocs $ seqlen' (array (1, nnn) $ (1,1):[(a, 0) | a <- [2..nnn]]) [2..(toInteger nnn)]
        where
            seqlen' a [] = a
            seqlen' a (x:xs) = seqlen' na xs
                              where na = accum seq a $ snd $ test a x
            test a x | x > toInteger nnn  = (n + 1, l)
                     | elem == 0          = (n + 1, (fromInteger x, fromInteger n + 1):l)
                     | otherwise          = (toInteger elem, [])
               where (n, l) = test a (f x)
                     elem   = a ! (fromInteger x)


-- Возвращает (число, длина последовательности)
maxseq ::  (Int, Int)
maxseq = foldr (\x y-> if (snd x) > (snd y) then x else y ) (1,1) seqlen 

main ::  IO ()
main = do
         putStrLn (show maxseq)

Можно ускорить?
Заменить везде Integer на Int не получается (некоторые члены последовательности не влезают).

Компилятор GHC 6.4.2.

Здравствуйте, Smal, Вы писали:

S>Привет.

S>Решаю задачки на projecteuler.
S>Возникла проблема с решение задачи 14 на haskell-е (на С++ я её решил без проблем).

Я решал эту задачу на Q — интерпретируемом языке и работала она достаточно быстро (может в минуту и не укладывалась), так что думай над алгоритмом.

Здравствуйте, Smal, Вы писали:

Мое решение (компилировать обязательно с оптимизацией):

import Data.Array
import Data.List

next n
    | even n    = n `div` 2
    | otherwise = 3*n+1

upper_bound = 1000000
chain_lengths = listArray (1, upper_bound) $ map chain_length [1..]

chain_length 1 = 1
chain_length n = 1 + len_next
    where n' = next n
          len_next = if n' < upper_bound then chain_lengths!n'
                                         else chain_length n'

(max_index, max_len) = maximumBy (\(_,x) (_,y) -> compare x y) $ assocs chain_lengths

chain 1 = [1]
chain n = n:(chain $ next n)

main = do putStrLn $! "max index: " ++ (show max_index)
          putStrLn $ "max chain length: " ++ (show max_len)
          putStrLn "max chain:"
          print $ chain max_index

Здравствуйте, palm mute, Вы писали:

PM>Мое решение (компилировать обязательно с оптимизацией):

Какой выдает ответ и за какое время?

Здравствуйте, Smal, Вы писали:

S>Можно ускорить?

Поиск в таблице у Вас какую сложность имеет?
Мое решение на OCaml использовало Int64 для значений и хэш-таблицу для хранения уже найденных. Работало 4,4 секунды. Исходник на 10-й странице обсуждения задачи.

PM>>Мое решение (компилировать обязательно с оптимизацией):
DM>Какой выдает ответ и за какое время?

$ time ./euler14
max index: 837799

real    0m3.231s
user    0m3.152s
sys     0m0.076s

Вычисление и печать самой длинной цепочки я убрал.

Здравствуйте, palm mute, Вы писали:

PM>Мое решение (компилировать обязательно с оптимизацией):

Спасибо за пример. Я разобрался. Как я и думал, я не правильно работал с массивом.
Я пытался менять значения в массиве, а надо было изначально заполнить его,
а потом просто вычислять.

Действительно, если не запоминать результаты для чисел больше миллиона, то быстрее.
Такой вариант на OCaml отрабатывает на 2,75 сек на P4 2,66:

open Int64;;
let mem = Hashtbl.create 10000000 and i2 = of_int 2 and i3 = of_int 3 and mil=of_int 1000000;;
let f n = if (rem n i2) = zero then div n i2 else add (mul i3 n) one;;

let rec rlen n = if n = one then 1 else
  if n >= mil then 1 + rlen(f n) else
  try Hashtbl.find mem n with Not_found-> let z = 1 + rlen(f n) in Hashtbl.add mem n z; z;;
  
let rec loop i maxlen bi =
  if i>999999 then bi else
  let t = rlen(of_int i) in if t > maxlen then loop (i+1) t i else loop (i+1) maxlen bi;; 
print_int(loop 1 0 0);;

Причем вариант с массивом вместо хэш-таблицы работает ровно столько же..

Вру, не то запускал. Вариант с массивом работает 1,2 секунды всего.

open Int64;;
let mem = Array.make 1000000 0 and i2 = of_int 2 and i3 = of_int 3 and mil=of_int 1000000;;
let f n = if (rem n i2) = zero then div n i2 else add (mul i3 n) one;;

let rec rlen n = if n = one then 1 else
  if n >= mil then 1 + rlen(f n) else
  let q = mem.(to_int n) in if q>0 then q else let z = 1 + rlen(f n) in mem.(to_int n)<-z; z;;
  
let rec loop i maxlen bi =
  if i>999999 then bi else
  let t = rlen(of_int i) in if t > maxlen then loop (i+1) t i else loop (i+1) maxlen bi;; 
print_int(loop 1 0 0);;

Здравствуйте, Smal, Вы писали:

S>Можно ускорить?
S>Заменить везде Integer на Int не получается (некоторые члены последовательности не влезают).

Решение влоб, работает порядка 30 секунд.

import Data.List (maximumBy)
import Data.Ord (comparing)

next :: Integer -> Integer
next n 
    | even n = n `quot` 2
    | otherwise = 3 * n + 1

sequence_rule :: Integer -> [Integer]
sequence_rule 1 = [1]
sequence_rule n = n : (sequence_rule $ next n)

magic_number = 1000000

main :: IO ()
main = do    
    print $ maximumBy (comparing snd) 
        [(x, length $ sequence_rule x) | x <- [1..magic_number]]

С Уважением, Andir!

Andir,

A>Решение влоб, работает порядка 30 секунд.

Причём код читается тоже в лоб, ибо совершенно прозрачен.

А вот если интересно мое решение на Лиспе, правда громоздко вышло:

(defparameter *cache* (make-hash-table))

(defun chain-length (start)
  (let ((len 1) (n start))
    (loop while (not (= 1 n)) do
      (if (gethash n *cache*)
          (progn
        (incf len (1- (gethash n *cache*)))
        (setf (gethash start *cache*) len)
        (return len))
          (progn
        (if (evenp n)
            (setq n (/ n 2))
            (setq n (+ 1 (* 3 n))))
        (incf len))))
    (setf (gethash start *cache*) len)
    len))

(defun main ()
  (let ((max 0) (result nil))
    (loop for x from 2 below 1000000 do
      (when (> (chain-length x) max)
        (progn
          (setq max (chain-length x))
          (setq result x))))
    result))

:- dynamic saved/3, len_saved/2, max_saved/1.

f(N, R) :-
    (   0 is N mod 2
    ->  R is N//2
    ;   R is 3 * N + 1
    ).

len(1, 1) :-!.
len(N, L) :-
    len_saved(N, L), !;
    f(N, R),
    len(R, L1),
    L is L1 + 1
    .

save_all_lens :-
    retractall(len_saved(_, _)),
    save_len(1).

save_len(N) :-
    N =< 1000000,
    log(N),
    len(N, L),
    asserta(len_saved(N, L)),
    Nnext is N + 1,
    save_len(Nnext).

log(N) :-
    (   0 is N mod 10000
    ->  write(N),nl
    ;   true
    ).

:- asserta(max_saved(1,1)).
max1 :-
    len_saved(N, L),
    log(N),
    max_saved(_, M),
    (   M < L
    ->  retractall(max_saved(_, _)),
        asserta(max_saved(N, L))
    ),
    fail.
max1 :-
    write('Max: '),max_saved(Nm, M), write(Nm),write(' '),write(M).

do :-
    (   save_all_lens; true),
    max1.

Работает 18 сек. Решение почти в лоб. К стати, интересно, почему пролог так не популярен, хотя он явно проще хаскелла? )

Здравствуйте, xonixx, Вы писали:

X>Работает 18 сек. Решение почти в лоб. К стати, интересно, почему пролог так не популярен, хотя он явно проще хаскелла? )

Вы вот этот вот называете "проще Хаскелла"? 8-O

Здравствуйте, xonixx, Вы писали:

X>Работает 18 сек. Решение почти в лоб. К стати, интересно, почему пролог так не популярен, хотя он явно проще хаскелла? )

Для меня область его применения уже.

Хаскель же здесь тормозит из-за своей лени — цепочки надо считать энергично, а не собирать их толпу. Можно примерно так (чистые списки, strict-свёртка):

import Data.List

next n | even n     = n `div` 2
       | otherwise  = 3 * n + 1

chain = chain' 0
    where
        chain' ac 0 = ac
        chain' ac 1 = ac
        chain' ac n = chain' (ac + 1) (next n)

findMax n = strictMax $ map (\x -> (chain x, x)) [0..n]
    where strictMax = foldl1' max
    
main = print $ snd $ findMax 1000000

Не сказал бы, что это решение смотрится хуже прологовского.