(50G) Perfect Permutation Producer
05-27-2015, 01:53 PM (This post was last modified: 06-15-2017 01:40 PM by Gene.)
Post: #1
 Gerald H Senior Member Posts: 1,522 Joined: May 2014
(50G) Perfect Permutation Producer
Given a prime positive integer P & a positive integer input the programme produces a perfect permutation of the positive integers < P.

A perfect permutation consists of integers where the difference between neighbours is not repeated.

eg For input

107
45

the programme returns

{ 1 45 99 68 64 98 23 72 30 66 81 7 101 51 48 20 44 54 76 103 34 32 49 65 36 15 33 94 57 104 79 24 10 22 27 38 105 17 16 78 86 18 61 70 47 82 52 93 12 5 11 67 19 106 62 8 39 43 9 84 35 77 41 26 100 6 56 59 87 63 53 31 4 73 75 58 42 71 92 74 13 50 3 28 83 97 85 80 69 2 90 91 29 21 89 46 37 60 25 55 14 95 102 96 40 88 }

Code:
 ::   CK2&Dispatch   # FFFF   ::     OVER     Z2_     EQUAL     caseSIZEERR     OVER     Z3_     EQUALcase     ::       2DROP       {         Z1_         Z2_       }     ;     Z1_     FPTR2 ^RSUBext     ::       SWAP       FPTR2 ^ZABS       FPTR2 ^DupZIsTwo?       case       ::         SWAPDROP         Z1_       ;       DUP       ::         FPTR2 ^ISPRIME         %0<>         ?SEMI         # DE1E         ERROROUT       ;       DUP       Z1_       FPTR2 ^QSub       DUP       FPTR2 ^MZSQFF       NULL{}       SWAP       #2/       DUPUNROT       ZERO_DO       2SWAP       DROP       >TCOMP       LOOP       SWAPROT       FPTR2 ^2LAMBIND       ROT       BEGIN       Z1_       FPTR2 ^QAdd       ::         DUP         FPTR2 ^ZSQRT         SWAPDROP         caseFALSE         3PICK         FPTR2 ^ZMod         FPTR2 ^DupQIsZero?         caseFALSE         TRUE         4UNROLL         2GETLAM         #1+_ONE_DO         DUP         1GETLAM         4PICK         INDEX@         NTHCOMPDROP         FPTR2 ^ZQUOText         5PICK         FPTR2 ^ModPow         4PICK         FPTR2 ^QMod         FPTR2 ^ZIsOne?         IT         ::           4ROLLDROP           FALSE           4UNROLL           ExitAtLOOP         ;         LOOP         4ROLL       ;       UNTIL       ABND       SWAPDROP     ;     Z1_     UNROTOVER     Z1_     FPTR2 ^RSUBext     3UNROLL     Z1_     ROTDUP     FPTR2 ^Z2BIN     #1-     DUPUNROT     FPTR2 ^2LAMBIND     #2/     ONE_DO     OVER     2GETLAM     FPTR2 ^ModMul     DUP     2GETLAM     FPTR2 ^Mod     2GETLAM     OVER     FPTR2 ^RSUBext     SWAPINDEX@     #4+     UNROLL     3UNROLL     LOOP     2DROP     1GETABND     {}N   ; ;
 « Next Oldest | Next Newest »

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