Revision 4f73847b-8d48-42c3-89a0-6cdff0b8d19c - Code Golf Stack Exchange

# [Labyrinth], 80 bytes

 ?::`}:("(!@
 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!][TIO-jtao5be9]**

---
\* so [this][1] or [this][2] 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 first pass only n=2 where `2%(2-1)=0`) 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]]
 - we 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:

 " - 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:

 :":}"":({):""}"%;:{:{+}}"""""""{{{ 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


[Labyrinth]: https://github.com/m-ender/labyrinth
[TIO-jtao5be9]: https://tio.run/##y0lMqizKzCvJ@P/f3soqodZKQ0lD0YGrILUoLTW5xIqr2qraylpVqZZLu6C0pNhaQYmrtiq1KN8KxEjNKU6t1rDiUspLTfdUUlCIr@NSAoPq6molRYf//y0MjSwA "Labyrinth – Try It Online"
[1]: https://tio.run/##y0lMqizKzCvJ@P/f3soqodZKQ0lD0YFLAQKsuKqtqq2sVZVqubRBfGsFJa5asASMUa1hxaUEYgCJ@DouJTCorq5WUnT4/9/C0MgCAA "Labyrinth – Try It Online"
[2]: https://tio.run/##y0lMqizKzCvJ@P/f3soqodZKQ0lD0YHLyTXcMchVwYqr2qraylpVqZZL28fRM8haQYmrVsHfTcEKxPD19POv1rDiUgpxDA1SUlCIr@NSAoPq6molRYf//y0MjSwA

AltStyle によって変換されたページ (->オリジナル) /