Polycarpus likes giving presents to Paraskevi. He has bought two chocolate bars, each of them has the shape of a segmented rectangle. The first bar is a1 × b1 segments large and the second one is a2 × b2 segments large.Polycarpus wants to give Paraskevi one of the bars at the lunch break and eat the other one himself. Besides, he wants to show that Polycarpus's mind and Paraskevi's beauty are equally matched, so the two bars must have the same number of squares.To make the bars have the same number of squares, Polycarpus eats a little piece of chocolate each minute. Each minute he does the following:  he either breaks one bar exactly in half (vertically or horizontally) and eats exactly a half of the bar,  or he chips of exactly one third of a bar (vertically or horizontally) and eats exactly a third of the bar. In the first case he is left with a half, of the bar and in the second case he is left with two thirds of the bar.Both variants aren't always possible, and sometimes Polycarpus cannot chip off a half nor a third. For example, if the bar is 16 × 23, then Polycarpus can chip off a half, but not a third. If the bar is 20 × 18, then Polycarpus can chip off both a half and a third. If the bar is 5 × 7, then Polycarpus cannot chip off a half nor a third.What is the minimum number of minutes Polycarpus needs to make two bars consist of the same number of squares? Find not only the required minimum number of minutes, but also the possible sizes of the bars after the process.

The first line of the input contains integers a1, b1 (1 ≤ a1, b1 ≤ 109) — the initial sizes of the first chocolate bar. The second line of the input contains integers a2, b2 (1 ≤ a2, b2 ≤ 109) — the initial sizes of the second bar. You can use the data of type int64 (in Pascal), long long (in С++), long (in Java) to process large integers (exceeding 231 - 1).

In the first line print m — the sought minimum number of minutes. In the second and third line print the possible sizes of the bars after they are leveled in m minutes. Print the sizes using the format identical to the input format. Print the sizes (the numbers in the printed pairs) in any order. The second line must correspond to the first bar and the third line must correspond to the second bar. If there are multiple solutions, print any of them. If there is no solution, print a single line with integer -1.

var
  x1,y1,x2,y2,x3,y3,x4,y4,n,m,w,h,u,v,r,s,a,b:longint;
procedure error;
 begin
   writeln('-1');
   halt;
 end;

function sol(p,q,x,y:longint):longint;
 var
   t,i,x1,x2,k:longint;
 begin
   x1:=p;
   x2:=q;
   t:=abs(x-y);
   if x-y>0 then
     begin
       p:=p+x-y;
       k:=x-y;
       while(k>0)and(n mod 3=0) do
         begin
           n:=(n div 3)*2;
           k:=k-1;
         end;
       while(k>0)and(m mod 3=0) do
         begin
           m:=(m div 3)*2;
           k:=k-1;
         end;
     end
            else
     begin
       q:=q+y-x;
       k:=y-x;
       while(k>0)and(w mod 3=0) do
         begin
           w:=(w div 3)*2;
           k:=k-1;
         end;
       while(k>0)and(h mod 3=0) do
         begin
           h:=(h div 3)*2;
           k:=k-1;
         end;
     end;
   t:=t+abs(p-q);
   writeln(t);
   if p-q>0 then
     begin
       for i:=q-1 downto p do
         n:=n*2;
       for i:=q+1 to p do
         if n mod 2=0 then n:=n div 2
                      else m:=m div 2;
     end
            else
     begin
       for i:=p-1 downto q do
         w:=w*2;
       for i:=p+1 to q do
         if w mod 2=0 then w:=w div 2
                      else h:=h div 2;
     end;
   writeln(n,' ',m);
   writeln(w,' ',h);
 end;

procedure cal(var a,b,p:longint;n:longint);
 var
   k:longint;
 begin
   k:=n;
   a:=0;
   b:=0;
   while k mod 2=0 do
     begin
       inc(a);
       k:=k div 2;
     end;
   while k mod 3=0 do
     begin
       inc(b);
       k:=k div 3;
     end;
   p:=k;
 end;

begin
  readln(n,m);
  readln(w,h);
  cal(x1,y1,u,n);
  cal(x2,y2,v,m);
  cal(x3,y3,r,w);
  cal(x4,y4,s,h);
  if v*u<>s*r then error;
  sol(x1+x2,x3+x4,y1+y2,y3+y4);
end.

var a, b: array [1..2] of array [1..2] of longint;
    d: array [1..2] of array [2..3] of byte;
    i, j, x, y: longint;
begin
        readln(a[1][1], a[1][2]);
        readln(a[2][1], a[2][2]);
        for i := 1 to 2 do
                for j := 1 to 2 do
                        b[i][j] := a[i][j];
        for i := 1 to 2 do
                for j := 1 to 2 do
                begin
                        while b[i][j] mod 3 = 0 do
                        begin
                                b[i][j] := (b[i][j] div 3) * 2;
                                inc(d[i][3]);
                        end;
                        while b[i][j] mod 2 = 0 do
                        begin
                                b[i][j] := b[i][j] div 2;
                                inc(d[i][2]);
                        end;
                end;
        if int64(b[1][1]) * b[1][2] <> int64(b[2][1]) * b[2][2] then
        begin
                writeln(-1);
                exit;
        end;
        x := d[1][2] - d[2][2];
        y := d[1][3] - d[2][3];
        writeln(abs(x) + abs(y));
        if y > 0 then
        begin
                for i := 1 to y do
                        if a[1][1] mod 3 = 0 then
                                a[1][1] := (a[1][1] div 3) * 2
                        else
                                a[1][2] := (a[1][2] div 3) * 2;
        end
        else
        begin
                for i := 1 to abs(y) do
                        if a[2][1] mod 3 = 0 then
                                a[2][1] := (a[2][1] div 3) * 2
                        else
                                a[2][2] := (a[2][2] div 3) * 2;
        end;
        if x > 0 then
        begin
                for i := 1 to x do
                        if a[1][1] mod 2 = 0 then
                                a[1][1] := a[1][1] div 2
                        else
                                a[1][2] := a[1][2] div 2;
        end
        else
        begin
                for i := 1 to abs(x) do
                        if a[2][1] mod 2 = 0 then
                                a[2][1] := a[2][1] div 2
                        else
                                a[2][2] := a[2][2] div 2;
        end;

        writeln(a[1][1], ' ', a[1][2]);
        writeln(a[2][1], ' ', a[2][2]);
end.

var a,b,c,d,a1,dob,dob1,ans,ans1:int64;
step2,step3:array[0..100] of int64;
prv2,prv3,drg2,drg3,tre2,tre3,cet2,cet3,res1,res2,res3,res4,p:longint;
mog1,mog2,mog3,mog4:longint;
i,j,k,l,min:longint;
 begin
  readln(a,b);
  readln(c,d);
  a1:=a;
  step2[0]:=1;
  for i:=1 to 62 do
  step2[i]:=step2[i-1]*2;
  step3[0]:=1;
  for i:=1 to 36 do
  step3[i]:=step3[i-1]*3;
  While a1 mod 2=0  do
   begin
    inc(prv2);
     a1:=a1 div 2;
    end;
   While (a1 mod 3=0) do
    begin
    inc(prv3);
    a1:=a1 div 3;
   end;
    a1:=b;
  While a1 mod 2=0  do
   begin
    inc(drg2);
     a1:=a1 div 2;
    end;
   While (a1 mod 3=0) do
    begin
    inc(drg3);
    a1:=a1 div 3;
   end;
    a1:=c;
  While a1 mod 2=0  do
   begin
    inc(tre2);
     a1:=a1 div 2;
    end;
   While (a1 mod 3=0) do
    begin
    inc(tre3);
    a1:=a1 div 3;
   end;
    a1:=d;
  While a1 mod 2=0  do
   begin
    inc(cet2);
     a1:=a1 div 2;
    end;
   While (a1 mod 3=0) do
    begin
    inc(cet3);
    a1:=a1 div 3;
   end;
   min:=10000;
  ans:=a*b;
  ans1:=c*d;
  for i:=0 to 62 do
  for j:=0 to 36 do
  for k:=0 to 62 do
  for l:=0 to 36 do
   begin
   p:=0;
   mog1:=prv2+drg2;
   mog2:=prv3+drg3;
   mog3:=tre2+cet2;
   mog4:=tre3+cet3;
   if (mog2>=j) then mog1:=mog1+j else inc(p);
   if mog1<i then inc(p);
   if mog4>=l then mog3:=mog3+l else inc(p);
   if mog3<k then inc(p);
   if p=0 then
    begin
    dob:=ans;
    dob1:=ans1;

    dob:=dob div step3[j];
    if i-j<0 then dob:=dob*step2[j-i] else
    dob:=dob div step2[i-j];
    dob1:=dob1 div step3[l];
    if k-l<0 then dob1:=dob1*step2[l-k] else
    dob1:=dob1 div step2[k-l];
    if dob=dob1 then
    if (i+j+k+l)<min then
     begin
     min:=i+j+k+l;
     res1:=i;
     res2:=j;
     res3:=k;
     res4:=l;
    end;
  end;
end;
if min=10000 then writeln(-1) else
 begin
 writeln(min);
 While (a mod 3=0) and (res2>0) do
  begin
  a:=a div 3;
  a:=a*2;
  dec(res2);
  end;
  While (b mod 3=0) and (res2>0) do
  begin
  b:=b div 3;
  b:=b*2;
  dec(res2);
  end;
  While (c mod 3=0) and (res4>0) do
  begin
  c:=c div 3;
  c:=c*2;
  dec(res4);
  end;
  While (d mod 3=0) and (res4>0) do
  begin
  d:=d div 3;
  d:=d*2;
  dec(res4);
  end;
  While (a mod 2=0) and (res1>0) do
   begin
    a:=a div 2;
    dec(res1);
   end;
   While (b mod 2=0) and (res1>0) do
   begin
    b:=b div 2;
    dec(res1);
   end;
   While (c mod 2=0) and (res3>0) do
   begin
    c:=c div 2;
    dec(res3);
   end;
   While (d mod 2=0) and (res3>0) do
   begin
    d:=d div 2;
    dec(res3);
   end;
   writeln(a,' ',b);
   writeln(c,' ',d);
 end;
 end.
//minut mi je falio da dodjem do tacnog resenja i da uradim prva cetri,steta

var
  a1,a2,b1,b2,s1,s2:int64;
  t1,t2,kq:longint;

begin
  readln(a1,b1);
  readln(a2,b2);
  s1:=a1*b1;
  s2:=a2*b2;
  t1:=0;
  t2:=0;
  kq:=0;
  while s1 mod 3=0 do
    begin
      s1:=s1 div 3;
      inc(t1);
    end;
  while s2 mod 3=0 do
    begin
      s2:=s2 div 3;
      inc(t2);
    end;
  kq:=abs(t1-t2);
  while (t2>t1)and(a2 mod 3=0) do
    begin
      a2:=a2*2 div 3;
      dec(t2);
    end;
  while (t2>t1)and(b2 mod 3=0) do
    begin
      b2:=b2*2 div 3;
      dec(t2);
    end;
  while (t1>t2)and(a1 mod 3=0) do
    begin
      a1:=a1*2 div 3;
      dec(t1);
    end;
  while (t1>t2)and(b1 mod 3=0) do
    begin
      b1:=b1*2 div 3;
      dec(t1);
    end;
  s1:=a1*b1;
  s2:=a2*b2;
  t1:=0;
  t2:=0;
  while s1 mod 2=0 do
    begin
      s1:=s1 div 2;
      inc(t1);
    end;
  while s2 mod 2=0 do
    begin
      s2:=s2 div 2;
      inc(t2);
    end;
  kq:=kq+abs(t1-t2);
  while (t2>t1)and(a2 mod 2=0) do
    begin
      a2:=a2 div 2;
      dec(t2);
    end;
  while (t2>t1)and(b2 mod 2=0) do
    begin
      b2:=b2 div 2;
      dec(t2);
    end;
  while (t1>t2)and(a1 mod 2=0) do
    begin
      a1:=a1 div 2;
      dec(t1);
    end;
  while (t1>t2)and(b1 mod 2=0) do
    begin
      b1:=b1 div 2;
      dec(t1);
    end;
  if a1*b1=a2*b2 then
    begin
      writeln(kq);
      writeln(a1,' ',b1);
      writeln(a2,' ',b2);
    end
  else writeln(-1);
end.

var
 ans,s1,s2,g,tw1,tw2,th1,th2:int64;
 a,b:array[1..2] of int64;

function gcd(a,b:int64):int64;
begin
 if a mod b=0 then exit(b) else exit(gcd(b,a mod b));
end;

procedure divide1(var s,tw,th:int64);
begin
 while s mod 2=0 do
  begin
   inc(tw);s:=s div 2;
  end;
 while s mod 3=0 do
  begin
   inc(th);s:=s div 3;
  end;
end;

procedure divide2(data,num,st:int64);
begin
 while (num>0)and(a[st] mod data=0) do
  begin
   dec(num);
   a[st]:=(a[st] div data)*(data-1);
  end;
 while (num>0)and(b[st] mod data=0) do
  begin
   dec(num);
   b[st]:=(b[st] div data)*(data-1);
  end;
end;

begin
 readln(a[1],b[1]);readln(a[2],b[2]);
 s1:=a[1]*b[1];s2:=a[2]*b[2];
 g:=gcd(s1,s2);
 s1:=s1 div g;s2:=s2 div g;
 divide1(s1,tw1,th1);divide1(s2,tw2,th2);
 if (s1<>1)or(s2<>1)
 then begin
       writeln(-1);
       close(input);close(output);
       halt;
      end;
 ans:=0;
 inc(ans,abs(th1-th2));
 if th1>th2
 then begin
       divide2(3,th1-th2,1);
       inc(tw1,th1-th2);th1:=th2;
      end
 else begin
       divide2(3,th2-th1,2);
       inc(tw2,th2-th1);th2:=th1;
      end;
 inc(ans,abs(tw1-tw2));
 if tw1>tw2
 then divide2(2,tw1-tw2,1)
 else divide2(2,tw2-tw1,2);
 writeln(ans);
 writeln(a[1],' ',b[1]);writeln(a[2],' ',b[2]);
end.

const inp='';//d2.inp';
      out='';//d2.out';

var a1,a2,b1,b2:int64;
    fi,fo:text;

procedure init;
begin
  readln(fi,a1,b1);
  readln(fi,a2,b2);
end;

procedure process;
var t1,t2,kq:longint;
    s1,s2:int64;
begin
  s1:=a1*b1;
  s2:=a2*b2;
  t1:=0;
  t2:=0;
  kq:=0;
  while s1 mod 3=0 do
    begin
      s1:=s1 div 3;
      inc(t1);
    end;
  while s2 mod 3=0 do
    begin
      s2:=s2 div 3;
      inc(t2);
    end;
  kq:=abs(t1-t2);
  while (t2>t1)and(a2 mod 3=0) do
    begin
      a2:=a2*2 div 3;
      dec(t2);
    end;
  while (t2>t1)and(b2 mod 3=0) do
    begin
      b2:=b2*2 div 3;
      dec(t2);
    end;
  while (t1>t2)and(a1 mod 3=0) do
    begin
      a1:=a1*2 div 3;
      dec(t1);
    end;
  while (t1>t2)and(b1 mod 3=0) do
    begin
      b1:=b1*2 div 3;
      dec(t1);
    end;
  s1:=a1*b1;
  s2:=a2*b2;
  t1:=0;
  t2:=0;
  while s1 mod 2=0 do
    begin
      s1:=s1 div 2;
      inc(t1);
    end;
  while s2 mod 2=0 do
    begin
      s2:=s2 div 2;
      inc(t2);
    end;
  kq:=kq+abs(t1-t2);
  while (t2>t1)and(a2 mod 2=0) do
    begin
      a2:=a2 div 2;
      dec(t2);
    end;
  while (t2>t1)and(b2 mod 2=0) do
    begin
      b2:=b2 div 2;
      dec(t2);
    end;
  while (t1>t2)and(a1 mod 2=0) do
    begin
      a1:=a1 div 2;
      dec(t1);
    end;
  while (t1>t2)and(b1 mod 2=0) do
    begin
      b1:=b1 div 2;
      dec(t1);
    end;
  if a1*b1=a2*b2 then
    begin
      writeln(fo,kq);
      writeln(fo,a1,' ',b1);
      writeln(fo,a2,' ',b2);
    end
  else writeln(fo,-1);
end;

begin
  assign(fi,inp);reset(fi);
  assign(fo,out);rewrite(fo);
  init;
  process;
  close(fi);close(fo);
end.

const fi = '';
      fo = '';
var mA, nA, mB, nB, tu, mau, count: Qword;

function ucln(a, b: Qword): Qword;
begin
 if b = 0 then exit(a)
 else exit(ucln(b, a mod b));
end;

procedure Enter;
begin
 readln(mA, nA);
 readln(mB, nB);
end;

procedure Checktu(a, b: Qword);
begin
 while tu mod a = 0 do
  begin
   inc(count);
   if mA mod a = 0 then mA:=mA div a * b
   else nA:=nA div a * b;
   tu:=tu div a * b;
  end;
end;

procedure Checkmau(a, b: Qword);
begin
 while mau mod a = 0 do
  begin
   inc(count);
   if mB mod a = 0 then mB:=mB div a * b
   else nB:=nB div a * b;
   mau:=mau div a * b;
  end;
end;

procedure Work;
var u: Qword;
begin
 u:=ucln(mA*nA, mB*nB);
 tu:=mA*nA div u; mau:=mB*nB div u;
 Checktu(3, 2);
 Checkmau(3, 2);

 u:=ucln(tu, mau);
 tu:=tu div u; mau:=mau div u;
 Checktu(2, 1);
 Checkmau(2, 1);

 if tu = mau then
  begin
   writeln(count);
   writeln(mA, ' ', nA);
   writeln(mB, ' ', nB);
  end
 else writeln(-1);
end;

begin
 assign(input, fi); reset(input);
 assign(output, fo); rewrite(output);

 Enter;
 Work;

 close(input); close(output);
end.

{$MODE OBJFPC}
const inp = '';
      outp = '';
var fi, fo: text;
    a1,a2,b1,b2 : int64;
    dem: array[1..2,2..3] of longint;
    res: array[1..2,2..3] of longint;
    check1,check2 : int64;

procedure INPUT;
begin
  assign(fi,inp); assign(fo,outp);
  reset(fi); rewrite(fo);
  readln(fi,a1,b1);
  readln(fi,a2,b2);
end;

procedure Init;
var tmp : int64;
begin
  tmp := a1 * b1;
  while (tmp mod 2 = 0) do
    begin
      inc(dem[1,2]);
      tmp := tmp div 2;
    end;
  while (tmp mod 3 = 0) do
    begin
      inc(dem[1,3]);
      tmp := tmp div 3;
    end;
  check1 := tmp;
  tmp := a2 * b2;
  while (tmp mod 2 = 0) do
    begin
      inc(dem[2,2]);
      tmp := tmp div 2;
    end;
  while tmp mod 3 = 0 do
    begin
      inc(dem[2,3]);
      tmp := tmp div 3;
    end;
  check2 := tmp;
end;

procedure Solve;
var tmp : longint;
  ans : longint;
    i : longint;
begin
  ans := 0;
  if check1 <> check2 then
    begin
      writeln(fo,-1);
      exit;
    end;
  tmp := abs(dem[1,3] - dem[2,3]);
  if dem[1,3] > dem[2,3] then
  begin
    res[1,3] := tmp;
    dem[1,2] := dem[1,2] + tmp;
  end
  else
    begin
      res[2,3] := tmp;
      dem[2,2] := dem[2,2] + tmp;
    end;
  tmp := abs(dem[1,2] - dem[2,2]);
  if dem[1,2] > dem[2,2] then res[1,2] := tmp
  else res[2,2] := tmp;
  ans := res[1,2] + res[1,3] + res[2,2] + res[2,3];
  writeln(fo,ans);
  for i:= 3 downto 2 do
  begin
  while (res[1,i] > 0) and (a1 mod i = 0) do
    begin
      a1:= a1 div i;
      if i = 3 then a1 := a1 * 2;
      dec(res[1,i]);
    end;
  while (res[1,i] > 0) and (b1 mod i = 0) do
    begin
      b1:= b1 div i;
      if i = 3 then b1 := b1 * 2;
      dec(res[1,i]);
    end;
  while (res[2,i] > 0) and (a2 mod i = 0) do
    begin
      a2:= a2 div i;
      if i = 3 then a2 := a2 *2;
      dec(res[2,i]);
    end;
  while (res[2,i] > 0) and (b2 mod i = 0) do
    begin
      b2:= b2 div i;
      if i = 3 then b2 := b2 * 2;
      dec(res[2,i]);
    end;
  end;
  writeln(fo,a1,' ',b1);
  writeln(fo,a2,' ',b2);
end;

procedure OUTPUT;
begin
  close(fi); close(fo);
end;

begin
  INPUT;
  init;
  Solve;
  OUTPUT;
end.

const   fi = '';
        fo = '';

var     f: text;
        d2,d3,c2,c3,res3x,res2x,res3y,res2y: longint;
        a1,a2,b1,b2: int64;
        check: boolean;

procedure readinp;
begin
        assign(f,fi);
        reset(F);
        read(f,a1,b1);
        read(f,a2,b2);
        close(f);
end;

function tinh(var a: int64; x: longint): longint;
var     s: longint;
begin
        s:=0;
        while a mod x = 0 do
        begin
                a:=a div x;
                inc(s);
        end;
        tinh:=s;
end;

procedure process;
var     i: longint;
        x,y: int64;
begin
        x:=a1*b1;
        y:=a2*b2;
        d2:=tinh(x,2);
        c2:=tinh(y,2);
        d3:=tinh(x,3);
        c3:=tinh(y,3);
        check:=false;
        if x<>y then exit;
        if c3<d3 then
        begin
                res3x:=d3-c3;
                d2:=d2+d3-c3;
        end
        else
        begin
                res3y:=c3-d3;
                c2:=c2+c3-d3;
        end;
        if c2<d2 then res2x:=d2-c2
                 else res2y:=c2-d2;
        check:=true;
end;

procedure timkq(var x,y: int64; a,b: longint);
var     i: longint;
begin
        while (b>0) and (x mod a=0) do
        begin
                x:=x div a;
                dec(b);
                if a=3 then x:=x*2;
        end;
        while (b>0) and (y mod a=0) do
        begin
                y:=y div a;
                dec(b);
                if a=3 then y:=y*2;
        end;
end;

procedure writeout;
begin
        assign(f,fo);
        rewrite(f);
        if not check then writeln(f,-1)
        else
        begin
                timkq(a1,b1,3,res3x);
                timkq(a1,b1,2,res2x);
                timkq(a2,b2,3,res3y);
                timkq(a2,b2,2,res2y);
                writeln(f,res2x+res3x+res2y+res3y);
                writeln(f,a1,' ',b1);
                writeln(f,a2,' ',b2);
        end;
        close(f);
end;

BEGIN
        READINP;
        PROCESS;
        WRITEOUT;
END.

program chocolate;

var ans,dva,tri,a1,b1,a2,b2,s1,s2,ss1,ss2:int64;
var d1,t1,d2,t2:longint;

begin
    readln(a1,b1);
    readln(a2,b2);
    s1:=a1*b1;
    s2:=a2*b2;
    ss1:=s1;
    ss2:=s2;
    d1:=0;
    d2:=0;
    t1:=0;
    t2:=0;
    while ss1 mod 2=0 do begin
        ss1:=ss1 div 2;
        inc(d1);
    end;
    while ss1 mod 3=0 do begin
        ss1:=ss1 div 3;
        inc(t1);
    end;
    while ss2 mod 2=0 do begin
        ss2:=ss2 div 2;
        inc(d2);
    end;
    while ss2 mod 3=0 do begin
        ss2:=ss2 div 3;
        inc(t2);
    end;
    if ss1<>ss2 then writeln(-1) else begin
        ans:=0;
        while t1>t2 do begin
            if a1 mod 3=0 then a1:=2*a1 div 3 else b1:=2*b1 div 3;
            dec(t1);
            inc(d1);
            inc(ans);
        end;
        while t2>t1 do begin
            if a2 mod 3=0 then a2:=2*a2 div 3 else b2:=2*b2 div 3;
            dec(t2);
            inc(d2);
            inc(ans);
        end;
        while d1>d2 do begin
            if a1 mod 2=0 then a1:=a1 div 2 else b1:=b1 div 2;
            dec(d1);
            inc(ans);
        end;
        while d2>d1 do begin
            if a2 mod 2=0 then a2:=a2 div 2 else b2:=b2 div 2;
            dec(d2);
            inc(ans);
        end;
        writeln(ans);
        write(a1);
        write(' ');
        writeln(b1);
        write(a2);
        write(' ');
        writeln(b2);
    end;
end.

Program PBD;
Const   ss=0.0000000001;
Var
        a,b,a1,b1,s1,s2,v1,v2:int64;
        c:array[1..2,1..2] of integer;
        r:array[1..2,1..2] of integer;
        i,j,k,t,res:integer;
Procedure tinh(val:int64;var d1,d2:integer);
Begin
        While val mod 2=0 do
          Begin
            inc(d1);
            val:=val div 2;
          End;
        While val mod 3=0 do
          Begin
            inc(d2);
            val:=val div 3;
          End;
End;
Begin
        readln(a,b);
        s1:=a*b;
        readln(a1,b1);
        s2:=a1*b1;
        fillchar(c,sizeof(c),0);
        tinh(s1,c[1,1],c[1,2]);
        tinh(s2,c[2,1],c[2,2]);
        res:=high(integer);
        For i:=0 to c[1,2] do
          For j:=0 to c[1,1]+i do
            For k:=0 to c[2,2] do
              Begin
                v1:=round(s2/exp(k*ln(3/2)));
                v2:=round(s1/(exp(i*ln(3/2))*exp(j*ln(2))));
                if  (v1 mod v2=0) and (abs(round(ln(v1/v2)/ln(2))-ln(v1/v2)/ln(2))<=ss) and (i+j+k+round(ln(v1/v2)/ln(2))<res) then
                  Begin
                    res:=i+j+k+round(ln(v1/v2)/ln(2));
                    r[1,1]:=j;
                    r[1,2]:=i;
                    r[2,1]:=round(ln(v1/v2)/ln(2));
                    r[2,2]:=k;
                  End;
              End;
        If res<high(integer) then
          Begin
            writeln(res);
            While (r[1,2]>0) and (a mod 3=0) do
              Begin
                a:=(a div 3)*2;
                dec(r[1,2]);
              End;
            While (r[1,2]>0) and (b mod 3=0) do
              Begin
                b:=(b div 3)*2;
                dec(r[1,2]);
              ENd;
            While (r[1,1]>0) and (a mod 2=0) do
              Begin
                a:=a div 2;
                dec(r[1,1]);
              End;
            While (r[1,1]>0) and (b mod 2=0) do
              Begin
                b:=b div 2;
                dec(r[1,1]);
              ENd;
            While (r[2,2]>0) and (a1 mod 3=0) do
              Begin
                a1:=(a1 div 3)*2;
                dec(r[2,2]);
              End;
            While (r[2,2]>0) and (b1 mod 3=0) do
              Begin
                b1:=(b1 div 3)*2;
                dec(r[2,2]);
              ENd;
            While (r[2,1]>0) and (a1 mod 2=0) do
              Begin
                a1:=a1 div 2;
                dec(r[2,1]);
              End;
            While (r[2,1]>0) and (b1 mod 2=0) do
              Begin
                b1:=b1 div 2;
                dec(r[2,1]);
              ENd;
            writeln(a,' ',b);
            writeln(a1,' ',b1);
          End
        else write(-1);
End.

var a1,b1,a2,b2,m,n1,n2:int64;
    k1,k2:array[1..2]of integer;
    ans:integer;
function gcd(p,q:int64):int64;
var x,y:int64;
begin
    x:=p;y:=q;
    while x<>y do
        if x mod y=0 then
            x:=y
        else
            if y mod x=0 then
                y:=x
            else
                if x>y then
                    x:=x mod y
                else
                    y:=y mod x;
    gcd:=x;
end;

begin
    readln(a1,b1,a2,b2);
    m:=gcd(a1*b1,a2*b2);
    n1:=a1*b1 div m;
    n2:=a2*b2 div m;
    while n1 mod 2=0 do begin
        inc(k1[1]);
        n1:=n1 div 2;
    end;
    while n1 mod 3=0 do begin
        inc(k1[2]);
        n1:=n1 div 3;
    end;
    while n2 mod 2=0 do begin
        inc(k2[1]);
        n2:=n2 div 2;
    end;
    while n2 mod 3=0 do begin
        inc(k2[2]);
        n2:=n2 div 3;
    end;
    if (n1=1)and(n2=1) then begin
        ans:=0;
        while k1[2]>k2[2] do begin
            if b1 mod 3=0 then
                b1:=b1 div 3*2
            else
                a1:=a1 div 3*2;
            inc(ans);dec(k1[2]);inc(k1[1]);
        end;
        while k2[2]>k1[2] do begin
            if b2 mod 3=0 then
                b2:=b2 div 3*2
            else
                a2:=a2 div 3*2;
            inc(ans);dec(k2[2]);inc(k2[1]);
        end;
        while k1[1]>k2[1] do begin
            if b1 mod 2=0 then
                b1:=b1 div 2
            else
                a1:=a1 div 2;
            inc(ans);dec(k1[1]);
        end;
        while k2[1]>k1[1] do begin
            if b2 mod 2=0 then
                b2:=b2 div 2
            else
                a2:=a2 div 2;
            inc(ans);dec(k2[1]);
        end;
        writeln(ans);
        writeln(a1,' ',b1,chr(10),a2,' ',b2);
    end
    else
        writeln(-1);
    readln;
end.

var
  a,b,c,d,z1,z2,k12,k13,k23,k22,x,ans : int64;

begin
  readln(a,b,c,d);
  z1:=a*b; z2:=c*d;
  while z1 mod 2 = 0 do begin z1:=z1 div 2; inc(k12); end;
  while z1 mod 3 = 0 do begin z1:=z1 div 3; inc(k13); end;
  while z2 mod 2 = 0 do begin z2:=z2 div 2; inc(k22); end;
  while z2 mod 3 = 0 do begin z2:=z2 div 3; inc(k23); end;
  if z1 <> z2 then begin writeln('-1'); halt; end;
  x:=k13-k23; ans:=abs(x);
  while x <> 0 do begin
    if x < 0 then begin
      dec(k23); inc(k22); inc(x);
      if c mod 3 = 0 then c:=c div 3*2 else d:=d div 3*2;
    end else begin
      dec(k13); inc(k12); dec(x);
      if a mod 3 = 0 then a:=a div 3*2 else b:=b div 3*2;
    end;
  end;
  x:=k12-k22; ans:=abs(x)+ans;
  while x <> 0 do begin
    if x < 0 then begin
      inc(x);
      if c mod 2 = 0 then c:=c div 2 else d:=d div 2;
    end else begin
      dec(x);
      if a mod 2 = 0 then a:=a div 2 else b:=b div 2;
    end;
  end;
  writeln(ans);
  writeln(a,' ',b);
  writeln(c,' ',d);
end.

var a,b,c,d,x,y,z,k11,k12,k21,k22,ans:int64;
begin
//assign(input,'qkl.in');reset(input);
//assign(output,'qkl.out');rewrite(output);
read(a,b);
read(c,d);
x:=a*b;y:=c*d;
while x mod 2=0 do begin x:=x div 2;k11:=k11+1; end;
while x mod 3=0 do begin x:=x div 3;k12:=k12+1; end;
while y mod 2=0 do begin y:=y div 2;k21:=k21+1; end;
while y mod 3=0 do begin y:=y div 3;k22:=k22+1; end;
if x<>y then begin write(-1);close(input);close(output);halt; end;
z:=k12-k22;
while z<>0 do
  begin
  if z<0 then
    begin
    if c mod 3=0 then c:=c div 3*2 else d:=d div 3*2;
    z:=z+1;k21:=k21+1;ans:=ans+1;
    end
  else
    begin
    if a mod 3=0 then a:=a div 3*2 else b:=b div 3*2;
    z:=z-1;k11:=k11+1;ans:=ans+1;
    end;
  end;
z:=k11-k21;
while z<>0 do
  begin
  if z<0 then
    begin
    if c mod 2=0 then c:=c div 2 else d:=d div 2;
    z:=z+1;ans:=ans+1;
    end
  else
    begin
    if a mod 2=0 then a:=a div 2 else b:=b div 2;
    z:=z-1;ans:=ans+1;
    end;
  end;
writeln(ans);
writeln(a,' ',b);
writeln(c,' ',d);
close(input);close(output);
end.

var a,b,c,d,x,y,x2,x3,y2,y3,ans:int64;

begin
//assign(input,'qkl.in');reset(input);
//assign(output,'qkl.out');rewrite(output);
read(a,b);
read(c,d);
x:=a*b;y:=c*d;
while x mod 2=0 do begin x:=x div 2;x2:=x2+1; end;
while x mod 3=0 do begin x:=x div 3;x3:=x3+1; end;
while y mod 2=0 do begin y:=y div 2;y2:=y2+1; end;
while y mod 3=0 do begin y:=y div 3;y3:=y3+1; end;
if x<>y then begin write(-1);close(input);close(output);halt; end;
while x3<>y3 do
  begin
  if x3>y3 then
    begin
    x2:=x2+1;x3:=x3-1;
    if a mod 3=0 then a:=a div 3*2
    else b:=b div 3*2;
    end
  else
    begin
    y2:=y2+1;y3:=y3-1;
    if c mod 3=0 then c:=c div 3*2
    else d:=d div 3*2;
    end;
  ans:=ans+1;
  end;
while x2<>y2 do
  begin
  if x2>y2 then
    begin
    x2:=x2-1;
    if a mod 2=0 then a:=a div 2
    else b:=b div 2;
    end
  else
    begin
    y2:=y2-1;
    if c mod 2=0 then c:=c div 2
    else d:=d div 2;
    end;
  ans:=ans+1;
  end;
writeln(ans);
writeln(a,' ',b);
writeln(c,' ',d);
close(input);close(output);
end.

{$MODE OBJFPC}
program onlylove;
var a1,b1,a2,b2 ,p,q: int64;
    log1,log2 : array[2..3]  of integer;
    need3,need2 : integer;
    m : int64;
procedure enter;
   begin
      readln(a1,b1);
      readln(a2,b2);
   end;
function pt(x : int64 ; y : integer) : int64;
   begin
      result:=0;
      while x mod y = 0 do
          begin
              inc(result);
              x := x div y;
          end;
   end;
function power( a , n : int64) : int64;
   var l : int64;
   begin
       if n = 0 then exit(1);
       l := power(a,n div 2);
       if odd(n)  then exit(l*l*a) else exit(l*l);
   end;
procedure phantich;
   var i ,d : integer;
   begin
       log1[2]:=pt(a1,2)+pt(b1,2);
       log2[2]:=pt(a2,2)+pt(b2,2);
       log1[3]:=pt(a1,3)+pt(b1,3);
       log2[3]:=pt(a2,3)+pt(b2,3);
       p :=( a1*b1 div power(2,log1[2]) ) div (power(3,log1[3]));
       q :=( a2*b2 div power(2,log2[2]) ) div (power(3,log2[3]));
       if p <> q then
             begin
                 Writeln(-1);
                 halt;
             end;
   end;

procedure solve;
   begin
      phantich;
      if log2[3] > log1[3]  then
          begin
            need3:=log2[3]-log1[3];
            inc(m,need3);
            log2[3]:=log1[3];
            inc(log2[2],need3);
            while (a2 mod 3 = 0) and (need3 > 0)  do
                 begin
                      a2 := a2 div 3 * 2;
                      dec(need3);
                 end;
             while (b2 mod 3 = 0) and (need3 > 0)  do
                 begin
                      b2 := b2 div 3 * 2;
                      dec(need3);
                 end;
           end else
           begin
            need3:=abs(log2[3]-log1[3]);
            inc(m,need3);
            log1[3]:=log2[3];
            inc(log1[2],need3);
            while (a1 mod 3 = 0) and (need3 > 0)  do
                 begin
                      a1 := a1 div 3 * 2;
                      dec(need3);
                 end;
             while (b1 mod 3 = 0) and (need3 > 0)  do
                 begin
                      b1 := b1 div 3 * 2;
                      dec(need3);
                 end;
           end;
           //------------------------------------------
           if log2[2] > log1[2] then
              begin
                 need2 := abs(log2[2]-log1[2]) ;
                 inc(m,need2);
                 while (a2 mod 2 = 0)  and (need2 > 0)  do
                     begin
                        a2:=a2 div 2;
                        dec(need2);
                     end;
                 while (b2 mod 2 = 0)  and (need2 > 0)  do
                    begin
                        b2 := b2 div  2 ;
                        dec(need2);
                    end;
              end else
              begin
                need2 := abs(log2[2]-log1[2]) ;
                 inc(m,need2);
                 while (a1 mod 2 = 0)  and (need2 > 0)  do
                     begin
                        a1:=a1 div 2;
                        dec(need2);
                     end;
                 while (b1 mod 2 = 0)  and (need2 > 0)  do
                    begin
                        b1 := b1 div  2 ;
                        dec(need2);
                    end;
              end;
   end;
begin
    enter;
    solve;
    Writeln(m);
   // Writeln(log1[2],' ',log1[3]);
    //Writeln(log2[2],' ',log2[3]);

    Writeln(a1,' ',b1);
    Writeln(a2,' ',b2);
end.

uses math;
var
     a1,b1,a2,b2,x1,x2,cnt2,cnt3,cnt21,cnt31,cnt22,cnt32,kol21,kol22,kol31,kol32:Int64;
     i:Longint;
begin
     Readln(a1,b1);
     Readln(a2,b2);
     x1:=a1*b1;
     x2:=a2*b2;
     while x1 mod 2=0 do
begin
     Inc(cnt21);
     x1:=x1 div 2;
 end;
     while x1 mod 3=0 do
begin
     Inc(cnt31);
     x1:=x1 div 3;
 end;
     while x2 mod 2=0 do
begin
     Inc(cnt22);
     x2:=x2 div 2;
 end;
     while x2 mod 3=0 do
begin
     Inc(cnt32);
     x2:=x2 div 3;
 end;
     if x1<>x2 then begin
                         Writeln('-1');
                         Halt;
                     end;
     cnt2:=min(cnt21,cnt22);
     Dec(cnt21,cnt2);
     Dec(cnt22,cnt2);
     cnt3:=min(cnt31,cnt32);
     Dec(cnt31,cnt3);
     Dec(cnt32,cnt3);
     kol21:=0;
     kol22:=0;
     kol31:=0;
     kol32:=0;
     if (cnt21+cnt31=0) then begin
                                  Writeln(cnt22+cnt32*2);
                                  kol22:=cnt22+cnt32;
                                  kol32:=cnt32;
                              end
                        else
     if (cnt22+cnt32=0) then begin
                                  Writeln(cnt21+cnt31*2);
                                  kol21:=cnt21+cnt31;
                                  kol31:=cnt31;
                              end
                        else
     if (cnt21+cnt32=0) then begin
                                  if cnt22>cnt31 then begin
                                                           Writeln(cnt22);
                                                           kol22:=cnt22-cnt31;
                                                           kol31:=cnt31;
                                                       end
                                                 else begin
                                                           Writeln(cnt22+(cnt31-cnt22)*2);
                                                           kol31:=cnt31;
                                                           kol21:=cnt31-cnt22;
                                                       end;

                               end
                        else begin
                                  if cnt21>cnt32 then begin
                                                           Writeln(cnt21);
                                                           kol21:=cnt21-cnt32;
                                                           kol32:=cnt32;
                                                       end
                                                 else begin
                                                           Writeln(cnt21+(cnt32-cnt21)*2);
                                                           kol32:=cnt32;
                                                           kol22:=cnt32-cnt21;
                                                       end;
                              end;
     for i:=1 to kol31 do
     if a1 mod 3=0 then a1:=(a1 div 3)*2
                   else b1:=(b1 div 3)*2;
     for i:=1 to kol32 do
     if a2 mod 3=0 then a2:=(a2 div 3)*2
                   else b2:=(b2 div 3)*2;
     for i:=1 to kol21 do
     if a1 mod 2=0 then a1:=a1 div 2
                   else b1:=b1 div 2;
     for i:=1 to kol22 do
     if a2 mod 2=0 then a2:=a2 div 2
                   else b2:=b2 div 2;
     Writeln(a1,' ',b1);
     Writeln(a2,' ',b2);
 end.

uses math;
type mass=array[1..4,0..41] of int64;
     majj=array[0..100000] of longint;
var n,res,i:longint;s1,s,s2:string;
    uk,e,l,r,ans,kol,q,x,j,y,rr,ans1,k,z, ab, bc, ac, abc : longint;
    u:boolean;
    a,b,c,d:int64;
    m:majj;
    m1,m2:mass;
procedure factor(a:int64;z:longint);
var i:longint;
Begin
   i:=2;
   while a>1 do
     Begin
        if i*i>a
        then Begin
                inc(m1[z,0]);
                m1[z,m1[z,0]]:=a;
                m2[z,m1[z,0]]:=1;
                exit;
             end;
        if (a mod i=0) and (m[i]=0)
        then Begin
                inc(m1[z,0]);
                m1[z,m1[z,0]]:=i;
                while a mod i=0 do
                   Begin
                      a:=a div i;
                      inc(m2[z,m1[z,0]]);
                   end;
             end;
        inc(i);
     end;
end;
begin
//   assign(input,'input.txt'); assign(output,'output.txt');
   readln(a,b);
   readln(c,d);
   m[1]:=1;
   for i:=2 to 100000 do
      if m[i]=0
      then Begin
             j:=i+i;
             while j<=100000 do
                Begin
                   m[j]:=1;
                   inc(j,i);
                end;
           end;
   factor(a,1);
   factor(b,2);
   factor(c,3);
   factor(d,4);
   for e:=1 to 2 do
     for i:=1 to m1[e,0] do
        if (m1[e,i]<>2) and (m1[e,i]<>3)
        then Begin
               a:=0;
               for z:=3 to 4 do
                 for j:=1 to m1[z,0] do
                     if m1[z,j]=m1[e,i]
                     then inc(a,m2[z,j]);
               if e=1
               then q:=2
               else q:=1;
               b:=m2[e,i];
               for z:=1 to m1[q,0] do
                  if m1[q,z]=m1[e,i]
                  then inc(b,m2[q,z]);
               if a<>b
               then Begin
                       writeln(-1);
                       halt(0);
                    end;
             end;
   for e:=3 to 4 do
     for i:=1 to m1[e,0] do
        if (m1[e,i]<>2) and (m1[e,i]<>3)
        then Begin
               a:=0;
               for z:=1 to 2 do
                 for j:=1 to m1[z,0] do
                     if m1[z,j]=m1[e,i]
                     then inc(a,m2[z,j]);
               if e=3
               then q:=4
               else q:=3;
               b:=m2[e,i];
               for z:=1 to m1[q,0] do
                  if m1[q,z]=m1[e,i]
                  then inc(b,m2[q,z]);
               if a<>b
               then Begin
                       writeln(-1);
                       halt(0);
                    end;
             end;
   res:=0;
   a:=0;
   for e:=1 to 2 do
      for i:=1 to m1[e,0] do
         if m1[e,i]=3
         then inc(a,m2[e,i]);
   b:=0;
   for e:=3 to 4 do
      for i:=1 to m1[e,0] do
         if m1[e,i]=3
         then inc(b,m2[e,i]);
   inc(res,abs(a-b));
   if a>b
   then Begin
            for e:=1 to 2 do
               for i:=1 to m1[e,0] do
                  if m1[e,i]=3
                  then Begin
                          while (m2[e,i]>0) and (a>b) do
                             Begin
                                dec(a);
                                dec(m2[e,i]);
                                if i<>1
                                then inc(m2[e,1])
                                else Begin
                                        inc(m1[e,0]);
                                        m1[e,m1[e,0]]:=2;
                                        m2[e,m1[e,0]]:=1;
                                     end;
                             end;
                          break;
                       end;
        end
   else Begin
            for e:=3 to 4 do
               for i:=1 to m1[e,0] do
                  if m1[e,i]=3
                  then Begin
                          while (m2[e,i]>0) and (b>a) do
                             Begin
                                dec(b);
                                dec(m2[e,i]);
                                if i<>1
                                then inc(m2[e,1])
                                else Begin
                                        inc(m1[e,0]);
                                        m1[e,m1[e,0]]:=2;
                                        m2[e,m1[e,0]]:=1;
                                     end;
                             end;
                          break;
                       end;
        end;
   a:=0;
   for e:=1 to 2 do
      for i:=1 to m1[e,0] do
         if m1[e,i]=2
         then inc(a,m2[e,i]);
   b:=0;
   for e:=3 to 4 do
      for i:=1 to m1[e,0] do
         if m1[e,i]=2
         then inc(b,m2[e,i]);
   inc(res,abs(a-b));
   if a>b
   then for e:=1 to 2 do
           for i:=1 to m1[e,0] do
              if m1[e,i]=2
              then while (m2[e,i]>0) and (a>b) do
                      Begin
                         dec(a);
                         dec(m2[e,i]);
                      end
              else
   else for e:=3 to 4 do
           for i:=1 to m1[e,0] do
               if m1[e,i]=2
               then while (m2[e,i]>0) and (b>a) do
                       Begin
                          dec(b);
                          dec(m2[e,i]);
                       end;
   writeln(res);
   for i:=1 to 4 do
      Begin
         a:=1;
         for z:=1 to m1[i,0] do
            for j:=1 to m2[i,z] do
               a:=a*m1[i,z];
         write(a,' ');
         if i=2
         then writeln;
      end;
end.

                              {$APPTYPE CONSOLE}
const  besk=1000000000;
   nnn=2000000;  eps=1e-13;
 label 1,2,3,4;
var ot,nn,chel,znam,dl,len,ii,jj,i3,i2,i1,j1,k1,kt,ppp,god,day,mon,mask,i0,j0,k,step,i,j,start,finish,m:longint;
p1,p2,n,yy1,xx1,xx2,q,xx,yy,t1,t2,p,t,aa,modul,pp,tt,ot1,ot2,s,kold,kkr:int64;
ostminus,kk,centr,koef:int64;
flag2,flag1,flag:boolean;
minotkl,dl1,dl2,dl3,hh,po,pt,doltek,dolpred:extended;
b,uvel,a,f,h,kop:array[0..2000000] of int64;
gr,c,x,y: array[-10..500,0..500] of int64;
ver: array[-10..51,-10..100,-10..100] of extended;
zan,bb,marked:array[-100000..250000] of boolean;
{ss:array[0..2000000] of char; }
ss:string;
ch11,ch12,ch1,ch:char;
dd: array[-10..100,-10..100,-10..100] of {int64}extended;
kol,rr,sl,sr,stoim,str :array[-10 ..200000] of int64;
ssot:array[-1000..110000] of string;
fact:array[0..100] of extended;
name:array[0..2000] of string;
function min (a,b:int64):int64;begin min:=b;if a<b then min:=a;  end;
function max (a,b:int64):int64;begin max:=b;if a>b then max:=a;  end;

    function nod(a,b:int64):int64; var p,t:int64;
begin if (a>0)and(b>0) then
   begin while (b>0) do begin t:=a mod b;a:=b;b:=t;    end;
    p:=a;
   end else if a=0 then p:=b else p:=a;
nod:=p;
end;

function deg2(pp:int64):int64; var ot,i,j:longint;
  begin
     ot:=0;
     while pp mod 2=0 do begin  pp:=pp div 2; inc(ot);   end;
   deg2:=ot;
  end;

function deg3(pp:int64):int64; var ot,i,j:longint;
  begin
     ot:=0;
     while pp mod 3=0 do begin  pp:=pp div 3; inc(ot);   end;
   deg3:=ot;
  end;

begin
   { assign (input,'input.txt');reset(input);
      assign (output,'output.txt'); rewrite(output);
    }
 n:=4; for i:=1 to n do read(a[i]);
  p1:=a[1]*a[2];
  p2:=a[3]*a[4];
  while p1 mod 2= 0 do p1:=p1 div 2;
  while p2 mod 2= 0 do p2:=p2 div 2;

  while p1 mod 3= 0 do p1:=p1 div 3;
  while p2 mod 3= 0 do p2:=p2 div 3;

  if p1<>p2 then begin  writeln(-1); goto 1;    end;
  ot:=0;
  while deg3(a[1]*a[2])>deg3(a[3]*a[4]) do
    begin
       if (deg3(a[1])>0)and(deg3(a[1]*a[2])>deg3(a[3]*a[4])) then
       begin  a[1]:=(a[1] div 3)*2;  inc(ot);   end;

       if (deg3(a[2])>0)and(deg3(a[1]*a[2])>deg3(a[3]*a[4])) then
       begin  a[2]:=(a[2] div 3)*2;  inc(ot);   end;

    end;

  while deg3(a[1]*a[2])<deg3(a[3]*a[4]) do
    begin
       if (deg3(a[3])>0)and(deg3(a[1]*a[2])<deg3(a[3]*a[4])) then
       begin  a[3]:=(a[3] div 3)*2;  inc(ot);   end;

       if (deg3(a[4])>0)and(deg3(a[1]*a[2])<deg3(a[3]*a[4])) then
       begin  a[4]:=(a[4] div 3)*2;  inc(ot);   end;

    end;

 while deg2(a[1]*a[2])>deg2(a[3]*a[4]) do
    begin
       if (deg2(a[1])>0)and(deg2(a[1]*a[2])>deg2(a[3]*a[4])) then
       begin  a[1]:=(a[1] div 2);  inc(ot);   end;

       if (deg2(a[2])>0)and(deg2(a[1]*a[2])>deg2(a[3]*a[4])) then
       begin  a[2]:=(a[2] div 2);  inc(ot);   end;

    end;

 while deg2(a[1]*a[2])<deg2(a[3]*a[4]) do
    begin
       if (deg2(a[3])>0)and(deg2(a[1]*a[2])<deg2(a[3]*a[4])) then
       begin  a[3]:=(a[3] div 2);  inc(ot);   end;

       if (deg2(a[4])>0)and(deg2(a[1]*a[2])<deg2(a[3]*a[4])) then
       begin  a[4]:=(a[4] div 2);  inc(ot);   end;

    end;

    writeln(ot);
    writeln(a[1],' ',a[2]);
    writeln(a[3],' ',a[4]);

   1:          close(output);
end.

var
  x1,y1,x2,y2,x3,y3,x4,y4,n,m,w,h,u,v,r,s,a,b:longint;
procedure error;
 begin
   writeln('-1');
   halt;
 end;

function sol(p,q,x,y:longint):longint;
 var
   t,i,x1,x2,k:longint;
 begin
   x1:=p;
   x2:=q;
   t:=abs(x-y);
   if x-y>0 then
     begin
       p:=p+x-y;
       k:=x-y;
       while(k>0)and(n mod 3=0) do
         begin
           n:=(n div 3)*2;
           k:=k-1;
         end;
       while(k>0)and(m mod 3=0) do
         begin
           m:=(m div 3)*2;
           k:=k-1;
         end;
     end
            else
     begin
       q:=q+y-x;
       k:=y-x;
       while(k>0)and(w mod 3=0) do
         begin
           w:=(w div 3)*2;
           k:=k-1;
         end;
       while(k>0)and(h mod 3=0) do
         begin
           h:=(h div 3)*2;
           k:=k-1;
         end;
     end;
   t:=t+abs(p-q);
   writeln(t);
   if p-q>0 then
     begin
       p:=p-abs(p-q);
       for i:=p downto x1+1 do
         n:=n*2;
       for i:=p to x1-1 do
         if n mod 2=0 then n:=n div 2
                      else m:=m div 2;
     end
            else
     begin
       k:=q-p;
       q:=q-abs(p-q);
       for i:=q downto x2+1 do
         w:=w*2;
       for i:=q to x2-1 do
         if w mod 2=0 then w:=w div 2
                      else h:=h div 2;
     end;
   writeln(n,' ',m);
   writeln(w,' ',h);
 end;

procedure cal(var a,b,p:longint;n:longint);
 var
   k:longint;
 begin
   k:=n;
   a:=0;
   b:=0;
   while k mod 2=0 do
     begin
       inc(a);
       k:=k div 2;
     end;
   while k mod 3=0 do
     begin
       inc(b);
       k:=k div 3;
     end;
   p:=k;
 end;

begin
  readln(n,m);
  readln(w,h);
  cal(x1,y1,u,n);
  cal(x2,y2,v,m);
  cal(x3,y3,r,w);
  cal(x4,y4,s,h);
  if v*u<>s*r then error;
  sol(x1+x2,x3+x4,y1+y2,y3+y4);
end.

var a, b: array [1..2] of array [1..2] of longint;
    d: array [1..2] of array [2..3] of byte;
    i, j, x, y: longint;
begin
        readln(a[1][1], a[1][2]);
        readln(a[2][1], a[2][2]);
        for i := 1 to 2 do
                for j := 1 to 2 do
                        b[i][j] := a[i][j];
        for i := 1 to 2 do
                for j := 1 to 2 do
                begin
                        while b[i][j] mod 3 = 0 do
                        begin
                                b[i][j] := (b[i][j] div 3) * 2;
                                inc(d[i][3]);
                        end;
                        while b[i][j] mod 2 = 0 do
                        begin
                                b[i][j] := b[i][j] div 2;
                                inc(d[i][2]);
                        end;
                end;
        if int64(b[1][1]) * b[1][2] <> int64(b[2][1]) * b[2][2] then
        begin
                writeln(-1);
                exit;
        end;
        x := d[1][2] - d[2][2];
        y := d[1][3] - d[2][3];
        writeln(abs(x) + abs(y));
        if x > 0 then
        begin
                for i := 1 to x do
                        if a[1][1] mod 2 = 0 then
                                a[1][1] := a[1][1] div 2
                        else
                                a[1][2] := a[1][2] div 2;
        end
        else
        begin
                for i := 1 to abs(x) do
                        if a[2][1] mod 2 = 0 then
                                a[2][1] := a[2][1] div 2
                        else
                                a[2][2] := a[2][2] div 2;
        end;
        if y > 0 then
        begin
                for i := 1 to y do
                        if a[1][1] mod 3 = 0 then
                                a[1][1] := (a[1][1] div 3) * 2
                        else
                                a[1][2] := (a[1][2] div 3) * 2;
        end
        else
        begin
                for i := 1 to abs(y) do
                        if a[2][1] mod 3 = 0 then
                                a[2][1] := (a[2][1] div 3) * 2
                        else
                                a[2][2] := (a[2][2] div 3) * 2;
        end;
        writeln(a[1][1], ' ', a[1][2]);
        writeln(a[2][1], ' ', a[2][2]);
end.

var a, b: array [1..2] of array [1..2] of longint;
    d: array [1..2] of array [2..3] of byte;
    i, j, x, y, z: longint;
begin
        readln(a[1][1], a[1][2]);
        readln(a[2][1], a[2][2]);
        for i := 1 to 2 do
                for j := 1 to 2 do
                        b[i][j] := a[i][j];
        for i := 1 to 2 do
                for j := 1 to 2 do
                begin
                        while b[i][j] mod 3 = 0 do
                        begin
                                b[i][j] := (b[i][j] div 3) * 2;
                                inc(d[i][3]);
                        end;
                        while b[i][j] mod 2 = 0 do
                        begin
                                b[i][j] := b[i][j] div 2;
                                inc(d[i][2]);
                        end;
                end;
        for i := 1 to 2 do
                if b[i][1] > b[i][2] then
                begin
                        z := b[i][1];
                        b[i][1] := b[i][2];
                        b[i][2] := z;
                end;
        for i := 1 to 2 do
                if b[1][i] <> b[2][i] then
                begin
                        writeln(-1);
                        exit;
                end;
        x := d[1][2] - d[2][2];
        y := d[1][3] - d[2][3];
        writeln(abs(x) + abs(y));
        if x > 0 then
        begin
                for i := 1 to x do
                        if a[1][1] mod 2 = 0 then
                                a[1][1] := a[1][1] div 2
                        else
                                a[1][2] := a[1][2] div 2;
        end
        else
        begin
                for i := 1 to abs(x) do
                        if a[2][1] mod 2 = 0 then
                                a[2][1] := a[2][1] div 2
                        else
                                a[2][2] := a[2][2] div 2;
        end;
        if y > 0 then
        begin
                for i := 1 to y do
                        if a[1][1] mod 3 = 0 then
                                a[1][1] := a[1][1] div 3 * 2
                        else
                                a[1][2] := a[1][2] div 3 * 2;
        end
        else
        begin
                for i := 1 to abs(y) do
                        if a[2][1] mod 3 = 0 then
                                a[2][1] := a[2][1] div 3 * 2
                        else
                                a[2][2] := a[2][2] div 3 * 2;
        end;
        writeln(a[1][1], ' ', a[1][2]);
        writeln(a[2][1], ' ', a[2][2]);
end.

var a, b: array [1..2] of array [1..2] of longint;
    d: array [1..2] of array [2..3] of byte;
    i, j, x, y, z: longint;
begin
        readln(a[1][1], a[1][2]);
        readln(a[2][1], a[2][2]);
        for i := 1 to 2 do
                for j := 1 to 2 do
                        b[i][j] := a[i][j];
        for i := 1 to 2 do
                for j := 1 to 2 do
                begin
                        while b[i][j] mod 2 = 0 do
                        begin
                                b[i][j] := b[i][j] div 2;
                                inc(d[i][2]);
                        end;
                        while b[i][j] mod 3 = 0 do
                        begin
                                b[i][j] := b[i][j] div 3;
                                inc(d[i][3]);
                        end;
                end;
        for i := 1 to 2 do
                if b[i][1] > b[i][2] then
                begin
                        z := b[i][1];
                        b[i][1] := b[i][2];
                        b[i][2] := z;
                end;
        for i := 1 to 2 do
                if b[1][i] <> b[2][i] then
                begin
                        writeln(-1);
                        exit;
                end;
        x := d[1][2] - d[2][2];
        y := d[1][3] - d[2][3];
        writeln(abs(x) + abs(y));
        if x > 0 then
        begin
                for i := 1 to x do
                        if a[1][1] mod 2 = 0 then
                                a[1][1] := a[1][1] div 2
                        else
                                a[1][2] := a[1][2] div 2;
        end
        else
        begin
                for i := 1 to abs(x) do
                        if a[2][1] mod 2 = 0 then
                                a[2][1] := a[2][1] div 2
                        else
                                a[2][2] := a[2][2] div 2;
        end;
        if y > 0 then
        begin
                for i := 1 to y do
                        if a[1][1] mod 3 = 0 then
                                a[1][1] := a[1][1] div 3
                        else
                                a[1][2] := a[1][2] div 3;
        end
        else
        begin
                for i := 1 to abs(y) do
                        if a[2][1] mod 3 = 0 then
                                a[2][1] := a[2][1] div 3
                        else
                                a[2][2] := a[2][2] div 3;
        end;
        writeln(a[1][1], ' ', a[1][2]);
        writeln(a[2][1], ' ', a[2][2]);
end.

var a,b,c,d,a1,dob,dob1,ans,ans1:int64;
step2,step3:array[0..100] of int64;
prv2,prv3,drg2,drg3,tre2,tre3,cet2,cet3,res1,res2,res3,res4,p:longint;
mog1,mog2,mog3,mog4:longint;
i,j,k,l,min:longint;
 begin
  readln(a,b);
  readln(c,d);
  a1:=a;
  step2[0]:=1;
  for i:=1 to 62 do
  step2[i]:=step2[i-1]*2;
  step3[0]:=1;
  for i:=1 to 36 do
  step3[i]:=step3[i-1]*3;
  While a1 mod 2=0  do
   begin
    inc(prv2);
     a1:=a1 div 2;
    end;
   While (a1 mod 3=0) do
    begin
    inc(prv3);
    a1:=a1 div 3;
   end;
    a1:=b;
  While a1 mod 2=0  do
   begin
    inc(drg2);
     a1:=a1 div 2;
    end;
   While (a1 mod 3=0) do
    begin
    inc(drg3);
    a1:=a1 div 3;
   end;
    a1:=c;
  While a1 mod 2=0  do
   begin
    inc(tre2);
     a1:=a1 div 2;
    end;
   While (a1 mod 3=0) do
    begin
    inc(tre3);
    a1:=a1 div 3;
   end;
    a1:=d;
  While a1 mod 2=0  do
   begin
    inc(cet2);
     a1:=a1 div 2;
    end;
   While (a1 mod 3=0) do
    begin
    inc(cet3);
    a1:=a1 div 3;
   end;
   min:=10000;
  ans:=a*b;
  ans1:=c*d;
  for i:=0 to 62 do
  for j:=0 to 36 do
  for k:=0 to 62 do
  for l:=0 to 36 do
   begin
   p:=0;
   mog1:=prv2+drg2;
   mog2:=prv3+drg3;
   mog3:=tre2+cet2;
   mog4:=tre3+cet3;
   if (mog2>=j) then mog1:=mog1+j else inc(p);
   if mog1<i then inc(p);
   if mog4>=l then mog4:=mog4+l else inc(p);
   if mog3<k then inc(p);
   if p=0 then
    begin
    dob:=ans;
    dob1:=ans1;

    dob:=dob div step3[j];
    if i-j<0 then dob:=dob*step2[j-i] else
    dob:=dob div step2[i-j];
    dob1:=dob1 div step3[l];
    if k-l<0 then dob1:=dob1*step2[l-k] else
    dob1:=dob1 div step2[k-l];
    if dob=dob1 then
    if (i+j+k+l)<min then
     begin
     min:=i+j+k+l;
     res1:=i;
     res2:=j;
     res3:=k;
     res4:=l;
    end;
  end;
end;
if min=10000 then writeln(-1) else
 begin
 writeln(min);
 While (a mod 3=0) and (res2>0) do
  begin
  a:=a div 3;
  a:=a*2;
  dec(res2);
  end;
  While (b mod 3=0) and (res2>0) do
  begin
  b:=b div 3;
  b:=b*2;
  dec(res2);
  end;
  While (a mod 3=0) and (res4>0) do
  begin
  c:=c div 3;
  c:=c*2;
  dec(res4);
  end;
  While (d mod 3=0) and (res4>0) do
  begin
  d:=d div 3;
  d:=d*2;
  dec(res4);
  end;
  While (a mod 2=0) and (res1>0) do
   begin
    a:=a div 2;
    dec(res1);
   end;
   While (b mod 2=0) and (res1>0) do
   begin
    b:=b div 2;
    dec(res1);
   end;
   While (c mod 2=0) and (res3>0) do
   begin
    c:=c div 2;
    dec(res3);
   end;
   While (d mod 2=0) and (res3>0) do
   begin
    d:=d div 2;
    dec(res3);
   end;
   writeln(a,' ',b);
   writeln(c,' ',d);
 end;
 end.
//minut mi je falio da dodjem do tacnog resenja i da uradim prva cetri,steta

var a,b,c,d,a1,dob,dob1,ans,ans1:int64;
step2,step3:array[0..100] of int64;
prv2,prv3,drg2,drg3,tre2,tre3,cet2,cet3,res1,res2,res3,res4,p:longint;
mog1,mog2,mog3,mog4:longint;
i,j,k,l,min:longint;
 begin
  readln(a,b);
  readln(c,d);
  a1:=a;
  step2[0]:=1;
  for i:=1 to 62 do
  step2[i]:=step2[i-1]*2;
  step3[0]:=1;
  for i:=1 to 36 do
  step3[i]:=step3[i-1]*3;
  While a1 mod 2=0  do
   begin
    inc(prv2);
     a1:=a1 div 2;
    end;
   While (a1 mod 3=0) do
    begin
    inc(prv3);
    a1:=a1 div 3;
   end;
    a1:=b;
  While a1 mod 2=0  do
   begin
    inc(drg2);
     a1:=a1 div 2;
    end;
   While (a1 mod 3=0) do
    begin
    inc(drg3);
    a1:=a1 div 3;
   end;
    a1:=c;
  While a1 mod 2=0  do
   begin
    inc(tre2);
     a1:=a1 div 2;
    end;
   While (a1 mod 3=0) do
    begin
    inc(tre3);
    a1:=a1 div 3;
   end;
    a1:=d;
  While a1 mod 2=0  do
   begin
    inc(cet2);
     a1:=a1 div 2;
    end;
   While (a1 mod 3=0) do
    begin
    inc(cet3);
    a1:=a1 div 3;
   end;
   min:=10000;
  ans:=a*b;
  ans1:=c*d;
  for i:=0 to 62 do
  for j:=0 to 36 do
  for k:=0 to 62 do
  for l:=0 to 36 do
   begin
   p:=0;
   mog1:=prv2+drg2;
   mog2:=prv3+drg3;
   mog3:=tre2+cet2;
   mog4:=tre3+cet3;
   if (mog2>=j) then mog1:=mog1+j else inc(p);
   if mog1<i then inc(p);
   if mog4>=l then mog4:=mog4+l else inc(p);
   if mog3<k then inc(p);
   if p=0 then
    begin
    dob:=ans;
    dob1:=ans1;

    dob:=dob div step3[j];
    if i-j<0 then dob:=dob*step2[j-i] else
    dob:=dob div step2[i-j];
    dob1:=dob1 div step3[l];
    if k-l<0 then dob1:=dob1*step2[l-k] else
    dob1:=dob1 div step2[k-l];
    if dob=dob1 then
    if (i+j+k+l)<min then
     begin
     min:=i+j+k+l;
     res1:=i;
     res2:=j;
     res3:=k;
     res4:=l;
    end;
  end;
end;
if min=10000 then writeln(-1) else
 begin
 writeln(min);
 While (a mod 3=0) and (res2>0) do
  begin
  a:=a div 3;
  a:=a*2;
  dec(res2);
  end;
  While (b mod 3=0) and (res2>0) do
  begin
  b:=b div 3;
  b:=b*2;
  dec(res2);
  end;
  While (c mod 3=0) and (res4>0) do
  begin
  c:=c div 3;
  c:=c*2;
  dec(res4);
  end;
  While (d mod 3=0) and (res4>0) do
  begin
  d:=d div 3;
  d:=d*2;
  dec(res4);
  end;
  While (a mod 2=0) and (res1>0) do
   begin
    a:=a div 2;
    dec(res1);
   end;
   While (b mod 2=0) and (res1>0) do
   begin
    b:=b div 2;
    dec(res1);
   end;
   While (c mod 2=0) and (res3>0) do
   begin
    c:=c div 2;
    dec(res3);
   end;
   While (d mod 2=0) and (res3>0) do
   begin
    d:=d div 2;
    dec(res3);
   end;
   writeln(a,' ',b);
   writeln(c,' ',d);
 end;
 end.
//minut mi je falio da dodjem do tacnog resenja i da uradim prva cetri,steta

const inp='';//d1.inp';
      out='';//d1.out';

var a1,a2,b1,b2:longint;
    fi,fo:text;

procedure init;
begin
  readln(fi,a1,b1);
  readln(fi,a2,b2);
end;

procedure process;
var s1,s2,t1,t2,kq:longint;
begin
  s1:=a1*b1;
  s2:=a2*b2;
  t1:=0;
  t2:=0;
  kq:=0;
  while s1 mod 3=0 do
    begin
      s1:=s1 div 3;
      inc(t1);
    end;
  while s2 mod 3=0 do
    begin
      s2:=s2 div 3;
      inc(t2);
    end;
  kq:=abs(t1-t2);
  while (t2>t1)and(a2 mod 3=0) do
    begin
      a2:=a2*2 div 3;
      dec(t2);
    end;
  while (t2>t1)and(b2 mod 3=0) do
    begin
      b2:=b2*2 div 3;
      dec(t2);
    end;
  while (t1>t2)and(a1 mod 3=0) do
    begin
      a1:=a1*2 div 3;
      dec(t1);
    end;
  while (t1>t2)and(b1 mod 3=0) do
    begin
      b1:=b1*2 div 3;
      dec(t1);
    end;
  s1:=a1*b1;
  s2:=a2*b2;
  t1:=0;
  t2:=0;
  while s1 mod 2=0 do
    begin
      s1:=s1 div 2;
      inc(t1);
    end;
  while s2 mod 2=0 do
    begin
      s2:=s2 div 2;
      inc(t2);
    end;
  kq:=kq+abs(t1-t2);
  while (t2>t1)and(a2 mod 2=0) do
    begin
      a2:=a2 div 2;
      dec(t2);
    end;
  while (t2>t1)and(b2 mod 2=0) do
    begin
      b2:=b2 div 2;
      dec(t2);
    end;
  while (t1>t2)and(a1 mod 2=0) do
    begin
      a1:=a1 div 2;
      dec(t1);
    end;
  while (t1>t2)and(b1 mod 2=0) do
    begin
      b1:=b1 div 2;
      dec(t1);
    end;
  if a1*b1=a2*b2 then
    begin
      writeln(fo,kq);
      writeln(fo,a1,' ',b1);
      writeln(fo,a2,' ',b2);
    end
  else writeln(fo,-1);
end;

begin
  assign(fi,inp);reset(fi);
  assign(fo,out);rewrite(fo);
  init;
  process;
  close(fi);close(fo);
end.

const inp='';//d1.inp';
      out='';//d1.out';

var a1,a2,b1,b2:longint;
    fi,fo:text;

procedure init;
begin
  readln(fi,a1,b1);
  readln(fi,a2,b2);
end;

procedure process;
var s1,s2,t1,t2,kq:longint;
begin
  s1:=a1*b1;
  s2:=a2*b2;
  t1:=0;
  t2:=0;
  kq:=0;
  while s1 mod 3=0 do
    begin
      s1:=s1 div 3;
      inc(t1);
    end;
  while s2 mod 3=0 do
    begin
      s2:=s2 div 3;
      inc(t2);
    end;
  kq:=abs(t1-t2);
  while (t2>t1)and(a2 mod 3=0) do
    begin
      a2:=a2*2 div 3;
      dec(t2);
    end;
  while (t2>t1)and(b2 mod 3=0) do
    begin
      b2:=b2*2 div 3;
      dec(t2);
    end;
  while (t1>t2)and(a1 mod 3=0) do
    begin
      a1:=a1*2 div 3;
      dec(t1);
    end;
  while (t1>t2)and(b1 mod 3=0) do
    begin
      b1:=b1*2 div 3;
      dec(t1);
    end;
  s1:=a1*b1;
  s2:=a2*b2;
  while s1 mod 2=0 do
    begin
      s1:=s1 div 2;
      inc(t1);
    end;
  while s2 mod 2=0 do
    begin
      s2:=s2 div 2;
      inc(t2);
    end;
  kq:=kq+abs(t1-t2);
  while (t2>t1)and(a2 mod 2=0) do
    begin
      a2:=a2 div 2;
      dec(t2);
    end;
  while (t2>t1)and(b2 mod 2=0) do
    begin
      b2:=b2 div 2;
      dec(t2);
    end;
  while (t1>t2)and(a1 mod 2=0) do
    begin
      a1:=a1 div 2;
      dec(t1);
    end;
  while (t1>t2)and(b1 mod 2=0) do
    begin
      b1:=b1 div 2;
      dec(t1);
    end;
  if a1*b1=a2*b2 then
    begin
      writeln(fo,kq);
      writeln(fo,a1,' ',b1);
      writeln(fo,a2,' ',b2);
    end
  else writeln(fo,-1);
end;

begin
  assign(fi,inp);reset(fi);
  assign(fo,out);rewrite(fo);
  init;
  process;
  close(fi);close(fo);
end.

const fi = '';
      fo = '';
      maxN = 100000;
      //maxN = 1000;
      maxDigit = 8;
var n, count: longint;
    a: array [0..maxN] of string;
    e10: array [0..maxDigit] of longint;

procedure Enter;
var i: longint;
begin
 readln(n);
 for i:=1 to n do readln(a[i]);
 a[0]:='0';

 e10[0]:=1;
 for i:=1 to maxDigit do e10[i]:=e10[i-1]*10;
end;

function isGreaterthan(a, b: string): boolean;
begin
 exit((length(a) > length(b)) or ((length(a) = length(b)) and (a > b)));
end;

procedure Replace(var s: string; n: longint);
var i, j: longint;
    r: string;
begin
 str(n, r); j:=0;
 while length(r) < count do r:='0'+r;
 for i:=1 to length(s) do
  if s[i] = '?' then
   begin inc(j); s[i]:=r[j]; end;
end;

function Check(n, k: longint): boolean;
var prev, cur: string;
begin
 prev:=a[k-1]; cur:=a[k];
 Replace(cur, n);
 exit((cur[1] <> '0') and isGreaterthan(cur, prev));
end;

function Find(k: longint): longint;
var i, l, r, mid, res: longint;
    code: integer;
begin
 count:=0;
 for i:=1 to length(a[k]) do
  if a[k][i] = '?' then inc(count);
 if count = 0 then
  begin
   if isGreaterthan(a[k], a[k-1]) then
    begin
     Val(a[k], res, code);
     exit(res);
    end
   else exit(-1);
  end;

 l:=0; r:=e10[count]-1; res:=-1;
 while l <= r do
  begin
   mid:=(l+r) div 2;
   if Check(mid, k) then
    begin
     res:=mid;
     r:=mid-1;
    end
   else l:=mid+1;
  end;
 exit(res);
end;

procedure Work;
var i, k: longint;
begin
 for i:=1 to n do
  begin
   k:=Find(i);
   if k = -1 then
    begin
     writeln('NO');
     exit;
    end;
   Replace(a[i], k);
  end;
 writeln('YES');
 for i:=1 to n do writeln(a[i]);
end;

begin
 assign(input, fi); reset(input);
 assign(output, fo); rewrite(output);

 Enter;
 Work;

 close(input); close(output);
end.

{$MODE OBJFPC}
const inp = '';
      outp = '';
type data = record
    x,y,c : int64;
    end;
var fi, fo: text;
    a1,b1,a2,b2 : int64;
    q : array[1..100,1..2] of data;
    d : array[1..100,1..2] of longint;
    n : array[1..2] of longint;
procedure INPUT;
begin
  assign(fi,inp); assign(fo,outp);
  reset(fi); rewrite(fo);
  readln(fi,a1,b1);
  readln(fi,a2,b2);
end;

procedure bfs(x,y,k : longint);
var first, last : longint;
    u : data;
    tmp : longint;
    i : longint;
begin
  first := 1;
  last := 1;
  q[1,k].x := x;
  q[1,k].y := y;
  q[1,k].c := x * y;
  while first <= last do
    begin
      u:= q[first,k];
      tmp := d[first,k];
      inc(first);
      for i:= 2 to 3  do
      begin
        if u.x mod i = 0 then
          begin
            inc(last);
            q[last,k].x := u.x - u.x div i;
            q[last,k].y := u.y;
            q[last,k].c := (u.x - u.x div i) * u.y;
            d[last,k] := tmp + 1;
          end;
        if u.y mod i = 0 then
          begin
            inc(last);
            q[last,k].x := u.x ;
            q[last,k].y := u.y - u.y div i;
            q[last,k].c := u.x * (u.y - u.y div i);
            d[last,k] := tmp + 1;
          end;
      end;
    end;
  n[k] := last;
end;

procedure Solve;
var min : longint;
    i,j : longint;
    x1,y1 : longint;
    x2,y2 : longint;
begin
  bfs(a1,b1,1);
  bfs(a2,b2,2);
  min := high(longint);
  for i:= 1 to n[1] do
    for j:= 1 to n[2] do
      if (q[i,1].c = q[j,2].c) and (d[i,1] + d[j,2] < min) then
      begin
        min := d[i,1] + d[j,2];
        x1 := q[i,1].x;
        y1 := q[i,1].y;
        x2 := q[j,2].x;
        y2 := q[j,2].y;
      end;
  if min = high(longint) then writeln(fo,'NO')
  else
    begin
      writeln(fo,min);
      writeln(fo,x1,' ',y1);
      writeln(fo,x2,' ',y2);
    end;
end;

procedure OUTPUT;
begin
  close(fi); close(fo);
end;

begin
  INPUT;
  Solve;
  OUTPUT;
end.

{$MODE OBJFPC}
const inp = '';
      outp = '';
var fi, fo: text;
    a1,a2,b1,b2 : int64;
    dem: array[1..2,2..3] of longint;
    res: array[1..2,2..3] of longint;
    check1,check2 : int64;

procedure INPUT;
begin
  assign(fi,inp); assign(fo,outp);
  reset(fi); rewrite(fo);
  readln(fi,a1,b1);
  readln(fi,a2,b2);
end;

procedure Init;
var tmp : int64;
begin
  tmp := a1 * b1;
  while (tmp mod 2 = 0) do
    begin
      inc(dem[1,2]);
      tmp := tmp div 2;
    end;
  while (tmp mod 3 = 0) do
    begin
      inc(dem[1,3]);
      tmp := tmp div 3;
    end;
  check1 := tmp;
  tmp := a2 * b2;
  while (tmp mod 2 = 0) do
    begin
      inc(dem[2,2]);
      tmp := tmp div 2;
    end;
  while tmp mod 3 = 0 do
    begin
      inc(dem[2,3]);
      tmp := tmp div 3;
    end;
  check2 := tmp;
end;

procedure Solve;
var tmp : longint;
  ans : longint;
    i : longint;
begin
  ans := 0;
  if check1 <> check2 then
    begin
      writeln(fo,-1);
      exit;
    end;
  tmp := abs(dem[1,3] - dem[2,3]);
  if dem[1,3] > dem[2,3] then
  begin
    res[1,3] := tmp;
    dem[1,2] := dem[1,2] + tmp;
  end
  else
    begin
      res[2,3] := tmp;
      dem[2,2] := dem[2,2] + tmp;
    end;
  tmp := abs(dem[1,2] - dem[2,2]);
  if dem[1,2] > dem[2,2] then res[1,2] := tmp
  else res[2,2] := tmp;
  ans := res[1,2] + res[1,3] + res[2,2] + res[2,3];
  writeln(fo,ans);
  for i:= 2 to 3 do
  begin
  while (res[1,i] > 0) and (a1 mod i = 0) do
    begin
      a1:= a1 div i;
      if i = 3 then a1 := a1 * 2;
      dec(res[1,i]);
    end;
  while (res[1,i] > 0) and (b1 mod i = 0) do
    begin
      b1:= b1 div i;
      if i = 3 then b1 := b1 * 2;
      dec(res[1,i]);
    end;
  while (res[2,i] > 0) and (a2 mod i = 0) do
    begin
      a2:= a2 div i;
      if i = 3 then a2 := a2 *2;
      dec(res[2,i]);
    end;
  while (res[2,i] > 0) and (b2 mod i = 0) do
    begin
      b2:= b2 div i;
      if i = 3 then b2 := b2 * 2;
      dec(res[2,i]);
    end;
  end;
  writeln(fo,a1,' ',b1);
  writeln(fo,a2,' ',b2);
end;

procedure OUTPUT;
begin
  close(fi); close(fo);
end;

begin
  INPUT;
  init;
  Solve;
  OUTPUT;
end.

{$MODE OBJFPC}
const inp = '';
      outp = '';
var fi, fo: text;
    a1,a2,b1,b2 : int64;
    dem: array[1..2,2..3] of longint;
    res: array[1..2,2..3] of longint;
    check1,check2 : int64;

procedure INPUT;
begin
  assign(fi,inp); assign(fo,outp);
  reset(fi); rewrite(fo);
  readln(fi,a1,b1);
  readln(fi,a2,b2);
end;

procedure Init;
var tmp : int64;
begin
  tmp := a1 * b1;
  while (tmp mod 2 = 0) do
    begin
      inc(dem[1,2]);
      tmp := tmp div 2;
    end;
  while (tmp mod 3 = 0) do
    begin
      inc(dem[1,3]);
      tmp := tmp div 3;
    end;
  check1 := tmp;
  tmp := a2 * b2;
  while (tmp mod 2 = 0) do
    begin
      inc(dem[2,2]);
      tmp := tmp div 2;
    end;
  while tmp mod 3 = 0 do
    begin
      inc(dem[2,3]);
      tmp := tmp div 3;
    end;
  check2 := tmp;
end;

procedure Solve;
var tmp : longint;
  ans : longint;
    i : longint;
begin
  ans := 0;
  if check1 <> check2 then
    begin
      writeln(fo,-1);
      exit;
    end;
  tmp := abs(dem[1,3] - dem[2,3]);
  if dem[1,3] > dem[2,3] then
  begin
    res[1,3] := tmp;
    dem[1,2] := dem[1,2] + tmp;
  end
  else
    begin
      res[2,3] := tmp;
      dem[2,2] := dem[2,3] + tmp;
    end;
  tmp := abs(dem[1,2] - dem[2,2]);
  if dem[1,2] > dem[2,2] then res[1,2] := tmp
  else res[2,2] := tmp;
  ans := res[1,2] + res[1,3] + res[2,2] + res[2,3];
  writeln(fo,ans);
  for i:= 2 to 3 do
  begin
  while (res[1,i] > 0) and (a1 mod 2 = 0) do
    begin
      a1:= a1 div 2;
      dec(res[1,i]);
    end;
  while (res[1,i] > 0) and (b1 mod 2 = 0) do
    begin
      b1:= b1 div 2;
      dec(res[1,i]);
    end;
  while (res[2,i] > 0) and (a2 mod 2 = 0) do
    begin
      a2:= a2 div 2;
      dec(res[2,i]);
    end;
  while (res[2,i] > 0) and (b2 mod 2 = 0) do
    begin
      b2:= b2 div 2;
      dec(res[2,i]);
    end;
  end;
  writeln(fo,a1,' ',b1);
  writeln(fo,a2,' ',b2);
end;

procedure OUTPUT;
begin
  close(fi); close(fo);
end;

begin
  INPUT;
  init;
  Solve;
  OUTPUT;
end.

{$MODE OBJFPC}
const inp = '';
      outp = '';
var fi, fo: text;
    a1,a2,b1,b2 : int64;
    dem: array[1..2,2..3] of longint;
    res: array[1..2,2..3] of longint;
    check1,check2 : int64;

procedure INPUT;
begin
  assign(fi,inp); assign(fo,outp);
  reset(fi); rewrite(fo);
  readln(fi,a1,b1);
  readln(fi,a2,b2);
end;

procedure Init;
var tmp : int64;
begin
  tmp := a1 * b1;
  while (tmp mod 2 = 0) do
    begin
      inc(dem[1,2]);
      tmp := tmp div 2;
    end;
  while (tmp mod 3 = 0) do
    begin
      inc(dem[1,3]);
      tmp := tmp div 3;
    end;
  check1 := tmp;
  tmp := a2 * b2;
  while (tmp mod 2 = 0) do
    begin
      inc(dem[2,2]);
      tmp := tmp div 2;
    end;
  while tmp mod 3 = 0 do
    begin
      inc(dem[2,3]);
      tmp := tmp div 3;
    end;
  check2 := tmp;
end;

procedure Solve;
var tmp : longint;
  ans : longint;
    i : longint;
begin
  ans := 0;
  if check1 <> check2 then
    begin
      writeln(fo,-1);
      exit;
    end;
  tmp := abs(dem[1,3] - dem[2,3]);
  if dem[1,3] > dem[2,3] then
  begin
    res[1,3] := tmp;
    dem[1,2] := dem[1,2] + tmp;
  end
  else
    begin
      res[2,3] := tmp;
      dem[2,2] := dem[2,3] + tmp;
    end;
  tmp := abs(dem[1,2] - dem[2,2]);
  if dem[1,2] > dem[2,2] then res[1,2] := tmp
  else res[2,2] := tmp;
  ans := res[1,2] + res[1,3] + res[2,2] + res[2,3];
  writeln(fo,ans);
  for i:= 2 to 3 do
  begin
  while (res[1,i] > 0) and (a1 mod i = 0) do
    begin
      a1:= a1 div i;
      if i = 3 then a1 := a1 * 2;
      dec(res[1,i]);
    end;
  while (res[1,i] > 0) and (b1 mod i = 0) do
    begin
      b1:= b1 div i;
      if i = 3 then b1 := b1 * 2;
      dec(res[1,i]);
    end;
  while (res[2,i] > 0) and (a2 mod i = 0) do
    begin
      a2:= a2 div i;
      if i = 3 then a2 := a2 *2;
      dec(res[2,i]);
    end;
  while (res[2,i] > 0) and (b2 mod i = 0) do
    begin
      b2:= b2 div i;
      if i = 3 then b2 := b2 * 2;
      dec(res[2,i]);
    end;
  end;
  writeln(fo,a1,' ',b1);
  writeln(fo,a2,' ',b2);
end;

procedure OUTPUT;
begin
  close(fi); close(fo);
end;

begin
  INPUT;
  init;
  Solve;
  OUTPUT;
end.

type canh = record
        x , y : longint;
end;
var f : text;
queue , queue2 : array[0..100001] of canh;
dem , dem2 : array[0..100001] of longint;
a , b , c , d , aa , bb , cc , dd , min : longint;
//_______________________________________________________
procedure nhap;
begin
        assign(f , '');
        reset(f);
        readln(f , a , b , c , d);
        close(f);
        assign(f , '');
        rewrite(f);
end;
//_______________________________________________________
procedure xu_li;
var i , dau , cuoi , m : longint;
u : canh;
begin
        dau := 1;
        cuoi := 1;
        queue[1].x := a;
        queue[1].y := b;
        dem[1] := 0;
        min := maxlongint;
        repeat
                u := queue[dau];
                if u.x = u.y then
                begin
                        if u.x mod 2 = 0 then
                        begin
                                inc(cuoi);
                                queue[cuoi].x := u.x div 2;
                                queue[cuoi].y := u.y;
                                dem[cuoi] := dem[dau] + 1;
                        end;
                        if u.x mod 3 = 0 then
                        begin
                                inc(cuoi);
                                queue[cuoi].x := u.x div 3 * 2;
                                queue[cuoi].y := u.y;
                                dem[cuoi] := dem[dau] + 1;
                        end;
                end
                else
                begin
                        if u.x mod 2 = 0 then
                        begin
                                inc(cuoi);
                                queue[cuoi].x := u.x div 2;
                                queue[cuoi].y := u.y;
                                dem[cuoi] := dem[dau] + 1;
                        end;
                        if u.x mod 3 = 0 then
                        begin
                                inc(cuoi);
                                queue[cuoi].x := u.x div 3 * 2;
                                queue[cuoi].y := u.y;
                                dem[cuoi] := dem[dau] + 1;
                        end;
                        if u.y mod 2 = 0 then
                        begin
                                inc(cuoi);
                                queue[cuoi].x := u.x;
                                queue[cuoi].y := u.y div 2;
                                dem[cuoi] := dem[dau] + 1;
                        end;
                        if u.y mod 3 = 0 then
                        begin
                                inc(cuoi);
                                queue[cuoi].x := u.x;
                                queue[cuoi].y := u.y div 3 * 2;
                                dem[cuoi] := dem[dau] + 1;
                        end;
                end;
                inc(dau);
        until dau > cuoi;
        m := cuoi;
        dau := 1;
        cuoi := 1;
        queue2[1].x := c;
        queue2[1].y := d;
        dem2[1] := 0;
        repeat
                u := queue2[dau];
                for i := 1 to m do
                        if int64(u.x) * int64(u.y) = int64(queue[i].x) * int64(queue[i].y) then
                                if dem[i] + dem2[dau] < min then
                                begin
                                        min := dem[i] + dem2[dau];
                                        aa := queue[i].x;
                                        bb := queue[i].y;
                                        cc := u.x;
                                        dd := u.y;
                                end;
                if u.x = u.y then
                begin
                        if u.x mod 2 = 0 then
                        begin
                                inc(cuoi);
                                queue2[cuoi].x := u.x div 2;
                                queue2[cuoi].y := u.y;
                                dem2[cuoi] := dem2[dau] + 1;
                        end;
                        if u.x mod 3 = 0 then
                        begin
                                inc(cuoi);
                                queue2[cuoi].x := u.x div 3;
                                queue2[cuoi].y := u.y;
                                dem2[cuoi] := dem2[dau] + 1;
                        end;
                end
                else
                begin
                        if u.x mod 2 = 0 then
                        begin
                                inc(cuoi);
                                queue2[cuoi].x := u.x div 2;
                                queue2[cuoi].y := u.y;
                                dem2[cuoi] := dem2[dau] + 1;
                        end;
                        if u.x mod 3 = 0 then
                        begin
                                inc(cuoi);
                                queue2[cuoi].x := u.x div 3;
                                queue2[cuoi].y := u.y;
                                dem2[cuoi] := dem2[dau] + 1;
                        end;
                        if u.y mod 2 = 0 then
                        begin
                                inc(cuoi);
                                queue2[cuoi].x := u.x;
                                queue2[cuoi].y := u.y div 2;
                                dem2[cuoi] := dem2[dau] + 1;
                        end;
                        if u.y mod 3 = 0 then
                        begin
                                inc(cuoi);
                                queue2[cuoi].x := u.x;
                                queue2[cuoi].y := u.y div 3;
                                dem2[cuoi] := dem2[dau] + 1;
                        end;
                end;
                inc(dau);
        until dau > cuoi;
        if min = maxlongint then writeln(f , '-1')
        else
        begin
                writeln(f , min);
                writeln(f , aa , #32 , bb);
                writeln(f , cc , #32 , dd);
        end;
        close(f);
end;
//_______________________________________________________
begin
        nhap;
        xu_li;
end.

var f : text;
mu1 , mu2 : array[1..2] of longint;
a , b , c , d : longint;
//_______________________________________________________
procedure nhap;
begin
        assign(f , '');
        reset(f);
        readln(f , a , b , c , d);
        close(f);
        assign(f , '');
        rewrite(f);
end;
//_______________________________________________________
procedure xu_li;
var tam1 , tam2 : int64;
i , dem : longint;
begin
        tam1 := int64(a) * int64(b);
        while tam1 mod 2 = 0 do
        begin
                inc(mu1[1]);
                tam1 := tam1 div 2;
        end;
        while tam1 mod 3 = 0 do
        begin
                inc(mu1[2]);
                tam1 := tam1 div 3;
        end;
        tam2 := int64(c) * int64(d);
        while tam2 mod 2 = 0 do
        begin
                inc(mu2[1]);
                tam2 := tam2 div 2;
        end;
        while tam2 mod 3 = 0 do
        begin
                inc(mu2[2]);
                tam2 := tam2 div 3;
        end;
        dem := 0;
        if mu1[2] > mu2[2] then
        begin
                dem := dem + mu1[2] - mu2[2];
                mu1[1] := mu1[1] + mu1[2] - mu2[2];
                mu1[2] := mu2[2];
        end
        else
                if mu1[2] < mu2[2] then
                begin
                        mu2[1] := mu2[1] + mu2[2] - mu1[2];
                        mu2[2] := mu2[1];
                        dem := dem + mu2[2] - mu2[1];
                end;
        if mu1[1] > mu2[1] then
        begin
                dem := dem + mu1[1] - mu2[1];
                mu1[1] := mu2[1];
        end
        else
                if mu1[1] < mu2[1] then
                begin
                        dem := dem + mu2[1] - mu1[1];
                        mu2[1] := mu1[1];
                end;
        for i := 1 to mu1[1] do tam1 := tam1 * int64(2);
        for i := 1 to mu1[2] do tam1 := tam1 * int64(3);
        for i := 1 to mu2[1] do tam2 := tam2 * int64(2);
        for i := 1 to mu2[2] do tam2 := tam2 * int64(3);
        if tam1 = tam2 then
        begin
                writeln(f , dem);
                writeln(f , a , #32 , b);
                writeln(f , c , #32 , d);
        end
        else
                writeln(f , '-1');
        close(f);
end;
//_______________________________________________________
begin
        nhap;
        xu_li;
end.

var f : text;
mu1 , mu2 : array[1..2] of longint;
a , b , c , d : longint;
//_______________________________________________________
procedure nhap;
begin
        assign(f , '');
        reset(f);
        readln(f , a , b , c , d);
        close(f);
        assign(f , '');
        rewrite(f);
end;
//_______________________________________________________
procedure xu_li;
var tam1 , tam2 : int64;
i , dem : longint;
begin
        tam1 := int64(a) * int64(b);
        while tam1 mod 2 = 0 do
        begin
                inc(mu1[1]);
                tam1 := tam1 div 2;
        end;
        while tam1 mod 3 = 0 do
        begin
                inc(mu1[2]);
                tam1 := tam1 div 3;
        end;
        tam2 := int64(c) * int64(d);
        while tam2 mod 2 = 0 do
        begin
                inc(mu2[1]);
                tam2 := tam2 div 2;
        end;
        while tam2 mod 3 = 0 do
        begin
                inc(mu2[2]);
                tam2 := tam2 div 3;
        end;
        dem := 0;
        if mu1[2] > mu2[2] then
        begin
                dem := dem + mu1[2] - mu2[2];
                mu1[1] := mu1[1] + mu1[2] - mu2[2];
                mu1[2] := mu2[2];
        end
        else
                if mu1[2] < mu2[2] then
                begin
                        mu2[1] := mu2[1] + mu2[2] - mu1[2];
                        mu2[2] := mu2[1];
                        dem := dem + mu2[2] - mu2[1];
                end;
        if mu1[1] > mu2[1] then
        begin
                dem := dem + mu1[1] - mu2[1];
                mu1[1] := mu2[1];
        end
        else
                if mu1[1] < mu2[1] then
                begin
                        dem := dem + mu2[1] - mu1[1];
                        mu2[1] := mu1[1];
                end;
        for i := 1 to mu1[1] do tam1 := tam1 * int64(2);
        for i := 1 to mu1[2] do tam1 := tam1 * int64(3);
        for i := 1 to mu2[1] do tam2 := tam2 * int64(2);
        for i := 1 to mu2[2] do tam2 := tam2 * int64(3);
        if tam1 = tam2 then writeln(f , dem)
        else
                writeln(f , '-1');
        close(f);
end;
//_______________________________________________________
begin
        nhap;
        xu_li;
end.

Program PBD;
Const   ss=0.0000000001;
Var     a,b,a1,b1:longint;
        s1,s2,v1,v2:int64;
        c:array[1..2,1..2] of integer;
        r:array[1..2,1..2] of integer;
        i,j,k,t,res:integer;
Procedure tinh(val:int64;var d1,d2:integer);
Begin
        While val mod 2=0 do
          Begin
            inc(d1);
            val:=val div 2;
          End;
        While val mod 3=0 do
          Begin
            inc(d2);
            val:=val div 3;
          End;
End;
Begin
        readln(a,b);
        s1:=a*b;
        readln(a1,b1);
        s2:=a1*b1;
        fillchar(c,sizeof(c),0);
        tinh(s1,c[1,1],c[1,2]);
        tinh(s2,c[2,1],c[2,2]);
        res:=high(integer);
        For i:=0 to c[1,2] do
          For j:=0 to c[1,1]+i do
            For k:=0 to c[2,2] do
              Begin
                v1:=trunc(s2/exp(k*ln(3/2)));
                v2:=trunc(s1/(exp(i*ln(3/2))*exp(j*ln(2))));
                if  (v1 mod v2=0) and (abs(trunc(ln(v1/v2)/ln(2))-ln(v1/v2)/ln(2))<=ss) and (i+j+k+trunc(ln(v1/v2)/ln(2))<res) then
                  Begin
                    res:=i+j+k+trunc(ln(v1/v2)/ln(2));
                    r[1,1]:=j;
                    r[1,2]:=i;
                    r[2,1]:=trunc(ln(v1/v2)/ln(2));
                    r[2,2]:=k;
                  End;
              End;
        If res<high(integer) then
          Begin
            writeln(res);
            While (r[1,2]>0) and (a mod 3=0) do
              Begin
                a:=(a div 3)*2;
                dec(r[1,2]);
              End;
            While (r[1,2]>0) and (b mod 3=0) do
              Begin
                b:=(b div 3)*2;
                dec(r[1,2]);
              ENd;
            While (r[1,1]>0) and (a mod 2=0) do
              Begin
                a:=a div 2;
                dec(r[1,1]);
              End;
            While (r[1,1]>0) and (b mod 2=0) do
              Begin
                b:=b div 2;
                dec(r[1,1]);
              ENd;
            While (r[2,2]>0) and (a1 mod 3=0) do
              Begin
                a1:=(a1 div 3)*2;
                dec(r[2,2]);
              End;
            While (r[2,2]>0) and (b1 mod 3=0) do
              Begin
                b1:=(b1 div 3)*2;
                dec(r[2,2]);
              ENd;
            While (r[2,1]>0) and (a1 mod 2=0) do
              Begin
                a1:=a1 div 2;
                dec(r[2,1]);
              End;
            While (r[2,1]>0) and (b1 mod 2=0) do
              Begin
                b1:=b1 div 2;
                dec(r[2,1]);
              ENd;
            writeln(a,' ',b);
            writeln(a1,' ',b1);
          End
        else write(-1);
End.

Program PBD;
Const   ss=0.0000000001;
Var     a,b,a1,b1:longint;
        s1,s2,v1,v2:int64;
        c:array[1..2,1..2] of integer;
        r:array[1..2,1..2] of integer;
        i,j,k,t,res:integer;
Procedure tinh(val:int64;var d1,d2:integer);
Begin
        While val mod 2=0 do
          Begin
            inc(d1);
            val:=val div 2;
          End;
        While val mod 3=0 do
          Begin
            inc(d2);
            val:=val div 3;
          End;
End;
Begin
        readln(a,b);
        s1:=a*b;
        readln(a1,b1);
        s2:=a1*b1;
        fillchar(c,sizeof(c),0);
        tinh(s1,c[1,1],c[1,2]);
        tinh(s2,c[2,1],c[2,2]);
        res:=high(integer);
        For i:=0 to c[1,2] do
          For j:=0 to c[1,1]+i do
            For k:=0 to c[2,2] do
              Begin
                v1:=round(s2/exp(k*ln(3/2)));
                v2:=round(s1/(exp(i*ln(3/2))*exp(j*ln(2))));
                if  (v1 mod v2=0) and (abs(round(ln(v1/v2)/ln(2))-ln(v1/v2)/ln(2))<=ss) and (i+j+k+round(ln(v1/v2)/ln(2))<res) then
                  Begin
                    res:=i+j+k+round(ln(v1/v2)/ln(2));
                    r[1,1]:=j;
                    r[1,2]:=i;
                    r[2,1]:=round(ln(v1/v2)/ln(2));
                    r[2,2]:=k;
                  End;
              End;
        If res<high(integer) then
          Begin
            writeln(res);
            While (r[1,2]>0) and (a mod 3=0) do
              Begin
                a:=(a div 3)*2;
                dec(r[1,2]);
              End;
            While (r[1,2]>0) and (b mod 3=0) do
              Begin
                b:=(b div 3)*2;
                dec(r[1,2]);
              ENd;
            While (r[1,1]>0) and (a mod 2=0) do
              Begin
                a:=a div 2;
                dec(r[1,1]);
              End;
            While (r[1,1]>0) and (b mod 2=0) do
              Begin
                b:=b div 2;
                dec(r[1,1]);
              ENd;
            While (r[2,2]>0) and (a1 mod 3=0) do
              Begin
                a1:=(a1 div 3)*2;
                dec(r[2,2]);
              End;
            While (r[2,2]>0) and (b1 mod 3=0) do
              Begin
                b1:=(b1 div 3)*2;
                dec(r[2,2]);
              ENd;
            While (r[2,1]>0) and (a1 mod 2=0) do
              Begin
                a1:=a1 div 2;
                dec(r[2,1]);
              End;
            While (r[2,1]>0) and (b1 mod 2=0) do
              Begin
                b1:=b1 div 2;
                dec(r[2,1]);
              ENd;
            writeln(a,' ',b);
            writeln(a1,' ',b1);
          End
        else write(-1);
End.

var a,b,c,d,x,y,z,k11,k12,k21,k22,ans:longint;
begin
//assign(input,'qkl.in');reset(input);
//assign(output,'qkl.out');rewrite(output);
read(a,b);
read(c,d);
x:=a*b;y:=c*d;
while x mod 2=0 do begin x:=x div 2;k11:=k11+1; end;
while x mod 3=0 do begin x:=x div 3;k12:=k12+1; end;
while y mod 2=0 do begin y:=y div 2;k21:=k21+1; end;
while y mod 3=0 do begin y:=y div 3;k22:=k22+1; end;
if x<>y then begin write(-1);close(input);close(output);halt; end;
z:=k12-k22;
while z<>0 do
  begin
  if z<0 then
    begin
    if c mod 3=0 then c:=c div 3*2 else d:=d div 3*2;
    z:=z+1;k21:=k21+1;ans:=ans+1;
    end
  else
    begin
    if a mod 3=0 then a:=a div 3*2 else b:=b div 3*2;
    z:=z-1;k11:=k11+1;ans:=ans+1;
    end;
  end;
z:=k11-k21;
while z<>0 do
  begin
  if z<0 then
    begin
    if c mod 2=0 then c:=c div 2 else d:=d div 2;
    z:=z+1;ans:=ans+1;
    end
  else
    begin
    if a mod 2=0 then a:=a div 2 else b:=b div 2;
    z:=z-1;ans:=ans+1;
    end;
  end;
writeln(ans);
writeln(a,' ',b);
writeln(c,' ',d);
close(input);close(output);
end.

uses math;
type mass=array[1..4,0..41] of int64;
     majj=array[0..100000] of longint;
var n,res,i:longint;s1,s,s2:string;
    uk,e,l,r,ans,kol,x,j,y,rr,ans1,k,z, ab, bc, ac, abc : longint;
    u:boolean;
    a,b,c,d:int64;
    m:majj;
    m1,m2:mass;
procedure factor(a:int64;z:longint);
var i:longint;
Begin
   i:=2;
   while a>1 do
     Begin
        if i*i>a
        then Begin
                inc(m1[z,0]);
                m1[z,m1[z,0]]:=a;
                m2[z,m1[z,0]]:=1;
                exit;
             end;
        if (a mod i=0) and (m[i]=0)
        then Begin
                inc(m1[z,0]);
                m1[z,m1[z,0]]:=i;
                while a mod i=0 do
                   Begin
                      a:=a div i;
                      inc(m2[z,m1[z,0]]);
                   end;
             end;
        inc(i);
     end;
end;
begin
//   assign(input,'input.txt'); assign(output,'output.txt');
   readln(a,b,c,d);
   m[1]:=1;
   for i:=2 to 100000 do
      if m[i]=0
      then Begin
             j:=i+i;
             while j<=100000 do
                Begin
                   m[j]:=1;
                   inc(j,i);
                end;
           end;
   factor(a,1);
   factor(b,2);
   factor(c,3);
   factor(d,4);
   for e:=1 to 2 do
     for i:=1 to m1[e,0] do
        if (m1[e,i]<>2) and (m1[e,i]<>3)
        then Begin
               a:=0;
               for z:=3 to 4 do
                 for j:=1 to m1[z,0] do
                     if m1[z,j]=m1[e,i]
                     then inc(a,m2[z,j]);
               if a<>m2[e,i]
               then Begin
                       writeln(-1);
                       halt(0);
                    end;
             end;
   for e:=3 to 4 do
     for i:=1 to m1[e,0] do
        if (m1[e,i]<>2) and (m1[e,i]<>3)
        then Begin
               a:=0;
               for z:=1 to 2 do
                 for j:=1 to m1[z,0] do
                     if m1[z,j]=m1[e,i]
                     then inc(a,m2[z,j]);
               if a<>m2[e,i]
               then Begin
                       writeln(-1);
                       halt(0);
                    end;
             end;
   res:=0;
   a:=0;
   for e:=1 to 2 do
      for i:=1 to m1[e,0] do
         if m1[e,i]=3
         then inc(a,m2[e,i]);
   b:=0;
   for e:=3 to 4 do
      for i:=1 to m1[e,0] do
         if m1[e,i]=3
         then inc(b,m2[e,i]);
   inc(res,abs(a-b));
   if a>b
   then Begin
            for e:=1 to 2 do
               for i:=1 to m1[e,0] do
                  if m1[e,i]=3
                  then Begin
                          while (m2[e,i]>0) and (a>b) do
                             Begin
                                dec(a);
                                dec(m2[e,i]);
                                if i<>1
                                then inc(m2[e,1])
                                else Begin
                                        inc(m1[e,0]);
                                        m1[e,m1[e,0]]:=2;
                                        m2[e,m1[e,0]]:=1;
                                     end;
                             end;
                          break;
                       end;
        end
   else Begin
            for e:=3 to 4 do
               for i:=1 to m1[e,0] do
                  if m1[e,i]=3
                  then Begin
                          while (m2[e,i]>0) and (b>a) do
                             Begin
                                dec(b);
                                dec(m2[e,i]);
                                if i<>1
                                then inc(m2[e,1])
                                else Begin
                                        inc(m1[e,0]);
                                        m1[e,m1[e,0]]:=2;
                                        m2[e,m1[e,0]]:=1;
                                     end;
                             end;
                          break;
                       end;
        end;
   a:=0;
   for e:=1 to 2 do
      for i:=1 to m1[e,0] do
         if m1[e,i]=2
         then inc(a,m2[e,i]);
   b:=0;
   for e:=3 to 4 do
      for i:=1 to m1[e,0] do
         if m1[e,i]=2
         then inc(b,m2[e,i]);
   inc(res,abs(a-b));
   if a>b
   then for e:=1 to 2 do
           for i:=1 to m1[e,0] do
              if m1[e,i]=2
              then while (m1[e,i]>0) and (a>b) do
                      Begin
                         dec(a);
                         dec(m1[e,i]);
                      end
              else
   else for e:=3 to 4 do
           for i:=1 to m1[e,0] do
               if m1[e,i]=2
               then while (m1[e,i]>0) and (b>a) do
                       Begin
                          dec(b);
                          dec(m1[e,i]);
                       end;
   writeln(res);
   for i:=1 to 4 do
      Begin
         a:=1;
         for z:=1 to m1[i,0] do
            for j:=1 to m2[i,z] do
               a:=a*m1[i,z];
         write(a,' ');
         if i=2
         then writeln;
      end;
end.

uses math;
type mass=array[1..4,0..41] of int64;
     majj=array[0..100000] of longint;
var n,res,i:longint;s1,s,s2:string;
    uk,e,l,r,ans,kol,x,j,y,rr,ans1,k,z, ab, bc, ac, abc : longint;
    u:boolean;
    a,b,c,d:int64;
    m:majj;
    m1,m2:mass;
procedure factor(a:int64;z:longint);
var i:longint;
Begin
   i:=2;
   while a>1 do
     Begin
        if i*i>a
        then Begin
                inc(m1[z,0]);
                m1[z,m1[z,0]]:=a;
                m2[z,m1[z,0]]:=1;
                exit;
             end;
        if (a mod i=0) and (m[i]=0)
        then Begin
                inc(m1[z,0]);
                m1[z,m1[z,0]]:=i;
                while a mod i=0 do
                   Begin
                      a:=a div i;
                      inc(m2[z,m1[z,0]]);
                   end;
             end;
        inc(i);
     end;
end;
begin
//   assign(input,'input.txt'); assign(output,'output.txt');
   readln(a,b);
   readln(c,d);
   m[1]:=1;
   for i:=2 to 100000 do
      if m[i]=0
      then Begin
             j:=i+i;
             while j<=100000 do
                Begin
                   m[j]:=1;
                   inc(j,i);
                end;
           end;
   factor(a,1);
   factor(b,2);
   factor(c,3);
   factor(d,4);
   for e:=1 to 2 do
     for i:=1 to m1[e,0] do
        if (m1[e,i]<>2) and (m1[e,i]<>3)
        then Begin
               a:=0;
               for z:=3 to 4 do
                 for j:=1 to m1[z,0] do
                     if m1[z,j]=m1[e,i]
                     then inc(a,m2[z,j]);
               if a<>m2[e,i]
               then Begin
                       writeln(-1);
                       halt(0);
                    end;
             end;
   for e:=3 to 4 do
     for i:=1 to m1[e,0] do
        if (m1[e,i]<>2) and (m1[e,i]<>3)
        then Begin
               a:=0;
               for z:=1 to 2 do
                 for j:=1 to m1[z,0] do
                     if m1[z,j]=m1[e,i]
                     then inc(a,m2[z,j]);
               if a<>m2[e,i]
               then Begin
                       writeln(-1);
                       halt(0);
                    end;
             end;
   res:=0;
   a:=0;
   for e:=1 to 2 do
      for i:=1 to m1[e,0] do
         if m1[e,i]=3
         then inc(a,m2[e,i]);
   b:=0;
   for e:=3 to 4 do
      for i:=1 to m1[e,0] do
         if m1[e,i]=3
         then inc(b,m2[e,i]);
   inc(res,abs(a-b));
   if a>b
   then Begin
            for e:=1 to 2 do
               for i:=1 to m1[e,0] do
                  if m1[e,i]=3
                  then Begin
                          while (m2[e,i]>0) and (a>b) do
                             Begin
                                dec(a);
                                dec(m2[e,i]);
                                if i<>1
                                then inc(m2[e,1])
                                else Begin
                                        inc(m1[e,0]);
                                        m1[e,m1[e,0]]:=2;
                                        m2[e,m1[e,0]]:=1;
                                     end;
                             end;
                          break;
                       end;
        end
   else Begin
            for e:=3 to 4 do
               for i:=1 to m1[e,0] do
                  if m1[e,i]=3
                  then Begin
                          while (m2[e,i]>0) and (b>a) do
                             Begin
                                dec(b);
                                dec(m2[e,i]);
                                if i<>1
                                then inc(m2[e,1])
                                else Begin
                                        inc(m1[e,0]);
                                        m1[e,m1[e,0]]:=2;
                                        m2[e,m1[e,0]]:=1;
                                     end;
                             end;
                          break;
                       end;
        end;
   a:=0;
   for e:=1 to 2 do
      for i:=1 to m1[e,0] do
         if m1[e,i]=2
         then inc(a,m2[e,i]);
   b:=0;
   for e:=3 to 4 do
      for i:=1 to m1[e,0] do
         if m1[e,i]=2
         then inc(b,m2[e,i]);
   inc(res,abs(a-b));
   if a>b
   then for e:=1 to 2 do
           for i:=1 to m1[e,0] do
              if m1[e,i]=2
              then while (m2[e,i]>0) and (a>b) do
                      Begin
                         dec(a);
                         dec(m2[e,i]);
                      end
              else
   else for e:=3 to 4 do
           for i:=1 to m1[e,0] do
               if m1[e,i]=2
               then while (m2[e,i]>0) and (b>a) do
                       Begin
                          dec(b);
                          dec(m2[e,i]);
                       end;
   writeln(res);
   for i:=1 to 4 do
      Begin
         a:=1;
         for z:=1 to m1[i,0] do
            for j:=1 to m2[i,z] do
               a:=a*m1[i,z];
         write(a,' ');
         if i=2
         then writeln;
      end;
end.

                              {$APPTYPE CONSOLE}
const  besk=1000000000;
   nnn=2000000;  eps=1e-13;
 label 1,2,3,4;
var ot,nn,chel,znam,dl,len,ii,jj,i3,i2,i1,j1,k1,kt,ppp,god,day,mon,mask,i0,j0,k,step,i,j,start,finish,m:longint;
p1,p2,n,yy1,xx1,xx2,q,xx,yy,t1,t2,p,t,aa,modul,pp,tt,ot1,ot2,s,kold,kkr:int64;
ostminus,kk,centr,koef:int64;
flag2,flag1,flag:boolean;
minotkl,dl1,dl2,dl3,hh,po,pt,doltek,dolpred:extended;
b,uvel,a,f,h,kop:array[0..2000000] of int64;
gr,c,x,y: array[-10..500,0..500] of int64;
ver: array[-10..51,-10..100,-10..100] of extended;
zan,bb,marked:array[-100000..250000] of boolean;
{ss:array[0..2000000] of char; }
ss:string;
ch11,ch12,ch1,ch:char;
dd: array[-10..100,-10..100,-10..100] of {int64}extended;
kol,rr,sl,sr,stoim,str :array[-10 ..200000] of int64;
ssot:array[-1000..110000] of string;
fact:array[0..100] of extended;
name:array[0..2000] of string;
function min (a,b:int64):int64;begin min:=b;if a<b then min:=a;  end;
function max (a,b:int64):int64;begin max:=b;if a>b then max:=a;  end;

    function nod(a,b:int64):int64; var p,t:int64;
begin if (a>0)and(b>0) then
   begin while (b>0) do begin t:=a mod b;a:=b;b:=t;    end;
    p:=a;
   end else if a=0 then p:=b else p:=a;
nod:=p;
end;

function deg2(pp:int64):int64; var ot,i,j:longint;
  begin
     ot:=0;
     while pp mod 2=0 do begin  pp:=pp div 2; inc(ot);   end;
   deg2:=ot;
  end;

function deg3(pp:int64):int64; var ot,i,j:longint;
  begin
     ot:=0;
     while pp mod 3=0 do begin  pp:=pp div 3; inc(ot);   end;
   deg3:=ot;
  end;

begin
   { assign (input,'input.txt');reset(input);
      assign (output,'output.txt'); rewrite(output);
    }
 n:=4; for i:=1 to n do read(a[i]);
  p1:=a[1]*a[2];
  p2:=a[3]*a[4];
  while p1 mod 2= 0 do p1:=p1 div 2;
  while p2 mod 2= 0 do p2:=p2 div 2;

  while p1 mod 3= 0 do p1:=p1 div 3;
  while p2 mod 3= 0 do p2:=p2 div 3;

  if p1<>p2 then begin  writeln(-1); goto 1;    end;
  ot:=0;
  while deg3(a[1]*a[2])>deg3(a[3]*a[4]) do
    begin
       if (deg3(a[1])>0)and(deg3(a[1]*a[2])>deg3(a[3]*a[4])) then
       begin  a[1]:=(a[1] div 3)*2;  inc(ot);   end;

       if (deg3(a[2])>0)and(deg3(a[1]*a[2])>deg3(a[3]*a[4])) then
       begin  a[2]:=(a[2] div 3)*2;  inc(ot);   end;

    end;

 while deg2(a[1]*a[2])>deg2(a[3]*a[4]) do
    begin
       if (deg2(a[1])>0)and(deg2(a[1]*a[2])>deg2(a[3]*a[4])) then
       begin  a[1]:=(a[1] div 2);  inc(ot);   end;

       if (deg2(a[2])>0)and(deg2(a[1]*a[2])>deg2(a[3]*a[4])) then
       begin  a[2]:=(a[2] div 2);  inc(ot);   end;

    end;

  while deg3(a[1]*a[2])<deg3(a[3]*a[4]) do
    begin
       if (deg3(a[3])>0)and(deg3(a[1]*a[2])<deg3(a[3]*a[4])) then
       begin  a[3]:=(a[3] div 3)*2;  inc(ot);   end;

       if (deg3(a[4])>0)and(deg3(a[1]*a[2])<deg3(a[3]*a[4])) then
       begin  a[4]:=(a[4] div 3)*2;  inc(ot);   end;

    end;

 while deg2(a[1]*a[2])<deg2(a[3]*a[4]) do
    begin
       if (deg2(a[3])>0)and(deg2(a[1]*a[2])<deg2(a[3]*a[4])) then
       begin  a[3]:=(a[3] div 2);  inc(ot);   end;

       if (deg2(a[4])>0)and(deg2(a[1]*a[2])<deg2(a[3]*a[4])) then
       begin  a[4]:=(a[4] div 2);  inc(ot);   end;

    end;

    writeln(ot);
    writeln(a[1],' ',a[2]);
    writeln(a[3],' ',a[4]);

   1:          close(output);
end.