Post Reply 
(48/49/50) Rank of Permutation
06-17-2023, 02:40 PM (This post was last modified: 06-17-2023 02:42 PM by John Keith.)
Post: #1
(48/49/50) Rank of Permutation
These two programs compute the rank (lexicographic index) of a permutation, or return a permutation (as a list) given the rank. The rank assumes 1-based lists, i.e. a sorted list has the rank 1. For the HP-48, the maximum length of the permutation list is 14. For the 49 and 50, the length is limited only by memory if used in Exact mode.

The first program, PRNK, takes a list on level 1 and returns the rank as an integer. The program uses LSORT but can also use the built-in SORT command on the 48G and later.

Code:

@ HP 49/50 version
\<< DUP LSORT
  IF DUP2 SAME                    @ If same as sorted list
  THEN DROP2 0                    @ then return 0.
  ELSE DUP SIZE DUP 1. - R\->I !  @ f = Factorial(size - 1)
    0 \-> n f r
    \<< OVER HEAD I\->R 1. n      @ Get list head and start FOR loop
      FOR k OVER k GET I\->R OVER
        IF <                      @ If list head is >= element k
        THEN 'r' f STO+ 1.        @ then increase rank by f, continue FOR loop
        ELSE DROP2 TAIL PRNK      @ else recurse with tail of list
          'r' STO+ n              @ Add result to rank and exit FOR loop
        END
      STEP r 1 +                  @ Return r + 1 as rank
    \>>
  END
\>>

Code:

@ HP-48 version.
\<< DUP LSORT
  IF DUP2 SAME                    @ If same as sorted list
  THEN DROP2 0                    @ then return 0.
  ELSE DUP SIZE DUP 1 - !         @ f = Factorial(size - 1)
    0 \-> n f r
    \<< OVER 1 GET 1 n            @ Get list head and start FOR loop
      FOR k OVER k GET  OVER
        IF <                      @ If list head is >= element k
        THEN 'r' f STO+ 1         @ then increase rank by f, continue FOR loop
        ELSE DROP2
          2 OVER SIZE SUB PRNK    @ else recurse with tail of list
          'r' STO+ n              @ Add result to rank and exit FOR loop
        END
      STEP r 1 +                  @ Return r + 1 as rank
    \>>
  END
\>>

The next program, PURNK (permutation unrank) is the inverse of the program above. Given integers n on level 2 and j on level 1, returns a permutation of the numbers 1..n with rank j.

The HP 49/50 version requires ListExt and should be used in exact mode.

Code:

\<< 1 - \-> n j                    @ Assume 1-based list
  \<< n LSEQ 1 n 1 -               @ Start with list of 1..n
    FOR k j n k - ! IDIV2 'j' STO  @ Find next element
      1 + DUP2 GET UNROT LRMOV     @ Remove element from list and save it
    NEXT EVAL n \->LIST            @ Assemble permutation list
  \>>
\>>

The HP-48 version is longer but still reasonably fast. It uses the program 'REL' from One-Minute Marvels as a replacement for LRMOV.

Code:

\<< 1 - \-> n j
  \<< 1 n
    FOR m m
    NEXT n \->LIST 1 n 1 -
    FOR k j n k - !
      DUP2 / FLOOR ROT ROT MOD 'j' STO
      1 + DUP2 GET ROT ROT SWAP LIST\-> 2 +
      DUP ROLL OVER SWAP - ROLL DROP 3 - \->LIST
    NEXT 1 GET n \->LIST
  \>>
\>>
Find all posts by this user
Quote this message in a reply
06-26-2023, 12:25 PM
Post: #2
RE: (48/49/50) Rank of Permutation
This is a variation of PURNK that takes a sorted list on level 2 instead of an integer. The objects in the list may be of any type(s).

For instance, with the list { "apple" "banana" "cherry" "grape" } on level 2 and the number 8 on level 1,
the program returns { "banana" "apple" "grape" "cherry" }.

HP 49/50 version:
Code:

\<< 1 - OVER SIZE R\->I \-> j n                 @ n is size of list
  \<< 1 n 1 -
    FOR k j n k - ! IDIV2 'j' STO
      1 + DUP2 GET UNROT LRMOV
    NEXT EVAL n \->LIST
  \>>
\>>

HP-48 version:
Code:

\<< 1 - OVER SIZE \-> j n                        @ n is size of list
  \<< 1 n 1 -
    FOR k j n k - !
      DUP2 / FLOOR ROT ROT MOD 'j' STO
      1 + DUP2 GET SWAP ROT LIST\-> 2 +
      DUP ROLL OVER SWAP - ROLL DROP 3 - \->LIST
    NEXT 1 GET n \->LIST
  \>>
\>>
Find all posts by this user
Quote this message in a reply
Post Reply 




User(s) browsing this thread: 1 Guest(s)