(50g) Necklace programs

[John Keith]

This is a group of programs that compute functions related to necklaces and bracelets (number theory, not jewelry!). The following sequences are covered:

A000011
A000013
A000016
A000029
A000031
A000046
A000048
A001037
A059053
A059076
A179781
A308706

Due to many inter-dependencies between programs, I am posting these programs as a directory object. Additionally, the programs require the GoferLists library and Gerald Hillier's MOB command, which computes the Moebius Mu function. The programs must be used in Exact mode.

In each program, an input of an integer n will return the corresponding A(n) for that sequence. These programs are very computationally intensive and can take several seconds on the physical calculator for large integers.

Leading zeros in the sequence names have been removed to improve readability in the calculator's menu displays.

Code:


%%HP: T(3)A(R)F(.);
DIR
  A11
  \<< DUP A13 SWAP I\->R 2. / IP R\->I 2 SWAP ^ + 2 /
  \>>
  A13
  \<<
    IF DUP I\->R 1. >
    THEN DUP DIVIS DUP REVLIST 2 SWAP ^ SWAP 2 * EULER * \GSLIST SWAP 2 * /
    ELSE DROP 1
    END
  \>>
  A16
  \<<
    IF DUP I\->R 2. >
    THEN DUP DIVIS
      \<< I\->R 2. MOD
      \>> Filter DUP PICK3 SWAP / 2 SWAP ^ SWAP EULER * Sum SWAP 2 * /
    ELSE DROP 1
    END
  \>>
  A29
  \<< DUP A31 OVER I\->R
    IF DUP 5. >
    THEN SWAP 2 / UNROT 2. MOD { 1 - 2 / 2 SWAP ^ } { 2 / 1 - 2 SWAP DUP2 1 - ^ UNROT ^ + } IFTE +
    ELSE DROP
    END
  \>>
  A31
  \<< DUP I\->R
    IF 3. >
    THEN DUP DIVIS DUP REVLIST 2 SWAP ^ SWAP EULER * \GSLIST SWAP /
    ELSE 1 +
    END
  \>>
  A46
  \<<
    IF DUP I\->R 3. >
    THEN DUP A48 SWAP A179781 + 2 /
    ELSE DROP 1
    END
  \>>
  A48
  \<<
    IF DUP I\->R 3. >
    THEN DUP DIVIS
      \<< I\->R 2. MOD
      \>> Filter DUP PICK3 SWAP / 2 SWAP ^ SWAP MOB * Sum SWAP 2 * /
    ELSE DROP 1
    END
  \>>
  A1037
  \<<
    IF DUP I\->R 1. >
    THEN DUP DIVIS DUP REVLIST MOB SWAP 2 SWAP ^ * \GSLIST SWAP /
    ELSE 1 +
    END
  \>>
  A59053
  \<< DUP I\->R
    IF 6. >
    THEN DUP A13 DUP ROT I\->R 2. / IP R\->I 2 SWAP ^ + 2 / -
    ELSE DROP 0
    END
  \>>
  A059076
  \<< \-> n
    \<< 0 n
      FOR k k A31
      NEXT n 1 + \->LIST 1 2 3 3 n
      START OVER 2 *
      NEXT n 1 + \->LIST - 2 /
    \>>
  \>>
  A179781
  \<<
    IF DUP I\->R 3. >
    THEN DIVIS DUP REVLIST MOB SWAP I\->R 2. / IP R\->I 2 SWAP ^ * \GSLIST
    ELSE DROP 1
    END
  \>>
  A308706
  \<<
    IF DUP I\->R 6. >
    THEN DUP A48 SWAP A179781 - 2 /
    ELSE DROP 0
    END
  \>>
END