%I #12 Jul 05 2020 14:06:34
%S 0,1,2,3,4,5,6,7,8,9,1,1,2,3,4,5,6,7,8,9,2,1,4,9,16,25,36,49,64,81,3,
%T 1,8,27,64,125,216,343,512,729,4,1,16,81,256,625,1296,2401,4096,6561,
%U 5,1,32,243,1024,3125,7776,16807,32768,59049,6,1,64,729,4096,15625,46656,117649
%N Powerback(n): reverse the decimal expansion of n, drop any leading zeros, then apply the powertrain map of A133500 to the resulting number.
%C a(A221221(n)) = A133500(A221221(n)) = A222493(n). - _Reinhard Zumkeller_, May 27 2013
%H N. J. A. Sloane, <a href="/A133048/b133048.txt">Table of n, a(n) for n = 0..10000</a>
%e E.g. 240 -> (0)42 -> 4^2 = 16; 12345 -> 54321 -> 5^4*3^2*1 = 5625.
%p powerback:=proc(n) local a,i,j,t1,t2,t3;
%p if n = 0 then RETURN(0); fi;
%p t1:=convert(n, base, 10); t2:=nops(t1);
%p for i from 1 to t2 do if t1[i] > 0 then break; fi; od:
%p a:=1; t3:=t2-i+1;
%p for j from 0 to floor(t3/2)-1 do a := a*t1[i+2*j]^t1[i+2*j+1]; od:
%p if t3 mod 2 = 1 then a:=a*t1[t2]; fi;
%p RETURN(a); end;
%t ptm[n_]:=Module[{idn=IntegerDigits[IntegerReverse[n]]},If[ EvenQ[ Length[idn]],Times@@ (#[[1]]^#[[2]]&/@Partition[idn,2]),(Times@@(#[[1]]^#[[2]]&/@Partition[ Most[ idn],2]))Last[idn]]];Array[ptm,70,0] (* Requires Mathematica version 10 or later *) (* _Harvey P. Dale_, Jul 05 2020 *)
%o (Haskell)
%o a133048 0 = 0
%o a133048 n = train $ dropWhile (== 0) $ a031298_row n where
%o train [] = 1
%o train [x] = x
%o train (u:v:ws) = u ^ v * (train ws)
%o -- _Reinhard Zumkeller_, May 27 2013
%Y Cf. A131571 (fixed points), A133059 and A133134 (records); A133500 (powertrain).
%Y Cf. A133144 (length of trajectory), A031346 and A003001 (persistence).
%Y Cf. A031298.
%K nonn,base
%O 0,3
%A _J. H. Conway_ and _N. J. A. Sloane_, Dec 31 2007