|
%I #20 Apr 20 2021 00:58:02
%S 2,23,25,29,21,211,27,289,22,223,20,227,26,201,2401,229,28,233,207,
%T 202,203,239,24,2209,205,2197,212,241,222,251,243,206,209,213,225,257,
%U 214,215,232,263,230,269,236,242,217,271,208,2809,244,218,245,277,248,219
%N Smallest number not included earlier, beginning with 2 and having prime signature of n.
%C A rearrangement of numbers beginning with 2.
%H Robert Israel, <a href="/A086557/b086557.txt">Table of n, a(n) for n = 2..2000</a>
%e a(40) = 232 = 2^3 * 29 as 40 = 2^3 * 5.
%p se := {seq(20+k,k=0..9),seq(200+k,k=0..99),seq(2000+k,k=0..999),seq(20000+k,k=0..9999),seq(200000+k,k=0..99999)}: a[2] := 2:for n from 3 to 60 do l := sort(convert(se,list)): ifa := ifactors(n):no := nops(ifa[2]): prisig := sort([seq(ifa[2][j][2],j=1..no)]):h := 0:while(true) do h := h+1: ifa := ifactors(l[h]): no2 := nops(ifa[2]):prisig2 := sort([seq(ifa[2][j][2],j=1..no2)]):ok := true: if(no<>no2) then ok := false: else for w from 1 to no do if(prisig[w]<>prisig2[w]) then ok := false:break:fi:od:fi: if(ok=true) then a[n] := l[h]:se := se minus {l[h]}:break:fi:od:od:seq(a[q],q=2..60); # _Sascha Kurz_
%p # alternative
%p ps:= proc(n) local t; sort(map(t -> t[2], ifactors(n)[2])) end proc:
%p R:= NULL: PS:= 'PS':
%p with(queue):
%p PS[[6]]:= new(17^6, 37^6): PS[[5]]:= new(3^5,19^5): PS[[9]]:= new(11^9, 31^9 ):
%p PS[[10]]:= new(7^10):
%p d:= 0: x:= 1:
%p for n from 2 to 1000 while x < 10^7 do
%p X:= ps(n);
%p if not assigned(PS[X]) then PS[X]:= new() fi;
%p flag:= empty(PS[X]);
%p while flag do
%p x:= x+1;
%p if x >= 3*10^d then d:= d+1; x:= 2*10^d fi;
%p Y:= ps(x);
%p if not assigned(PS[Y]) then PS[Y]:= new() fi;
%p if empty(PS[Y]) or x > front(PS[Y]) then enqueue(PS[Y],x) fi;
%p flag:= (Y<>X);
%p od;
%p y:= dequeue(PS[X]);
%p R:= R, y;
%p od:
%p R; # _Robert Israel_, Apr 19 2021
%t Block[{a = {}, s = PositionIndex@ Table[ToString@ Sort[FactorInteger[n][[All, -1]]], {n, Product[Prime@ i, {i, 6}]}]}, Do[AppendTo[a, #] &@ SelectFirst[Lookup[s, ToString@ Sort[FactorInteger[n][[All, -1]]] ], And[First@ IntegerDigits@ # == 2, FreeQ[a, #]] &], {n, 2, 55}]; a] (* _Michael De Vlieger_, Aug 15 2017 *)
%Y Cf. A086549.
%K base,nonn
%O 2,1
%A _Amarnath Murthy_, Aug 30 2003
%E Corrected and extended by _Sascha Kurz_, Sep 22 2003
|
