# Writing a program that divide numbers until I hit a one digit number

Well, I have the following question:

How can I write a program such that an input number $$n$$ is divided by the number $$k$$ as long as the resulting number does not have one digit, if the resulting number is not an integer we need to take the floor-function of the fraction. Then I need to count how many divisions it took to do that.

Example:

When I have the number $$n=100$$ and $$k=2$$. Now divide the number by $$2$$ to get $$n/k=50$$, that is not a one digit number so we divide by $$2$$ again and get $$n/(2k)=25$$, still not a one digit number so divide by $$2$$ again $$n/(3k)=12.5$$ which is not an integer so we need to take the floor function $$\lfloor12.5\rfloor=12$$ now divide by $$2$$ again and get $$6$$ which is a one digit number so we stop. The number of divisions is: $$4$$.

• What have you tried so far? Jun 11, 2020 at 9:55
• @yarchik I have no clue where to start. Jun 11, 2020 at 10:21
• If I'm not mistaken, the number of divisions required is always $d = \lfloor \log_k (n/10) \rfloor + 1$. This can be proven by noting that all integers between $10, ... 10k - 1$ require one division by $k$ to be reduced to one digit, all integers between $10k, ... 10k^2 - 1$ require two divisions to be reduced to one digit, and in general all integers between $10 k^{d-1}, ... 10 k^d - 1$ require $d$ divisions to be reduced to one digit. (This can be proved formally by induction.) But this is more of mathematical proof than a program, and the question specifically requested a program. Jun 11, 2020 at 20:12
• So basically the question is how to write a program that calculates the logarithm. Jun 13, 2020 at 14:43

One way might be

NestWhileList[Floor[#/2] &, 100, Length[IntegerDigits[Floor[#]]] > 1 &]

(* {100, 50, 25, 12, 6} *)

NestWhileList[Floor[#/2] &, 500,Length[IntegerDigits[Floor[#]]] > 1 &]

(* {500, 250, 125, 62, 31, 15, 7} *)


Or if you prefer to code it yourself

foo[n_Integer, k_Integer] := Module[{z},
If[k == 0, Return["Error k=0", Module]];
If[n == 0, Print[0]; Return[Null, Module]];
If[k == 1, Print[n]; Return[Null, Module]];
If[Abs[n] < Abs[k], Print[n]; Return[Null, Module]];
If[n == k, Print[1]; Return[Null, Module]];
Print[n];
z = n/k;

If[Length[IntegerDigits[Floor[z]]] == 1,
Print[Floor[z]];
Return[Null, Module]
,
foo[Floor[z], k]
];
];

foo[100, 2]


   foo[500, 2]


• Nice procedural approach ;-) ... good programmers write FORTRAN (BASIC, Java, C...) code in every language Jun 11, 2020 at 10:50
• Is it Ok that foo[1,2] yields 1, 0 ? Jun 11, 2020 at 11:00
• @yarchik I thought I had check for n<k, I must forgot it. Added now. Thanks. The procedural version was just for fun. I would use the Mathematica build in version myself. Jun 11, 2020 at 11:05

You can also use

### FixedPointList

ClearAll[quotients1]

quotients1[n_, k_] := Most @
FixedPointList[If[IntegerLength[#] > 1, Quotient[#, k], #] &, n]


Examples:

quotients1[100, 2]

 {100, 50, 25, 12, 6}

quotients1[950, 3]

 {950, 316, 105, 35, 11, 3}


### ReplaceRepeated

ClearAll[quotients2]

quotients2[n_, k_] := {n} //.
{a___, b_} /; IntegerLength[b] > 1 :> {a, b,  Quotient[b, k]}


Examples:

quotients2[100, 2]

 {100, 50, 25, 12, 6}

quotients2[950, 3]

 {950, 316, 105, 35, 11, 3}

g[x_ /; x <= 9] := x
g[x_ /; x > 9] := Floor[x/2]


Most@FixedPointList[g,500]


{500, 250, 125, 62, 31, 15, 7}