(* Mathematica code for A325204 to 178 terms.  - Ray Chandler, Sep 14 2019 *)

nmax = 10^1000;
cs = {{1, 2}, {2, 4}, {4, 5}};
a1 = a2 = {};
cnt1 = cnt2 = 0;
jmax = Floor[Log[3, nmax]];
jn = 1;
Do[
  imax = Floor[Log[2, nmax/jn]];
  in = jn;
  Do[
   ins = Table[Max[1, in + k] , {k, -2, 2}];
   pns = Table[0, {5}];
   Do[
    If[Mod[ins[[k]], 2] == 0, 
     ins[[k]] = ins[[k]]/2^IntegerExponent[ins[[k]], 2]];
    If[Mod[ins[[k]], 3] == 0, 
     ins[[k]] = ins[[k]]/3^IntegerExponent[ins[[k]], 3]];
    pns[[k]] = If[ins[[k]] == 1, 0, If[PrimePowerQ[ins[[k]]], 1, 2]];
     , {k, 5}];
   Do[ 
    c = cs[[k]];
    {c1, c2} = c;
    found = 0;
    spns = pns[[c]];
    If[Plus @@ spns == 2,
     If[spns == {1, 1},
       found = 1;
       ,
       cnt2++;
       Print["{cnt2,i,j,in}=", {cnt2, i, j, in}, 
        " unexpected siuation"];
       ind = If[pns[[c1]] = 2, c1, c2];
       If[PrimeNu[ins[[ind]]] == 2,
        found = 1;
        ];
       ];
     ];
    If[found == 1,
     AppendTo[a1, in + k - 3];
     cnt1++;
     ];
    , {k, 3}];
   in *= 2;
   , {i, 0, imax}];
  jn *= 3;
  , {j, 0, jmax}];
a1 = Sort[a1]