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.
: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
;
;