cp's OEIS Frontend

A046851 Numbers n such that n^2 can be obtained from n by inserting internal (but not necessarily contiguous) digits.

%I A046851 #32 Nov 05 2016 12:53:02
%S A046851 0,1,10,11,95,96,100,101,105,110,125,950,960,976,995,996,1000,1001,
%T A046851 1005,1006,1010,1011,1021,1025,1026,1036,1046,1050,1100,1101,1105,
%U A046851 1201,1205,1250,1276,1305,1316,1376,1405,9500,9505,9511,9525,9600,9605,9625
%N A046851 Numbers n such that n^2 can be obtained from n by inserting internal (but not necessarily contiguous) digits.
%C A046851 Contains A038444.  In particular, the sequence is infinite. - _Robert Israel_, Oct 20 2016
%C A046851 If n is any positive term, then b_n(k) := n*10^k (k >= 0) is an infinite subsequence. - _Rick L. Shepherd_, Nov 01 2016
%C A046851 From Robert Israel's comment it follows that the subsequence of terms with no trailing zeros is also infinite (contains A000533). - _Rick L. Shepherd_, Nov 01 2016
%H A046851 Reinhard Zumkeller, <a href="/A046851/b046851.txt">Table of n, a(n) for n = 1..10000</a>
%e A046851 110^2 = 12100 (insert "2" and "0" into "1_1_0").
%p A046851 IsSublist:= proc(a, b)
%p A046851   local i,bp,j;
%p A046851   bp:= b;
%p A046851   for i from 1 to nops(a) do
%p A046851     j:= ListTools:-Search(a[i],bp);
%p A046851     if j = 0 then return false fi;
%p A046851     bp:= bp[j+1..-1];
%p A046851   od;
%p A046851   true
%p A046851 end proc:
%p A046851 filter:= proc(n) local A,B;
%p A046851   A:= convert(n,base,10);
%p A046851   B:= convert(n^2,base,10);
%p A046851   if not(A[1] = B[1] and A[-1] = B[-1]) then return false fi;
%p A046851   if nops(A) <= 2 then return true fi;
%p A046851   IsSublist(A[2..-2],B[2..-2])
%p A046851 end proc:
%p A046851 select(filter, [$0..10^4]); # _Robert Israel_, Oct 20 2016
%t A046851 id[n_]:=IntegerDigits[n];
%t A046851 insQ[n_]:=First[id[n]]==First[id[n^2]]&&Last[id[n]]==Last[id[n^2]];
%t A046851 sort[n_]:=Flatten/@Table[Position[id[n^2],id[n][[i]]],{i,1,Length[id[n]]}];
%t A046851 takeQ[n_]:=Module[{lst={First[sort[n][[1]]]}},
%t A046851    Do[
%t A046851     Do[
%t A046851      If[Last[lst]<sort[n][[i]][[h]],AppendTo[lst,sort[n][[i]][[h]]];Break[]],
%t A046851      {h,1,Length[sort[n][[i]]]}
%t A046851      ],
%t A046851     {i,2,Length[sort[n]]}
%t A046851     ];
%t A046851    If[Length[lst]==Length[id[n]]&&lst==Sort[lst],True,False]
%t A046851 ];
%t A046851 Select[Range[0,9625],insQ[#]&&takeQ[#]&] (* _Ivan N. Ianakiev_, Oct 19 2016 *)
%o A046851 (Haskell)
%o A046851 import Data.List (isInfixOf)
%o A046851 a046851 n = a046851_list !! (n-1)
%o A046851 a046851_list = filter chi a008851_list where
%o A046851    chi n = (x == y && xs `isSub` ys) where
%o A046851       x:xs = show $ div n 10
%o A046851       y:ys = show $ div (n^2) 10
%o A046851    isSub [] ys       = True
%o A046851    isSub _  []       = False
%o A046851    isSub us'@(u:us) (v:vs)
%o A046851          | u == v    = isSub us vs
%o A046851          | otherwise = isSub us' vs
%o A046851 -- _Reinhard Zumkeller_, Jul 27 2011
%Y A046851 Cf. A045953, A008851, A018834, A038444, A086457 (subsequence).
%K A046851 nonn,base,easy,nice
%O A046851 1,3
%A A046851 _David W. Wilson_