HP Forums
(48gii) Verbal Sequence - Printable Version

+- HP Forums (https://www.hpmuseum.org/forum)
+-- Forum: HP Software Libraries (/forum-10.html)
+--- Forum: General Software Library (/forum-13.html)
+--- Thread: (48gii) Verbal Sequence (/thread-7787.html)



(48gii) Verbal Sequence - Gerald H - 02-17-2017 07:51 PM

The programme "Verbal" below takes integer input from the stack, eg 6, & returns the labelled lengths of the prodromic & periodic parts of the verbal description of the input & the descriptions of the input to the stack, in our case

:Pre-period: 10

:Period: 1

indicating prodromic length 10 & periodic length 1 & stores the actual descriptive sequence in the variable "VLIST", in our case

{ 6 16 1611 1631 161321 16131231 16231241 1614132231 1614232241 1624133231 "°" 1614332231 }

to be read as

{ SIX ONESIX ONESIXONEONE ONESIXTHREEONES ONESIXONETHREETWOONES ......... "°" ONESIXONEFOURTHREETHREESTWOTWOSTHREEONES }

the last element of the list being the periodic part as the number is a description of itself.

Code:

Verbal

::
  CK1&Dispatch
  # FF
  ::
    DUP
    ONE{}N
    SWAP
    FPTR2 ^Z>S
    ZEROSWAP
    ::
      BEGIN
      BINT0
      BINT10
      NDUPN
      '
      NULLLAM
      SWAP
      NDUPN
      DOBIND
      DUPLEN$
      #1+_ONE_DO
      DUPINDEX@
      SUB$1#
      BINT47
      #-DUP
      GETLAM
      #1+SWAP
      PUTLAM
      LOOP
      NULL$
      BINT11
      ONE_DO
      INDEX@
      GETLAM
      DUP#0=ITE
      DROP
      ::
        #>$
        INDEX@
        #1-
        #>$
        &$
        SWAP&$
      ;
      LOOP
      ABND
      SWAPDROP
      SWAP#1+SWAP
      DUP
      FPTR2 ^S>Z
      4PICK
      FPTR2 ^ListPos
      DUP#0=
      NOTcase
      AGAIN
      DROPROT
      OVER
      FPTR2 ^S>Z
      >TCOMP
      3UNROLL
      AGAIN
    ;
    RDROP
    #1-
    SWAPDROPDUP
    4ROLL
    "°"
    4PICK
    #1+
    FPTR2 ^INSERT{}N
    '
    ID VLIST
    ?STO_HERE
    ROT
    SWAP#-
    FPTR2 ^#>Z
    "Period"
    >TAG
    SWAP
    FPTR2 ^#>Z
    "Pre-period"
    >TAG
    SWAP
  ;
;