Base conversion (including fractional parts)

[Han]

Started by this thread: http://hpmuseum.org/forum/thread-7585-post-67381.html

Code below is from the aforementioned thread.

Code:

EXPORT basecalc()
BEGIN
  local maxdigits:=20; // maximum number of digits for frac part

  local j,k,t,run:=1;
  local b1:=10;
  local b2:=16;
  local d:=0;
  local n:="";
  local ds:="";
  local r:=string(rand,1,12); // create a random CAS variable
  local var:="";
  local ipn:=""; // integer part of n
  local fpn:=""; // frac part of n
  
  local digits:="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";

  k:=size(r)-2;
  var:="tmp" + right(r,k);


  while run do
    t:=input(
      { 
        { n, [2], { 15, 80, 0 } },
        { b1, [0], { 25, 25, 1 } },
        { b2, [0], { 70, 25, 1 } },
        { maxdigits, [0], {25,25, 2 } }
      },
      "Base Converter",
      { "n=", "base1=", "base2=", "digits=" },
      {
        "Enter the integer",
        "Enter the base of the integer n",
        "Enter the base to convert to",
        "Max allowable digits"
      }
    );

    if t then
      r:=var + ":={0,0}";
      CAS(EVAL(r));
      k:=size(n);
      if (k AND (b1 >= 2) AND (b2 <= 62)) then

        j:=instring(n,".");

        if j then
          if (j-1>0) then ipn:=left(n,j-1); end;
          if (k-j>0) then fpn:=right(n,k-j); end;
          k:=j-2;
        else
          ipn:=n;
          k:=size(n)-1;
        end;

        // k = largest exponent
        t:=size(ipn);
        for j from 1 to t do
          ds:=mid(ipn,j,1);
          d:=instring(digits,ds)-1;
          if ((d >= b1) OR (d < 0)) then msgbox("Invalid digit: " + ds); j:=-1; break; end;
          r:=var + "[1]:=" + var + "[1]+" + d + "*" + b1 + "^" + k;
          k:=k-1;
          CAS(EVAL(r));
        end;
        if (j == -1) then continue; end;

        t:=size(fpn);
        for j from 1 to t do
          ds:=mid(fpn,j,1);
          d:=instring(digits,ds)-1;
          if ((d >= b1) OR (d < 0)) then msgbox("Invalid digit: " + ds); j:=-1; break; end;
          r:=var + "[2]:=" + var + "[2]+" + d + "*" + b1 + "^" + k;
          k:=k-1;
          CAS(EVAL(r));
        end;
        if (j == -1) then continue; end;

        n:="";

        t:=size(ipn);
        if t then
          r:="ip(ln(" + var + "[1])/ln(" + b2 + ")))";
          k:=CAS(EVAL(r));
          for j from k downto 0 do
            r:="ip(" + var + "[1]/(" + b2 + "^" + j + "))";
            d:=CAS(EVAL(r));
            ds:=mid(digits,d+1,1);
            n:=n+ds;
            r:=var + "[1]:=" + var + "[1] - " + d + "*" + b2 + "^" + j;
            CAS(EVAL(r));
          end;
        end;

        t:=size(fpn);
        if t then
          n:=n+".";
          r:="numer(" + var + "[2])"; t:=CAS(EVAL(r));
          r:="denom(" + var + "[2])"; k:=CAS(EVAL(r));
          for j from 1 to maxdigits do
            r:="ip(" + var + "[2]*" + b2 + ")";
            d:=CAS(EVAL(r));
            r:=var + "[2]:=" + var + "[2]*" + b2 + "-" + d;
            CAS(EVAL(r));

            // floating point issue
            r:=var + "[2] < 0";
            if CAS(EVAL(r)) then
              r:=var + "[2]:=" + var + "[2]+1";
              CAS(EVAL(r));
              d:=d-1;
            end;
            ds:=mid(digits,d+1,1);
            n:=n+ds;
            r:=var + "[2] == 0";
            if CAS(EVAL(r)) then break; end;
          end;
        end;

        t:=b1;
        b1:=b2;
        b2:=t;

      else
        msgbox("Invalid input");
      end;

    else
      run:=0;
    end;

  end;

  r:="purge(" + var + ")";
  CAS(EVAL(r));
  return(0);
END;

[compsystems]

Radix, Very good program


an idea

To start choosing the style

1: single [input / output] field (current)

2: two separate [input] / [output] fields, To view or compare conversion

3: an option with text (bases more known or useful)

BINARY 2
OCTAL 8
DECIMAL 10
DUDECIMAL 12
HEXADECIMAL 16
VIGECIMAL 20
SEXAGECIMAL 60
https://en.wikipedia.org/wiki/Radix

4: separate in the case of hexadecimal numbers the outputs in pairs for easier reading
FF 8F 0F

5: lowercase support ff8f0f

[Han]

(01-27-2017 08:57 PM)compsystems Wrote:  Radix, Very good program

I was not able to find a program named Radix in the HP Prime software library. Do you have a link?

Quote:an idea

To start choosing the style

1: single [input / output] field (current)

2: two separate [input] / [output] fields, To view or compare conversion

3: an option with text (bases more known or useful)

BINARY 2
OCTAL 8
DECIMAL 10
DUDECIMAL 12
HEXADECIMAL 16
VIGECIMAL 20
SEXAGECIMAL 60
https://en.wikipedia.org/wiki/Radix

4: separate in the case of hexadecimal numbers the outputs in pairs for easier reading
FF 8F 0F

I will leave these ideas for others to implement. I usually hate doing UI design :-)

Quote:5: lowercase support ff8f0f

Lower case letters are actually used as digits for bases 37 through 62, so this would cause a conflict if we were to use lower case letters as alternatives to capital letters. I suppose that we could allow for lower case letters for digits only in the cases where the base is 36 or less. A simple test of the base, along with a conversion to upper case would be more than sufficient. But again, this is a "UI" option I'll leave to folks who are not as lazy as myself. :-)

[compsystems]

Radix synonymous of base =)

Base conversion is a port of BASECAL (rpn)? As a suggestion to separate the hp-prime code in sub-functions

PHP Code:

%%HP: T(3)A(R)F(.);

@->IB  : Take either a binary or a real from the stack and return
@       it in the base specified in BBASE, rounded off to IBFIX
@        places.

@IB->  : Take an IB string from the stack and convert it to either
@        a binary number or a real.  If IBFIX is set to zero, it will
@        always return a binary number.  If IBFIX is set to somthing
@        other than zero, it will use return a real if the base-10
@        numver is less than 1E12.

@IB2-> : Runs IB-> on the objects in level one and two, leaving their
@        order intact.

@BBASE : The current base. (2-62 is valid)

@IBFIX : Number of desired decimal places. (0 will force all calculations
@                                          to be carried out in binaries)

@->IB2 : Runs ->IB on the objects in level 1 and two, leaving their
@        order intact.


@ BASECALC by Ian Matthew Smith
@ Automatic decimal lengths added by Joe Horn
DIR

  BMTH @ create custom menu
    \<< { Add \<< IB2\-> + \->IB \>> }
        { Sub \<< IB2\-> - \->IB \>> }
        { Mul \<< IB2\-> * \->IB \>> }
        { Div \<< IB2\-> / \->IB \>> }
      BBASE "/" IBFIX + +
      { \<< B\->FIX 'BBASE' STO BMTH \>>
        \<< B\->FIX SWAP IB\-> SWAP 'BBASE' STO \->IB BMTH \>>
        \<< 'IBFIX' STO BMTH \>> }
      2 \->LIST { CONV {
      \<< DUP
        IF TYPE 2 ==
        THEN IB\->
        ELSE \->IB
        END
      \>>
      \<< DUP
        IF TYPE 0 ==
        THEN R\->B
        ELSE DUP
          IF TYPE 10 ==
          THEN B\->R
          END
        END
      \>> } } 6 \->LIST TMENU
    \>>

  \->IB
    \<< DUP
      IF TYPE 0 ==
      THEN DUP FP SWAP IP R\->B
      ELSE 0 SWAP
      END DUP
      IF TYPE 10 ==
      THEN RCWS SWAP "" SWAP 64 STWS
        WHILE DUP B\->R
        REPEAT DUP BBASE DUP2 / * - 1 + BSTR SWAP
          B\->R DUP SUB ROT + SWAP BBASE /
        END DROP SWAP STWS SWAP
        IF DUP BBASE IBFIX ^ * 1 <
        THEN DROP
        ELSE "" SWAP 1 IBFIX
          START
            IF DUP 0 \=/
            THEN BBASE * DUP IP BSTR SWAP 1 + DUP SUB ROT SWAP + SWAP FP
            END
          NEXT DROP "." SWAP + +
        END
      END
    \>>

  IB\->
    \<< DUP
      IF TYPE 2 ==
      THEN RCWS SWAP 64 STWS
        IF DUP "." POS
        THEN DUP DUP "." POS SWAP DUP SIZE ROT 1 + SWAP SUB
          SWAP DUP "." POS 1 - 1 SWAP SUB
        ELSE "" SWAP
        END # 0d SWAP DUP SIZE 1 - 0 SWAP
        FOR j DUP DUP SIZE j - DUP SUB BSTR SWAP POS 1 - # 1d
          IF j 0 >
          THEN BBASE 1 j
            START DUP ROT * SWAP
            NEXT DROP
          END * ROT + SWAP
        NEXT DROP
        IF DUP B\->R 1.E12 < IBFIX AND
        THEN B\->R
        END SWAP
        IF DUP SIZE
        THEN 0 SWAP DUP SIZE 1 SWAP
          FOR j DUP j j SUB BSTR SWAP POS 1 - BBASE j NEG ^ * ROT + SWAP
          NEXT DROP +
        ELSE DROP
        END SWAP STWS
      ELSE
        IF DUP TYPE 0 == IBFIX NOT AND
        THEN R\->B
        END
      END
    \>>

  IB2\->
    \<< IB\-> SWAP IB\-> SWAP
    \>>

  BBASE 16

  IBFIX 0

  \->IB2
    \<< \->IB SWAP \->IB SWAP
    \>>
  B\->FIX  @ this tiny routine was tacked on by Joe Horn
    \<< 2 MAX 62 MIN 12 OVER LOG / IP 'IBFIX' STO
    \>>

  BSTR
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
END 


[Han]

(01-28-2017 03:57 AM)compsystems Wrote:  Base conversion is a port of BASECAL (rpn)?

No, I just wrote the program based on my own understanding of base conversions and what Joe was requesting.

[compsystems]

What utility have the conversion of real numbers between different bases? I have only used conversion between integers.

About the program, please separate the UI from the functions, to create custom UI