(49G) OEIS A178225: Test for Binary-Palindromicity

[Gerald H]

For integer decimal input N the programme tests whether N in binary is palindromic.

This is OEIS

https://oeis.org/A178225

Size: 95.5

CkSum: # C785h

Code:

::
  CK1&Dispatch
  # FF
  ::
    ::
      FPTR2 ^DupQIsZero?
      casedrop
      "0"
      NULL$SWAP
      FPTR2 ^Z>ZH
      FPTR2 ^ZBits
      ZERO_DO
      INDEX@
      FPTR2 ^ZBit?
      ITE
      CHR_1
      CHR_0
      ROTSWAP
      >H$
      SWAPLOOP
      DROP
    ;
    DUP'
    xSREV
    EvalNoCK
    EQUAL
    COERCEFLAG
  ;
;

[Gerald H]

A neater, faster programme:


Size: 122.5

CkSum: # 1FA9h

Code:

::
  CK1&Dispatch
  # FF
  ::
    DUP
    ZINT 2
    Z<
    casedrop
    %1
    FPTR2 ^Z>ZH
    FPTR2 ^ZBits
    DUP
    BINT2
    #/
    #+
    3UNROLL
    ZERO_DO
    INDEX@
    FPTR2 ^ZBit?
    SWAP
    ISTOP-INDEX
    #1-
    FPTR2 ^ZBit?
    ROT
    EQUAL
    ITE
    ::
      OVERINDEX@
      #<>
      ?SEMI
      %1
      ExitAtLOOP
    ;
    ::
      %0
      ExitAtLOOP
    ;
    LOOP
    ROTROT2DROP
  ;
;

[Gerald H]

Here the definitive version of the programme, a model of elegance, shortest & fastest possible.

I'm sure no one can find an improvement - I'd be amazed if you did!

Size: 105.

CkSum: # 2C8Eh

Code:

::
  CK1&Dispatch
  # FF
  ::
    %1
    SWAPDUP
    ZINT 2
    Z<
    caseDROP
    FPTR2 ^Z>ZH
    FPTR2 ^ZBits
    DUPUNROT
    BINT2
    #/
    #+
    ZERO_DO
    SWAP#1-SWAP
    OVER
    FPTR2 ^ZBit?
    SWAPINDEX@
    FPTR2 ^ZBit?
    ROT
    EQUAL
    ?SKIP
    ::
      ROTDROP
      %0
      3UNROLL
      ExitAtLOOP
    ;
    LOOP
    2DROP
  ;
;

[Werner]

Well..
that sounded like a challenge, no? Never could resist.

Two things bothered me about your code:

First, the sequence

Code:

BINT2
#/
#+

While #2/ is not the same, in this case it does the job - there's no need to test the middle bit, so to speak.

Second thing: the snippet

Code:

     ?SKIP
     ::
       ROTDROP
       %0
       3UNROLL
       ExitAtLOOP
     ;

The secondary wastes 5 bytes in my eyes ;-) so I tried to do without one.
It turned out not to be so easy to improve upon, though. All I've been able to manage so far is save a single command (2.5 bytes).
Well, this is it, 97.5 Bytes, # 945Fh

Code:

::
   CK1&Dispatch
   # FF
   ::
     DUP
     ZINT 2
     Z<
     casedrop
     %1
     FPTR2 ^Z>ZH
     FPTR2 ^ZBits
     DUPUNROT
     #2/
     DUP
     ZERO_DO
       DROP
       SWAP#1-SWAP
       OVER
       FPTR2 ^ZBit?
       SWAPINDEX@
       FPTR2 ^ZBit?
       ROT
       EQUAL
       DUP
       ?SKIP
       ExitAtLOOP
     LOOP
     UNROT2DROP
     COERCEFLAG
   ;
 ;

Cheers, Werner

[Gerald H]

Very nice, Werner, congrats!

After incorporating your suggestion not to test the middle bit into my version, my programme tested the 691 decimal digits binary palindrome

89994266347114322108746659078169039569886836647229215093154781927492078804634569​22990872105835307171055080251964909961257453802179645499054716333672539545544118​93296869188408496068869259741343375987448069985484450183609485013394798375320481​76982817886331167530545036964043593615781256129315397406710665088647843515291543​91934339180653852887403515211867169617043784799543175497949666073579771413066215​42108320862971393018627252724226016264248021072932669162724037299988660687566937​55242456783484062171328388910483028865334964030365455426391620387906591970874002​38193942009504229380072518565320107237768892369217461716099224829006631795274618​330918728005922738663971483339019497645460273904057

in

3.891345 s

& your programme took

3.869235 s

(average of 20 runs).

So your programme is smaller & faster, I shall put it in my library.

Thus the crestfallen boaster acknowledges your acumen.

[Gerald H]

Shorter:

Size: 92.5

CkSum: # 1249h

Code:

::
  CK1&Dispatch
  # FF
  ::
    FPTR2 ^DupQIsZero?
    casedrop
    %1
    FPTR2 ^Z>ZH
    FPTR2 ^ZBits
    DUPUNROT
    #2/
    DUP
    ZERO_DO
    DROP
    SWAP#1-SWAP
    OVER
    FPTR2 ^ZBit?
    SWAPINDEX@
    FPTR2 ^ZBit?
    ROT
    EQUAL
    DUP
    ?SKIP
    ExitAtLOOP
    LOOP
    ROTROT2DROP
    COERCEFLAG
  ;
;

[Gerald H]

Shorter:

NB PTR 273B6 has been stable at least from version 1.19-6 on.

Size: 90.

CkSum: # FB5Bd (edited to correct incorrect checksum)

Code:

::
  CK1&Dispatch
  # FF
  ::
    PTR 273B6
    FPTR2 ^ZNMax
    FPTR2 ^Z>ZH
    FPTR2 ^ZBits
    DUPUNROT
    #2/
    DUP
    ZERO_DO
    DROP
    SWAP#1-SWAP
    OVER
    FPTR2 ^ZBit?
    SWAPINDEX@
    FPTR2 ^ZBit?
    ROT
    EQUAL
    DUP
    ?SKIP
    ExitAtLOOP
    LOOP
    ROTROT2DROP
    COERCEFLAG
  ;
;

[Werner]

But what does it do, PTR 273B6?
Werner

[Gerald H]

It puts the short form of

ZINT 1

on the stack.

[Werner]

In that case, add

EQU ZINT_1 $273B6

as first line of your source code, then you can use ZINT_1. A bit clearer than PTR 273B6 ;-)

Werner

[Gerald H]

In my own programming environment I use an XTable library where

Z1_

represents the pointer.

As not everyone has the same XTable library I avoid using Z1_ publicly, preferring to use the pointer, which should compile OK for everyone.

Your suggestion is a good idea, I mean more transparent, but could well confuse those not so experienced in Sys programming.

[Werner]

"but could well confuse those not so experienced in Sys programming"

? More confused than by PTR 273B6?

Werner