4
$\begingroup$

The DigitCount[n,b] function "counts the gives a list of the numbers of $1, 2, \ldots, b-1, 0$ digits in the base-$b$ representation of $n$".

I want to extend this to negative bases, for instance when $b=-2$. Is there already a function for this is Mathematica? Or perhaps a "quick" solution?

Question

How to extend DigitCount[n,b] for negative b?

Due diligence

Wikipedia's Negative base article provides code examples to calculate negative base representation in various languages, but no Wolfram Language.

BaseForm, IntegerDigits and IntegerLength explicitly state in their error messages that the bases must be integers larger than $1$, so it seems that current versions of Mathematica do not have built-in implementations for negative basis.

BaseForm[42, -2] 

BaseForm::intpm: Positive machine-sized integer expected at position 2 in BaseForm[42, -2]

IntegerDigits[42, -2]

IntegerDigits::ibase: Base -2 is not an integer greater than 1.

IntegerLength[42, -2] 

IntegerLength::ibase: Base -2 is not an integer greater than 1.

$\endgroup$
4
  • $\begingroup$ In the future, probably you could do a minimum due diligence research yourself, and share how far you managed to go. The code was readily available from a quick search. $\endgroup$
    – rhermans
    Oct 31, 2022 at 11:36
  • 2
    $\begingroup$ It would be reasonable to request Wolfram Development team (via Wolfram Support) to include support for negative bases in future versions. $\endgroup$
    – rhermans
    Oct 31, 2022 at 11:41
  • 1
    $\begingroup$ I think this would be a great feature and to avoid the the diffusion of responsibility I have submitted a request to Wolfram to include this in future upgrades :) $\endgroup$ Oct 31, 2022 at 12:49
  • 1
    $\begingroup$ I have updated my previously mistaken answer, I think now I got it right. $\endgroup$
    – rhermans
    Nov 1, 2022 at 11:39

2 Answers 2

6
$\begingroup$

Background

mathworld.wolfram.com contains entries for Negabinary, Negadecimal and Base, including Wolfram language code examples

Base $(-2)$ Negabinary

Negabinary[n_Integer] := Module[
    {t = (2/3)(4^Floor[Log[4, Abs[n] + 1] + 2] - 1)},
    IntegerDigits[BitXor[n + t, t], 2]
]

Base $(-10)$ Negadecimal

Negadecimal[0] := {0}
Negadecimal[i_] := Rest @ Reverse @ Mod[
     NestWhileList[
           (# - Mod[#, 10])/-10&,
           i, 
           # != 0& 
     ], 10]

In general, NegativeIntegerDigits

NegativeIntegerDigits[0, n_Integer?Negative] := {0}
NegativeIntegerDigits[i_, n_Integer?Negative] :=    Rest @ Reverse @ Mod[
    NestWhileList[
    (# - Mod[#, -n])/n& ,
    i,
    # != 0& 
    ],    -n
    ]

Now this should be the right answer

Now that you can calculate the digits, you can easily measure the Count the digits

 Map[ Count[NegativeIntegerDigits[n, b],#]&, Mod[Range[Abs[b]],Abs[b]] ]

Solution

We can Unprotect the definition of DigitCount, extend its definition for negative bases, RotateRight the evaluation order (to put our definition first and avoid parameter checks that triggers "DigitCount::base" Message) and then Protect again. I use the definition of NegativeIntegerDigits from mathworld.wolfram.com.

NegativeIntegerDigits[0, n_Integer?Negative] := {0}
NegativeIntegerDigits[i_, n_Integer?Negative] := Rest @ Reverse @ Mod[ NestWhileList[ (# - Mod[#, -n])/n& , i, # != 0&  ], -n ];

(* Unprotect the definition of DigitCount *)
Unprotect[DigitCount];
(* Our new definition for negative bases *)
DigitCount[n_Integer, b_Integer /; b < -1] := Map[Count[NegativeIntegerDigits[n, b],#]&,Mod[Range[Abs[b]],Abs[b]] ];
(* Change the evaluation order. Moves the new definition from last to first positions. *)
(* This is to skip a parameter check that triggers the 'DigitCount::base'  Message *)
DownValues[DigitCount] = RotateRight[DownValues[DigitCount]];
(* Protect again *)
Protect[DigitCount]; 

And now

DigitCount[18,-10]

enter image description here

$\endgroup$
4
  • 1
    $\begingroup$ Very nice use of NestWhileList +1 $\endgroup$ Oct 31, 2022 at 12:52
  • $\begingroup$ which parameter check are you referring to? $\endgroup$ Nov 1, 2022 at 11:52
  • $\begingroup$ This would be a long explanation, I may craft a question about this, but in short, the internal definition of DigitCount includes DigitCount[pattern] := digitcountcore[args] /; TestDCArgs[args]; I mean that /; TestDCArgs that give errors if the base is negative. $\endgroup$
    – rhermans
    Nov 1, 2022 at 11:55
  • 1
    $\begingroup$ Updated with a better solution to avid the parameter check that triggers "DigitCount::base" Message. $\endgroup$
    – rhermans
    Nov 1, 2022 at 12:45
4
$\begingroup$

Here is my solution which uses a loop format mimicking the solutions on Wikipedia

integerDigits[0, n_Integer?Negative] := {0};
integerDigits[number_Integer, base_Integer?Negative]:=
  With[
   {absBase = Abs[base]},
   Module[
    {quotient = number, remainder, remainders},
    remainders =
     Reap@While[
       quotient != 0,
       {quotient, remainder} = QuotientRemainder[quotient, base];
       If[
        Negative[remainder], {quotient, remainder} += {1, absBase}];
       Sow[remainder];
       ];
    Reverse@First@remainders[[2]]
    ]
   ];


digitCount[n_Integer, b_Integer?Negative] := 
  Count[integerDigits[n, b], #] & /@ Range[Abs[b]];

digitCount[n_Integer] := digitCount[n, -10]

digitCount[n_Integer, b_Integer?Negative, d_Integer?Positive] := 
  Count[integerDigits[n, b], d];

So

integerDigits[18, -10]
digitCount[18, -10]

{1, 9, 8}

{1, 0, 0, 0, 0, 0, 0, 1, 1, 0}

$\endgroup$
2
  • $\begingroup$ +1, but I think the original DigitCount has the counts for zero at the end of the list. i.e DigitCount[199000,10] gives {1,0,0,0,0,0,0,0,2,3} not {3,1,0,0,0,0,0,0,0,2} . $\endgroup$
    – rhermans
    Nov 1, 2022 at 11:44
  • 1
    $\begingroup$ Good point, I have just noticed that too. I will edit my answer $\endgroup$ Nov 1, 2022 at 11:54

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.