Project Euler

Problem #74

The number 145 is well known for the property that the sum of the factorial of its digits is equal to 145:

1! + 4! + 5! = 1 + 24 + 120 = 145

Perhaps less well known is 169, in that it produces the longest chain of numbers that link back to 169; it turns out that there are only three such loops that exist:

169 → 363601 → 1454 → 169
871 → 45361 → 871
872 → 45362 → 872

It is not difficult to prove that EVERY starting number will eventually get stuck in a loop. For example,

69 → 363600 → 1454 → 169 → 363601 (→ 1454)
78 → 45360 → 871 → 45361 (→ 871)
540 → 145 (→ 145)

Starting with 69 produces a chain of five non-repeating terms, but the longest non-repeating chain with a starting number below one million is sixty terms.

How many chains, with a starting number below one million, contain exactly sixty non-repeating terms?

Erlang: Running time = 12.94s
+%digit_split

%
% Here we loop up to a million, for each number computing the length
% of the chain, but also storing any other results we get in the
% process, so we don't end up repeating ourselves.
% 

p74()->
	Fax=array:from_list(lists:map(fun factorial/1,lists:seq(0,9))),
	MyFun=fun(N)->
		lists:sum(lists:map(fun(D)->
			array:get(D,Fax) end,digit_split(N))) end,
	Res=p74_loop(3,array:from_list([0,0,0]),MyFun),
	Ans=length(lists:filter(fun(X)->X==60 end,array:sparse_to_list(Res))),
	io:format("~w~n",[Ans]).

p74_loop(1000000,Res,_)->Res;
p74_loop(N,Res,NextFun)->
	case array:get(N,Res) of
		undefined->
			R=p74_investigate(N,[N],sets:from_list([N]),Res,NextFun),

			p74_loop(N+1,R,NextFun);
		_Else->p74_loop(N+1,Res,NextFun)
	end.

%
% This is the function that actually looks through the chain. At each
% step it checks to see if the next value has already been computed,
% and if so, it stops and records the values in the chain relative to
% the previously computed value.
%
% The chain is stored as both a list and a set, for ordered retrieval
% and easy lookup. Once a repeat is found, the numbers are assigned
% appropriately
%

p74_investigate(N,List,Set,PrevRes,NextFun)->
	Next=NextFun(N),
	case array:get(Next,PrevRes) of
		undefined->
			case sets:is_element(Next,Set) of
				true->
					{After,Before}=lists:splitwith(fun(X)->X /= Next end,List),
					Arr1=lists:foldl(fun(Index,Arr)->array:set(Index,1+length(After),Arr) end,PrevRes,After),
					{Arr2,_}=
						lists:foldl(fun(Index,{Arr,Inc})->
							{array:set(Index,Inc,Arr),Inc+1} end,{Arr1,1+length(After)},Before),
					Arr2;
				false->p74_investigate(Next,[Next|List],sets:add_element(Next,Set),PrevRes,NextFun)
			end;
		Res->
			lists:foldl(fun({Index,Increment},Arr)->array:set(Index,Res+Increment,Arr) end,PrevRes,
				lists:zip(List,lists:seq(1,length(List))))
	end.