RemoveTwo[x_]  :=  
      Module[{i},  i  =  x;  
        While[  Mod[i, 2]  ==  0,  i  =  i / 2];  
        Return[i]]

RemoveTwo[248]

F[x_]  :=  RemoveTwo[ 5*RemoveTwo[x]  +  1]

F[7]

"We now give a code to check the first digits of the 3x+1 \
problem"

F3[x_]  :=  RemoveTwo[ 3*RemoveTwo[x]  +  1];

ben3[start_,  num_]  :=  
        Module[ {d, m, j, x}, 
For[m = 1,  
            m ≤  9,  m++,  
            numdig[m]  =  0]; 
x  =  
            start; 
count  =  0; 
For[
            j  =  1,  
            j  ≤  
              num,  j++, 
{
  
numdig[   Mod[  Floor[
                      x*1.0 / 10^Floor[Log [10,  x]] ],  
                    10 ] ]++; 
count  =  
                count + 1; 
x  =  
                F3[x]; 
If[x  ==  1,  
                j  =  num  +  
                    5];
}]; 
bF[
              y_]  :=  numdig[Floor[y  +   .5]] /
              count; 
ben[y_]  :=  
            Log[10,  
              1  +  (1.0/y)]; 
Plot[ {bF[y],  
              ben[y]},  {y,  .5, 
              9.5}]; 
Print["Count (the number of terms \
before we hit one) = ",  
            count]; 
Print["The number is approximately \
10^",  Floor[Log[10, 1.0 start]]];
];

ben3[
      12398999999991111919919191534758345728579345729345729579367345898503258203458358238562068683485034852045834583683946895865386498650948648035385345839583908539458903854684568093859348023523459036904683046830958348509284092859034850386093485305834958368945864568349503495453594056945694563464565464564534549346803486365467045834985283453453543535345472935738457349674385738572808782074310472085738638573457207502348930530457340674675763054025820958305834953068390468456745768347524029401983210932748357348573751307530135703485784572037452057283420742057346703572875305702357207205725734067306703485025242351513432424385743568746845764875834578927428374389457348957439867345630589304583409584684568456408634850934850349654670598459609205305830589248204830583045630670546745670458934829084092181083420475495767586745673045702753857027207502758434534597684435234523423488047583080280252407485736743805820528348347586780457305113453509029402530520702752020342837410742058534680153889898947577584587483938311, 
      10000]

"We see from the above that, dividing by the highest power of 2, \
things do look Benford."

"We now give a new code, without removing highest power of 2s"

bennoremove[start_,  num_]  :=  
        Module[ {d, m, j, x}, 
For[m = 1,  
            m ≤  9,  m++,  
            numdig[m]  =  0]; 
x  =  
            start; 
count  =  0; 
For[
            j  =  1,  
            j  ≤  
              num,  j++, 
{
  
numdig[   Mod[  Floor[
                      x*1.0 / 10^Floor[Log [10,  x]] ],  
                    10 ] ]++; 
count  =  
                count + 1; 
If[Mod[x, 2]  ==  0,  
                x  =  x/2,  
                x  =  (3 x  +  1)];; 
If[
                x  ==  1,  
                j  =  num  +  
                    5];
}]; 
bF[
              y_]  :=  numdig[Floor[y  +   .5]] /
              count; 
ben[y_]  :=  
            Log[10,  
              1  +  (1.0/y)]; 
Plot[ {bF[y],  
              ben[y]},  {y,  .5, 
              9.5}]; 
Print["Count (the number of terms \
before we hit one) = ",  
            count]; 
Print["The number is approximately \
10^",  Floor[Log[10, 1.0 start]]];
];

bennoremove[
      12398999999991111919919191534758345728579345729345729579367345898503258203458358238562068683485034852045834583683946895865386498650948648035385345839583908539458903854684568093859348023523459036904683046830958348509284092859034850386093485305834958368945864568349503495453594056945694563464565464564534549346803486365467045834985283453453543535345472935738457349674385738572808782074310472085738638573457207502348930530457340674675763054025820958305834953068390468456745768347524029401983210932748357348573751307530135703485784572037452057283420742057346703572875305702357207205725734067306703485025242351513432424385743568746845764875834578927428374389457348957439867345630589304583409584684568456408634850934850349654670598459609205305830589248204830583045630670546745670458934829084092181083420475495767586745673045702753857027207502758434534597684435234523423488047583080280252407485736743805820528348347586780457305113453509029402530520702752020342837410742058534680153889898947577584587483938311, 
      50000]

numdig[5]

\(g[x_, \ end_]\  := \ 
      Module[\ {numat, \ 
          tempplot}, 
tempplot\  = \ {\ {0, 
              0}\ }; 
numat\  = \ 
          RemoveTwo[x]; \ 
\ \ \ \ For[j = \ 1, \ 
            j\  ≤ \ 
              end, \ \ \(j++\), \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ {\ \ 
Print["x = ", \ 
                numat, \ " and goes to ", \ 
                F[numat]]; 
AppendTo[\ 
                tempplot, \ {j, \ numat}\ ]; 
numat\  = \ 
                F[numat];\ }\ ]\ 
ListPlot[\ tempplot, \ 
            PlotJoined\  -> \ True]\ ]\)

\(glog[x_, \ end_]\  := \ 
      Module[\ {numat, \ tempplot, \ numdig, \ lognumdig, \ m, y, \ 
          temp}, 
Clear[tempplot]; \ 
        Clear[temp]; 
For[m\  = \ 1, \ 
          m\  ≤ \ 9, \ \(m++\), \ {\ lognumdig[m]\  = \ 0; \ 
            numdig[m]\  = \ 
              0;\ }\ ]; 
tempplot\  = \ {\ {0, 
              0}\ }; 
numat\  = \ 
          RemoveTwo[x]; \ 
\ \ \ \ For[j = \ 1, \ 
            j\  ≤ \ 
              end, \ \ \(j++\), \ 
\ \ \ \ \ \ {\ \ 
If[\ 
                Mod[j, \ 1000]\  == \ 
                  0, \ \(Print["j = ", \ j, \ " x = ", \ 
                    numat, \ " and goes to ", \ 
                    F[numat]];\)\ ]; 
AppendTo[\ 
                tempplot, \ {j, \ 
                  Log[E, numat]}\ ]; 
AppendTo[\ 
                tempplot, \ \ {j, \ 
                  Log[E, \ 1.25]\ *\ j\  + \ 
                    Log[E, x]}]; 
\(numdig[\ \ \ Mod[\ \ Floor[numat*1.0\ /\ 10^Floor[Log\ [10, \ numat]]\ ], \ 
                    10\ ]\ ]++\); 
temp\  = \ 
                Exp[Log[10, \ numat]\  - \ 
                    j*Log[10, \ 
                        1.25]]; 
\(lognumdig[\ \ \ Mod[\ \ Floor[temp*1.0\ /\ 10^Floor[Log\ [10, \ temp]]\ ], \ 
                    10\ ]\ ]++\); 
numat\  = \ 
                F[numat];
\ }\ 
]\ 
ListPlot[\ tempplot, \ 
            PlotJoined\  -> False]\ ; 
Clear[
          tempplot]; \ 
        tempplot\  = \ {\ {0, 0}\ }; 
For[\ m\  = \ 1, \ 
          m\  ≤ \ 9, \ \(m++\), \ 
          AppendTo[
            tempplot, \ {m, \ 
              1.0*numdig[m]\ /\ end}]]; 
ListPlot[\ 
          tempplot]; 
Clear[
          tempplot]; 

bF[y_]\  := \ 
          numdig[Floor[y\  + \  .5]]\ /\ end; 
ben[
            y_]\  := \ Log[10, \ 
            1\  + \ \((1.0/y)\)]; 
Plot[\ {bF[y], \ 
            ben[y]}, \ {y,  .5, 
            9.5}]; 

\ 
        tempplot\  = \ {\ {0, 0}\ }; 
For[\ m\  = \ 1, \ 
          m\  ≤ \ 9, \ \(m++\), \ 
          AppendTo[
            tempplot, \ {m, \ 
              1.0*lognumdig[m]\ /\ end}]]; 
 (*\ \(ListPlot[
              tempplot];\)\ *) 

logbF[
            y_]\  := \ lognumdig[Floor[y\  + \  .5]]\ /\ 
            end; 
Plot[\ {logbF[y], \ ben[y]}, \ {y,  .5, 
            9.5}];
\ ]\)

glog[421, 1500]

\(gbm[end_]\  := \ 
      Module[\ {numat, \ tempplot, \ numdig, \ lognumdig, \ m, y, \ 
          temp}, 
Clear[tempplot]; \ 
        Clear[temp]; 
For[m\  = \ 1, \ 
          m\  ≤ \ 
            9, \ \(m++\), \ \ \(numdig[m]\  = \ 
              0;\)\ \ ]; 
tempplot\  = \ {\ {0, 
              0}\ }; 
runsum\  = \ 
          0; 
\ \ \ \ For[j = \ 1, \ 
            j\  ≤ \ 
              end, \ \ \(j++\), \ 
\ \ \ \ \ \ {\ \ 
If[\ 
                Mod[j, \ 1000]\  == \ 
                  0, \ \(Print["j = ", \ 
                    j\ ];\)]; 
runsum\  = \ 
                runsum\  + \ 
                  Log[10, \ Sqrt[211.1]]\ *2\ *\ 
                    Random[Integer]; 
AppendTo[\ 
                tempplot, \ {j, \ runsum}\ ]; 
AppendTo[\ 
                tempplot, \ \ {j, \ 
                  j*\ Log[10, Sqrt[211.1]]\ }]; 
If\ [
                runsum\  ≠ \ 0, 
{\ 
                  temp\  = \ 
                    10^runsum; 
\(numdig[\ \ \ Mod[\ \ Floor[temp*1.0\ /\ 10^\((Floor[Log\ [10, \ temp]]\ )\)], \ 
                        10\ ]\ ]++\);
}];
\ }\ 
]\ 
ListPlot[\ tempplot, \ 
            PlotJoined\  -> False]\ ; 
Clear[
          tempplot]; \ 
        tempplot\  = \ {\ {0, 0}\ }; 
For[\ m\  = \ 1, \ 
          m\  ≤ \ 9, \ \(m++\), \ 
          AppendTo[
            tempplot, \ {m, \ 
              1.0*numdig[m]\ /\ 
                  end}]]; 

bF[y_]\  := \ 
          numdig[Floor[y\  + \  .5]]\ /\ end; 
ben[
            y_]\  := \ Log[10, \ 
            1\  + \ \((1.0/y)\)]; 
Plot[\ {bF[y], \ 
            ben[y]}, \ {y,  .5, 9.49}];
\ ]\)

gbm[5000]