title: Does it oscillate periodically?

text:
# Question
Title: Does it oscillate periodically?
# Challenge

Given a list, determine if grouping the list into runs of increasing and decreasing elements will result in a list of equal-sized lists.

In other words, "turning points" of the list are spaced out evenly.

# Example

Here's an example: `0, 3, 7, 5, 2, 3, 6`

`0, 3, 7` increases, `7, 5, 2` decreases, and `2, 3, 6` increases. Therefore this is truthy.

Another example: `1, 4, 6, 8, 5, 3, 5, 7, 9`

`1, 4, 6, 8` increases, `8, 5, 3` decreases, and `3, 5, 7, 9` increases. Therefore this is falsy.

# Rules and Specifications

* No adjacent elements will be equal
* All numbers can be assumed to be within your language's reasonable number range
* You may assume that all numbers are integers, if it helps you golf your submission
* This is , so the shortest answer wins
* Input as a list in any reasonable representation and output as any truthy/falsy value. The two values must be consistent.

# Test Cases

```
Input -> Output
1, 3, 5, 8, 6, 4, 2, 3, 5, 7, 6, 4, 2, 5, 7, 9, 6, 4, 2 -> True
1, 3, 5, 7, 6, 4, 5, 7, 9, 8, 6, 4, 2, 3, 5 -> False
2, 3, 6, 4, 2, 3, 7, 5, 3, 4, 6 -> True
3, 6, 4, 8, 5, 7, 3, 5, 2 -> True
8 -> True
1, 3, 5, 7 -> True
4, 5, 7, 6, 8, 9 -> False
6, 4, 2, 3, 5, 4, 2 -> True
8, 5, 3, 2, 4, 6, 5, 3, 2, 5, 7 -> False

```

**Note**: You may not assume that all numbers are single digits (unless that is all your language is capable of handling); the test cases reflect that just because it's easier for me to type the cases this way :P Here are a few test cases with numbers outside of that range:

```
1, 5, 10, 19, 15, 13, 8, 13, 18, 23, 19, 18, 14 -> True
15, 14, 17, 16, 19, 18 -> True
12, 16, 19, 15, 18, 19 -> False

```

# Answer
> 9 votes
# MATL, ~~10~~ 9 bytes

```
dZS&Y'da~

```

Try it online!

Saved one byte thanks to Luis Mendo!

### Explanation:

Assume the input is: `[0, 3, 7, 5, 2, 3, 6]`:

```
            % Implicit input:                                [0, 3, 7, 5, 2, 3, 6]
d           % Difference between adjacent elements:          [3, 4, -2, -3,  1,  3]
 ZS         % Sign of the differences:                       [1, 1, -1, -1, 1, 1]
   &Y'      % Length of runs of consecutive elements:        [2, 2, 2]
     d      % Difference between the lengths:                [0, 0]
      a     % Any non-zero elements:                         False
       ~    % Negate, to get a truthy value if all are zero: True

```

# Answer
> 8 votes
# Jelly, 6 bytes

```
IṠŒgAE

```

Try it online!

Saved 1 byte thanks to Adnan!

## How it works

```
IṠŒgAE  - Full program.

I       - Increments (Deltas).
 Ṡ      - Sign of each. -1 if negative, 0 if null, 1 if positive.
  Œg    - Group runs of adjacent elements.
    A   - Absolute value. Vectorizes. This maps -1 and 1 to the same value.
     E  - Are all equal?

```

While golfing, I discovered some cool, longer alternatives: `IṠŒgL€E`, `IṠŒrṪ€E` (uses run-length-encode instead).

# Answer
> 7 votes
# Wolfram Language (Mathematica), 38 bytes

```
Equal@@(1^Differences@#~SplitBy~Sign)&

```

Try it online!

### Explanation

```
Equal@@(1^Differences@#~SplitBy~Sign)&  (* Input:                {3, 6, 4, 8, 5, 7, 3, 5, 2} *)

          Differences@#                 (* Take differences:     {3, -2, 4, -3, 2, -4, 2, -3} *)
                       ~SplitBy~Sign    (* Split by sign:        {{3}, {-2}, {4}, {-3}, {2}, {-4}, {2}, {-3}} *)
        1^                              (* Raise to power of 1:  {{1}, {1}, {1}, {1}, {1}, {1}, {1}, {1}} *)
Equal@@                                 (* Check equal:          True *)

```

# Answer
> 7 votes
# Octave, ~~54~~ 50 bytes

```
@(x)nnz(unique(diff(find([diff(diff(x)>0) 1]))))<2

```

**Try it online!**

### Explanation

```
@(x)nnz(unique(diff(find([diff(diff(x)>0) 1]))))<2

@(x)                                                % Define anonymous function
                               diff(x)              % Deltas (consecutive differences)
                                      >0            % Positive? Gives signs
                          diff(         )           % Deltas between signs
                         [                1]        % Append 1 to "close" last group
                    find(                   )       % Indices of nonzeros
               diff(                         )      % Deltas. Gives group lengths
        unique(                               )     % Remove duplicates
    nnz(                                       )    % Number of nonzeros. Gives length
                                                <2  % If 1 or 0: input is periodic

```

# Answer
> 6 votes
## R, 36 bytes

```
function(n)!sd(rle(sign(diff(n)))$l)

```

`diff` computes the successive differences, then `sign` squishes those down to ±1. `rle` then run-length encodes them. All the elements of this `rle` should be the same, i.e. the vector has standard deviation zero. `!` then produces the correct logical output.

# Answer
> 5 votes
# 05AB1E, ~~8~~ 7 bytes

```
¥0.SγaË

```

Try it online!

-1 thanks to Adnan.

# Answer
> 5 votes
# C (gcc), ~~143~~ ~~140~~ ~~138~~ ~~136~~ ~~135~~ 132 bytes

* Saved three bytes; using a variable `r` to store the function's return boolean instead of terminating using `return`.
* Saved two bytes; golfing `int A[]` to `int*A` (using a pointer instead of an array).
* Saved two bytes thanks to Steadybox; golfing `f(int*A,int a)` to `f(A,a)int*A;`.
* Saved a byte; golfing `if(d!=...` to `if(d-...`.
* Saved three bytes; golfing `;j++...j+1` to `;...++j`.

```
j,d,e,l,m,r;f(A,a)int*A;{for(d=A[0]>A[1],r=1,j=m=l=0;j-~-a;){l++;if(d-(e=A[j]>A[++j]))d=e,j--,r*=l>=(m=!m?l:m),l=0;}r*=-~l==m||m<1;}

```

Try it online!

Defines a function `f` which looks at every element in the list but the last and determines this element's relation to the next element in the list. The number of consecutive equal comparisons is stored the first time the relation flips, any runs after the initial run that differ in length to the stored length result in a falsy output. At the end, the second-to-last element's relation to the last element's is looked at so that it matches the rest of the list.

# Answer
> 4 votes
# Pyth, 11 bytes

```
qFlM.g._k.+

```

Try it here.

# Answer
> 4 votes
# Python 2, ~~107~~ ~~105~~ ~~103~~ ~~97~~ ~~96~~ ~~94~~ 91 bytes

```
lambda l:len({sum(g)**2for k,g in groupby(map(cmp,l[:-1],l[1:]))})<2
from itertools import*

```

Try it online!

# Python 3, ~~102~~ ~~100~~ 97 bytes

```
lambda l:len({len([*g])for k,g in groupby(x>y for x,y in zip(l,l[1:]))})<2
from itertools import*

```

Try it online!

# Answer
> 4 votes
# Husk, 7 bytes

```
EmLġ±Ẋ-

```

Try it online!

## How this works

```
EmLġ±Ẋ-  ~ Full program.

     Ẋ   ~ Map over pairs of adjacent elements.
      -  ~ With subtraction (this computes the deltas)
   ġ     ~ Group using equality predicate.
    ±    ~ Sign.
 mL      ~ Get the lengths.
E        ~ Are all equal?

```

Some cute alternatives:

```
εġLġ±Ẋ-
εüLġ±Ẋ-

```

# Answer
> 4 votes
# Python 2, 96 bytes

```
import re
def f(x):exec"x=map(cmp,x[1:],x[:-1]);"*2;re.match('.([^1]*)(-?1, \\1)*9',`x+[9]`)<0<_

```

Try it online! Output via exit code: crash (1) is falsey, clean exit (0) is truthy.

### Python 2, 106 bytes

```
def f(x):d=map(cmp,x[1:],x[:-1]);l=len(d);s=(d+[0])[0];k=(d+[-s]).index(-s);print((k*[s]+k*[-s])*l)[:l]==d

```

Try it online!

# Answer
> 4 votes
# Desmos, 82 bytes

```
f(l)=0^{mod(k/k[1],1).total}
L=D(D(l))
k=[1...L.length][LL=1]
D(l)=sign(l[2...]-l)

```

Try It On Desmos!

Try It On Desmos! - Prettified

### Explanation

`D(l)=sign(l[2...]-l)`: Takes the consecutive differences of the input list `l`, and takes the `sign` of the resulting differences.

`L=D(D(l))`: Applies the function `D` described above 2 times on `l`. The first difference will output a list (which I will denote as `A`) that, for each value of the original list `l[i]` for some `i` in the range `[1,l.length-1]`, does the following:

* If `l[i]<l[i+1]`, `A[i]` will be 1. In other words, if `l` increases from `l[i]` to the next element, then it is denoted in the new list as 1.
* If `l[i]>l[i+1]`, `A[i]` will be -1. In other words, if `l` decreases from `l[i]` to the next element, then it is denoted in the new list as -1.

Note that we don't have to consider the case where `l[i]=l[i+1]`, because that is guaranteed not to happen as per the specs:

> * No adjacent elements will be equal

The second difference outputs a list (denoted as `B` below) that does the following for each value in `A`, `A[i]`, for some `i` in the range `[1,A.length-1]` (remember that the first difference is denoted as `A`):

* If `A[i]=A[i+1]`, then `B[i]` will be 0. In terms of `l`, what this checks for is if `l[i]`, `l[i+1]`, and `l[i+2]` are all either increasing or decreasing.
* If `A[i]<A[i+1]`, then `B[i]` will be 1. In terms of `l`, what this checks for is if it decreases from `l[i]` to `l[i+1]`, but increases from `l[i+1]` to `l[i+2]`. In other words, this will check for transitions from a decreasing run to an increasing run.
* Similarly, if `A[i]>A[i+1]`, then `B[i]` will be -1. In terms of `l`, what this checks for is if it increases from `l[i]` to `l[i+1]`, but decreases from `l[i+1]` to `l[i+2]`. In other words, this will check for transitions from an increasing run to a decreasing run.

`k=[1...L.length][LL=1]`: Filters the range `[1...L.length]` based on whether `L*L` is 1. This essentially obtains a list of indices at which `L` is either 1 or -1, and removes the indices where it is 0. What this achieves is that it will find the indices of the "turning points".

`f(l)=0^{mod(k/k[1],1).total}`: Divides each element of `k` by the first element `k[1]`, and then takes the fractional part of the resulting quotients.

If the "turning points" are spaced out evenly, then this will result in a list of all 0's. Otherwise, at least one element will be a decimal number.

The `total` of this list is 0 only if the list only contains 0's, and nothing else. Otherwise, the `total` will be some number greater than 0. In other words, the `total` is 0 only if the elements are spaced out equally.

The last part is that, `0^0` is 1, will `0^n` for some positive number `n` is 0. We can take advantage of this by using the `total` we obtained, and raising 0 to the power of the `total`. Recall that if the "turning points" are all spaced out evenly, then the `total` will be 0. This will cause `0^{mod(k/k[1],1).total}` to be 1. Otherwise, if they aren't spaced out equally, the `total` is greater than 0, so `0^{mod(k/k[1],1).total}` will be 0.

# Answer
> 3 votes
# JavaScript (ES6), 81 bytes

This seems too long. I'm probably missing something here... Returns either `true` or `undefined`.

```
f=(a,p=1)=>a.every((n,i)=>!i|!(1/(y=a[i+1]))|!(i%p)^y>n^a[i-1]>n)||a[p]&&f(a,p+1)

```

Looks for a period ***0 \< p \< a.length*** such that all direction changes occur every ***p*** elements.

### Test cases

```
f=(a,p=1)=>a.every((n,i)=>!i|!(1/(y=a[i+1]))|!(i%p)^y>n^a[i-1]>n)||a[p]&&f(a,p+1)

console.log(f([1, 3, 5, 8, 6, 4, 2, 3, 5, 7, 6, 4, 2, 5, 7, 9, 6, 4, 2])) // -> True
console.log(f([1, 3, 5, 7, 6, 4, 5, 7, 9, 8, 6, 4, 2, 3, 5])) // -> False
console.log(f([2, 3, 6, 4, 2, 3, 7, 5, 3, 4, 6])) // -> True
console.log(f([3, 6, 4, 8, 5, 7, 3, 5, 2])) // -> True
console.log(f([8])) // -> True
console.log(f([1, 3, 5, 7])) // -> True
console.log(f([4, 5, 7, 6, 8, 9])) // -> False
console.log(f([15, 14, 17, 16, 19, 18])) // -> True
console.log(f([19, 15, 14, 17, 18, 17, 16, 19, 20])) // -> True
```

# Answer
> 3 votes
# Haskell, ~~79~~ ~~78~~ 77 bytes

```
import Data.List
g s|h:t<-(1<$)<$>group(zipWith(<)s$tail s)=all(==h)t
g _=1<3

```

Try it online!

Given a list `s`, `zipWith(<)s$tail s`tests for each element whether it is smaller than its successor, e.g. `s=[2,3,6,4,2,3,7,5,3]` yields `[True,True,False,False,True,True,False,False]`. Then `group` runs of the same elements together: `[[True,True],[False,False],[True,True],[False,False]]`. To check whether all those lists have the same length, replace their elements with `1` (see this tip) yielding `[[1,1],[1,1],[1,1],[1,1]]` and check if all elements in the tail `t` of this list equal the head `h`: `all(==h)t`.

This approach does not work for singleton lists, but because those are always true, we can handle them in their own case: `g[_]=1<3`.

# Answer
> 2 votes
# , 57 bytes

```
function(x){d=diff
sum(rle(d(which(!!d(d(x)>0))))$v^0)<2}

```

Try it online!

# Answer
> 2 votes
# Japt, 15 bytes

```
ä- mg ò¦ mÊä¥ e

```

Try it online!

## Explanation

```
ä- mg ò¦ mÊä¥ e                                                  [0,3,7,5,2,3,6]
ä-                // Difference between neighboring elements     [-3,-4,2,3,-1,-3]
   mg             // Get the sign of each element                [-1,-1,1,1,-1,-1]
      ò¦          // Partition between different elements        [[-1,-1],[1,1],[-1,-1]]
         mÊ       // Get the length of each element              [2,2,2]
           ä¥     // Check for uniqueness                        [true,true]
              e   // Return true if all elements are truthy      true

```

# Answer
> 2 votes
## Clojure, ~~70~~ 63 bytes

```
#(<(count(set(map count(partition-by pos?(map -(rest %)%)))))2)

```

Returns true or false. The original answer was a bit silly.

# Answer
> 2 votes
# Haskell (Lambdabot), 59 bytes

```
g(map(1<$).group.ap(zipWith(<))tail->h:t)=all(==h)t;g _=1<3

```

Based on @Laikoni's answer

# Answer
> 1 votes
# Python 2, ~~110~~ 99 bytes

*-11 bytes thanks to @Lynn*

```
d=input()
exec"d=map(cmp,d[:-1],d[1:]);"*2
x=[i+1for i,e in enumerate(d)if e]
for i in x:i%x[0]>0<q

```

Try it online!

# Answer
> 1 votes
# Java (OpenJDK 8), ~~437~~ ~~302~~ ~~256~~ 188 bytes

```
a->{int i=0,g=0,x=0,l=0;String d="";for(;i<~-a.length;d+=a[0].compare(a[i+1],a[i++])+1);for(String s:d.split("(?<=(.))(?!\\1)"))if(g++<1)x=s.length();else if(s.length()!=x)l++;return l<1;}

```

Try it online!

# Answer
> 1 votes
# Java (OpenJDK 8), 135 bytes

```
a->{Integer i=0,c,d=0,p=0,r=0;for(;++i<a.length;)d+=(i<2|(c=i.signum(a[i-1]-a[i]))<0?d<0:d>0)?c:p==0|p==-d?c-(p=d):1-(r=1);return r<1;}

```

Try it online!

# Explanations

```
a->{                    // int array
 Integer i=0,c,d=0,p=0,r=0;
                        // variable definitions, use Integer to abuse static calls
 for(;++i<a.length;)    // Loop from 1 till length - 1
  d+=                   // Change d
   (i<2                 // First iteration?
     |(c=i.signum(a[i-1]-a[i]))<0?d<0:d>0
   )                    // Or do c and d have the same sign?
    ?c                  // then increase the magnitude of d.
    :p==0|p==-d         // else we're in a u-turn. Is it the first? Or is the magnitude the same as previously?
     ?c-(p=d)           // assign the new magnitude with sign to p and reset d to -1 (if was positive) or 1 (if was negative)
     :1-(r=1);          // else just do r=1 (technically: "add 1-1=0 to d" as well)
 return r<1;            // return whether there were wrong amplitudes.
}

```

# Answer
> 1 votes
# Ruby, 57 bytes

```
->a{!a.each_cons(2).chunk{|x,y|x>y}.uniq{|*,x|x.size}[1]}

```

Try it online!

# Answer
> 1 votes
# Japt, 9 bytes

Outputs `false` for truthy and `true` for falsey.

```
äÎòÎmÊäÎd

```

Try it (footer negates the output) or run all test cases

```
äÎòÎmÊäÎd     :Implicit input of array                                    > [0,3,7,5,2,3,6]
ä             :Consecutive pairs                                          > [[0,3],[3,7],[7,5],[5,2],[2,3],[3,6]]
 Î            :  Reduced by the sign of their differences (1 or -1)       > [-1,-1,1,1,-1,-1]
  ò           :Partition between elements that return true (not zero)
   Î          :  Get the sign of their difference                         > [[-1,-1],[1,1],[-1,-1]]
    m         :Map
     Ê        :  Length                                                   > [2,2,2]
      ä       :Consecutive pairs                                          > [[2,2],[2,2]]
       Î      :  Reduced by the sign of their differences                 > [0,0]
        d     :Any truthy?                                                > false

```

# Answer
> 1 votes
# Husk, 7 bytes

```
Λ≡gẊo±-

```

Try it online!

# Answer
> 1 votes
# Vyxal, 5 bytes

```
¯±Ġȧ≈

```

Try it Online!

Port of Jelly answer.

## How?

```
¯±Ġȧ≈
¯     # Get the deltas (consecutive differences) of input
 ±    # Get the sign (implicit vectorization)
  Ġ   # Group consecutive identical items
   ȧ  # Absolute value (implicit double-vectorization)
    ≈ # All equal?

```

# Answer
> 1 votes
# Factor, 49 bytes

```
[ [ trends check-lengths t ] [ tuple? ] recover ]

```

Try it online!

There is a lot to unpack here. First, Factor (nearly!) has the perfect word for this problem, `trends`, which splits a sequence into its rising, falling, and stable parts. This question guarantees no two adjacent elements will be equal, so we don't need to worry about receiving any stable trends in the result.

The problem is, for some unfathomable reason, if the sequence has only one trend, `trends` returns a single trend object instead of a sequence with a single trend object in it. Thus when we attempt to see if the lengths of the trends are all equal, we'll get an error that `length` can't be applied to a non-sequence if there is only a single trend.

Next, instead of saying something like `[ length ] map all-eq?`, Factor has a word in its (exposed) compiler named `check-lengths` that throws an error if the lengths of a sequence are not all equal. So `check-lengths` is capable of failing in two different ways: either it'll end up calling `length` on a non-sequence, or it'll throw an error if the lengths of its input are not all the same.

Enter `recover`, one of Factor's exception handling words. It calls the first quotation (which will simply return `t` if no errors are encountered) and calls the second quotation with the error on top of the stack if the first quotation encounters an error. Inside this quotation, all we need to do is check whether the error is a tuple or not, because calling `length` on a non-sequence produces an actual error tuple while `check-lengths` throws a simple string error if the lengths are unequal.

---
Tags: code-golf, array, decision-problem
---


# Question
Title: How Mondrian is your fine art collection?
For the purpose of this challenge a rectangular piece of ASCII art is *Mondrian* if it looks the same upside down.

#### What does "looks the same" mean?

A *feature* is any orthogonally connected region of at last 5 characters. A *Mondrian feature* is any feature that appears in the same picture upside down. (This includes the possibility of the feature being rotationally symmetric in which case the feature counts as its own upside-down appearance.)

A picture is *Mondrian* if each of its characters is part of at least one Mondrian feature.

#### Your task:

Write a function or program that given a rectangle of ASCII characters returns it upside down if it is Mondrian and unchanged otherwise. If the entire picture is rotationally symmetric (such that it is Mondrian but has no upside-down state) the program or function should die horribly. You are free to choose amongst crash, hang, run forever, error out or simply end without output.

You may assume that the input is a clean rectangle of size at least 2x2.

This is code-golf. Standard rules apply, except despite this more or less being a binary decision you *cannot* do the usual truthy / falsy shenanigans.

You can take input in any reasonable format, e.g. newline separated string, list of lines, array of characters, but must output in the same format.

#### More clarifications on "upside down":

* We mean (180-degree) rotation, not mirroring.
* Characters are atoms, for example `p` upside down is `p`, not `d`.

Also: Features are allowed to overlap. (They do in both Mondrian examples below.)

#### Examples:

Mondrian:

```
-+-----+--
 |     |
=#=====#==
-+-----+--

*|./*
-+=+-
=#-#=
.|*/.

```

Explanation (possible list of Mondrian features) for 2nd example:

```
-+=+-

=#-#=

*
-
=
.|*

./*
=
-
*

```

Not Mondrian:

```
-___---
//O////
~/|\.~~
./ \...

```

Mondrian impostor (not Mondrian):

```
----
||||
----
||||
~~~~

```

Die horribly:

```
 -
/ \
|
 \
  |
\ /
 -

```

# Answer
> 8 votes
# , 114 bytes

```
-.@(-:g)#,=&#[:~.@;@,(g=.|.@|:^:2)([:(#~4<#&>)@(</.~[:+./ .*^:_~1>:|@-/~)$j./@#:I.@,)@:="2]|.!.(u:0)~[:>@,@{<@i:@$

```

Try it online!

The basic approach is the only mildly interesting part, so I will explain that without breaking down the J mechanics, which are straightforward, could likely be golfed further, though it wouldn't be terribly interesting without a high-level strategy change as well.

1. Do the 180 rotation.
2. Check where it is equal to the input.
3. Also check every possible 2d sliding of the input. You can imagine it as two sheets of paper, keeping the edges aligned, sliding the top one in every direction where there is still any overlap.
4. For each of these, we then have a boolean matrix showing which elements are equal. But we only care about connected `1` islands of length 5 or more.
5. To find these, we turn the `1`s into coordinates and compute an adjacency matrix, taking their transitive closure, grouping by equal rows, and only keeping "sets" of equal rows of length 5 or more. This is part is done here.
6. We combine all these valid coordinates we've found for every slid position, take their uniq, and see if it has as many elements as the input. If so, we are Mondrian.
7. Finally, we check if the rotation is equal to the input directly, and filter away our input if it is.

# Answer
> 2 votes
# Python3, 730 bytes:

```
E=enumerate
v=lambda x:[[i[j]for i in x[::-1]]for j,_ in E(x[0])]
t=lambda x:{(x,y):k for x,a in E(x)for y,k in E(a)}
V=lambda b,x,y:0<=x<len(b)and 0<=y<len(b[0])
F=''.join
M='\n'.join
P=lambda x:M(W[max(i for i,_ in E(x[0])if all(y[:i].lstrip()==''for y in x)):].strip()for W in x)
def f(b):
 B,C=t(b),t(c:=v(v(b)))
 q,r=[(i,I,[i])for i in B for I in C if B[i]==C[I]],[]
 while q:
  (x,y),(X,Y),p=q.pop(0)
  if len(p)>4:r+=[p]
  for j,k in[(1,0),(0,1),(-1,0),(0,-1)]:
   if V(b,J:=x+j,K:=y+k)and V(c,Q:=X+j,W:=Y+k)and(J,K)not in p and B[(J,K)]==C[(Q,W)]:q+=[((J,K),(Q,W),p+[(J,K)])]
 if{B[j]for k in r for j in k}=={j for k in b for j in k}:
  if P([*map(F,b)])==P([*map(F,c)]):f(b)
  return M(map(F,v(v(b))))
 return M(map(F,b))

```

Try it online!

---
Tags: code-golf, ascii-art, decision-problem, image-processing
---


title: Increment, decrement, undo, peek

text:
# Question
Title: Increment, decrement, undo, peek
Write a program or function (hereafter "function") that returns or prints the source code of four new functions: Increment, decrement, undo, and peek.

The initial function contains an internal integer value of `0`. Each of the returned functions contains a value based on that value, and each behaves differently:

* **Increment** contains the value of the function that created it plus 1. When called, it returns or prints the source code of four new functions: Increment, decrement, undo, and peek.
* **Decrement** contains the value of the function that created it minus 1. When called, it returns or prints the source code of four new functions: Increment, decrement, undo, and peek.
* **Undo** returns increment, decrement, undo, and peek functions equivalent to those returned by the function that created the function that created it, i.e. its grandparent. Calling successive Undo functions will return functions earlier and earlier in the "history." *Note: Because the very first generation of Undo has no "grandparent" its behavior is undefined. It may return any value, throw an error, etc.*
* **Peek** contains the value of the function that created it. When called it returns or prints that value.

## Example

Suppose `yourFunction` is your initial function. It returns four strings that contain the source code of the subsequent functions.

```
[incr, decr, undo, peek] = yourFunction();
eval(peek)(); // => 0

[incrB, decrB, undoB, peekB] = eval(incr)();
eval(peekB)(); // => 1

[incrC, decrC, undoC, peekC] = eval(incrB)();
eval(peekC)(); // => 2

[incrD, decrD, undoD, peekD] = eval(incrC)();
eval(peekD)(); // => 3

[incrE, decrE, undoE, peekE] = eval(undoD)();
eval(peekE)(); // => 2

[incrF, decrF, undoF, peekF] = eval(undoE)();
eval(peekF)(); // => 1

[incrG, decrG, undoG, peekG] = eval(decrF)();
eval(peekG)(); // => 0
eval(peekF)(); // => 1

```

## Rules

1. This is a challenge. With the exception of "peek," the initial function and the functions it creates (and the functions they create and so on) must return source code that can be stored (copied/pasted, saved in a file, et al) and executed in a separate session. Returning a closure, for example, is not valid.
2. The functions generated don't need to be named "increment," "decrement," etc. They're not required to be named at all.
3. The "depth" of the Undo functions, i.e. how far back you can go in their "history," should be limited only by memory or language constraints.
4. You're encouraged to include in your answer examples of the four functions generated by your initial function or its successors.
5. The output formats are flexible. Inclusive of rule (1), standard I/O rules apply; your initial function—and the subsequent functions—could return four programs separated by newlines; an array of four strings; an object with four string properties; four files; etc.
6. Standard rules apply and standard loopholes are forbidden.
7. This is . Your score is the number of bytes in your initial function. Lowest number of bytes wins.

# Answer
> 8 votes
# Wolfram Language (Mathematica), ~~54~~ 35 bytes

```
Hold[1~#0~##,#0[-1,##],#0@##2,+##]&

```

Try it online!

Returns `Hold[incr, decr, undo, peek]`, where the expression body consists of four unevaluated expressions. When evaluated, `incr`, `decr`, and `undo` reduce to similar four-element `Hold[...]` expressions, and `peek` to an integer\*.

* Upon `undo`ing with no history, `peek` takes on the value `##2`, and subsequent `incr`/`decr` operations yield `peek=n+##2` for some integer `n`. `undo`ing that `undo` restores `peek=0`.

# Answer
> 6 votes
# JavaScript (ES6), 98 bytes

```
f=(k=0,p='' )=>[(g=n=>(0+f).replace(/\S*/,`f=(k=${k+n},p="${btoa(f)}"`))(1),g(-1),atob(p),"_=>"+k]

```

Try it online!

# Answer
> 6 votes
# Python REPL, ~~67~~ ~~61~~ 59 bytes

```
eval(s:='0,(n:="eval(s:=%r)")%("-~"+s),n%("~-"+s),n%s[2:]')

```

Attempt This Online!

Outputs `(peek, incr, decr, undo)`

# Python, ~~89~~ ~~99~~ ~~93~~ ~~91~~ 86 bytes

```
lambda:eval(s:='(n:="lambda:eval(s:=%r)")%(s+"\'+1\'"),n%(s+"\'-1\'"),n%s[:-4],n%"0"')

```

Attempt This Online!

Outputs `(incr, decr, undo, peek)`

+10 bytes due to an oversight (peek was a lambda and not a string which contained a lambda. Old Answer)

# Answer
> 6 votes
# Rust, 603 bytes

```
fn f(){let m=("fn ","(){let m=",";let n=vec!",";println!(\"fn a(){{println!(\\\"","\\\")}}\");for i in [(\"b\",",",\"\"),(\"c\",",",\"\"),(\"d\",",",\"o.pop();\")]{let mut o=n.clone();o.push(i.1);","println!(\"{}{}{}{:?}{}{:?}{}{}{}{}{}{}{}{}{}{}{}\",m.0,i.0,m.1,m,m.2,o,m.3,i.1,m.4,i.1+1,m.5,i.1-1,m.6,o[o.len()-2],m.7,i.2,m.8);}}");let n=vec![0,0];println!("fn a(){{println!(\"0\")}}");for i in [("b",1,""),("c",-1,""),("d",0,"o.pop();")]{let mut o=n.clone();o.push(i.1);println!("{}{}{}{:?}{}{:?}{}{}{}{}{}{}{}{}{}{}{}",m.0,i.0,m.1,m,m.2,o,m.3,i.1,m.4,i.1+1,m.5,i.1-1,m.6,o[o.len()-2],m.7,i.2,m.8);}}

```

Attempt This Online!

Attempt this after a couple iterations

Probably not anywhere close to optimally golfed, but I'm pretty impressed with myself for getting it to work at all.

Expanded version:

```
fn f() {
    let m=("fn ","(){let m=",";let n=vec!",";println!(\"fn a(){{println!(\\\"","\\\")}}\");for i in [(\"b\",",",\"\"),(\"c\",",",\"\"),(\"d\",",",\"o.pop();\")]{let mut o=n.clone();o.push(i.1);","println!(\"{}{}{}{:?}{}{:?}{}{}{}{}{}{}{}{}{}{}{}\",m.0,i.0,m.1,m,m.2,o,m.3,i.1,m.4,i.1+1,m.5,i.1-1,m.6,o[o.len()-2],m.7,i.2,m.8);}}");
    let n = vec![0, 0];
    println!("fn a(){{println!(\"0\")}}");
    for i in [("b", 1, ""), ("c", -1, ""), ("d", 0, "o.pop();")] {
        let mut o = n.clone();
        o.push(i.1);
        println!(
            "{}{}{}{:?}{}{:?}{}{}{}{}{}{}{}{}{}{}{}",
            m.0,
            i.0,
            m.1,
            m,
            m.2,
            o,
            m.3,
            i.1,
            m.4,
            i.1 + 1,
            m.5,
            i.1 - 1,
            m.6,
            o[o.len() - 2],
            m.7,
            i.2,
            m.8
        );
    }
}

```

# Answer
> 6 votes
# Rust, 279 bytes

```
||{macro_rules!q{($x:tt)=>{$x(stringify!($x))}}
q!((|s|move|mut v:Vec<_>,n|{let f=|m,u:&_|format!("||{{macro_rules!q{{($x:tt)=>{{$x(stringify!($x))}}}}
q!({})(vec!{:?},{})}}",s,u,m);v.push(n);(f(n+1,&v),f(n-1,&v),f({v.pop();v.pop()}.unwrap(),&v),format!("||{}",n))}))(vec![0],0)}

```

This is a nullary closure that returns a 4-tuple of strings. It uses a macro to do most of the quine heavy-lifting. The state is inserted right towards the end, using a vector for the undo history. The undo history starts with a single entry so the `.unwrap()` doesn't panic, but the program outputted using it *will* panic.

Attempt This Online! (after a few iterations)

Initial output:

```
// inc
||{macro_rules!q{($x:tt)=>{$x(stringify!($x))}}
q!((| s | move | mut v : Vec < _ >, n |
{
    let f = | m, u : & _ | format!
    ("||{{macro_rules!q{{($x:tt)=>{{$x(stringify!($x))}}}}
q!({})(vec!{:?},{})}}",
    s, u, m) ; v.push(n) ;
    (f(n + 1, & v), f(n - 1, & v), f({ v.pop() ; v.pop() }.unwrap(), & v),
    format! ("||{}", n))
}))(vec![0, 0],1)}

// dec
||{macro_rules!q{($x:tt)=>{$x(stringify!($x))}}
q!((| s | move | mut v : Vec < _ >, n |
{
    let f = | m, u : & _ | format!
    ("||{{macro_rules!q{{($x:tt)=>{{$x(stringify!($x))}}}}
q!({})(vec!{:?},{})}}",
    s, u, m) ; v.push(n) ;
    (f(n + 1, & v), f(n - 1, & v), f({ v.pop() ; v.pop() }.unwrap(), & v),
    format! ("||{}", n))
}))(vec![0, 0],-1)}

// undo (will panic)
||{macro_rules!q{($x:tt)=>{$x(stringify!($x))}}
q!((| s | move | mut v : Vec < _ >, n |
{
    let f = | m, u : & _ | format!
    ("||{{macro_rules!q{{($x:tt)=>{{$x(stringify!($x))}}}}
q!({})(vec!{:?},{})}}",
    s, u, m) ; v.push(n) ;
    (f(n + 1, & v), f(n - 1, & v), f({ v.pop() ; v.pop() }.unwrap(), & v),
    format! ("||{}", n))
}))(vec![],0)}

// peek
||0

```

# Answer
> 4 votes
# Kotlin 1.7.10, 494 490 bytes

```
{val q='!'+1;val h=listOf(0,0);fun p(h:List<Int>){val l=listOf("{val q='!'+1;val h=listOf(","h.joinToString()",");fun p(h:List<Int>){val l=listOf(",");print(l[0]+h.joinToString()+l[2]);for(r in l)print(q+r+q+',');println(l[3])};p(h+(h.last()+1));p(h+(h.last()-1));p(h.dropLast(1));print('{');print(h.last());print('}')}");print(l[0]+h.joinToString()+l[2]);for(r in l)print(q+r+q+',');println(l[3])};p(h+(h.last()+1));p(h+(h.last()-1));p(h.dropLast(1));print('{');print(h.last());print('}')}

```

Try it on Kotlin Playground!

A function/lambda that prints the source code for four new lambdas: increment, decrement, undo and peek.

Calling the first-generation undo function produces a lambda that compiles but produces invalid sources for its own undo.

## Explanation

```
{                         // A lambda of type () -> Unit
    val q = '!' + 1       // The " character to avoid backslashes
    val h = listOf(0, 0)  // The history of numbers, initialised with two numbers
                          // to make initial undo compilable
    fun p(h: List<Int>) { // Define a nested function p(h) that prints
                          // the source code for increment/decrement/undo
        val l = listOf(   // List of source code lines to print
            "{val q='!'+1;val h=listOf(",
            "h.joinToString()",
            ");fun p(h:List<Int>){val l=listOf(",
            ");print(l[0]+h.joinToString()+l[2]);for(r in l)print(q+r+q+',');println(l[3])};p(h+(h.last()+1));p(h+(h.last()-1));p(h.dropLast(1));print('{');print(h.last());print('}')}"
        )
        print(l[0] + h.joinToString() + l[2])
        for (r in l) print(q + r + q + ',') // Print a quoted version of the whole lambda
        println(l[3])
    }
    p(h + (h.last() + 1)) // Increment
    p(h + (h.last() - 1)) // Decrement
    p(h.dropLast(1))      // Undo
    print('{')            // Peek
    print(h.last())
    print('}')
}

```
* Increment/decrement/undo are similar lambdas with a different `h`istory
* Peek is a lambda that always *returns* the last value of `h` (while the others print)

## Example outputs

After one round of incrementing:

* Increment/decrement/undo print the following program:
```
{val q='!'+1;val h=LIST;fun p(h:List<Int>){val l=listOf("{val q='!'+1;val h=listOf(","h.joinToString()",");fun p(h:List<Int>){val l=listOf(",");print(l[0]+h.joinToString()+l[2]);for(r in l)print(q+r+q+',');println(l[3])};p(h+(h.last()+1));p(h+(h.last()-1));p(h.dropLast(1));print('{');print(h.last());print('}')}",);print(l[0]+h.joinToString()+l[2]);for(r in l)print(q+r+q+',');println(l[3])};p(h+(h.last()+1));p(h+(h.last()-1));p(h.dropLast(1));print('{');print(h.last());print('}')}

```
where `LIST` is actually:
    + Increment: `listOf(0, 0, 1, 2)`
    + Decrement: `listOf(0, 0, 1, 0)`
    + Undo: `listOf(0, 0)` (the original history)
* Peek prints `{1}`, a constant lambda returning the latest value in the history

-4 bytes by replacing the last `println` with `print`

# Answer
> 3 votes
# Python 3, ~~105~~ ~~93~~ 83 bytes

-12 bytes thanks to 97.100.97.109
-10 bytes thanks to Mukundan314 and xnor

```
print(*map(open(__file__).read().replace,['0']*3,['-~0','~-0','0'[2:]]),'print(0)')

```

Outputs \[incr, decr, undo, peek\] separated by spaces

Try it online!

# Answer
> 3 votes
# JavaScript (Node.js), ~~64~~ 62 bytes

```
f=_=>`f=${f}+'+1'\nf=${f}+'-1'\nf=${(f+"").slice(0,-5)}\n_=>0`

```

Try it online!

-2 bytes thanks to @emanresu A

# Answer
> 3 votes
# Bash, ~~68~~ 51 bytes

```
echo 'bc<<<0';sed 's/0/0+1/p;s/+/-/p;s/0..../0/' $0

```

Try it online!

-17 bytes thanks to @Jiří

Outputs `[peek, incr, decr, undo]` seperated by newlines

# Answer
> 2 votes
# C (gcc), 241 bytes

```
// 0
v;f;l;char*e,b[999];c(n){f=fopen(__FILE__,"r");for(l=1;fgets(b,999,f);l=0)l?v=strtol(b+3,&e,10),printf(n-80?n-85?"// %d%s":"// %s%s":"%s",n-80?n-85?n-73?v-1:v+1:"":b,n-85?b+2:e):puts(b);}main(){c(73);c(68);c(80);c(85);printf("%d\n",v);}

```

Try it online!

~~Creates~~ Prints the source code the following programs:

* `I` increment
* `D` decrement
* `P` peek
* `U` undo

Full Example

It is oddly satisfying running this on a machine with a spinning hdd with caching disabled.

# Answer
> 2 votes
# ARM Thumb machine code, 63 bytes

(Note: offset starts at 2 for alignment)

```
00000002: 0f a3 01 22 00 21 10 e0 0d a3 1a 78 98 5c 70 47  ...".!.....x.\pG
00000012: 0b a3 1a 78 01 3a 99 5c 07 e0 01 24 00 e0 ff 24  ...x.:.\...$...$
00000022: 07 a3 1a 78 99 5c 21 44 01 32 36 25 5b 1b ae 18  ...x.\!D.26%[...
00000032: 81 55 01 3e 99 5d 81 55 fb d1 42 55 70 47 01     .U.>.].U..BUpG.

```

Commented assembly

```
    .syntax unified
    .arch armv7ve
    .thumb
    .globl PEEK, INCR, DECR, UNDO
    .p2align 2,0
    // force 4 byte misalignment. Unscored.
    nop
    .globl func
    .thumb_func

    // Input: r0: pointer to output buffer, bits[1:0] = 0b10
    // Output: written to *r0
    // Clobbers: r0-r6
func:
    // Get address of data (as main code expects)
    adr    r3, data
    // Initial length
    movs   r2, #1
    // Initial value
    movs   r1, #0
    // Output the code
    b      .Lwrite_no_len
begin:
    // Input: none
    // Output: r0
    // Clobbers: r0, r2, r3
peek:
    // Get address of data
    adr    r3, data
    // Load length
    ldrb   r2, [r3, #0]
    // Load data[length]
    ldrb   r0, [r3, r2]
    // Return
    bx     lr
    // Input: r0: pointer to output buffer, bits[1:0] = 0b10
    // Output: written to *r0
    // Clobbers: r0-r6
undo:
    // Get address of data
    adr    r3, data
    // Load length
    ldrb   r2, [r3, #0]
    // Decrement length
    subs   r2, #1
    // Load new value
    ldrb   r1, [r3, r2]
    // Output the code
    b      .Lwrite_no_len

    // Input: r0: pointer to output buffer, bits[1:0] = 0b10
    // Output: written to *r0
    // Clobbers: r0-r6
incr:
    // Value to add
    movs   r4, #1
    // Jump to the common code for incr and decr
    b      .Lnext

    // Input: r0: pointer to output buffer, bits[1:0] = 0b10
    // Output: written to *r0
    // Clobbers: r0-r6
decr:
    // Value to add (I use 8-bit arith so 0xFF == -1)
    movs   r4, #0xFF
.Lnext:
    // Get address of length
    adr    r3, data
    // Load length
    ldrb   r2, [r3]
    // Load data[length]
    ldrb   r1, [r3, r2]
    // Add either 1 or 0xFF to the value
    add    r1, r4
    // Increment length
    adds   r2, #1
    // func and undo jump here to skip length calc
    // expected state:
    //   - r0 = out pointer
    //   - r1 = value
    //   - r2 = length
    //   - r3 = address of length
.Lwrite_no_len:
    // FIXME: awkward
    // Offset from beginning to data
    // Save in a register for later
    // Doesn't work in Clang
    movs.n r5, #data - begin
    // Subtract from pointer to get the beginning
    subs   r3, r3, r5
    // Add to length
    adds   r6, r5, r2
    // Store new value at the end of the stack
    strb   r1, [r0, r6]
    // memcpy loop
.Lloop:
    subs   r6, r6, #1
    ldrb   r1, [r3, r6]
    strb   r1, [r0, r6]
    bne    .Lloop
    // Store length since it is overwritten by memcpy
    strb   r2, [r0, r5]
    // Return
    bx     lr

    .p2align 2,0
data:
    // While this value isn't important, it is still read
    // from in the memcpy loop.
    .byte  1
end:
    // stack of values will be added here

    // helpers for driver, not part of code
    .section .rodata
    .globl INCR, DECR, UNDO, PEEK, SIZE
INCR: .word incr - begin
DECR: .word decr - begin
UNDO: .word undo - begin
PEEK: .word peek - begin
SIZE: .word end - func

```

Note that this assembly file **must be compiled by GAS or GCC**. Clang emits a garbage value for the label arithmetic at `movs.n`.

The code must be placed at a 2 bytes aligned, 4 byte misaligned address, and so must all the output pointers.

This is a doozy that can probably be optimized a lot. The main issue is that calling functions on ARM doesn't automatically make a call stack like x86, the `lr` register must be saved manually. Additionally, `bl` is a 4 byte instruction so calling a helper function has a 6 byte overhead.

This generates code by writing to a pointer. Since self modifying code is pretty tricky, here is a driver for Linux:

```
#include <stdio.h>
#include <stdlib.h>
#include <sys/mman.h>
#include <unistd.h>
typedef volatile unsigned char vu8;
extern void func(vu8*);

// These are helpers in the asm file that mean I don't have to recalculate the lengths.
extern const int PEEK, UNDO, INCR, DECR, SIZE;
#define MAX_SIZE 4096

// Just calling the function pointer wouldn't work
// because the compiler expects me to follow a
// calling convention for some reason.
// Note that you must compile with -march=armv7-a
// (technically v5te+ will work as well) for blx.
static int call(vu8 *output, const volatile void *func)
{
    register int inout asm("r0") = (int)output;
    // ensure Thumb bit
    register int funcptr asm("r1") = 1 | (int)func;
    asm(
        "blx %1"
      : "+r" (inout), "+r" (funcptr)
      :
      : "r2", "r3", "r4", "r5", "r6", "r12", "lr", "cc", "memory"
    );
    return inout;
}

static vu8 *get_page(void)
{
    // Allocate a read/write page
    vu8 *ptr = mmap(
        NULL,
        MAX_SIZE,
        PROT_READ | PROT_WRITE,
        MAP_PRIVATE | MAP_ANONYMOUS,
        -1,
        0
    );
    if (ptr == MAP_FAILED || ptr == NULL) abort();
    // fill with UDF #0xDE to make out of bounds jumps crash
    memset((void *)ptr, 0xDE, MAX_SIZE);
    // Misalign so the pointer is not 4 byte aligned
    return ptr + 2;
}

static void make_exec(vu8 *ptr)
{
    // mark read/exec
    // No rwx here
    mprotect((char *)ptr - 2, MAX_SIZE, PROT_READ | PROT_EXEC);
    // clear instruction cache
    __builtin___clear_cache((char *)ptr - 2, (char *)ptr - 2 + MAX_SIZE);
}

static void peek(vu8 *ptr)
{
    int val = call(NULL, ptr + PEEK);
    printf("%d\n", val);
}

static vu8 *eval(vu8 *ptr, int func_offset)
{
    vu8 *output = get_page();
    call(output, ptr + func_offset);
    make_exec(output);
    peek(output);
    return output;
}

int main(void)
{
    printf("size: %d\n", SIZE);
    printf("offsets: %d %d %d %d\n", INCR, DECR, UNDO, PEEK);
    vu8 *A = get_page();
    call(A, func);
    make_exec(A);
    peek(A);
    vu8 *B = eval(A, INCR);
    vu8 *C = eval(B, INCR);
    vu8 *D = eval(C, INCR);
    vu8 *E = eval(D, UNDO);
    vu8 *F = eval(E, UNDO);
    vu8 *G = eval(F, DECR);
    peek(F);
}

```

The functions all use the same calling convention except for `peek` which follows AAPCS.

The input is `r0`, which is a pointer that is 2 byte aligned and 4 byte misaligned. The function will be written to this pointer.

The function clobbers r0-r6, which is not AAPCS compliant.

The way the code works is it replicates itself by literally reading itself, followed by a length, then a stack of values.

```
    code
    length
    values....

```

Each time a new value is added, the new value is appended and the length is incremented. When undo is called, the length is decremented.

The length and the values are all 8-bit integers, so this can only store up to 254 values (the stack is 1-indexed because of the length byte)

Currently, the functions will be stored at the following offsets in the output buffer. When calling these, remember that the lowest bit must be set as these are Thumb functions.

* `peek`: 0
* `undo`: 8
* `incr`: 18
* `decr`: 22

# Answer
> 1 votes
# sclin, 64 bytes

```
0.
,`">S form"map c><"dup "["1+""1-"\pop2*`"end"].".\n"g@"++"4*#

```

Try it here! Returns `[ inc dec undo peek ]`.

For testing/convenience purposes, the following snippet:

```
; ."\n"++ n>< n>o

```

will output each code on separate lines for easy copy-pasting.

For example, running the initial code with the snippet:

```
; ."\n"++ n>< n>o
0.
,`">S form"map c><"dup "["1+""1-"\pop2*`"end"].".\n"g@"++"4*#

```

outputs:

```
"0"dup 1+.
,`">S form"map c><"dup "["1+""1-"\pop2*`"end"].".\n"g@"++"4*#

"0"dup 1-.
,`">S form"map c><"dup "["1+""1-"\pop2*`"end"].".\n"g@"++"4*#

"0"dup pop pop.
,`">S form"map c><"dup "["1+""1-"\pop2*`"end"].".\n"g@"++"4*#

"0"dup end.
,`">S form"map c><"dup "["1+""1-"\pop2*`"end"].".\n"g@"++"4*#

```

Running `inc`:

```
; ."\n"++ n>< n>o
"0"dup 1+.
,`">S form"map c><"dup "["1+""1-"\pop2*`"end"].".\n"g@"++"4*#

```

outputs:

```
"0""1"dup 1+.
,`">S form"map c><"dup "["1+""1-"\pop2*`"end"].".\n"g@"++"4*#

"0""1"dup 1-.
,`">S form"map c><"dup "["1+""1-"\pop2*`"end"].".\n"g@"++"4*#

"0""1"dup pop pop.
,`">S form"map c><"dup "["1+""1-"\pop2*`"end"].".\n"g@"++"4*#

"0""1"dup end.
,`">S form"map c><"dup "["1+""1-"\pop2*`"end"].".\n"g@"++"4*#

```

## Explanation

Somewhat prettified code:

```
0.
,` ( >S form ) map c>< "dup " [ "1+" "1-" \pop 2*` "end" ] .".\n" g@ \++ 4*#

```

This solution takes advantage of the stack to trivialize the history functionality; for example, undo becomes a simple matter of popping the stack.

* `,` ( >S form ) map c><` serializes the stack into a series of formatted number strings. This is because sclin constructs negative numbers as `1_` but string-formats numbers as `-1`; luckily, sclin can perform arithmetic on number strings.
* `"dup "` is code for "new item in history" (which, in this case, is simply duplicating the top of the stack).
* `[ "1+" "1-" \pop 2*` "end" ]` are the core `[ inc dec undo peek ]` codes.
* `.".\n"` is code for "execute the next line."
* `g@` gets the current line as a string, which allows for code generation in subsequent iterations.
* `\++ 4*#` vectorized-concatenates all the code pieces to create complete `[ inc dec undo peek ]` codes.

A concatenative solution in a concatenative language!

---
Tags: code-golf, number, code-generation, function
---


title: Equality in the sum of digits

text:
# Question
Title: Equality in the sum of digits
### Introduction

Let's take the number `180`. This is an interesting number because the sum of digits of this number is equal to:

```
1 + 8 + 0 = 9

```

And the squared version of this number, or:

```
180² = 32400 > 3 + 2 + 4 + 0 + 0 = 9

```

These are both **9**. The sum of digits of the original number and the squared number are the same. Of course, this is also found at OEIS: A058369.

### Task

Given a non-negative integer `n`, output the `n`th *positive* number with this condition.

### Test cases (*zero-indexed*)

```
Input > Output

0 > 1
1 > 9
2 > 10
3 > 18
4 > 19
5 > 45
6 > 46
7 > 55
8 > 90
9 > 99
10 > 100
11 > 145
12 > 180
13 > 189
14 > 190
15 > 198
16 > 199
17 > 289
18 > 351
19 > 361

```

The input can also be **1-indexed** if that fits you better.

This is , so the submission with the least amount of bytes wins!

# Answer
# Jelly, 13 bytes

```
,²DS€=/
1Ç³#Ṫ

```

Input is 1-indexed. Try it online!

### How it works

```
1Ç³#Ṫ    Main link. Argument: n (index)

1        Set the return value to 1.
   #     Execute ... until ... matches have been found.
 Ç         the helper link
  ³        n
    Ṫ    Extract the last match.

,²DS€=/  Helper link. Argument: k (integer)

,²       Pair k with k².
  D      Convert each to decimal.
   S€    Compute the sum of each list of base 10 digits.
     =/  Reduce by equality.

```
> 7 votes

# Answer
# 05AB1E, ~~10~~ ~~9~~ 8 bytes

```
µNÐn‚1öË

```

1-indexed.

-1 byte thanks to *@Emigna* by removing the implicit `½` (increase `counter_variable` after every iteration) at the end
-1 byte thanks to *@Grimy* removing the duplicated `SO` by using `‚1ö`

Try it online.

**Explanation:**

```
µ         # Loop while the counter_variable is not equal to the (implicit) input yet:
 NÐ       #  Push the 0-based loop index three times
   n      #  Take the square of this index
          #   i.e. 180 → 32400
    ‚     #  Pair it with the index
          #   i.e. 180 and 32400 → [180,32400]
     1ö   #  Convert both numbers from base-1 to base-10, which basically sums the digits
          #   i.e. [180,32400] → [9,9]
       Ë  #  Check if both sums are equal
          #   i.e. [9,9] → 1 (truthy)
          #  (if they are: implicitly increase the counter_variable by 1)
          # (after the loop: implicitly print the top of the stack, which is the remaining
          #  copy of the index from the triplicate we've used)

```
> 8 votes

# Answer
# Mathematica, 64 bytes

```
a=Tr@*IntegerDigits;Nest[NestWhile[#+1&,#+1,a@#!=a[#^2]&]&,1,#]&

```

Simple anonymous function. Zero-indexed.
> 6 votes

# Answer
## Haskell, 54 bytes

```
s=sum.map(read.pure).show
([x|x<-[1..],s x==s(x^2)]!!)

```

Usage example: `([x|x<-[1..],s x==s(x^2)]!!) 17` -\> `289`.

```
s calculates the digit sum:

                    show     -- turn number into a string
     map(read.pure)          -- turn every character (the digits) in to a
                             -- one element string and convert back to integer
sum                          -- sum those integers

main function:

[x|x<-[1..]            ]     -- make a list of all x starting from 1
           ,s x==s(x^2)      -- where s x == s (x^2)
                        !!   -- pick nth element from that list

```
> 6 votes

# Answer
# Perl 6, ~~47~~ 46 bytes

```
{(grep {$_.comb.sum==$_².comb.sum},1..*)[$_]}

```
> 6 votes

# Answer
# Pyth, 15

```
e.fqsjZTsj^Z2TQ

```

1 byte thanks to DenkerAffe!

Try it here or run a Test Suite.

Uses the 1-indexed option.

Naive implementation using `.f` which gets the first `n` numbers that match the given condition.
> 5 votes

# Answer
# JavaScript (ES6), ~~76 73~~ 72 bytes

```
n=>eval("for(q=s=>eval([...s+''].join`+`),i=1;q(i)!=q(i*i)||n--;i++);i")

```

I spent 30 minutes trying to get this to work until I realized I was outputting the wrong variable :|

This is zero-indexed.
> 5 votes

# Answer
# Vyxal, 8 bytes

```
↵'²"Ṡ≈;i

```

Try it Online!

Insights scraped from the MathGolf answer and the 05AB1E answer.

```
↵'²"Ṡ≈;i # Takes the number as input and returns the n-th number in the series, 0-indexed
↵        # 10**input
 '    ;  # Filter the implicit range [0..n]
  ²      # Square the input
   "     # Pair the square with the input
    Ṡ    # Vectorised sum
     ≈   # All equal?
       i # Index into the resulting list

```
> 5 votes

# Answer
# MATL, ~~24~~ 23 bytes

```
x`@2:^"@V!Us]=?@]NG<]1$

```

Uses 1-based input.

**Try it online!**

```
x        % take inpout and delete it (gets copied into clipboard G)
`        %   do...while
  @      %   push loop iteration index: candidate number, n
  2:^    %   array [n n^2]
  "      %   for each element of that array
    @    %     push that element
    V!U  %     get its digits (to string, transpose, to number)
    Xs   %     compute their sum
  ]      %   end for each
  =      %   are the two sums equal?
  ?      %   if so
    @    %     the candidate number is valid: push it
  ]      %   end if
  NG<    %   is number of elements in stack less than input?
]        % if so, proceed with next iteration. End do...while.
1$       % specify 1 input for implicit display: only top of stack

```
> 4 votes

# Answer
# PARI/GP 46 bytes

```
s=sumdigits;k=0;while(n,n-=!(s(k++)-s(k^2)));k

```

1-indexed
> 4 votes

# Answer
# Mathematica, ~~63~~ ~~60~~ ~~61~~ 59 bytes

```
Select[Range[9^#],Equal@@Tr/@IntegerDigits/@{#,#^2}&][[#]]&

```

~~While making this the other answer popped up but I'm beating them by a single byte and I'm posting this before that one gets golfed.~~ One indexed.
> 3 votes

# Answer
## Convex 0.2, ~~36~~ 35 bytes

Convex is a new language that I am developing that is heavily based on CJam and Golfscript. The interpreter and IDE can be found here. Input is an integer into the command line arguments. Indexes are one-based. Uses the **CP-1252** encoding.

```
1\{\__2#¶{s:~:+}%:={\(\)\}{)\}?}h;(

```
> 3 votes

# Answer
# Julia, ~~79~~ 66 bytes

```
f(n,x=0,i=1,s=c->sum(digits(c)))=x<n?f(n,x+(s(i)==s(i^2)),i+1):i-1

```

This is a recursive function that accepts an integer and returns an integer. It uses 1-based indexing.

We store a few things as function arguments:

* `n` : The input
* `x` : A counter for how many numbers with this condition we've found
* `i` : A number to check for the condition
* `s` : A function to compute the sum of the digits of its input

While `x` is less than the input, we recurse, incrementing `x` if `i` meets the condition and incrementing `i`. Once `x == n`, we return `i`, but we have to subtract 1 because it will have been incremented one too many times.
> 3 votes

# Answer
# Retina, 103 bytes

```
\d+
$*1 x
{`x+
$.0$*x¶$.0$*a¶$.0$*b
%`b
$_
a+|b+
$.0
\d
$*
+`1¶1
¶
1(.*)¶¶$|¶[^d]+
$1x
}`^ ?x

x

```

Definitely golfable.

Uses the new Retina feature `%` for squaring (hence not working with the online version yet).
> 3 votes

# Answer
# Mathcad, ~~70~~ 50 bytes

Mathcad has no built in functions to convert a number to its digit string, so the user function d(a) does this job. A program then iterates through the positive integers, testing for equality of sums, until it has accumulated n numbers in the vector v. The program is evaluated using the = operator, which displays the result vector. (*Note that the whole program appears exactly as displayed below on the Mathcad worksheet*)

Updated program: Assumes default initialization of a to zero and makes use of fact that Mathcad returns the value of the last evaluated statement in a program.
Makes use of evaluation order of expressions to increment variable a in the first summation (and which is then available for use in the sum of square)

Original program: Returns a vector of all numbers up to n.
> 3 votes

# Answer
# Ruby, 85 bytes

```
->n,*a{[*(1..).lazy.filter_map{_1 if _1.digits.sum==(_1**2).digits.sum}.take(n)][-1]}

```

Attempt This Online!
> 3 votes

# Answer
# Pip, ~~22~~ ~~21~~ 20 bytes

```
($=$+*[_SQ_]FI,EE3a)

```

-2 Bytes thanks to DLosc!

1-Indexed

Currently operates with a limited range for efficiency, replace `3` with `a` for infinite range

Try It Online!

How?

```
($=$+*[_SQ_]FI,EE3a)
                EE3    - 10 to the power of 3
               ,       - Range 0 to n
             FI        - Filter: keep items which return truthy
      [     ]          - Pair
       _               - Identity function
         SQ_           - Identity function squared
   $+*                 - Sum, vectorized at a depth of 1
 $=                    - Are they equivalent?
                   a   - Value at index Input

```
> 3 votes

# Answer
# Fig, \\$10\log\_{256}(96)\approx\\$ 8.231 bytes

```
iFmN'=SxS*

```

Try it online!

Could be ~7.4 bytes under normal sequence rules

## Explained

```
iFmN'=SxS*
 FmN'       # From an infinite list of natural numbers, keep only those where
      Sx    #   the digital sum of the number
     =      #   equals
        S*  #   the digital sum of the square of the number
i           # get the inputh item of the list

```
> 3 votes

# Answer
# Java 8, 113 bytes

```
n->{int r=0;for(;n>=0;)if((++r+"").chars().map(c->c-48).sum()==(r*r+"").chars().map(c->c-48).sum())n--;return r;}

```

0-indexed

**Explanation:**

Try it online.

```
n->{           // Method with integer as both parameter and return-type
  int r=0;     //  Result-integer, starting at 0
  for(;n>=0;)  //  Loop as long as `n` is zero or positive
    if((++r    //   Increase `r` by 1 first
       +"").chars().map(c->c-48).sum()
               //   And if the sum of its digits
       ==(r*r+"").chars().map(c->c-48).sum())
               //   equals the sum of the digit of its square
      n--;     //    Decrease `n` by 1
  return r;}   //  Return the result

```
> 2 votes

# Answer
# Perl 5 `-p`, 53 bytes

Includes `+1` for `-p`

1 based

```
#!/usr/bin/perl -p
$.++while$_-=!eval+("-($.) ".$.**2)=~s/\B/+/gr;$_=$.

```

Try it online!
> 2 votes

# Answer
# TI-BASIC ~~66~~ 62 bytes

```
Ans→N:While X<N:IS>(A,A::A:prgmA:Ans→B:A²:prgmA:If B=Ans:IS>(X,N:End:A
sum(int(10fPart(Ans₁₀^(seq(⁻X-1,X,0,log(Ans

```

Input is \\$n\\$ in `Ans`.
Output is the **1-indexed** \\$n\\$th term in the sequence.

Helper function generates the sum of the digits of the value in `Ans`.

**Examples:**

```
3:prgmCDGF1E
             10
5:prgmCDGF1E
             19
8:prgmCDGF1E
             55
10:prgmCDGF1E
             99

```

**Explanation:**

```
Ans→N:While X<N:IS>(A,A::A:prgmA:Ans→B:A²:prgmA:If B=Ans:IS>(X,N:End:A ;prgmCDGF1E

Ans→N            ;store the input in N
While X<N        ;loop until the Nth term has been reached
IS>(A,A:         ;add 1 to A
                 ; (Increment A and skip the next statement if A>A)
A                ;leave A in Ans
prgmA            ;call the helper program below
Ans→B            ;store the result of the helper program in B
A²               ;square A and leave the result in Ans
prgmA            ;call the helper program below
                 ; (result is in Ans)
If B=Ans         ;if the two results are equal
IS>(X,N          ;add 1 to X
                 ; (Increment X and skip the next statement if X>N)
End
A                ;leave A in Ans
                 ;implicit print of Ans

sum(int(10fPart(Ans₁₀^(seq(⁻X-1,X,0,log(Ans   ;prgmA

                      seq(⁻X-1,X,0,log(Ans    ;generate a list...
                                              ; using X as the variable,
                                              ; starting at 0,
                                              ; ending at the log of Ans,
                                              ; and evaluating "⁻X-1" for each element
                                              ; (implicit increment of 1)
                   ₁₀^(                       ;raise 10 to the power of each element
                Ans                           ;multiply each element by the input
          fPart(                              ;remove the integer part from each element
        10                                    ;multiply each element by 10
    int(                                      ;round each element to the nearest integer
sum(                                          ;then sum the resulting list

```

---

**Note:** TI-BASIC is a tokenized language. Character count does ***not*** equal byte count.
> 2 votes

# Answer
# Japt, ~~15~~ 12 bytes

1-indexed

```
Èìx ¶X²ìx}iU

```

Try it

```
Èìx ¶X²ìx}iU     :Implicit input of integer U
È                :Function taking an integer as argument X
 ì               :  To digit array
  x              :  Reduce by addition
    ¶            :  Is equal to
     X²ìx        :  Digit sum of X squared
         }       :End function
          iU     :Get the Uth integer that returns true

```
> 1 votes

# Answer
# , 62 bytes

```
[:{:({.@](>:@[,],[#~(=&(1#."."0@":)*:)@[)}.@])^:(#@]<1+[)^:_&1

```

Try it online!

1 indexed. J once again not performing well on these "nth of" tasks, because of the excessive bookeeping mechanics.
> 1 votes

# Answer
# APL(NARS), 49 chars, 98 bytes

```
r←h w;c
c←r←0
→2×⍳∼=/+/¨(⍎¨⍕)¨r,r×r+←1⋄→2×⍳w>c+←1

```

1-indexed, test:

```
  h¨⍳20
1 9 10 18 19 45 46 55 90 99 100 145 180 189 190 198 199 289 351 361

```
> 1 votes

# Answer
# MathGolf, 10 bytes

```
♪╒gÆ‼Σ²Σ=§

```

Try it online!

## Explanation

To make this usable, I chose to present a version which calculates every number with this property below 1000, and fetches the correct item from that list. To have a solution which would work for any input size, the first byte could be replaced by `ú` (push 10\**TOS). Since the n:th term in the sequence is always less than \\$10^n\\$, the script would always succeed. However, this puts a practical limit on calculation that's very low.

```
♪            push 1000
 ╒           range(1,n+1)
  gÆ         filter list using the next 5 operators
    ‼        apply next two commands to TOS
     Σ       sum(list), digit sum(int)
      ²      pop a : push(a*a) (square)
       Σ     sum(list), digit sum(int) (pushes the digit sum of the square)
        =    pop(a, b), push(a==b) (compares the two)
         §   get from array (returns the <input>th item from the filtered list

```
> 1 votes

# Answer
# Python 3, ~~125~~ 124 bytes

```
def f(x,i=1,a=()):
 while len(a)!=x:
  if sum(int(j)for j in str(i))==sum(int(j)for j in str(i**2)):a+=i,
  i+=1
 print(i-1)

```

Try it online!

1-indexed
> 1 votes

# Answer
# JavaScript, ~~67~~ 66 bytes

I feel very rusty golfing in JS so I'm sure there's something I'm missing here.

1-indexed

```
n=>(g=x=>(h=y=>eval([...y+``].join`+`))(++x)-h(x*x)||--n?g(x):x)``

```

Try it online!
> 1 votes

# Answer
# Factor \+ `benchmark.ant lists.lazy`, 56 bytes

```
[ 1 lfrom [ dup sq [ sum-digits ] same? ] lfilter lnth ]

```

Try it online!

* `1 lfrom` Infinite lazy list of the positive integers
* `[ ... ] lfilter` Take the ones where...
* `dup sq [ sum-digits ] same?` ...the digit sum of the number and its square are the same
* `lnth` Take the nth one
> 1 votes

# Answer
# JavaScript, 60 bytes

```
n=>(g=x=>(s=x=>x&&x%10+s(x/10|0))(++x)-s(x*x)||n--?g(x):x)``

```

An alternate approach for the sum of digits. 0-indexed.
> 1 votes

# Answer
# C (gcc), <sup>~~66~~</sup> 65 bytes

-1 bytes thanks to @ceilingcat

```
i;s(n){n=n?n%10+s(n/10):0;}f(n){for(i=0;n-=s(++i)==s(i*i););n=i;}

```

Try it online!
> 0 votes

# Answer
# Vyxal, 8 bytes

```
₌∑²∑=)ȯt

```

Try it Online!

Alternate 8 byter that uses a more obvious approach, 1-indexed.

## Explained

```
₌∑²∑=)ȯt
     )ȯ  # first n numbers where:
₌∑       #  the sum of the number
₌ ²∑     #  and the sum of the square of the number
    =    #  are equal
       t # last item

```
> 0 votes

---
Tags: code-golf, number, sequence
---


title: Preparing a multiple choice test

text:
# Question
Title: Preparing a multiple choice test
### Introduction

Note: this is not some kind of method to encourage cheating. As Cᴏɴᴏʀ O'Bʀɪᴇɴ already said, studying is the best solution for passing a test :3.

Consider the following answers to the multiple choice test:

```
ABCBCAAB

```

Here is a table which indicates whether the answers match:

```
    A B C B C A A B

A   1 0 0 0 0 1 1 0
B   0 1 0 1 0 0 0 1
C   0 0 1 0 1 0 0 0

```

This gives us the following numbers:

```
10000110, 01010001, 00101000

```

The challenge is to print these binary numbers. But it is **important** to see which letters are used in the multiple choice test. For example:

```
ABCDCDBCDABC

```

This **highest letter** is `D`, which is the *4th letter in the alphabet*. Therefore, we need to output **4 different** binary numbers. Namely:

```
100000000100, 010000100010, 001010010001, 000101001000

```

Note that you have to look at the *highest letter*. Consider the following example:

```
AACCACAC

```

Although the `B` is not used, we need to output the binary result for `B`. That means, the answer would be:

```
11001010, 00000000, 00110101

```

---

### Task

Given the answers to a multiple choice test, output the binary numbers. **You may assume that the input will be non-empty and only containing the letters `[A-Z]`** . Instead of ones and zeroes, you may also use true and false.

---

### Test cases:

```
Input: ABBBABABA
Output: 100010101, 011101010

Input: AAAAAAAAA
Output: 111111111

Input: AFGHEEHFD
Output: 100000000 000000000 000000000 000000001 000011000 010000010 001000000 000100100

Input: Z
Output: 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1

Input: ABCDCDBCDABC
Output: 100000000100, 010000100010, 001010010001, 000101001000

```

This is , so the submission with the least amount of bytes wins!

# Answer
## Pyth, 12 bytes

```
mqLdzfsgRTzG

```

Outputs as a nested array of booleans.

```
                Implicit: z=input
m               Map lambda d:
 qLdz            map equal-to-d over z
     f           over all letters T in the
           G     lowercase alphabet for which
      s           At least one char in z
       gRTz       >= T.

```

Try it here.
> 3 votes

# Answer
# Python 3, 71

Saved 22 bytes thanks to Ogaday.
Saved 3 bytes thanks to DSM.

Saved a bunch of bytes thanks to an array of bools being valid.

```
*k,=map(ord,input())
x=65
while x<=max(k):print([v==x for v in k]);x+=1

```

Takes uppercase command line input.
> 6 votes

# Answer
## PowerShell, ~~95~~ ~~94~~ 73 bytes

```
param([char[]]$a)0..(($a|sort)[-1]-65)|%{$d=$_;-join($a|%{+!($_-$d-65)})}

```

Takes input as an uppercase string, but immediately casts it `[char[]]`. We then loop from `0..` to the maximal value of `$a` taken alphabetically (hence the `-65` to convert from ASCII). For example, with `ADCEB`, this can be thought of as looping from `A` to `E`.

Each iteration, we set a helper variable `$d` equal to the current alphabetical (not ASCII) value. We then loop through all of `$a`, each time putting either `0` or `1` on the pipeline, based on whether `$_-$d-65` is truthy or falsey (i.e., whether we're in the right "slot"). This works because any non-zero value in PowerShell is truthy, meaning if our current letter `$_` doesn't "equal" what slot we're in `$d`, then the `!` of that is `$false`, or `0`.

Each of those arrays of `0`s and `1`s is then `-join`ed together and re-put on the pipeline. When the outer loop ends, we have an array of strings, which will print one string per line.

### Examples

```
PS C:\Tools\Scripts\golfing> .\preparing-a-multiple-choice-test.ps1 ABCDEFGH
10000000
01000000
00100000
00010000
00001000
00000100
00000010
00000001

PS C:\Tools\Scripts\golfing> .\preparing-a-multiple-choice-test.ps1 AFGHEEHFD
100000000
000000000
000000000
000000001
000011000
010000010
001000000
000100100

```

Edit 1 -- saved a byte by using Boolean-not instead of -eq
Edit 2 -- saved another 21 bytes by eliminating the extra array $b
> 3 votes

# Answer
# LabVIEW, ~~30~~ ~~22~~ 20 LabVIEW Primitives

Goes through from a-z until the sum of all bools is equal to the input lenght. then Transforms the bools to numbers.

Now directly takes the max instead of checking the bool sum.

Since 2D bools are viable now im saving 2 Primitives by outputting the green wire in front of `?1:0` could redo it but im too lazy...
> 3 votes

# Answer
## Pyth, ~~20~~ ~~19~~ ~~17~~ ~~15~~ 14 bytes

```
VhxGeSzmq@GNdz

```

Explanation:

```
               - autoassign z = input()
V              - For N in range(V)
 hxGeSz
    eSz        - max(z)
  xG           - lowercase_alphabet.index(^)
 h             - +1
       mq@GNdz
       m     z - [V for d in z]
         @GN   - lowercase_alphabet[N]
        q   d  - is_equal(^, ^^)
               - print "".join(^)

```

Outputs a 2D array of bools

Try it here
> 2 votes

# Answer
# Cjam, 25 bytes

```
l{'A-i}%_:e>),\f{f=", "}

```

Sigh,

## Explanation

```
l{'A-i}%_:e>),\f{f=", "}
l                        e# get the input
 {'A-i}%                 e# get the normalized array
        _:e>             e# get the maximum value
            ),           e# create the array from 1..N
              \f{      } e# map over the created array
                 f=      e# 1 if match, 0 if not
                   ", "  e# add separator

```
> 2 votes

# Answer
## Haskell, ~~46~~ 34 bytes

```
g x=(<$>x).(==)<$>['A'..maximum x]

```

Usage example: `g "ACDC"`-\> `[[True,False,False,False],[False,False,False,False],[False,True,False,True],[False,False,True,False]]`.

How it works:

```
        <$>['A'..maximum x]   -- for every letter from A to the highest letter in x
<$>x                          -- loop over x and
      ==                      -- compare the letter with the current element in x
                              -- which results in a boolean

```
> 2 votes

# Answer
# Octave, 19 bytes

```
@(s)s==[65:max(s)]'

```

Uses Octave's automatic broadcasting over the range `A` to the max element in the input to produce 2d boolean array of matching elements.

Example:

```
Key = ABCDCDBCDABC

ans =

   1   0   0   0   0   0   0   0   0   1   0   0
   0   1   0   0   0   0   1   0   0   0   1   0
   0   0   1   0   1   0   0   1   0   0   0   1
   0   0   0   1   0   1   0   0   1   0   0   0

```

Try it here on ideone.
> 2 votes

# Answer
## ES6, 92 bytes

```
s=>[..."ABCDEFGHIJKLMNOPQRSTUVWXYZ"].map(c=>[...s].map(m=>m==c&&!!(l=n),n++),n=0).slice(0,l)

```

Returns an array of arrays of falses and trues. If you prefer an array of strings of zeros and ones, then for 97 bytes:

```
s=>[..."ABCDEFGHIJKLMNOPQRSTUVWXYZ"].map(c=>s.replace(/./g,m=>m==c?(l=n,1):0,n++),n=0).slice(0,l)

```
> 2 votes

# Answer
# Lua, ~~208~~ 189 Bytes

That was tricky in lua, as usual, we have to do everything from scratch, and it takes a lot of place ! This program takes a string as argument, and print out the result :).

**Edit: @Adnan told me we're now allowed to return a matrix of booleans, so here's a new version! It is now a function that takes a string of capitalised character and return the matrix :).**

```
function f(x)a={}b={}for i=1,#x do a[i]=x:sub(i,i)end table.sort(a)for i=1,a[#a]:byte()-64 do b[i]={}end x:gsub(".",function(c)for i=1,#b do z=b[i]z[#z+1]=i+64==c:byte()end end)return b end

```

### Old 208 Byte version

This is the one that works with argument and print results.

```
a={}b={}x=arg[1]for i=1,#x do a[i]=x:sub(i,i)end table.sort(a)for i=1,a[#a]:byte()-64 do b[i]=""end x:gsub(".",function(c)for i=1,#b do b[i]=b[i]..(i+64==c:byte()and"1"or"0")end end)print(table.concat(b,","))

```

### Ungolfed and explanations

```
function f(x)
a={}                   -- We need 2 arrays, and while b=a would have been shorter
b={}                   -- arrays in lua are passed by pointer, so it wouldn't have worked

for i=1,#x             -- iterate over the inpute to transform the string
do                     -- into an array
  a[i]=x:sub(i,i)      -- with each cells containing a characyer
end
table.sort(a)          -- sort the array/string

for i=1,               -- iterate n times were n is the place in the alphabet
       a[#a]:byte()-64 -- of the last element of the (sorted) array a
do
  b[i]={}              -- initialise cells in b up to n with empty arrays
end                    -- a cell's index is the position of a letter in the alphabet

x:gsub(".",function(c) -- for each character in the input
  for i=1,#b           -- iterate over each cells in b
  do
    z=b[i]             -- define z pointing on the array b[i]
    z[#z+1]=           -- insert into b[i] the result of the
       i+64==c:byte()  -- comparison of the current char, and the answer
  end
end)
return b
end

```

Trying to print an array in Lua would result in printing its address and concatenating bools is impossible. So here's a function that will help you if you want to test this submission

```
function f(x)a={}b={}for i=1,#x do a[i]=x:sub(i,i)end table.sort(a)for i=1,a[#a]:byte()-64 do b[i]={}end x:gsub(".",function(c)for i=1,#b do z=b[i]z[#z+1]=i+64==c:byte()end end)return b end

function printBooleanMatrix(m)
  s="{"
  for i=1,#m
  do
    s=s.."{"
    for j=1,#m[i]
    do
      s=s..(m[i][j]and"1"or"0")..(j==#m[i]and""or",")
    end
    s=s.."}"..(i==#m and""or",\n")
  end
  print(s.."}")
end

printBooleanMatrix(f("ABBCCDDC"))

```
> 1 votes

# Answer
# PHP, ~~106~~ ~~92~~ ~~90~~ 87 bytes

Uses Windows-1252 encoding.

```
for($x=A;$x++<=max($z=str_split($argv[1]));print~Ó)for(;$c=$z[+$$x++];)echo+(++$c==$x);

```

Run like this (`-d` added for aesthetics only):

```
php -d error_reporting=30709 -r 'for($x=A;$x++<=max($z=str_split($argv[1]));print~Ó)for(;$c=$z[+$$x++];)echo+(++$c==$x); echo"\n";' ABCDDHFHUYFSJGK

```
* Saved 14 bytes by nesting the loops the other way around
* Saved 2 bytes by using variable variables to prevent `$i=0`
* Saved a byte by inverting string and dropping string delimiters
* Saved a byte by moving the echo (changed to a print to fit) inside the first for loop and dropping curly braces
* Saved a byte by incrementing `$x` somewhere else, and incrementing `$c` to compensate
> 1 votes

# Answer
# Perl, 84 bytes

```
$\="\n";@i=split//,<>;pop@i;for$c('a'..(reverse sort@i)[0]){print map{/$c/?1:0}@i;}

```

Oh dear, I seem to have broken the highlighter.

Ungolfed version:

```
# output formatting
$\ = "\n";
# get input chars as array
@i = split //, <>;
# lose the newline
pop @i;
# iterate over characters up to the max
for $c ('a'..(reverse sort @i)[0]) {
    # print 1 for each match, 0 otherwise
    print map { /$c/ ? 1 : 0 } @i;
}

```
> 1 votes

# Answer
# Ruby, 53 bytes

```
->s{(?A..s.chars.max).map{|c|s.gsub(/./){c==$&?1:0}}}

```

Attempt This Online!
> 1 votes

# Answer
# Japt, 13 bytes

```
;m!aB
rÔò@®¥X

```

Try it

Input as an array of uppercase letters

```
;m!aB
;       # B = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 m      # For each character:
  !a    #  Find its index in
    B   #  B
        # Store as U

rÔò@®¥X
rÔ      # Find the maximum value in U
  ò@    # For each value X in the range [0...maximum]:
    ®   #  For each value Z in U:
     ¥X #   True when Z == X

```

Alternate version in one line is 2 bytes longer, unless it can output with rows and columns transposed.

Taking input as a string in either case requires 1 additional byte (`¬` before the `m`)
> 1 votes

# Answer
# Vyxal `r`, 7 bytes

```
øA:Gɾv=

```

Try it Online! (test suite) Input and output as a list of characters of `[A-Z]` and list of booleans respectively.

```
øA:Gɾv= # whole program

øA      # convert each char to its alphabetical index (1-indexing)
  :     # duplicate
   G    #                                maximum
    ɾ   # convert into a range from 1 to         inclusive
     v= # for each num in the range, check if each converted chars == num
        #   (doubly vectorises)
        #   (the r flag swaps the arguments, giving the resulting command)
        # implicitly output

```
> 1 votes

# Answer
# Factor, 52 bytes

```
[ 65 over supremum [a..b] swap [ = ] cartesian-map ]

```
> 1 votes

# Answer
## C#, 68 bytes

```
c=>Enumerable.Range(65,c.Max()-64).Select(x=>c.Select(y=>x==y?1:0));

```

Run in C# Pad

This anonymous function takes a `char[]` as input and outputs an `IEnumerable<IEnumerable<int>>`, with only 0's and 1's.
> 0 votes

# Answer
# k, 15 bytes

```
{x=/:65_!|/1+x}

```

Try it online!
> 0 votes

---
Tags: code-golf, string, binary
---


title: Produce a List of Rotonyms 2

text:
# Question
Title: Produce a List of Rotonyms 2
# Rotonyms 2

A "Rotonym" is a word that ROT13s into another word (in the same language).

For this challenge, we'll use an alternate definition: a "Rotonym" is a word that circular shifts/rotates into *another* word (in the same language).

For example:

```
'stable' < 'tables' < 'ablest'
'abort' > 'tabor'
'tada' >> 'data'

```

# The Challenge

Write a program or function that accepts a dictionary/word list and prints or returns a complete list of rotonyms.

1. Order doesn't matter.
2. Comparisons should be case-insensitive, so you can assume the input will be passed as a lower-case-only dictionary.
3. Result should be expressed as single words (not the pairs) and contain no duplicates, so you can assume the input has no duplicates.
4. This is .

# Example

Given

```
ablest
abort
green
irk
stable
tables
tabor
tata
terra
vex
you

```

Return

```
ablest
abort
stable
tables
tabor

```

# A Real Test

Given

```
a aa aal aalii aam aani aardvark aardwolf aaron aaronic aaronical aaronite aaronitic aaru ab aba ababdeh ababua abac abaca abacate abacay abacinate abacination abaciscus abacist aback abactinal abactinally abaction abactor abaculus abacus abadite abaff abaft abaisance abaiser abaissed abalienate abalienation abalone abama abampere abandon abandonable abandoned abandonedly abandonee abandoner abandonment abanic abantes abaptiston abarambo abaris abarthrosis abarticular abarticulation abas abase abased abasedly abasedness abasement abaser abasgi abash abashed abashedly abashedness abashless abashlessly abashment abasia abasic abask abassin abastardize abatable abate abatement abater abatis abatised abaton abator abattoir abatua abature abave abaxial abaxile abaze abb abba abbacomes abbacy abbadide abbas abbasi abbassi abbasside abbatial abbatical abbess abbey abbeystede abbie abbot abbotcy abbotnullius abbotship abbreviate abbreviately abbreviation abbreviator abbreviatory abbreviature abby abcoulomb abdal abdat abderian abderite abdest abdicable abdicant abdicate abdication abdicative abdicator abdiel abditive abditory abdomen abdominal abdominales abdominalian abdominally abdominoanterior abdominocardiac abdominocentesis abdominocystic abdominogenital abdominohysterectomy abdominohysterotomy abdominoposterior abdominoscope abdominoscopy abdominothoracic abdominous abdominovaginal abdominovesical abduce abducens abducent abduct abduction abductor abe abeam abear abearance abecedarian abecedarium abecedary abed abeigh abel abele abelia abelian abelicea abelite abelmoschus abelmosk abelonian abeltree abencerrages abenteric abepithymia aberdeen aberdevine aberdonian aberia aberrance aberrancy aberrant aberrate aberration aberrational aberrator aberrometer aberroscope aberuncator abet abetment ablest abort abut ach ache acher achete achill achor acor acre acyl ad adad adat add addlings adet ala ama baa bafta balonea batea beta caba cha chilla cora crea da dad dada data each lacy orach rache saddling stable tables tabor tabu tade teache zoquean zoraptera zorgite zoril zorilla zorillinae zorillo zoroastrian zoroastrianism zoroastrism zorotypus zorrillo zorro zosma zoster zostera zosteraceae zosteriform zosteropinae zosterops zouave zounds zowie zoysia zubeneschamali zuccarino zucchetto zucchini zudda zugtierlast zugtierlaster zuisin zuleika zulhijjah zulinde zulkadah zulu zuludom zuluize zumatic zumbooruk zuni zunian zunyite zupanate zutugil zuurveldt zuza zwanziger zwieback zwinglian zwinglianism zwinglianist zwitter zwitterion zwitterionic zyga zygadenine zygadenus zygaena zygaenid zygaenidae zygal zygantra zygantrum zygapophyseal zygapophysis zygion zygite zygnema zygnemaceae zygnemales zygnemataceae zygnemataceous zygnematales zygobranch zygobranchia zygobranchiata zygobranchiate zygocactus zygodactyl zygodactylae zygodactyli zygodactylic zygodactylism zygodactylous zygodont zygolabialis zygoma zygomata zygomatic zygomaticoauricular zygomaticoauricularis zygomaticofacial zygomaticofrontal zygomaticomaxillary zygomaticoorbital zygomaticosphenoid zygomaticotemporal zygomaticum zygomaticus zygomaxillare zygomaxillary zygomorphic zygomorphism zygomorphous zygomycete zygomycetes zygomycetous zygon zygoneure zygophore zygophoric zygophyceae zygophyceous zygophyllaceae zygophyllaceous zygophyllum zygophyte zygopleural zygoptera zygopteraceae zygopteran zygopterid zygopterides zygopteris zygopteron zygopterous zygosaccharomyces zygose zygosis zygosperm zygosphenal zygosphene zygosphere zygosporange zygosporangium zygospore zygosporic zygosporophore zygostyle zygotactic zygotaxis zygote zygotene zygotic zygotoblast zygotoid zygotomere zygous zygozoospore zymase zyme zymic zymin zymite zymogen zymogene zymogenesis zymogenic zymogenous zymoid zymologic zymological zymologist zymology zymolyis zymolysis zymolytic zymome zymometer zymomin zymophore zymophoric zymophosphate zymophyte zymoplastic zymoscope zymosimeter zymosis zymosterol zymosthenic zymotechnic zymotechnical zymotechnics zymotechny zymotic zymotically zymotize zymotoxic zymurgy zyrenian zyrian zyryan zythem zythia zythum zyzomys zyzzogeton

```

Return

```
aal aam aba abac abaft abalone abate abet ablest abort abut ach ache acher achete achill achor acor acre acyl ad adad adat add addlings adet ala ama baa bafta balonea batea beta caba cha chilla cora crea da dad dada data each lacy orach rache saddling stable tables tabor tabu tade teache

```

# Answer
> 6 votes
# APL (Dyalog Unicode), ~~25~~ ~~23~~ ~~22~~ ~~17~~ 16 bytesSBCS

Borrows ideas from ngn's ngn/k solution. And then -6 thanks to him. Also -1 by returning an enclosed list as like H.PWiz.

Anonymous tacit prefix function.

```
⊂∩¨1,.↓(∪≢,/,⍨)¨

```

Try it online!

`(` apply the following tacit function to each word:

`,⍨` concatenate the word to itself

`≢,/` all word-length sub-strings (i.e. all rotations)

unique elements of those rotations (to prevent words like `tata` for appearing twice)

`1,.↓` the concatenation of the drop-firsts (the original words) of each list

`⊂∩¨` intersection of the the content of that and the entire original word list

---

### Old solution

-2 thanks to ngn.

Anonymous prefix lambda.

```
{⍵/⍨2≤+/⍵∊⍨↑(∪≢,/,⍨)¨⍵}

```

Try it online!

`{``}` function where  is the word list:

`(` apply the following tacit function to each word:

`,⍨` concatenate the word to itself

`≢,/` all word-length sub-strings (i.e. all rotations)

unique elements of those rotations (to prevent words like `tata` for appearing twice)

mix the list of lists into a single matrix (pads with all-space strings)

`⍵∊⍨` indicate which elements of the matrix are members of the original list

`+/` sum the rows (counts occurrences of each of the original words)

`2≤` indicate which have duplicates (i.e. occur other than when rotated back to original)

`⍵/⍨` use that to filter the original list

# Answer
> 5 votes
# Jelly, 8 bytes

```
ṙ1$ƬfḊɗƇ

```

Try it online!

### Alternate version, 7 bytes

```
ṙƬ1fḊʋƇ

```

Dyadic `Ƭ` used to do something weird, so this didn't work when the challenge was posted.

Try it online!

### How it works

```
ṙƬ1fḊʋƇ  Main link. Argument: A (array of strings)

     ʋ   Vier; combine the 4 preceding links into a dyadic chain.
      Ƈ  Comb; for each string s in A, call the chain with left argument s and
         right argument A. Keep s iff the chain returned a truthy value.
 Ƭ           'Til; keep calling the link to the left, until the results are no
             longer unique. Return the array of unique results.
ṙ 1          Rotate the previous result (initially s) one unit to the left.
   f         Filter; keep only rotations that belong to A.
             s is a rotonym iff there are at least two rotations of s in A.
    Ḋ        Deque; remove the first string (s) of the result.
             The resulting array is non-empty / truthy iff s is a rotonym.

```

# Answer
> 4 votes
# APL (Dyalog), 20 bytes

Requires `⎕io←0`

```
⊂∩¨(,/(1↓∘∪⍳∘≢⌽¨⊂)¨)

```

Try it online!

`(1↓∘∪⍳∘≢⌽¨⊂)¨` gets the unique rotations (excluding the string itself) of each string in the dictionary

takes the length of a vector

`⍳∘≢` creates the range from 0 up to the length

rotates a vector some number of times, e.g 2⌽'abort' -\> 'ortab'

`⍳∘≢⌽¨⊂` will then give all the rotations of a vector

removes the duplicates

`1↓` removes the first element (the original string)

`,/` flattens all the rotations into one list

`⊂∩¨` takes the intersection of the dictionary with the rotations

# Answer
> 4 votes
# Brachylog, 26 bytes

```
g;?z{tWl⟧₆∋I;W↺₍R;W≠&h∋R}ˢ

```

Try it online!

```
g;?z                          % Zip the whole input with each word in it respectively
    {                   }ˢ    % Apply this predicate to each pair in the zip
                              %   and select the successful values
     tW                       % Let the current word be W
       l⟧₆∋I                  % There exists a number I from 1 to length(W)-1
            ;W↺₍R             % And R is the result of circularly shifting the
                              %   current word I times
                 ;W≠          % And R is not the current word itself (needed for words like "tata")
                    &h∋R      % And R is one of the input dictionary words
                              % (R is implicitly the output of the predicate, and
                              %  successful R values are collected and output by the ˢ)

```

# Answer
> 3 votes
# Python 2, ~~73~~ ~~69~~ 67 bytes

```
lambda d:[w for w in d if{w[i:]+w[:i]for i in range(len(w))}-{w}&d]

```

Try it online!

Takes a set of words (lowercase), and returns a list of rotonyms.

---

Saved

* -2 bytes, thanks to ovs

# Answer
> 3 votes
# K (ngn/k), 23 bytes

```
{x^x^,/1_'(,/|0 1_)\'x}

```

Try it online!

`{` `}` is a function with argument `x`

`0 1_` cuts a string at indices 0 and 1, e.g. `"abcd"` -\> `(,"a";"bcd")`

`|` reverses the two slices: `("bcd";,"a")`

`,/` joins them: `"bcda"`

`(,/|0 1_)\` returns all rotations of a string

`(,/|0 1_)\'x` are the rotations of each string in `x`

`1_'` drops the first "rotation" of each, i.e. each trivial identity rotation

`,/` join

`x^y` is the list `x` without elements of the list `y`

`x^x^y` is the intersection of `x` and `y`

# Answer
> 3 votes
# JavaScript (Node.js), ~~105~~ 99 bytes

```
f=l=>l.filter(w=>[...Array(k=w.length)].map((x,i)=>(w+w).substr(i,k)).some(r=>l.includes(r)&&r!=w))

```

Ungolfed:

```
f = list =>
  list.filter( word =>
    // create a list of all rotonyms for the current word
    [ ...Array( len = word.length ) ]
      .map( (x,i) =>
         ( word+word ).substr(i, len)
      )
    // check if any of the rotonyms is in the initial dictionary/wordlist
     .some( rotonym =>
        list.includes( rotonym )
    // and is not the word itself
        && rotonym != word
     )

```

Try it online!

# Answer
> 2 votes
# 05AB1E, 14 bytes

```
εDvDÀ})ÙåO<Ā}Ï

```

Try it online!

**Explanation**

```
ε           }    # apply to each word in the input
 Dv  }           # for each letter in the word
   DÀ            # copy the previous word and rotate it left
      )Ù         # wrap the rotations in a list and remove duplicates
        å        # check each rotation for presence in the input
         O       # sum presences
          <Ā     # decrement the sum and truthify it (check if 1 or greater)
             Ï   # filter, keep words in input that are true in the resulting list

```

# Answer
> 2 votes
# PynTree, 44 bytes

```
§y:f#x0€[x/|Ḟz&⁻xzėzḞw+#x`wLx#x`0wRLxy]y#\x1

```

Try it online!

This turned out to reveal a major flaw in the way PynTree constructs list comprehensions because it uses functions to assign variables so that assignment can go in expressions, but then the conditions end up not having the value of the variable until after it has been evaluated and the main block has been evaluated. This appears to be easily fixable but I did not notice this earlier and so this answer is hideously long.

Actually even if I fixed that I think it still might be terribly long.

# Answer
> 2 votes
# Perl 6, 65 bytes

```
{@^a.grep:{@a∋any(($/=[.comb]).rotate,*.rotate...^*eq$/).join}}

```

Try it

## Expanded:

```
{  # bare block lambda with placeholder parameter @a

  @^a     # declare and use placeholder parameter
  .grep:  # find the values that match
  {

    @a
    ∋            # Set contains operator

    any(         # create a junction of the following

      # generate a sequence
      (
        $/ =     # store into $/ (no declaration needed for this variable)
        [        # turn into an array instead of a one-time sequence
          .comb  # the input split into characters
        ]
      ).rotate,  # start the sequence on the first rotation

      *.rotate   # use this to generate the rest of the values in the sequence

      ...^       # keep generating values until: (and throw out last value)

      * eq $/    # one of them matches the cached array of the input

    ).join       # for each array in the junction join the strings (no spaces)
  }
}

```

# Answer
> 2 votes
# Python 2, ~~66~~ ~~55~~ 70 bytes

```
lambda d:{w for w in d for v in d if v not in w not in v in w*2in v*3}

```

Try it online!

11 bytes thx to Dennis to use chained `x in y in z` approach.

Takes a set of words `d`; returns a set of Rotonyms.

# Answer
> 2 votes
# PowerShell Core, 131 bytes

```
($t=$args|%{@{r=0..($l=($k=$_).Length-1)|%{-join$k[-$_..($l-$_)]}
w=$_}})|%{$u=$_
$t|?{$u.w-ne$_.w-and$u.w-in$_.r}|%{$_.w}}|sort|gu

```

Try it online!

For each word in the list, create generate a list of all its rotations
Then look for a matching rotation with a different original word
If it exists, keep the word.
Then sort and deduplicate them.
Sorting is required in PowerShell as `Get-Unique` only works on sorted lists.

# Answer
> 1 votes
# Retina 0.8.2, ~~71~~ 62 bytes

```
^(\w)(\w*)
$2$1!¶$&
%+)s`^(.+)(!.*¶\1)$
$2
O`
!`\b(.+)(?=¶\1!)

```

Try it online! Explanation:

```
%+)

```

Repeat for each word.

```
^(\w)(\w*)
$2$1!¶$&

```

Prepend the next rotation of the word with a trailing `!`.

```
s`^(.+)(!.*¶\1)$
$2

```

But if that's the original word, then delete it again.

```
O`

```

Sort the words.

```
!`\b(.+)(?=¶\1!)

```

Find the duplicates.

# Answer
> 1 votes
# C# (.NET Core), ~~100~~ 94 bytes

```
x=>x.Where(y=>y.Select((z,i)=>x.Where(c=>c!=y).Contains(y.Remove(0,i)+y.Remove(i))).Any(b=>b))

```

Try it online!

# Answer
> 1 votes
# Japt, 17 bytes

*Extremely* slow, but works. TIO times out, but I confirmed it works by manually lowering the number of iterations in the language source.

```
f@_XéZ ÀX©UøXéZ}a
f@                // Filter the input array by
  _            }a // generating up to 1e8 rotations of each string
   XéZ ÀX         // and checking if the rotation is different than the original,
         ©UøXéZ   // yet still exists in the input array.

```

Try it online!

# Answer
> 1 votes
## Javascript, 129 Chars

```
f=a=>{n={};r=w=>w.slice(1,w.length)+w[0];a.map(w=>{m=r(w);while(m!=w){if(-~a.indexOf(m))n[m]=1;m=r(m);}});return Object.keys(n);}

```

## Ungolfed

```
f=a=>{
    n={};
    r=w=>w.slice(1,w.length)+w[0];
    a.map(w=>{
        m=r(w);
        while(m!=w){
            if(-~a.indexOf(m))n[m]=1;
            m=r(m);
        }
    });
    return Object.keys(n);
}

```

Try it online!

# Answer
> 1 votes
# Java (JDK 10), 144 bytes

```
l->{for(var s:l){var r=s;for(int i=s.length();i-->1;){r=r.substring(1)+r.charAt(0);if(!r.equals(s)&l.contains(r)){System.out.println(s);i=0;}}}}

```

Try it online!

# Answer
> 1 votes
# JavaScript (Node.js), 66 bytes

```
s=>s.filter(t=>s.some(u=>(t+t).match(u)&&t!=u&t.length==u.length))

```

Try it online!

boring answer

# Answer
> 1 votes
# Japt `-f`, 9 bytes

```
¬£éYÃøWkU

```

Try it

```
¬£éYÃøWkU     :Implicit filter of each string U in input array W
¬             :Split
 £            :Map each element at 0-based index Y
  éY          :  Rotate U right Y times
    Ã         :End map
     ø        :Does that contain any element of
      WkU     :  W with U removed

```

# Answer
> 1 votes
# Ruby, ~~81~~ 59 bytes

Port of l4m2's JavaScript solution

```
->s{s.select{|t|s.any?{|u|(t+t)[u]&&t!=u&&t.size==u.size}}}

```

Attempt This Online!

---
Tags: code-golf
---