0
$\begingroup$

So, I am trying to write a function that takes a number between 0 and 1 in base 10 as input and gives a list of its decimal figures in it's expression in base 17. For example, $f(0.5)= \lbrace 8,8,8,8,8,\ldots\rbrace$. My function in particular needs to provide the output in a certain manner. For instance, $f(1/17)=\lbrace 0,16,16,16,16,\ldots\rbrace$ BUT $f(2/17)=\lbrace 2,0,0,\ldots\rbrace$.

The function I have writen so far is as follows:

Base17[t_] := Block[{digitsandexponent, listofdigits, n, m},
  digitsandexponent = RealDigits[N[t], 17];
  listofdigits = digitsandexponent[[1]];
  m = digitsandexponent[[2]];
  n = 0;
  If[m > n,
   (*the only considered case in which this could happen is if t=1*)
   listofdigits = {16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16},
   
   (*if it's not one, add the decimal 0's to the front*)
   While[n < -m,
    PrependTo[listofdigits, 0];
    n = n + 1]
   ];
  
  If[AnyTrue[listofdigits, OddQ], 
   If[Length[Position[listofdigits, _Integer?OddQ]] > 1,
    (*if there's more than one odd number, do nothing*)
     listofdigits = listofdigits,
    
    
    (*if there's exactly one odd number and after that it is all \
16's, add one to the odd number and turn the 16's into 0's*)
    If[listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]] + 
          1 ;;  ]] == 
      Table[16, {i, Position[listofdigits, _Integer?OddQ][[1, 1]] + 1,
         Length[listofdigits]}],
     listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]] + 1 ;;
          Length[listofdigits]]] = 
      Table[0, {i, Position[listofdigits, _Integer?OddQ][[1, 1]] + 1, 
        Length[listofdigits]}];
     listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]]]] = 
      listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]]]] + 
       1];
    
    
    (*if there's exactly one odd number and after that it is all 0's, 
    substract one to the odd number and turn the 0's into 16's*)
    If[listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]] + 
          1 ;; Length[listofdigits]]] == 
      Table[0, {i, Position[listofdigits, _Integer?OddQ][[1, 1]] + 1, 
        Length[listofdigits]}],
     listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]] + 1 ;;
          Length[listofdigits]]] = 
      Table[16, {i, Position[listofdigits, _Integer?OddQ][[1, 1]] + 1,
         Length[listofdigits]}];
     listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]]]] = 
      listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]]]] - 
       1];
    ]
   ];
  
  Return[listofdigits]
  ]

In general it works well, but it returns some errors. For example, for $t=22718/1419857$, it produces good output but with the next errors:

Part::partw: Part 1 of {} does not exist.

Part::span: 1+{}[[1,1]];;14 is not a valid Span specification. A Span specification should be 1, 2, or 3 machine-sized integers separated by ;;. (Any of the integers can be omitted or replaced with All.)

Part::partw: Part 1 of {} does not exist.

Table::iterb: Iterator {i,1+{}[[1,1]],14} does not have appropriate bounds.

Table::iterb: Iterator {i,1+{}[[1,1]],14} does not have appropriate bounds.

However, for $t=22717/1419857$ it produces no errors.

Does anyone have any idea why this happens? Thank you for your time!

enter image description here

$\endgroup$
0

1 Answer 1

2
$\begingroup$

Perhaps you can do:

base17[t_] := Replace[
    RealDigits[N[t, 15], 17, Automatic, -1][[1]],
    {
    {b___,i_?OddQ,r : 0 ...} :>{b,i-1, Splice[ConstantArray[16,Length[{r}]]]},
    {b___,i_?OddQ,r : 16 ...} :> {b,i+1,  Splice[ConstantArray[0,Length[{r}]]]}
    }
]

Your examples:

base17[22717/1419857]
base17[22718/1419857]

{0, 4, 10, 10, 4, 16, 16, 16, 16, 16, 16, 16, 16}

{0, 4, 10, 10, 6, 0, 0, 0, 0, 0, 0, 0, 0}

$\endgroup$
5
  • $\begingroup$ That works awesomely well, and way much cleaner than mine! It only has the issue that 0 and 1 have the same output, but a simple If solves that matter. Thank you very much! $\endgroup$ Aug 4, 2021 at 22:41
  • $\begingroup$ Actually, I have found something with the behaviour of that function that I do not really know how to solve in a neat way. For $t=10/17+9/17^2$, it produces output {10,9,0,0,0,0,0,0,0} instead of {10,8,16,16,16...}. Any suggestion of a neat code for that matter? $\endgroup$ Aug 7, 2021 at 10:36
  • $\begingroup$ @juanzaragoza long do you want the lists to be? Should it always have length 13? $\endgroup$
    – Carl Woll
    Aug 8, 2021 at 17:12
  • $\begingroup$ not really, I just felt that 13 numbers would be enough precision to give a flavour of what the infinite expression would be like. $\endgroup$ Aug 10, 2021 at 14:57
  • $\begingroup$ @juanzaragoza I modified my answer to use extended precision instead. See if that works better. $\endgroup$
    – Carl Woll
    Aug 11, 2021 at 3:06

Your Answer

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

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