?::`}:("(!@ perfect: {:{:;%"} +puts; " }zero: " }else{(: "negI" _~ """"""{{{"!@
The Latin characters perfect puts zero else neg I are actually just comments*.
i.e. if the input is perfect a 0 is printed, otherwise -1 is.
Try it online!
* so this or this work too...
?::`}:("(!@ ?::`}:("(!@ : BEWARE : {:{:;%"} {:{:;%"} + ; " +LAIR; " } : " } OF : " } {(: }MINO{(: " " _~ "TAUR" _~ """"""{{{"!@ """"""{{{"!@
How?
Takes as an input a positive integer n and places an accumulator variable of -n onto the auxiliary stack, then performs a divisibility test for each integer from n-1 down to, and including, 1, adding any which do divide n to the accumulator. Once this is complete if the accumulator variable is non-zero a -1 is output, otherwise a 0 is.
The ?::`}:( is only executed once, at the beginning of execution:
?::`}:( Main,Aux ? - take an integer from STDIN and place it onto Main [[n],[]] : - duplicate top of Main [[n,n],[]] : - duplicate top of Main [[n,n,n],[]] ` - negate top of Main [[n,n,-n],[]] } - place top of Main onto Aux [[n,n],[-n]] : - duplicate top of Main [[n,n,n],[-n]] ( - decrement top of Main [[n,n,n-1],[-n]]
The next instruction, ", is a no-op, but we have three neighbouring instructions so we branch according to the value at the top of Main, zero takes us forward, while non-zero takes us right.
If the input was 1 we go forward because the top of Main is zero:
(!@ Main,Aux ( - decrement top of Main [[1,1,-1],[-1]] ! - print top of Main, a -1 @ - exit the labyrinth
But if the input was greater than 1 we turn right because the top of Main is non-zero:
:} Main,Aux : - duplicate top of Main [[n,n,n-1,n-1],[-n]] } - place top of Main onto Aux [[n,n,n-1],[-n,n-1]]
At this point we have a three-neighbour branch, but we know n-1 is non-zero, so we turn right...
"% Main,Aux " - no-op [[n,n,n-1],[-n,n-1]] % - place modulo result onto Main [[n,n%(n-1)],[-n,n-1]] - ...i.e we've got our first divisibility indicator n%(n-1), an - accumulator, a=-n, and our potential divisor p=n-1: - [[n,n%(n-1)],[a,p]]
We are now at another three-neighbour branch at %.
If the result of % was non-zero we go left to decrement our potential divisor, p=p-1, and leave the accumulator, a, as it is:
;:{(:""}" Main,Aux ; - drop top of Main [[n],[a,p]] : - duplicate top of Main [[n,n],[a,p]] { - place top of Aux onto Main [[n,n,p],[a]] - three-neighbour branch but n-1 is non-zero so we turn left ( - decrement top of Main [[n,n,p-1],[a]] : - duplicate top of Main [[n,n,p-1,p-1],[a]] "" - no-ops [[n,n,p-1,p-1],[a]] } - place top of Main onto Aux [[n,n,p-1],[a,p-1]] " - no-op [[n,n,p-1],[a,p-1]] % - place modulo result onto Main [[n,n%(p-1)],[a,p-1]] - ...and we branch again according to the divisibility - of n by our new potential divisor, p-1
...but if the result of % was zero (for the first pass only when n=2) we go straight on to BOTH add the divisor to our accumulator, a=a+p, AND decrement our potential divisor, p=p-1:
;:{:{+}}""""""""{(:""} Main,Aux ; - drop top of Main [[n],[a,p]] : - duplicate top of Main [[n,n],[a,p]] { - place top of Aux onto Main [[n,n,p],[a]] : - duplicate top of Main [[n,n,p,p],[a]] { - place top of Aux onto Main [[n,n,p,p,a],[]] + - perform addition [[n,n,p,a+p],[]] } - place top of Main onto Aux [[n,n,p],[a+p]] } - place top of Main onto Aux [[n,n],[a+p,p]] """"""" - no-ops [[n,n],[a+p,p]] - a branch, but n is non-zero so we turn left " - no-op [[n,n],[a+p,p]] { - place top of Aux onto Main [[n,n,p],[a+p]] - we branch, but p is non-zero so we turn right ( - decrement top of Main [[n,n,p-1],[a+p]] : - duplicate top of Main [[n,n,p-1,p-1],[a+p]] "" - no-ops [[n,n,p-1,p-1],[a+p]] } - place top of Main onto Aux [[n,n,p-1],[a+p,p-1]]
At this point if p-1 is still non-zero we turn left:
"% Main,Aux " - no-op [[n,n,p-1],[a+p,p-1]] % - modulo [[n,n%(p-1)],[a+p,p-1]] - ...and we branch again according to the divisibility - of n by our new potential divisor, p-1
...but if p-1 hit zero we go straight up to the : on the second line of the labyrinth (you've seen all the instructions before, so I'm leaving their descriptions out and just giving their effect):
:":}"":({):""}"%;:{:{+}}"""""""{{{ Main,Aux : - [[n,n,0,0],[a,0]] " - [[n,n,0,0],[a,0]] - top of Main is zero so we go straight - ...but we hit the wall and so turn around : - [[n,n,0,0,0],[a,0]] } - [[n,n,0,0],[a,0,0]] - top of Main is zero so we go straight "" - [[n,n,0,0],[a,0,0]] : - [[n,n,0,0,0],[a,0,0]] ( - [[n,n,0,0,-1],[a,0,0]] { - [[n,n,0,0,-1,0],[a,0]] - top of Main is zero so we go straight - ...but we hit the wall and so turn around ( - [[n,n,0,0,-1,-1],[a,0]] : - [[n,n,0,0,-1,-1,-1],[a,0]] "" - [[n,n,0,0,-1,-1,-1],[a,0]] } - [[n,n,0,0,-1,-1],[a,0,-1]] - top of Main is non-zero so we turn left " - [[n,n,0,0,-1,-1],[a,0,-1]] % - (-1)%(-1)=0 [[n,n,0,0,0],[a,0,-1]] ; - [[n,n,0,0],[a,0,-1]] : - [[n,n,0,0,0],[a,0,-1]] { - [[n,n,0,0,0,-1],[a,0]] : - [[n,n,0,0,0,-1,-1],[a,0]] { - [[n,n,0,0,0,-1,-1,0],[a]] + - [[n,n,0,0,0,-1,-1],[a]] } - [[n,n,0,0,0,-1],[a,-1]] } - [[n,n,0,0,0],[a,-1,-1]] """"""" - [[n,n,0,0,0],[a,-1,-1]] - top of Main is zero so we go straight { - [[n,n,0,0,0,-1],[a,-1]] { - [[n,n,0,0,0,-1,-1],[a]] { - [[n,n,0,0,0,-1,-1,a],[]]
Now this { has three neighbouring instructions, so...
...if a is zero, which it will be for perfect n, then we go straight:
"!@ Main,Aux " - [[n,n,0,0,0,-1,-1,a],[]] - top of Main is a, which is zero, so we go straight ! - print top of Main, which is a, which is a 0 @ - exit the labyrinth
...if a is non-zero, which it will be for non-perfect n, then we turn left:
_~"!@ Main,Aux _ - place a zero onto Main [[n,n,0,0,0,-1,-1,a,0],[]] ~ - bitwise NOT top of Main (=-1-x) [[n,n,0,0,0,-1,-1,a,-1],[]] " - [[n,n,0,0,0,-1,-1,a,-1],[]] - top of Main is NEGATIVE so we turn left ! - print top of Main, which is -1 @ - exit the labyrinth
1would be perfect, since every number is divisible by1and itself. The sum of proper divisors of1is0\$\endgroup\$