title: Generate a random derangement

text:
# Question
Title: Generate a random derangement
# Challenge description

A "derangement" of a sequence is a permutation where no element appears in its original position. For example `ECABD` is a derangement of `ABCDE`, but `CBEDA` is not:

```
ABCDE
 | |   <- B and D are in their orignal positions
CBEDA

```

Given a sequence, generate a random derangement of it.

# Notes

* You may take either a string as an input or an array/list of elements (integers, chars, objects...)
* Instead of returning a new object, you can modify an existing one by swapping its elements
* Each derangement should have an equal probability of being generated
* You may assume that there is more than one element in the sequence and none appear more than once

# Answer
## CJam, 14 bytes

```
q:X{mr_X.=:|}g

```

Try it online!

Keeps shuffling the input until it's a derangement.

### Explanation

```
q:X   e# Read input and store it in X.
{     e# While the condition at the end of the loop is truthy...
  mr  e#   Shuffle the string.
  _X  e#   Duplicate it and push the input.
  .=  e#   Element-wise equality check.
  :|  e#   Reduce OR over the list, gives something truthy if any character
      e#   remained in its original position.
}g

```
> 12 votes

# Answer
# Jelly, 6 bytes

```
Ẋ=³S$¿

```

Try it online!

## Explanation

```
Ẋ    ¿    Shuffle the given list while this is nonzero for it:
    $       A two-step process:
 =³           Element-wise equality of it and L (the original list)...
   S          Sum the ones in this binary array.

```

Jonathan Allan saved a byte.
> 9 votes

# Answer
# Python, 85 bytes

Modifies the list passed to it (allowed by meta and in the question).

```
from random import*
def D(l):
 o=l[:]
 while any(x==y for x,y in zip(o,l)):shuffle(l)

```

**Try it online here!**
> 6 votes

# Answer
# ES6 (Javascript), ~~71~~, 69 bytes

Input and output are arrays, should work with any element types (strings, numbers e.t.c.), as long as they can be compared with "==".

**Golfed**

```
F=s=>(r=[...s]).sort(_=>Math.random()-.5).some((e,i)=>s[i]==e)?F(s):r

```

**Test**

```
F=s=>(r=[...s]).sort(_=>Math.random()-.5).some((e,i)=>s[i]==e)?F(s):r

F(['A','B','C','D'])
Array [ "D", "C", "A", "B" ]

F(['A','B','C','D'])
Array [ "D", "A", "B", "C" ]

F(['A','B','C','D'])
Array [ "C", "D", "B", "A" ]

F(['A','B','C','D'])
Array [ "D", "C", "B", "A" ]

F(['A','B','C','D'])
Array [ "C", "D", "B", "A" ]

```

**Interactive Snippet**

```
F=s=>(r=[...s]).sort(_=>Math.random()-.5).some((e,i)=>s[i]==e)?F(s):r

function G() {
    console.log(F(T.value.split``).join``);
}
```

```
<input id=T value="ABCDEF"><button id=G onclick="G()">GENERATE</button>
```
> 5 votes

# Answer
## Perl 6, 33 bytes

```
{first (*Zne$_).all,.pick(*)xx *}

```

A lambda that takes a list of integers or characters as input, and returns a new list.

If it must support lists of *arbitrary* values, `ne` would have to be replaced with `!eqv` (+2 bytes).

(Try it online.)

### Explanation:

* `{ }`: Defines a lambda.
* `.pick(*)`: Generates a random shuffle of the input list.
* `.pick(*) xx *`: Creates a lazy infinite sequence of such shuffles.
* `(* Zne $_).all`: A lambda that zips two lists (its argument `*`, and the outer lambda's argument `$_`) with the `ne` (negative string equality) operator, yielding a list of booleans, and then creates an `all` junction to collapse them to a single boolean state.
* `first PREDICATE, SEQUENCE`: Takes the first element from our infinite sequence of permutations that fulfills the "derangement" test.
> 5 votes

# Answer
# MATL, 7 bytes

This is a translation of my Octave post (and similar to some of the other submissions here). I posted my first MATL post yesterday (CNR crack), so I guess this is not optimal, but it's the best I've got so far.

To be honest, I'm not entirely sure `t` is needed in there, but it's the only way I can get this to work. It's used so that I can compare the user input (retrieved with `G`), with the random permutation. I would think I could compare the two without it, but...?

Anyway, here goes:

```
`Z@tG=a

`          % Loop
 Z@        % Random permutation of input
   t       % Duplicating the stack
    G      % Paste from clipboard G (user input)
     =     % Comparing the random permutation with the input (retrieved from clipboard)
      a    % any(input == random permutation)
           % Implicit end and display

```

Try it online!
> 4 votes

# Answer
# Brachylog, ~~19~~ ~~18~~ ~~15~~ 13 bytes

```
@~.:?z:#da;?&

```

Try it online!

### Explanation

```
@~.                Output is a shuffle of the input
  .:?z             Zip the output with the input
      :#da         All couples of integers of the zip must be different
          ;      Or
           ?&      Call recursively this predicate with the same input

```
> 4 votes

# Answer
# Perl 6, 45 bytes

```
{(@^a,{[.pick(*)]}...{none @a Zeqv@$_})[*-1]}

```

```
{(@^a,{[.pick(*)]}...{!sum @a Zeqv@$_})[*-1]}

```

Try it

Input is an Array of anything.

## Expanded:

```
{
  (

    @^a,          # declare parameter, and seed sequence generator

    {             # lambda with implicit parameter ｢$_｣
      [           # store into an array
        .pick(*)  # shuffle ｢$_｣
      ]
    }

    ...           # keep generating the sequence until

    {
      none        # none
      @a          # of the outer blocks input
      Z[eqv]      # is zip equivalent
      @$_         # with the current value being tested
    }

  )[ * - 1 ]      # return the last value
}

```
> 3 votes

# Answer
# Actually, 13 bytes

```
;;WX╚│♀=ΣWX)X

```

Try it online!

Explanation:

```
;;WX╚│♀=ΣWX)X
;;             make two copies of input
  WX╚│♀=ΣW     while top of stack is truthy:
   X             discard top of stack
    ╚            shuffle array
     │           duplicate entire stack
      ♀=         compare corresponding elements in shuffled and original for equality
        Σ        sum (truthy if any elements are in the same position, else falsey)
          X)X  discard everything but the derangement

```
> 3 votes

# Answer
# Octave, ~~56~~ 55 bytes

```
x=input('');while any(x==(y=x(randperm(nnz(x)))));end,y

```

We have to use `input('')` since this is not a function. Also, since I can choose to have the input as a string we can use the trick that `nnz(x)==numel(x)`.

**Explanation:**

```
x=input('')            % Self-explanatory
while any(x==y)        % Loop until x==y has only 0s (i.e. no elements are equal)
y=x(randperm(nnz(x)))  % Continue to shuffle the indices and assign x(indices) to y
end                    % End loop
y                      % Display y

```

Thanks to Luis for noticing that the input can be a string, thus I could use `nnz` instead of `numel` saving two bytes.
> 2 votes

# Answer
# Pyth - ~~10~~ 9 bytes

This keeps on shuffling the input while any of the characters equal the characters at their index in the input.

```
.WsqVHQ.S

```

Try it online here.

```
.W           Iterate while
 s           Sum, this is works as any() on a boolean list
  qV         Vectorized equality
   H         The lambda variable for the check step
   Q         The input
 .S          Shuffle
  (Z)        Lambda variable, implicit
 (Q)         Start .W with input, implicit

```
> 2 votes

# Answer
# MATL, 13 bytes

This is a joint effort of @LuisMendo and me. In contrast to many other answers here this one is deterministic in the sense that it does not sample random permutations until it gets a derangement, but it generates all derangements and chooses one randomly.

```
Y@tG-!Af1ZrY)

```

Try It Online!

### Explanation

```
Y@tG-!Af1ZrY)
Y@             generate all permutatoins
  t            create a duplicate
   G-!A        find the (logical) indices of all valid derangements (where no character of the string is in the same position as the original string)
       f       convert logical to linear indices
        1Zr    choose one of those indices randomly
           Y)  get the derangement (from the ones we generated earlier) at this index

```
> 2 votes

# Answer
# Mathematica, 57 bytes

```
#/.x_:>RandomChoice@Select[Permutations@x,FreeQ[#-x,0]&]&

```

Unnamed function taking a list of whatevers as input and outputting a list. After generating all permutations `#` of the input `x`, we keep only the ones for which the set `#-x` of element-wise differences doesn't contain a `0`; then we make a (uniformly) random choice from that set.
> 2 votes

# Answer
# PHP, 85 bytes

```
for($a=$b=str_split($argv[1]);array_diff_assoc($a,$b)!=$a;)shuffle($b);echo join($b);

```

Copies the string argument to two arrays, shuffles one of them until the difference between them (also comparing indexes of the elements) equals the other one. Run with `-r`.
> 0 votes

# Answer
# Wonder, 32 bytes

```
f\@[/>#I zip#=[#0a\shuf#0]?f a?a

```

Usage:

```
f\@[/>#I zip#=[#0a\shuf#0]?f a?a];f[1 2 3 4 5]

```

# Explanation

More readable:

```
f\@[
  some #I zip #= [#0; a\ shuf #0]
    ? f a
    ? a
]

```

Recursive function `f`. Does an element-wise comparison between `f`'s input list and and a shuffled version of the input list. If the comparison yields any equal values, then `f` is called on the shuffled list. Otherwise, we simply return the shuffled list.
> 0 votes

# Answer
# R, 59 bytes

```
z=x=1:length(y<-scan(,""));while(any(x==z))z=sample(x);y[z]

```

Reads a list of elements to STDIN, takes the length of the list and starts sampling ranges from 1 to the length, until it finds one that shares no places with the ordered list. Then prints that list.
> 0 votes

# Answer
# Octave,  ~~54~~ 53 bytes

```
@(a)((p=perms(a))(L=!any(p==a,2),:))(randi(sum(L)),:)

```

Generate all permutations of `a` and select randomly a row that doesn't have a common element with `a` .

note: It is accidentally the same as @flawr MATL answer!
> 0 votes

# Answer
# Ruby, 67 bytes

```
def f a
while (a.zip(o=a.shuffle).map{|x,y|x-y}.index 0);end
o
end

```
> 0 votes

# Answer
## Clojure, ~~94~~ ~~90~~ 79 bytes

```
#(let[s(shuffle %)](if(not(some(fn[[x y]](= x y))(map vector % s)))s(recur %)))

```

-4 bytes by changing the conditional inside the reduction to an `and`, and inlining `done?`.

-11 bytes by converting the reduction to `some`.

WOOT! Beat PHP.

Brute-force method. Shuffles the list while it's invalid. This finishes stupid fast considering it's a brute force method that does nothing to prevent duplicate tries. It found 1000 dearangments of a 1000 element long list in less than a second.

Ungolfed:

```
(defn dearang [ls]
  (let [s (shuffle ls)
        bad? (some (fn [[x y]] (= x y))
                (map vector ls s))]
    (if (not bad?) s (recur ls))))

```
> 0 votes

# Answer
## Clojure, 56 bytes

```
#(let[s(shuffle %)](if((set(map = % s))true)(recur %)s))

```

Note that a string cannot be shuffled, must be passed through `seq` or `vec`.

Originally I tried `#(first(remove(fn[s]((set(map = % s))true))(iterate shuffle %)))` but `recur` approach is indeed shorter than `iterate`.

The magic is that `(set(map = % s))` returns either a set of false, set of true or set of true and false. This can be used as a function, if it contains `true` then the answer is `true`, otherwise falsy `nil`. `=` is happy to take two input arguments, no need to wrap it with something.

```
((set [false]) true)
nil

```

Maybe there is even shorter way to check if any of the values is true?
> 0 votes

# Answer
# APL, 11 bytes.

With the string in the right argument:

`⍵[⍋(⍴⍵)?⍴⍵]`

# Explanation

`ρ⍵` gets the length (or shape) of the right argument.

`?` returns a random array of `(⍴⍵)` of these numbers.

returns the order of them in order to ensure no duplicates.

`⍵[..]` represents the random assortment of the string using this index.
> 0 votes

---
Tags: code-golf, array, random, permutations
---


title: Gather the trash

text:
# Question
Title: Gather the trash
You're looking at an avenue, and someone has left the trash out! You need to write a program to help fix the problem, by putting the trash into trashcans.

# The task

The avenue is made up of a string of printable ASCII characters, e.g.:

```
[[](dust)[]] car ((paper)vomit) (broken(glass)) [[] (rotten) fence (dirty)

```

Some of the brackets here are unmatched; those are just decoys. What we care about are the matched sets of brackets.

A *trash can* is a string starting with `[` and ending with `]`, and with internally matched brackets and parentheses. For example, `[]` and `[[](dust)[]]` are trash cans in the above string.

A *trash bag* is a string starting with `(` and ending with `)`, and with internally matched brackets and parentheses. For example, `(dust)` is a trash bag in the above string.

It's possible that some of the trash bags are in trash cans already. However, at least one will have been left out, and we need to move the trash bags so that they're all inside trash cans. Specifically, for each trash bag that isn't currently inside a trash can (i.e. a substring of that trash can), we need to remove it from its current location in the string, and insert it into a location that's inside a trash can instead.

There's an additional rule here. Because we don't want to spend too much money on garbage collectors, and their route takes them along the avenue from right to left, we want to move each trash bag *to the left* (most important criterion, assuming we have to move it at all) and *the shortest distance possible* (as long as it's moved to the left). So for example, the only correct output for

```
[can1](bag)[can2]

```

is

```
[can1(bag)][can2]

```

(moving the bag just one character leftwards). Additionally, the bags need to stay in the same relative order:

```
[can](bag1)(bag2)

```

has to become

```
[can(bag1)(bag2)]

```

(i.e. you can't put `(bag2)` to the left of `(bag1)`.)

# Clarifications

* There won't be any trash bags to the left of the leftmost trash can; it will always be possible to can all the trash by moving it to the left.
* There will always be at least one bag to move. There might be more than one.
* There will never be a trash can inside a trash bag (the cans are too valuable to just throw away).
* If a bag is already inside a can, just leave it alone.
* It's OK for the input and output to differ in trailing whitespace (including newlines).

Examples:

* Input: `[[](dust)[]] car ((paper)vomit) (broken(glass)) [[] (rotten) fence (dirty)`

Output: `[[](dust)[]((paper)vomit)(broken(glass))] car [[(rotten)(dirty)] fence`
* Input: `[]] (unusable) door (filthy) car`

Output : `[(unusable)(filthy)]] door car`

# Answer
## JavaScript (ES6), ~~263~~ ~~228~~ ~~209~~ ~~205~~ ~~184~~ ~~177~~ ~~173~~ 162 bytes

Any help with the code / regular expressions is greatly appreciated.

```
f=s=>s.match(t=/\[\[][\w()]*\[]]|\[]/g,g=/\([\w()]*\)/g,i=0,u=s.split(t).filter(e=>e)).map(e=>e.substr(0,e.length-1)+u[i].match(g).join``+`]`+u[i++].replace(g,``)).join``

```

An anonymous function; takes one `String` parameter, `s`, and returns the output.

`/\[\[][\w()]*\[]]|\[]/g` matches trash cans with nested trash bags, however I don't think it could check balanced brackets within trash bags if needed.
> 3 votes

---
Tags: code-golf, balanced-string
---


title: Variable-Prices income!

text:
# Question
Title: Variable-Prices income!
## Introduction and credit

Assume you're a bartender. You have many happy people in your bar at most times, but many only ever drink the very same drink and too few for your taste and you want to change that. So you introduce a system where the price of a drink is variable, depending on how many have already been sold, but never more or less expensive than certain thresholds. For some odd reason you always forget to keep proper track of all sold drinks and prices and thus you need to think of a short (= memorable!) piece of code that does the math for you given the amount of drinks consumed.

This challenge has already appeared in the mid-term exam in 2012 at the functional programming course at my uni and I've got my professor's ok to post it here. We have been provided an example solution in the exam's language.

## Input

Your input will be a list of strings which don't contain spaces - these are the names of the drinks sold. Take the input using your preferred, generally accepted input method.

## Output

Your output will be a single number - this is the income you have generated this evening. Give the output using your preferred, generally accepted output method.

## What to do?

This applies for each drink individually:

* The starting price is 10.
* Each time the drink is bought, it's price is bumped up by 1 for the next buyer.
* The maximal price is 50. If the drink has been bought for 50 the new price will be 10 again.

Your task is to find the overall income, generated by the input list of drinks given the above rules.

---

In case you're wondering: "50 bucks is really damn expensive for a drink!", this is 50-deci Bucks, so 50 * 0.1 * Unit, but I've opted to go for 10-50 to not exclude languages without floating point arithmetic.

## Who wins?

This is , so the shortest code in bytes wins! Standard rules apply.

## Potential Corner Cases

If the input list is empty, the output shall be 0.
The input list icannot be assumed to be sorted by drink.

## Examples

```
[] -> 0
["A"] -> 10
["A","B"] -> 20
["A","A","B"] -> 31
["A","B","A"] -> 31
["A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A"] -> 1240
["A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","B","B","B","C","C","D"] -> 1304
["D","A","A","C","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","B","B","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","B","C"] -> 1304
["A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","B","B","B","C","C","D","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A"] -> 1304

```

# Answer
> 4 votes
# Python 2, ~~79~~ ~~74~~ ~~54~~ 48 Bytes

Massive byte count increase by rethinking the problem. ~~I would like to get rid of the `int` cast but my brain isn't working~~. Making use of `l.pop()` to avoid trimming the list twice and some good old lambda recursion :)

```
f=lambda l:l and l.count(l.pop())%41+10+f(l)or 0

```

<sup>*thanks to Jonathan Allan for saving 6 bytes :)*</sup>

My old 54-byte version I was quite proud of :)

```
f=lambda l:int(l>[])and~-l.count(l[0])%41+10+f(l[1:])

```

# Answer
> 4 votes
# JavaScript (ES6), 50 bytes

```
a=>a.map(x=>t+=d[x]=d[x]<50?d[x]+1:10,t=0,d={})&&t

```

# Answer
> 2 votes
# 05AB1E, ~~16~~ 15 bytes

Thanks to *Emigna* for saving a byte!

```
ÎÙv¹y¢L<41%T+OO

```

Uses the **CP-1252** encoding. Try it online!

# Answer
> 2 votes
# Pyth, 15 bytes

```
ssm<*lQ}T50/Qd{

```

A program that takes input of a list and prints the result.

Test suite (First line to allow multiple input)

**How it works**

```
ssm<*lQ}T50/Qd{   Program. Input: Q
ssm<*lQ}T50/Qd{Q  Implicit input fill
              {Q  Deduplicate Q
  m               Map over that with variable d:
       }T50        Yield [10, 11, 12, ..., 48, 49, 50]
    *lQ            Repeat len(Q) times
   <       /Qd     First Q.count(d) elements of that
 s                Flatten
s                 Sum
                  Implicitly print

```

# Answer
> 2 votes
# Jelly, ~~14 11~~ 10 bytes

```
50⁵rṁÐ€ĠSS

```

**TryItOnline!**

### How?

```
50⁵rṁÐ€ĠSS - Main link: list of drink names                e.g. ['d', 'a', 'b', 'a', 'c']
       Ġ   - group indices by values                       e.g. [[2, 4], [3], [5], [1]]
  ⁵        - 10
50         - 50
   r       - inclusive range, i.e. [10, 11, 12, ..., 48, 49, 50]
    ṁÐ€    - mould left (the range) like €ach of right(Ð)  e.g. [[10, 11], [10], [10], [10]]
                 note: moulding wraps, so 42 items becomes [10, 11, 12, ..., 48, 49, 50, 10]
        S  - sum (vectorises)                              e.g. [40, 11]
         S - sum                                           e.g. 51

```

# Answer
> 1 votes
# Perl 41 Bytes

Includes +1 for `-p`

```
$\+=$H{$_}+=$H{$_}?$H{$_}>49?-40:1:10;}{

```

Takes input on newlines.

Increments a hash value by: `10` if it's `undef`, `-40` if it's `> 49` i.e. `50`, or `1` otherwise. This is then added to `$\`, the output separator, which the `-p` prints.

**Example:**

```
$ echo -e 'A\nB\nA' | perl -pe '$\+=$H{$_}+=$H{$_}?$H{$_}>49?-40:1:10;}{'
31

```

# Answer
> 1 votes
# 05AB1E, 13 bytes

```
{.¡€gL<41%T+O

```

**Explanation**

`["A","B","A"]` used as example.

```
{               # sort input
                # STACK: ["A","A","B"]
 .¡             # split on different
                # STACK: [["A","A"],["B"]]
   €g           # length of each sublist
                # STACK: [2,1]
     L          # range [1 ... x] (vectorized)
                # STACK: [1,2,1]
      <         # decrease by 1
                # STACK: [0,1,0]
       41%      # mod 41
                # STACK: [0,1,0]
          T+    # add 10
                # STACK: [10,11,10]
            O   # sum
                # OUTPUT: 31

```

# Answer
> 1 votes
# C++14, 105 bytes

As generic unnamed lambda returning via reference parameter. Requires input to be a container of `string` that has `push_back`, like `vector<string>`.

Using the `%41+10` trick from Kade's Python answer.

```
[](auto X,int&r){r=0;decltype(X)P;for(auto x:X){int d=0;for(auto p:P)d+=x==p;r+=d%41+10;P.push_back(x);}}

```

Creates an empty container `P` as memory what has been served already. The price is calculated by counting the `x` in `P`.

Ungolfed and usage:

```
#include<iostream>
#include<vector>
#include<string>

using namespace std;

auto f=
[](auto X, int& r){
  r = 0;
  decltype(X) P;
  for (auto x:X){
    int d = 0;
    for (auto p:P)
      d += x==p;
    r += d % 41 + 10;
    P.push_back(x);
  }
}
;

int main(){
 int r;
 vector<string> V;
 f(V,r);cout << r << endl;
 V={"A"};
 f(V,r);cout << r << endl;
 V={"A","B"};
 f(V,r);cout << r << endl;
 V={"A","B","C"};
 f(V,r);cout << r << endl;
 V={"A","A"};
 f(V,r);cout << r << endl;
 V={"A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A"};
 f(V,r);cout << r << endl;
 V={"A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","B","B","B","C","C","D"};
 f(V,r);cout << r << endl;
 V={"A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","B","C"};
 f(V,r);cout << r << endl;
}

```

# Answer
> 0 votes
# Mathematica, 64 bytes

Feels like it should be shorter.

```
Tr[(19+#)#/2&/@(Length/@Gather@#//.z_/;z>41:>Sequence[41,z-41])]&

```

`Length/@Gather@#` counts the repetitions of each drink. `//.z_/;z>41:>Sequence[41,z-41]` splits any integer `z` exceeding 41 in this into `41` and `z-41`, to reflect the price drop. Then each of the counts is plugged into the formula `(19+#)#/2`, which is the total cost of `#` drinks as long as `#` is at most 41. Finally, `Tr` sums up those costs.

# Answer
> 0 votes
# k, 22 bytes

The argument can be any list - strings, numerics etc.

```
{+/,/10+(#:'=x)#\:!41}

```

The `q` translation is easier to read:

```
{sum raze 10+(count each group x)#\:til 41}

```

# Answer
> 0 votes
# **C#, 193 bytes + 33**

An extra 33 bytes for `using System.Collections.Generic;`

```
void m(string[]a){int t=0;Dictionary<string,int>v=new Dictionary<string,int>();foreach(string s in a){if(v.ContainsKey(s)){v[s]=v[s]==50?10:v[s]+1;}else{v.Add(s,10);}t+=v[s];}Console.WriteLine(t);}

```

I'm sure this can be golfed to oblivion, Dictionaries are definitely not the best way to do this and I could probably work a ternary into my if. Aside from that I think it's okay!

Examples:

```
a = {"A", "A", "A", "B", "B", "C"};
//output = 64

a = {"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A",, "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A", "A" ,"A" "A" ,"A", "A" ,"A", "B", "B", "C"};
//output 727

```

Ungolfed

```
void m(string[] a)
{
    int t=0;
    Dictionary<string,int> v = new Dictionary<string,int>();
    foreach(string s in a)
    {
        if(v.ContainsKey(s))
        {
            v[s]=v[s]==50?10:v[s]+1;
        }
        else
        {
            v.Add(s,10);
        }
        t+=v[s];
    }
    Console.Write(t);
}

```

# Answer
> 0 votes
## Clojure, 79 bytes

```
#(apply +(mapcat(fn[l](for[i(range l)](+(mod i 41)10)))(vals(frequencies %)))))

```

Counts frequencies of drinks, then calculates the base price as `10 + (i % 41)`. `mapcat` concatenates them and `apply +` calculates the sum.

# Answer
> 0 votes
# PHP, 47 bytes

```
while($k=$argv[++$i])$s+=10+$p[$k]++%41;echo$s;

```

takes input from command line arguments; run with `-r`.

---
Tags: code-golf, math
---


title: Make a 24 Game Solver

text:
# Question
Title: Make a 24 Game Solver
The 24 Game is a card game. On each cards are four interger numbers. For a player, the goal is to use Addition, Subtraction, Multiplication and Division to end up with 24.

The goal of this code golf/puzzle is to write a program that, for four intergers, will state the one or multiple solutions possible with those numbers.

Further notes:

* Should work for an input of any four interger numbers (below 24, above 0). If there is no solution, display `0 solutions` as output.
* Should output the total number of solutions for this set of four numbers as well as the formulas used.
    + Brackets () can be used (and are often important) to get one or multiple solutions.
* Should only display distinct solutions. For instance, when given {1, 1, 4, 4}, it should not display the cases where the ones and the fours are swapped. Also, if have a solution (a\*b)\*(c\*d), you should not output (c\*d)\*(a\*b) as well, for instance.

An example: For *{9, 6, 3, 2}*, the program should output:

```
   (9-3-2)×6
   (6+2)×9/3
   6×2+9+3
   (9-3)×(6-2)
   (3-2/6)×9
   9×6/2-3
   9×3-6/2
   (9+6-3)×2
   8 solutions

```

Kudos if you can make a working program that follows the rules outlined above.

Even more kudos if you do this in as little code as possible.

Happy Code Puzzling/Golfing!

# Answer
## Ruby, ~~253~~ 243 (incomplete, many duplicates, no error message)

```
g=gets.split.map(&:to_i).permutation(4)
s=[0,2,4,6]
%w[+ - * /].repeated_permutation(3).map{|x|g.map{|y|s.map{|b|s.select{|e|e>b}.map{|a|y.zip(x).flatten[0..6].join.insert(a+1,?)).insert(b,?()}}}}.flatten.each{|x|puts x if 24==eval(x)rescue''}

```

I got this so far, but there are a lot of duplicates. Example run:

```
c:\a\ruby>24
9 6 3 2
(9+3)+6*2
(9+3+6*2)
9+(3+6*2)
9+3+(6*2)
(9+3)+2*6
(9+3+2*6)
9+(3+2*6)
9+3+(2*6)
(3+9)+6*2
(3+9+6*2)
3+(9+6*2)
3+9+(6*2)
(3+9)+2*6
(3+9+2*6)
3+(9+2*6)
3+9+(2*6)
(9+6-3)*2
(6+9-3)*2
(9+6*2)+3
(9+6*2+3)
9+(6*2)+3
9+(6*2+3)
(9+2*6)+3
(9+2*6+3)
9+(2*6)+3
9+(2*6+3)
(3+6*2)+9
(3+6*2+9)
3+(6*2)+9
3+(6*2+9)
(3+2*6)+9
(3+2*6+9)
3+(2*6)+9
3+(2*6+9)
(6+2)*9/3
(2+6)*9/3
(9-3+6)*2
(6-3+9)*2
(9-3-2)*6
(9-2-3)*6
(6*2)+9+3
(6*2+9)+3
(6*2+9+3)
6*2+(9+3)
(6*2)+3+9
(6*2+3)+9
(6*2+3+9)
6*2+(3+9)
(2*6)+9+3
(2*6+9)+3
(2*6+9+3)
2*6+(9+3)
(2*6)+3+9
(2*6+3)+9
(2*6+3+9)
2*6+(3+9)
2*(9+6-3)
2*(6+9-3)
9*(6+2)/3
9*(2+6)/3
2*(9-3+6)
2*(6-3+9)
6*(9-3-2)
6*(9-2-3)
(9*3)-6/2
(9*3-6/2)
9*3-(6/2)
(3*9)-6/2
(3*9-6/2)
3*9-(6/2)
(9*6)/2-3
(9*6/2)-3
(9*6/2-3)
9*(6/2)-3
(6*9)/2-3
(6*9/2)-3
(6*9/2-3)
9/3*(6+2)
9/3*(2+6)
(6/2)*9-3
(6/2*9)-3
(6/2*9-3)

```

It will probably prove very difficult to eliminate duplicates. I am working on it, but I am afraid it will triple my code size, so I'm posting here first. aaaaaaahhhhh my brain hurts now, so I will continue working on this later :P
> 7 votes

# Answer
# Mathematica ~~449 479~~ 470

This was based on Zhe Hu's approach but I kept native Mathematica expressions, with numbers stored as strings, throughout. This had two advantages: (1) easy detection of duplicates and (2) high-quality formatting in output.

Because the "deep structure" of the output is kept in a canonical, sorted form, duplicates are easily detected even if the components were initially generated in slightly different ways. Thus commutativity is recognized for addition and multiplication but not imputed to subtraction, division. Further, associativity is implicitly acknowledged.

```
p[{a_, b_, c_, d_}] := Module[{h, v, q},
q[x_, y_] := If[y == 0, Null, x/y];
h[m_, m_, num_] := {Part[num, m]};
h[s_, f_, num_] := h[s, f, num] = Flatten[Table[Outer[F, {Plus, Subtract, Times, q}, h[s, i, num],
   h[i + 1, f, num]], {i, s, f - 1}]];
v[o_, n1_, n2_] := o[n1, n2];
t = (Map[# &, Select[Map[h[1, 4, #] &, Permutations[{a, b, c, d}]] // Flatten, (# /. F -> v) == 24 &]]) //. {q -> Divide, n_Integer :>  ToString[n]};
Append[u = Union[t //. {F[o_, j_, k_] :> o[j, k]}] //. {Times[a1_String, b1_String] :> Row[{"(", a1, "\[Times]", b1, ")"}]}, ToString[Length[u]] <> " solutions"] // Column]

```

---

The `FullForm` of the following solution,

is

```
Plus[Times[-1,"3"],Times[Power["2",-1],Row[List["(","6","\[Times]","9",")"]]]]

```

the structure of which is most clearly rendered in its `TreeForm`.

```
TreeForm[%]

```

The only reason for using a `Row` for multiplication was to explicitly show the multiplication operator for the product of two known numbers: e.g. (6 x 9) instead of (6 9).

---

## Examples

The code produced 9 solutions, not 8, for the suggested test case.

```
p[{2, 3, 6, 9}]

```

---

```
p[{1, 13, 5, 9}]

```

---

```
p[{24, 13, 5, 9}]

```
> 5 votes

# Answer
An all nighter, a ton of code (C# isn't the most terse of languages) and 8, that's right 8 computed solutions. There's a bunch of things I'd probably change about this... and it's probably wrong but I figured I'd get it in now.

```
+-* 9,6,3,2 | 15,12,24 //(9+6-3)×2
*/- 9,6,2,3 | 54,27,24  //9×6/2-3
-+* 9,3,6,2 | 6,12,24
--* 9,3,2,6 | 6,4,24  //(9-3-2)×6
--* 9,2,3,6 | 7,4,24
-+* 6,3,9,2 | 3,12,24
*++ 6,2,9,3 | 12,21,24 //6×2+9+3
+*/ 6,2,9,3 | 8,72,24 //(6+2)×9/3
8 Solutions

(9-3)×(6-2)???
(3-2/6)×9???
9×3-6/2???

using System;
using System.Linq;
using System.Collections.Generic;

namespace ConsoleApplication10
{
    class Program
    {
        static void Main(string[] args)
        {
            var n = new List<double> { 9, 6, 3, 2 };
            var r = new List<double[]>();
            P(n, new List<double>(), r);
            var F = new Dictionary<String, Func<double, double, double>> { { "*", (x, y) => x * y }, { "/", (x, y) => x / y }, { "+", (x, y) => x + y }, { "-", (x, y) => x - y } };
            var fa = (from a in F
                      from b in F
                      from c in F
                      select new[] { a, b, c }).ToList();
            var ir = new List<Tuple<string, double[], double[]>>();
            foreach (var p in r)
                foreach (var f in fa)
                {
                    var t = new double[4];
                    t[0] = p[0];
                    for (int i = 1; i < 4; i++)
                        t[i] = f[i - 1].Value(t[i - 1], p[i]);
                    if (Math.Abs(t.Last() - 24) < 0.01)
                        ir.Add(Tuple.Create(string.Join("", f.Select(_ => _.Key)), t.Skip(1).ToArray(), p));
                }

            var fr = new List<Tuple<string, double[], double[]>>();
            ir.ForEach(i =>
            {
                if (fr.Any(_ => _.Item1.OrderBy(c=>c).SequenceEqual( i.Item1.OrderBy(c=>c))) &&
                    fr.Any(_ => _.Item2.OrderBy(c=>c).SequenceEqual( i.Item2.OrderBy(c=>c)))) return;
                if (fr.Any(_ => _.Item1.Take(2).Concat(i.Item1.Take(2)).All(k=> "/*".Contains(k)) && _.Item3.Last() == i.Item3.Last() ) ||
                    fr.Any(_ => _.Item1.Skip(1).Concat(i.Item1.Skip(1)).All(k=> "/*".Contains(k)) && _.Item2.First() == i.Item2.First() ))
                    return;
                fr.Add(i);
            });

            fr.ForEach(x => Console.WriteLine(x.Item1 + " " + string.Join(",", x.Item3) + " | " + string.Join(",", x.Item2)));
            Console.WriteLine(fr.Count + " Solutions");
            Console.ReadLine();
        }

        static void P<T>(List<T> s, List<T> c, List<T[]> r)
        {
            if (s.Count < 2) r.Add(c.Concat(s).ToArray());
            else
                for (int i = 0; i < s.Count; i++)
                {
                    var cc = c.ToList();
                    cc.Add(s[i]);
                    var ss = s.ToList();
                    ss.RemoveAt(i);
                    P(ss, cc, r);
                }
        }

    }
}

```
> 2 votes

# Answer
## Java

It's quite long - I ought to rewrite it in Python or Haskell - but I think it's correct.

```
import java.util.ArrayList;
import java.util.Arrays;
import java.util.Collection;
import java.util.HashMap;
import java.util.HashSet;
import java.util.Iterator;
import java.util.List;
import java.util.Map;
import java.util.Set;

public class TwentyFour {
  public static void main(String[] _) {
    for (Expression exp : getExpressions(Arrays.asList(9, 6, 3, 2)))
      if (exp.evaluate() == 24)
        System.out.println(exp);
  }

  static Set<Expression> getExpressions(Collection<Integer> numbers) {
    Set<Expression> expressions = new HashSet<Expression>();
    if (numbers.size() == 1) {
      expressions.add(new ConstantExpression(numbers.iterator().next()));
      return expressions;
    }

    for (Collection<Collection<Integer>> grouping : getGroupings(numbers))
      if (grouping.size() > 1)
        expressions.addAll(getExpressionsForGrouping(grouping));
    return expressions;
  }

  static Set<Expression> getExpressionsForGrouping(Collection<Collection<Integer>> groupedNumbers) {
    Collection<Set<Expression>> groupExpressionOptions = new ArrayList<Set<Expression>>();
    for (Collection<Integer> group : groupedNumbers)
      groupExpressionOptions.add(getExpressions(group));

    Set<Expression> result = new HashSet<Expression>();
    for (Collection<Expression> expressions : getCombinations(groupExpressionOptions)) {
      boolean containsAdditive = false, containsMultiplicative = false;
      for (Expression exp : expressions) {
        containsAdditive |= exp instanceof AdditiveExpression;
        containsMultiplicative |= exp instanceof MultiplicativeExpression;
      }

      Expression firstExpression = expressions.iterator().next();
      Collection<Expression> restExpressions = new ArrayList<Expression>(expressions);
      restExpressions.remove(firstExpression);

      for (int i = 0; i < 1 << restExpressions.size(); ++i) {
        Iterator<Expression> restExpressionsIter = restExpressions.iterator();
        Collection<Expression> a = new ArrayList<Expression>(), b = new ArrayList<Expression>();
        for (int j = 0; j < restExpressions.size(); ++j)
          Arrays.asList(a, b).get(i >> j & 1).add(restExpressionsIter.next());
        if (!containsAdditive)
          result.add(new AdditiveExpression(firstExpression, a, b));
        if (!containsMultiplicative)
          try {
            result.add(new MultiplicativeExpression(firstExpression, a, b));
          } catch (ArithmeticException e) {}
      }
    }
    return result;
  }

  // Sample input/output:
  // [ {a,b} ]               -> { [a], [b] }
  // [ {a,b}, {a} ]          -> { [a,b], [a,a] }
  // [ {a,b,c}, {d}, {e,f} ] -> { [a,d,e], [a,d,f], [b,d,e], [b,d,f], [c,d, e], [c,d,f] }
  static <T> Set<Collection<T>> getCombinations(Collection<Set<T>> collectionOfOptions) {
    if (collectionOfOptions.isEmpty())
      return new HashSet<Collection<T>>() {{ add(new ArrayList<T>()); }};

    Set<T> firstOptions = collectionOfOptions.iterator().next();
    Collection<Set<T>> restCollectionOfOptions = new ArrayList<Set<T>>(collectionOfOptions);
    restCollectionOfOptions.remove(firstOptions);

    Set<Collection<T>> result = new HashSet<Collection<T>>();
    for (T first : firstOptions)
      for (Collection<T> restCombination : getCombinations(restCollectionOfOptions))
        result.add(Util.concat(restCombination, first));
    return result;
  }

  static <T> Set<Collection<Collection<T>>> getGroupings(final Collection<T> values) {
    Set<Collection<Collection<T>>> result = new HashSet<Collection<Collection<T>>>();
    if (values.isEmpty()) {
      result.add(new ArrayList<Collection<T>>());
      return result;
    }

    for (Collection<T> firstGroup : getSubcollections(values)) {
      if (firstGroup.size() == 0)
        continue;

      Collection<T> rest = new ArrayList<T>(values);
      for (T value : firstGroup)
        rest.remove(value);

      for (Collection<Collection<T>> restGrouping : getGroupings(rest)) {
        result.add(Util.concat(restGrouping, firstGroup));
      }
    }
    return result;
  }

  static <T> Set<Collection<T>> getSubcollections(final Collection<T> values) {
    if (values.isEmpty())
      return new HashSet<Collection<T>>() {{ add(values); }};

    T first = values.iterator().next();
    Collection<T> rest = new ArrayList<T>(values);
    rest.remove(first);

    Set<Collection<T>> result = new HashSet<Collection<T>>();
    for (Collection<T> subcollection : getSubcollections(rest)) {
      result.add(subcollection);
      result.add(Util.concat(subcollection, first));
    }
    return result;
  }
}

abstract class Expression {
  abstract double evaluate();

  @Override
  public abstract boolean equals(Object o);

  @Override
  public int hashCode() {
    return new Double(evaluate()).hashCode();
  }

  @Override
  public abstract String toString();
}

abstract class AggregateExpression extends Expression {}

class AdditiveExpression extends AggregateExpression {
  final Expression firstOperand;
  final Collection<Expression> addOperands;
  final Collection<Expression> subOperands;

  AdditiveExpression(Expression firstOperand, Collection<Expression> addOperands,
                     Collection<Expression> subOperands) {
    this.firstOperand = firstOperand;
    this.addOperands = addOperands;
    this.subOperands = subOperands;
  }

  @Override
  double evaluate() {
    double result = firstOperand.evaluate();
    for (Expression exp : addOperands)
      result += exp.evaluate();
    for (Expression exp : subOperands)
      result -= exp.evaluate();
    return result;
  }

  @Override
  public boolean equals(Object o) {
    if (o instanceof AdditiveExpression) {
      AdditiveExpression that = (AdditiveExpression) o;
      return Util.equalsIgnoreOrder(Util.concat(this.addOperands, this.firstOperand),
                                    Util.concat(that.addOperands, that.firstOperand))
          && Util.equalsIgnoreOrder(this.subOperands, that.subOperands);
    }
    return false;
  }

  @Override
  public String toString() {
    StringBuilder sb = new StringBuilder(firstOperand.toString());
    for (Expression exp : addOperands)
      sb.append('+').append(exp);
    for (Expression exp : subOperands)
      sb.append('-').append(exp);
    return sb.toString();
  }
}

class MultiplicativeExpression extends AggregateExpression {
  final Expression firstOperand;
  final Collection<Expression> mulOperands;
  final Collection<Expression> divOperands;

  MultiplicativeExpression(Expression firstOperand, Collection<Expression> mulOperands,
                           Collection<Expression> divOperands) {
    this.firstOperand = firstOperand;
    this.mulOperands = mulOperands;
    this.divOperands = divOperands;
    for (Expression exp : divOperands)
      if (exp.evaluate() == 0.0)
        throw new ArithmeticException();
  }

  @Override
  double evaluate() {
    double result = firstOperand.evaluate();
    for (Expression exp : mulOperands)
      result *= exp.evaluate();
    for (Expression exp : divOperands)
      result /= exp.evaluate();
    return result;
  }

  @Override
  public boolean equals(Object o) {
    if (o instanceof MultiplicativeExpression) {
      MultiplicativeExpression that = (MultiplicativeExpression) o;
      return Util.equalsIgnoreOrder(Util.concat(this.mulOperands, this.firstOperand),
                                    Util.concat(that.mulOperands, that.firstOperand))
          && Util.equalsIgnoreOrder(this.divOperands, that.divOperands);
    }
    return false;
  }

  @Override
  public String toString() {
    StringBuilder sb = new StringBuilder(maybeAddParens(firstOperand));
    for (Expression exp : mulOperands)
      sb.append('*').append(maybeAddParens(exp));
    for (Expression exp : divOperands)
      sb.append('/').append(maybeAddParens(exp));
    return sb.toString();
  }

  static String maybeAddParens(Expression exp) {
    return String.format(exp instanceof AdditiveExpression ? "(%s)" : "%s", exp);
  }
}

class ConstantExpression extends Expression {
  final int value;

  ConstantExpression(int value) {
    this.value = value;
  }

  @Override
  double evaluate() {
    return value;
  }

  @Override
  public boolean equals(Object o) {
    return o instanceof ConstantExpression && value == ((ConstantExpression) o).value;
  }

  @Override
  public String toString() {
    return Integer.toString(value);
  }
}

class Util {
  static <T> boolean equalsIgnoreOrder(Collection<T> a, Collection<T> b) {
    Map<T, Integer> aCounts = new HashMap<T, Integer>(), bCounts = new HashMap<T, Integer>();
    for (T value : a) aCounts.put(value, (aCounts.containsKey(value) ? aCounts.get(value) : 0) + 1);
    for (T value : b) bCounts.put(value, (bCounts.containsKey(value) ? bCounts.get(value) : 0) + 1);
    return aCounts.equals(bCounts);
  }

  static <T> Collection<T> concat(Collection<T> xs, final T x) {
    List<T> result = new ArrayList<T>(xs);
    result.add(x);
    return result;
  }
}

```

Like David's, my code gives 9 solutions for `{9, 6, 3, 2}`:

```
3*9-6/2
(3-9)*(2-6)
(9-3)*(6-2)
9*6/2-3
(3-2/6)*9
3+6*2+9
6*(9-3-2)
(6+2)*9/3
(9+6-3)*2

```

I haven't read the 24theory.com page thoroughly, but it seems reasonable to call `(3-9)*(2-6)` and `(9-3)*(6-2)` distinct, doesn't it?
> 1 votes

# Answer
# R

I'm sure there's a shorter way to write this, plus I hard-coded the possible parenthesis, but it works!

```
# set up
library(combinat)
library(iterpc)
library(data.table)
numbers = c(9,6,3,2)
operators = c('+','-','*','/')

# set up formulas without parens
numbers_permu = do.call('rbind', permn(numbers))
operators_permu = getall(iterpc(table(operators), 3, replace=TRUE, order=TRUE))

for(i in seq(nrow(numbers_permu))) {
    for(j in seq(nrow(operators_permu))) {
        tmp = c(rbind(numbers_permu[i,], operators_permu[j,]))
        if (i==1 & j==1) formulas = data.table(t(tmp))
        if (i>1 | j>1) formulas = rbind(formulas, data.table(t(tmp)))
    }
}
formulas$V8 = NULL # undo recycling

# add parens, repeating once for each possible parenthesis combo
setnames(formulas, names(formulas), c('V3', 'V4', 'V7', 'V8', 'V11', 'V12', 'V15'))
p1 =c(" ", " ", " ", " ", "(",  "(",  " ", " ", " ", " ", ")",  " ", " ", " ", " ", ")")
p2 =c(" ", " ", " ", " ", "(",  " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", ")")
p3 =c("(",  " ", " ", " ", "(",  " ", " ", " ", " ", " ", ")",  ")",  " ", " ", " ", " ")
p4 =c("(",  "(",  " ", " ", " ", " ", ")",  " ", " ", " ", ")",  " ", " ", " ", " ", " ")
p5 =c(" ", " ", " ", " ", " ", " ", " ", " ", " ", "(",  " ", " ", " ", " ", " ", ")")
p6 =c("(",  " ", " ", " ", " ", " ", ")",  " ", " ", " ", " ", " ", " ", " ", " ", " ")
p7 =c("(",  " ", " ", " ", " ", " ", " ", " ", " ", " ", ")",  " ", " ", " ", " ", " ")
p8 =c("(",  " ", " ", " ", " ", " ", ")",  " ", "(",  " ", " ", " ", " ", " ", ")",  " ")
p9 =c(" ", " ", " ", " ", "(",  " ", " ", " ", "(",  " ", " ", " ", " ", " ", ")",  ")")
p10=c(" ", " ", " ", " ", " ", "(",  " ", " ", " ", " ", ")",  " ", " ", " ", " ", " ")
p11=c(" ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ")
parens_permu = t(data.table(p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11))

for(i in seq(nrow(formulas))) {
    for(j in seq(nrow(parens_permu))) {
        f = paste0(formulas[i,])
        p = paste0(parens_permu[j,])
        tmp = c(p[1] ,p[2] ,f[1], p[3] ,p[4], f[2],
                p[5] ,p[6] ,f[3], p[7] ,p[8], f[4],
                p[9] ,p[10],f[5], p[11],p[12],f[6],
                p[13],p[14],f[7], p[15],p[16])
        if (i==1 & j==1) full_formulas = data.table(t(tmp))
        if (i>1 | j>1) full_formulas = rbind(full_formulas, data.table(t(tmp)))
    }
}

# evaluate
for(i in seq(nrow(full_formulas))) {
    equation = paste(full_formulas[i], collapse='')
    solution = tryCatch(eval(parse(text=equation)), error = function(e) NA)
    if (i==1) solutions = data.table(equation, solution)
    if (i>1) solutions = rbind(solutions, data.table(equation, solution))
}
solutions[solution==24]

```
> 0 votes

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


title: Approximate Mills' Constant

text:
# Question
Title: Approximate Mills' Constant
# The Task

Write a program or function which, when passed some positive integer `n` as input, returns Mills' Constant accurate up to `n` digits.

# The Definition

Mills' Constant worked out to six thousand digits may be located here.

# Examples

Let `f` be the function described by the challenge.

```
>>> f(1)
1

>>> f(3)
1.31

>>> f(100)
1.306377883863080690468614492602605712916784585156713644368053759966434053766826598821501403701197396

```

# Rules

* Your program must print or return Mills' Constant for any `n` between 1 and 1000.
* Your program must approximate Mills' Constant such that all digits between the first to the `n`th returned or output are accurate to Mills' Constant. Extraneous digits are disallowed.
* No form of hard-coding may be used. This means directly storing the digits of Mills' Constant or storing any of Mills' Primes (including those unlisted within OEIS). This rule includes compression. The solution must generate the number, not just output it.
* The final digit must be rounded according to the digit following the final digit. In other words, if digit `n+1` is five or greater, add one to the final digit.
* Built-in functions or constants relating directly to Mills' Constant or the Riemann zeta function may not be used.
* You may assume that the Riemann hypothesis is true.

# Answer
> 4 votes
# Python 2 + gmpy2, 132 123 bytes

```
from gmpy2 import*
get_context().precision=9999
n=2
exec"n=next_prime(n**3);"*8
print"{:.{}f}".format(root(n,3**9),input())

```

The 9th Mill's prime provides enough precision for 1000 digits. So we calculate that prime, and then use it to calculate the constant.

To speed up the program a lot, replace the exec statement with:

```
mills = [2]
for o in [3, 30, 6, 80, 12, 450, 894, 3636, 70756, 97220, 66768, 300840]:
    mills.append(mills[-1]**3 + o)
n = mills[8]

```

---
Tags: code-golf, number, number-theory
---


title: Run-Length Encoding

text:
# Question
Title: Run-Length Encoding
Write a program uses run-length encoding to shorten a list of non-negative integers it has to read in.

You can assume the non-negative integers can fit in 32bit signed integers.

**Input Format**

The length, `n`, of the list on the first line.

On the second line, a space-separated list of integers representing the list of integers.

**Output Format**

A space separated list of integers. The first 2 integers represent the first run, the next 2 integers the second run and so on. For each pair of integers representing a run, the first integer represents the length of the run and the second represents the value of the integer in the run.

**Sample Input**

1.

```
5
1 1 3 2 2

```

2.

```
3
1 1 1

```

**Sample Output**

1.

```
2 1 1 3 2 2

```

2.

```
3 1

```

**Limits**

```
0<n<10000

```

# Answer
# sh - ~~33~~ ~~29~~ 28

```
read;echo`xargs -n1|uniq -c`

```

Usage:

```
$ cat input|sh 1015.sh
2 1 1 3 2 2

```
* `read` skips the first line
* `xargs -n1` reads the reast and outputs each number on one line:

```
1
1
3
2
2

```
* `uniq -c` filters adjacent matching lines (with the `c` switch it also prints the number of adjancent lines) :

```
2 1
1 3
2 2

```
* `echo` sees those numbers as separate arguments and just prints them separated by a space:

```
2 1 1 3 2 2

```
> 26 votes

# Answer
## Perl, 46 ~~56~~ ~~68~~

```
$_=<>;s/(?{$a=1})(\d+)( \1(?{++$a}))*/$a $1/g

```

Run with the `p` command-line option (counted in code size):

```
$ perl -pe '$_=<>;s/(?{$a=1})(\d+)( \1(?{++$a}))*/$a $1/g'
5
1 1 3 2 2
  => 2 1 1 3 2 2
3
1 1 1
  => 3 1

```
> 5 votes

# Answer
## Haskell (~~84~~ 82)

```
import List
main=interact$unwords.(>>= \x->[show$length x,x!!0]).group.tail.words

```

Number of elements in the list is ignored.
> 3 votes

# Answer
# Ruby - 57

```
$><<[*$<][-1].gsub(/(\d+)( \1)*/){"#{$&.split.size} "+$1}

```

Ungolfed:

```
length = STDIN.readline
input = STDIN.readline
print input.gsub(/(\d+)( \1)*/) { |match|
    "%d %s" % [ match.split.size, $1 ]
}

```
> 3 votes

# Answer
## Python - 92

Here's my attempt, which is mostly what I had before I posted this question, though for some reason I used a literal space instead of a comma.

```
from itertools import*
r=raw_input
r()
for k,g in groupby(r().split()):print len(list(g)),k,

```
> 3 votes

# Answer
# Scala - 136

```
def f(s:Seq[_]):String=if(s.isEmpty)""else{val(l,r)=s.span(s.head==);l.size+" "+s.head+" "+f(r)}
readLine
println(f(readLine split' '))

```
> 3 votes

# Answer
# Scala - 101 characters

This is based on the regex solution. I didn't know this was valid regex in Java, actually! (Scala's regex is based on Java's)

```
print("(\\d+)( \\1)*".r.replaceAllIn({readLine;readLine},m=>(m.matched split' 'size)+" "+m.group(1)))

```
> 3 votes

# Answer
# R, 33 bytes

Late answer....

```
cat(t(mapply(c,rle(scan()[-1]))))

```

Ungolfed

```
scan()[-1]      # read in from stdin [-1] drops first element
rle(..)         # perform run length encoding (return list with lengths and values)
mapply(c, list) # converts list to matrix
t()             # transposes this matrix so when extracted as a vector is length value ...
cat()           # writes to stdout (separated by space)

```
> 3 votes

# Answer
## Python - 106 chars

Very simple conceptually, but some very expensive words weigh it down

```
from itertools import*
input()
print" ".join(`len(list(j))`+' '+i for i,j in groupby(raw_input().split()))

```
> 2 votes

# Answer
**C 101 Characters**

```
#define p printf("%d %d ",c,l)
main(c,i,l){gets(&i);for(c=0;~scanf("%d",&i);l=i)i!=l&&c?p,c=1:c++;p;}

```
> 2 votes

# Answer
**Python 100 Characters**

```
c=l=0
input()
for i in raw_input().split():
 if i!=l and c:print c,l,;c=1
 else:c=c+1
 l=i
print c,l

```
> 2 votes

# Answer
## Python - 110 chars

```
import re;R=raw_input;R()
print" ".join(`len(x[0].split())`+' '+x[1]for x in re.findall(r"((\d+)( \2)*)",R()))

```
> 2 votes

# Answer
# Golfscript - ~~40~~ 39

```
~-1](;(:<1\@{:b={)<}{' '<' '1b:<}if}/;;

```
> 2 votes

# Answer
# CJam, 11 bytes

```
l;l~]e`e_S*

```

CJam interpreter online (test case provided by this comment).

Explanation:

```
l;l~]e`e_S*
l           Get input line
 ;          Remove ToS
  l         Get input line
   ~        Evaluate code
    ]       Wrap the stack in an array (from [-mark)
     e`     Run-length encode
       e_   Flatten
         S  Space (' ')
          * Join

```
> 2 votes

# Answer
## Retina, 23 bytes

Thanks to @MartinEnder who helped me save 23 (!!) bytes and helped me understand some new features to (hopefully) produce better examples of Retina code in the future!

```
A1`
(\d+)( \1|)*
$#2 $1

```

### Explanation

The first line is AntiGrep with a limit of 1 to remove the first line. Then we match any integer followed by either a space and the same integer or nothing which handles our count correctly, so we can just replace with the number of matches of group 2 (`$#2`), and the original integer (`$1`).

Try it online!
> 2 votes

# Answer
# Scala - 141 chars

a purely functional scala solution. i am using 2 hacks here (beginning and end markers = "a", have to cut them off at the end :()

"a" is the program parameter

the full working code is

```
package hstar.randomstuff

import tools.nsc.io.File

/**
 * Developed with pleasure :)<br>
 * User: HoD<br>
 * Date: 28.07.11<br>
 * Time: 19:37<br>
 */

object RLEEncoder {
  def main(a: Array[String]) {
   print(((0,"","")/:(File(a(0)).lines.toSeq(1).split(' '):+"a"))((a,c)=>if(a._2!=c)(0,c,a._3+' '+a._1+' '+a._2)else(a._1+1,c,a._3))._3.drop(4))
  }
}

```

the actual logic is

```
print(((0,"","")/:(File(a(0)).lines.toSeq(1).split(' '):+"a"))((a,c)=>if(a._2!=c)(0,c,a._3+' '+a._1+' '+a._2)else(a._1+1,c,a._3))._3.drop(4))

```
> 1 votes

# Answer
# Scala - ~~247~~ 196

(+ 4 separators)

Being a beginner at Scala, I found the challenge interesting for a functional approach, but I fear I haven't took a concise approach. I guess a seasoned Scala coder will make a one liner... Particularly if I missed a useful collection method!

Anyway, here is the golfed version, even if it is out of competition:

```
readLine;val n=(readLine+" z").split(' ')
def g(v:String)={var a=1
(n:String)=>{if(n==v){a+=1;Nil}else List(a,v)}}
var p=g(n.head)
print(n.tail.flatMap{n=>val r=p(n);if(r!=Nil)p=g(n);r}.mkString(" "))

```

I feel the newlines should be counted (as spaces) as here they are mandatory separators. But well, the Python scripts above doesn't count them (while they are mandatory too), so I hadn't either...

The uncompressed version, with comments for my own benefit:

```
// Read the stdin, skipping the first line, returning the second one
// cat input.txt | scala RLE.scala
readLine // Thanks Daniel!
val line = readLine

// Add an arbitrary symbol that is dropped in the process... (trigger last sequence processing)
val numbers = (line + " z").split(' ')
println(numbers mkString " ")

/** Returns a closure to process the given value in the sequence to come */
def getSeq(value: String) =
{
  var acc = 1
  // Make a closure over value and acc
  (n: String) =>
  {
    if (n == value)
    {
      acc += 1
      Nil
    }
    else // Different value, return the cumulation so far
    {
      List(acc, value)
    }
  }
}

var process = getSeq(numbers.head) // Initial closure
/** Processes the numbers in the sequence. */
def accumulate(n: String) =
{
  val p = process(n)
  if (p != Nil) // We got a result
  {
    process = getSeq(n) // We need a fresh function over the new sequence that starts
  }
  p
}

println(numbers.tail.flatMap(accumulate).mkString(" "))

```

Feels clumsy with ugly hacks (the additional symbol, using head and tail...) but at least it works...

\[EDIT\] I used some of the tricks shown by Daniel Sobral to shorten a bit my code. I kept my original design/algorithm to be distinctive... :-)
> 0 votes

# Answer
# JavaScript, 126 bytes

```
(x,j=0)=>(x=x.split` `).reduce((a,v,i)=>(v!=x[i-1]?(a[++j]=[]):a[j]).push(v)&&a,[]).reduce((a,v)=>a+v.length+" "+v[0]+" " ,"")

```

I'm guessing this can be reduced further, but I'm just happy it works.

First I split based on the space, then I convert the array from \[1,1,1,2,2,3,3\] to a series of array representing each run \[\[1,1,1\],\[2,2\],\[3,3\]\], then I reduce that again to produce the required output of "3 1 2 2 2 3".
> 0 votes

# Answer
# Stacked, noncompeting, 34 bytes

```
([prompt]2*eval)behead flatrle out

```

Confirms strictly with the IO format. Try it here!

Or, we can use the builtin for 7 bytes: `flatrle` (or `$flatrle`).
> 0 votes

---
Tags: code-golf, compression
---


title: Sloping Binary Numbers

text:
# Question
Title: Sloping Binary Numbers
Given an integer `n`, output the first `n` sloping binary numbers, either 0- or 1-indexed. They are called this because of how they are generated:

Write numbers in binary under each other (right-justified):

```
........0
........1
.......10
.......11
......100
......101
......110
......111
.....1000
.........

```

Then, you need to take each diagonal from bottom-left to top-right, such that each final digit is the final digit of a diagonal. Here's the fourth diagonal (zero-indexed) marked with `x`'s, which is `100`:

```
........0
........1
.......10
.......11
......10x
......1x1
......x10
......111
.....1000
.........

```

The upward-sloping diagonals in order are:

```
0
11
110
101
100
1111
1010
.......

```

Then, convert to decimal, giving `0, 3, 6, 5, 4, 15, 10, ...`

**OEIS A102370**

This is , so **the shortest code in bytes wins.**

# Answer
# Jelly, 11 bytes

```
ḤḶBUz0ŒDUḄḣ

```

Try it online!

### Explanation

```
ḤḶBUz0ŒDUḄḣ    Main link. Argument: n
Ḥ              Double the argument. This ensures there are enough
               rows, since n + log2(n) <= 2n.
 Ḷ             Get range [0 .. 2n-1].
  B            Convert each number to binary.
   U           Reverse each list of digits.
    z0         Transpose, padding with zeroes to a rectangle.
      ŒD       Get the diagonals of the rectangle, starting from the
               main diagonal. This gets the desired numbers, reversed,
               in binary, with some extras that'll get dropped.
        U      Reverse each diagonal.
         Ḅ     Convert each diagonal from binary to a number.
          ḣ    Take the first n numbers.

```

The transpose is the simplest way to pad the array for the diagonals builtin to work. Then the reverses are added to get everything in the correct order.
> 3 votes

# Answer
## JavaScript (ES6), 53 bytes

```
n=>[...Array(n)].map(g=(j=1,i)=>j>i?0:j&i|g(j+j,i+1))

```

0-indexed. It's not often I get to use a recursive function as a parameter to `map`.
> 7 votes

# Answer
# Mathematica, 46 bytes

```
Plus@@@Table[BitAnd[n+k,2^k],{n,0,#},{k,0,n}]&

```

Unnamed function taking a nonnegative integer `#` as input and returning the 0-index sequence up to the `#`th term. Constructs the sloping binary numbers using `BitAnd` (bitwise "and") with appropriate powers of 2.
> 4 votes

# Answer
# Python3, ~~63~~ 61 bytes

```
lambda i:[sum(n+k&2**k for k in range(n+1))for n in range(i)]

```

Uses the formula from OEIS.

-2 bytes thanks to Luis Mendo! `i+1` --\> `i`
> 2 votes

# Answer
# MATL, ~~18~~ 17 bytes

```
:q"@tt:+5MW\~fWs+

```

Try it online!

This uses the formula from OEIS:

```
a(n) = n + Sum_{ k in [1 2... n] such that n + k == 0 mod 2^k } 2^k

```

Code:

```
:q"     % For k in [0 1 2 ...n-1], where n is implicit input
  @     %   Push k
  tt    %   Push two copies
  :     %   Range [1 2 ... k]
  +     %   Add. Gives [n+1 n+2 ... n+k]
  5M    %   Push [1 2... k] again
  W     %   2 raised to that
  \     %   Modulo
  ~f    %   Indices of zero entries
  W     %   2 raised to that
  s     %   Sum of array
  +     %   Add
        % End implicitly. Display implicitly

```
> 1 votes

# Answer
# PHP, 68 bytes

```
for(;$n++<$argv[1];print$s._)for($s=$i=0;$i<$n;)$s|=$n+$i-1&1<<$i++;

```

takes input from command line argument, prints numbers separated by underscores. Run with `-r`.
> 1 votes

# Answer
# Perl 6, ~~59~~ 43 bytes

~~```
{map ->\n{n+sum map {2**$_ if 0==(n+$_)%(2**$_)},1..n},^$_}

```~~
```
{map {sum map {($_+$^k)+&2**$k},0..$_},^$_}

```

Uses the formula from the OESIS page.
Update: Switched to the bitwise-and based formula from TuukkaX's Python answer.

# Perl 6, 67 bytes

```
{map {:2(flip [~] map {.base(2).flip.comb[$++]//""},$_..2*$_)},^$_}

```

Naive solution.
Converts the numbers that are part of the diagonal to base 2, takes the correct digit of each, and converts the result back to base 10.
> 0 votes

# Answer
# Jelly, 15 bytes

```
2*ḍ+
ḶçÐ€ḶUḄ+Ḷ’

```

This would be shorter than the other Jelly answer if we had to print only the **n**th term.

Try it online!
> 0 votes

# Answer
## R, 66 bytes

```
function(n,k=0:length(miscFuncs::bin(n-1)))sum(bitwAnd(k+n-1,2^k))

```

Unnamed function which uses the `bin` function from the `miscFuncs` package to calculate the length of `n` represented in binary and then using one of the OEIS formulas.
> 0 votes

---
Tags: code-golf, sequence, base-conversion, binary
---


title: Write a 0815 interpreter

text:
# Question
Title: Write a 0815 interpreter
I like the concept of 0815, except the interpreter on the creator's website returns an Error 404. So I decided to ask you all to help!

# The Basics

0815 is based around three (3) registers and a queue. The registers are named X, Y, and Z, with X being write-only, Z being read-only, and Y being a "helper" register that can't be directly accessed. All registers start out set to 0. All numbers are in hexadecimal.

# Instructions

**Note:** Some instructions take parameters which are formatted like `}:hello:` where the `:hello:` is the parameter. **Other note:** Some of the instruction descriptions are unclear, so I took some liberties with them. (Original instructions here)

`~` means the parameter is required

```
----------|---|--------------------------------------------
  ~Move   | < | <:8: will write 8 to X (parameter required)
----------|---|--------------------------------------------
   Swap   | x | Swap X and Y
----------|---|--------------------------------------------
  ~Label  | } | }:hello: makes a label called 'hello'
----------|---|--------------------------------------------
  Input   | | | Set X to an integer from input in
 Number   |   | hexadecimal greedily (regex: [0-9A-F]+)
----------|---|--------------------------------------------
  Input   | ! | Set X to the ASCII code of one ASCII
  ASCII   |   | character in the input
----------|---|--------------------------------------------
  Print   | % | Prints an integer stored in Z
  number  |   | (hexadecimal base)
----------|---|--------------------------------------------
  Print   | $ | Prints an ASCII char stored in Z
  ASCII   |   |
----------|---|--------------------------------------------
  Roll    |   | Rolls all registers to the left
Registers | ~ | X <- Y <- Z <- X
  Left    |   | After roll: X = Y, Y = Z and Z = X
----------|---|--------------------------------------------
  Roll    |   | Rolls all registers to the right
Registers | = | X -> Y -> Z -> X
  Right   |   | After roll: Y = X, Z = Y and X = Z
----------|---|--------------------------------------------
 ~Jump if | ^ | ^:loop: Jumps to the label 'loop' if Z is
 not zero |   | not zero
----------|---|--------------------------------------------
 ~Jump if | # | #:loop: Jumps to the label 'loop' if Z is
   zero   |   | zero
----------|---|--------------------------------------------

```

## Queue Instructions

```
----------|---|--------------------------------------------
   Clear  | ? | Clears the queue
----------|---|--------------------------------------------
  Enqueue | > | Enqueue the number stored in Z
----------|---|--------------------------------------------
  Dequeue | { | Dequeue a number into X
----------|---|--------------------------------------------
          |   | Rolls the queue to the left, wrapping as
   Roll   |   | necessary. The first number becomes the
   Queue  | @ | last; second becomes first and so on. Can
   Left   |   | take a parameter to roll a certain number
          |   | of times. @:b: rolls 11 times.
----------|---|--------------------------------------------
   Roll   |   |
   Queue  | & | The opposite of @
   Right  |   |
----------|---|--------------------------------------------

```

## Arithmetic instructions

```
----------|---|--------------------------------------------
   Add    | + | Z = X + Y
----------|---|--------------------------------------------
 Subtract | - | Z = X - Y
----------|---|--------------------------------------------
 Multiply | * | Z = X * Y
----------|---|--------------------------------------------
  Divide  | / | Z = X / Y
          |   | Y = remainder
----------|---|--------------------------------------------

```

# Example programs

Hello world: (Slightly golfed)

```
<:48:~$<:65:~$<:6C:~$$><:6F:~$>@<:2C:~$<:20:~$<:57:~${~$<:72:~${~$<:64:~$

```

Cat:

```
}:_t:!~$^:_t:

```

Truth Machine:

```
|~}:i:%^:i:

```

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

# Answer
> 9 votes
## Pip, ~~321~~ ~~262~~ 248 bytes

Greatly shortened using eval and some Kolmogorov-complexity tricks.

```
a@:`.(:.*?:)?`z:Y0w:2**64W++v<#a{UnpWa@v^':;V("Yp57Syi7UybWb^@(b@?`[^0-9A-F]|$`)Yy57Y APOb7OzTB167O Cz7SyzSyi7SyiSyz7I2I!2l:[]7lPBz7Y3B3UDQl7z:(y+4-4*4//i)i:y%i"R2`zv:a@?"}:".p.':7`R3"POl7Lp?p5olP"R4"i)%w7z:(y"R5"FB16%w"^7"<x|!%$~=^#?>{@&+-*/"@?n)}

```

Try it online! (The example is the Collatz/hailstone numbers program from the language author's website.)

Notes:

* Takes the 0815 code as the first command-line argument and the input as the second. Yes, it's a bit awkward (much less so on TIO, where you get separate text boxes), but Pip isn't that great at reading all of stdin.
* Numbers in input must use uppercase hex digits (as per OP: matching the regex `[0-9A-F]+`). If, at a `|` instruction, the next character of input is not `0-9A-F`, the read fails and causes potentially weird behavior. This means the author's even-odd program doesn't work as written... I'm not sure how he expected multiple number reads to work, but I just implemented according to what the spec said.
* If a label is duplicated, a jump goes to the first one. If a label doesn't exist, a jump terminates the program.

---

My ungolfed version with comments:

```
;;; INITIALIZATION ;;;

; a is the code, analyzed with regex into a list of instructions
a @: `.(:.*?:)?`
; b is the input
; x, y, z are registers (initially three 0s)
x:y:z:0
; l is the queue (initially empty list)
; v is the instruction pointer (initially -1, but gets incremented at top of loop)
; w represents the width of the registers
w:2**64

;;; MAIN LOOP ;;;

; Loop while IP hasn't gone past last instruction
W ++v<#a {
 ; Unify n with first char of current iNstruction, p with the parameter (or nil)
 U np W a@v ^ ':

 ; If n eQuals "<": move p value into x
 InQ'<
  ; Convert p from hex and truncate to register width
  x : pFB16%w
 ; Swap x and y
 InQ'x
  Sxy
 ; Input number (in hex, uppercase only)
 InQ'| {
  ; Find index of first non-hex character in b and split at that index
  ; Unify left half with x and right with b
  U xb W b^@(b @? `[^0-9A-F]|$`)
  ; Convert x from hex and truncate to register width
  x : xFB16%w
 }
 ; Input ASCII
 InQ'!
  ; Pop 1st char of b and get ASCII code
  x : A POb
 ; Print number (in hex)
 InQ'%
  ; Output z converted to hex
  O zTB16
 ; Print ASCII
 InQ'$
  ; Output chr(z)
  O Cz
 ; Roll registers left
 InQ'~ {
  ; With three registers, a roll is just two swaps
  Sxz
  Sxy
 }
 ; Roll registers right
 InQ'= {
  Sxy
  Sxz
 }
 ; Jump (combines if-nonzero and if-zero cases)
 I nQ'^ & z | nQ'# & !z
  ; Construct the corresponding label, find its index in a, and set IP to that
  v : a @? "}:".p.':
  ; If the label doesn't exist, v becomes nil, which makes the loop condition nil,
  ; which (being falsy) exits the loop and terminates the program

 ; Clear queue
 InQ'?
  l:[]
 ; Enqueue
 InQ'>
  ; Push z to back of l
  lPBz
 ; Dequeue
 InQ'{
  ; Pop l and assign to x
  x:POl
 ; Roll queue left
 ; NOTE: doesn't work if 0 is a valid parameter for roll operation
 ; If we want to handle that case, use #p?... instead of p?... for +1 byte
 InQ'@
  ; Loop specified number of times (converted from hex), or 1 if not specified
  L p ? pFB16 1
   ; Pop (front of) l and push that value to the back of l
   l PB POl
 ; Roll queue right
 InQ'&
  L p ? pFB16 1
   ; Dequeue from back of l and push that value to (the front of) l
   l PU DQl

 ; Add (truncating as needed)
 InQ'+
  z:(x+y)%w
 ; Subtract (truncating as needed)
 InQ'-
  z:(x-y)%w
 ; Multiply (truncating as needed)
 InQ'*
  z:x*y%w
 ; Divide (truncating not needed)
 InQ'/ {
  z:x//y
  y:x%y
 }
}

```

# Answer
> 7 votes
# haxe, 987 bytes

```
class Main{static function main(){var c=sys.io.File.getContent(Sys.args()[0]).split(""),i=0,x=0,y=0,z=0,t=0,m=0,g=Sys.getChar.bind(false),f=String.fromCharCode,b="",B="",l="",A=[];while(i<c.length)switch(l=c[i++]){case"<"|"}"|"^"|"#":b=l=="<"?"0x":"";if(c[i++]==":")while((B=c[i++])!=":")b+=B;if(l=="<")x=Std.parseInt(b);else if(l!="}"&&(z==0)==(l=="#")){t=0;while(t!=(m=(i+t++)%c.length)){if(c[m]==":")t+=c.indexOf(":",m+1)-m;else if(c[m]=="}"){l="";if(c[++m]==":")while((B=c[++m])!=":")l+=B;if(b==l){i=m;break;}}}return;}case"x":t=x;x=y;y=t;case"|":b="0x";while(((t=g())>47&&t<58)||(t>96&&t<103))b+=f(t);x=Std.parseInt(b);case"!":x=g();x=x<0?0:x;case"%"|"$":Sys.print(l=="%"?[for(j in 0...8){"0123456789abcdef".split("")[z>>((7-j)*4)&15];}].join(""):f(z));case"?":A=[];case">":A.push(z);case"{":x=A.shift();case"@":A.push(A.shift());case"&":A.unshift(A.pop());case"+":z=x+y;case"-":z=x-y;case"*":z=x*y;case"~":t=x;x=y;y=z;z=t;case"=":t=x;x=z;z=y;y=t;case"/":z=Math.floor(x/y);y=x%y;}}}

```

or with some whitespace:

```
class Main{static function main(){
var c=sys.io.File.getContent(Sys.args()[0]).split(""),
    i=0,
    x=0,
    y=0,
    z=0,
    t=0,
    m=0,
    g=Sys.getChar.bind(false),
    f=String.fromCharCode,
    b="",
    B="",
    l="",
    A=[];
while(i<c.length)switch(l=c[i++]){
    case"<"|"}"|"^"|"#":
        b=l=="<"?"0x":"";
        if(c[i++]==":")
            while((B=c[i++])!=":")
                b+=B;
        if(l=="<")
            x=Std.parseInt(b);
        else if(l!="}"&&(z==0)==(l=="#")){
            t=0;
            while(t!=(m=(i+t++)%c.length)){
                if(c[m]==":")
                    t+=c.indexOf(":",m+1)-m;
                else if(c[m]=="}"){
                    l="";
                    if(c[++m]==":")
                        while((B=c[++m])!=":")
                            l+=B;
                        if(b==l){
                            i=m;
                            break;
                        }
                }
            }
            return;
        }
    case"x":
        t=x;x=y;y=t;
    case"|":
        b="0x";
        while(((t=g())>47&&t<58)||(t>96&&t<103))
            b+=f(t);
        x=Std.parseInt(b);
    case"!":
        x=g();
        x=x<0?0:x;
    case"%"|"$":
        Sys.print(l=="%"?[
            for(j in 0...8){
                "0123456789abcdef".split("")[z>>((7-j)*4)&15];
            }
        ].join(""):f(z));
    case"?":
        A=[];
    case">":
        A.push(z);
    case"{":
        x=A.shift();
    case"@":
        A.push(A.shift());
    case"&":
        A.unshift(A.pop());
    case"+":
        z=x+y;
    case"-":
        z=x-y;
    case"*":
        z=x*y;
    case"~":
        t=x;x=y;y=z;z=t;
    case"=":
        t=x;x=z;z=y;y=t;
    case"/":
        z=Math.floor(x/y);
        y=x%y;
}}}

```

Successfully golfed with haxe? Wow.

# Answer
> 5 votes
# Python 3, 1320 bytes

The ungolfed version, as well as analysis of (and where necessary, corrected versions of) the test programs, can be found in this gist.

Design decisions:

* Multiple definitions of labels are ignored. Only the first definition of a label is used. (Formerly the most recently seen definition would be used, but that got golfed out.)
* Input complies with the OP's spec: numeric input reads hex characters greedily. (Originally it would read until newline, and error when non-hex characters were read.)
* "ASCII" input is taken to mean "byte-oriented" input. (Originally it had full Unicode support, which took less code thanks to being Python 3... but meeting the next bullet point meant reading byte by byte was now shorter.)
* Parameters where no parameters are expected are ignored; hence, they are usable as comments.

There are issues with the example programs using CR alone as their newline (sometimes), which makes my shell overwrite the current line rather than starting a new one. This affects the Fibonacci Sequence and 99 Bottles of Beer programs. The last verse of 99 Bottles of Beer also isn't printing correctly, and I'm still investigating why.

```
import sys as y
import sys as y
b=y.stdin.buffer
I=int
g=getattr
X=2**64
R=lambda a:property(lambda s:g(s,a)-[X,0][0<=g(s,a)<X/2],lambda s,v:setattr(s,a,I(v)&X-1))
M,*Q=':<}^#@&xX|!%$~=?>{+-*/'
class A:
 x,y,z=map(R,'uvw')
 def R(s,p):
  s.p,s.s,*s.q=p,3,;s.x=s.y=s.z=s.i=0
  while s.s<4:
   t='';p=s.s=i=0
   while s.s<3:
    k=s.p[s.i];s.i+=1
    if s.s==1:
     if k==M:
      if p==2:s.t=s.i;g(s,s.I[i])(t);s.s=max(s.s,3)
     else:t+=k
    elif k==M:p,s.s=s.s,1
    elif k in Q:
     i=k;m=M==s.p[s.i]
     if k in Q[:6]and m:s.s=2
     elif k in Q[6:]or k in'@&'and m<1:g(s,s.I[i])()
 def B(s,v):s.x=I(v,16)
 def C(s):s.x,s.y=s.y,s.x
 def D(s,l):0
 def E(s):
  s.x=0
  try:
   while 1:s.x=s.x*16+I(b.peek()[:1],16);b.read(1)
  except:0
 def F(s):s.x=b.read(1)[0]
 def G(s):print(format(s.z,'x'),end='')
 def H(s):print(chr(s.z),end='')
 def J(s):s.x,s.y,s.z=s.y,s.z,s.x
 def K(s):s.J();s.J()
 def j(s,l):
  a=s.p.find('}:'+l+M)
  if a<0:s.s=4
  else:s.i=a
 def L(s,l):
  if s.z:s.j(l)
 def T(s,l):
  if s.z==0:s.j(l)
 def U(s):s.q=[]
 def V(s):s.q+=s.z,
 def W(s):s.x,*s.q=s.q
 def Y(s,d='1'):d=I(d,16);s.q=s.q[d:]+s.q[:d]
 def Z(s,d='1'):Y('-'+d)
 def a(s):s.z=s.x+s.y
 def b(s):s.z=s.x-s.y
 def c(s):s.z=s.x*s.y
 def d(s):s.z,s.y=divmod(s.x,s.y)
 I=dict(zip(Q,'BDLTYZCCEFGHJKUVWabcd'))
try:A().R(open(y.argv[1]).read())
except:0

```

# Answer
> 4 votes
## Scala, ~~3,123~~ ~~2,844~~ ~~2,626~~ 2,540 bytes

In addition to the constraints outlined in the question, this interpreter was written to lean as much as possible towards FP principles. Specifically:

* Only immutable stuctures
* All functions are pure

This was accomplished, with the exception of the four lines of code that drive the main loop of the interpreter. Immutable structures were very difficult to utilize here because the state of the registers drives the control flow of the loop (specifically the two GOTO statements). I am still thinking on how to convert it to use pure & immutable structures, but that is irrelevant to the code golf challenge.

```
import java.util.Scanner
import scala.util._
object Z extends App{type K=Long
type G=List[K]
type I=String
type E=Boolean
val(f,t,ф,д,б)=(false,true,(z:G)=>z(0),(z:G)=>z.tail,(q:K,w:K,e:K)=>q::w::e::Nil)
trait O{def h(z:I)=BigInt(z,16).longValue()}
trait S extends O
trait B extends S with P{def apply(r:G):E}
trait R extends O{def a(r:G):G}
trait T extends O{def a(r:G,s:G):(G,G)}
trait P{def p:I}
case class L(p:I)extends S with P
case class U(p:I)extends B{def apply(r:G):E=r(2)==0}
case class J(p:I)extends B{def apply(r:G):E=r(2)!=0}
case class M(p:I)extends R with P{def a(r:G):G=h(p)::д(r)}
class Y extends R{def a(r:G):G=б(r(0),r(0)%r(1),r(0)/r(1))}
case class Q(p:I)extends T with P{def r(q:G,i:Int):G={val s=д(q):+ф(q)
if(i>0)r(s,i-1)else s}
def a(e:G,t:G)=e->r(t,Try(p.toInt).getOrElse(1))}
case class N(p:I)extends T with P{def r(q:G,i:Int):G={
val s=q.last::q.iterator.sliding(2).map(_(0)).toList
if(i>0)r(s,i-1)else s}
def a(e:G,t:G)=e->r(t,Try(p.toInt).getOrElse(1))}
case class A(n:Array[O], l:Map[I,Int]){def e={var (r,t,x)=(List(0L,0,0),List[K](),0)
while(x<n.length){x=n(x)match{case i:B=>if(i(r))l(i.p)else x+1
case i:R=>r=i.a(r);x+1
case i:T=>val(y,u)=i.a(r,t);r=y;t=u;x+1
case _=>x+1}}}}
object A{def apply(i:Seq[O]):A={A(n=i.toArray,l=Map(i.zipWithIndex.flatMap{case(e:L,i)=>Some(e.p->i)
case _=>None}.toList:_*))}}
object X{def v(y:(Char, Option[Z.I]))=y._2.getOrElse("");val F=Map('x->new R{def a(t:G)=б(t(1),t(0),t(2))},'|'->new R{def a(r:G)=h(new Scanner(System.in).next("[0-9a-fA-F]+"))::д(r)},'!'->new R{def a(r:G)=(System.in.read match{case i if i== -1=>0;case i=>i})::д(r)},'%'->new R{def a(r:G)={print(Integer.toHexString(r(2).toInt));r}},'$'->new R{def a(r:G)={print(r(2).toChar);r}},'~'->new R{def a(r:G)=д(r):+ф(r)},'='->new R{def a(r:G)=б(r(2),r(0),r(1))},'?'->new T{def a(r:G,s:G)=r->List()},'>'->new T{def a(r:G,s:G)=r->(r(2)::s)},'{'->new T{def a(r:G, s:G)=(ф(s)::д(r))->д(s)},'+'->new R{def a(r:G)=б(r(0),r(1),r(0)+r(1))},'-'->new R{def a(r:G)=б(r(0),r(1),r(0)-r(1))},'*'->new R{def a(r:G)=б(r(0),r(1),r(0)*r(1))},'/'->new Y);def apply(i:I)={(i+" ").foldLeft((List[(Char,Option[I])](),None:Option[Char],"",f))((a,n)=>{n match{case i if i==':'=>if(a._4)(a._1:+(a._2.get->Some(a._3)),None,"",f)else(a._1,a._2,"",t)
case i if a._4=>(a._1,a._2,a._3+i,t)
case i if a._2.isEmpty=>(a._1,Some(i),"",f)
case i=>(a._1:+(a._2.get->None),Some(i),"",f)}})._1.map(x=>x._1 match{
case'<'=>M(v(x))
case'}'=>L(v(x))
case'^'=>J(v(x))
case'#'=>U(v(x))
case'@'=>Q(v(x))
case'&'=>N(v(x))
case c=>F(c)})}}
A(X(args(0))).e}

```

I will post the ungolfed version on Github and will provide a link when I do so. For now, I will post the original version here:

```
import java.util.Scanner
import scala.util.Try

trait Operation {
  def hexToLong(hex:String):Long = BigInt(hex, 16).longValue()
}

trait Parameter {
  def param:String
}

trait RegisterOperation extends Operation { def apply(registers:List[Long]):List[Long] }
trait StackOperation extends Operation { def apply(registers:List[Long], stack:List[Long]):(List[Long], List[Long]) }
trait SpecialOperation extends Operation
trait SpecialRegisterOperation extends SpecialOperation with Parameter  { def apply(registers:List[Long]):Boolean }

class Move(val param:String) extends RegisterOperation with Parameter { override def apply(registers:List[Long]): List[Long] = hexToLong(param) :: registers.tail }
class Swap extends RegisterOperation { override def apply(registers:List[Long]): List[Long] = registers(1) :: registers(0) :: registers(2) :: Nil }
class InputNumber extends RegisterOperation { override def apply(registers:List[Long]): List[Long] = hexToLong(new Scanner(System.in).next("[0-9a-fA-F]+")) :: registers.tail }
class InputAscii extends RegisterOperation {
  override def apply(registers:List[Long]): List[Long] = (System.in.read() match {
  case i if i == -1 => 0
  case i => i}) :: registers.tail }

class PrintNumber extends RegisterOperation { override def apply(registers:List[Long]): List[Long] = { print(Integer.toHexString(registers(2).toInt)); registers } }
class PrintAscii extends RegisterOperation { override def apply(registers:List[Long]): List[Long] = { print(registers(2).toChar); registers } }
class RegisterRollLeft extends RegisterOperation { override def apply(registers:List[Long]): List[Long] = registers.tail :+ registers.head }
class RegisterRollRight extends RegisterOperation { override def apply(registers:List[Long]): List[Long] = registers(2) :: registers(0) :: registers(1) :: Nil }

class Add extends RegisterOperation { override def apply(registers:List[Long]): List[Long] =  registers(0) :: registers(1) :: (registers(0) + registers(1)) :: Nil }
class Subtract extends RegisterOperation { override def apply(registers:List[Long]): List[Long] =  registers(0) :: registers(1) :: (registers(0) - registers(1)) :: Nil }
class Multiply extends RegisterOperation { override def apply(registers:List[Long]): List[Long] =  registers(0) :: registers(1) :: (registers(0) * registers(1)) :: Nil }
class Divide extends RegisterOperation { override def apply(registers:List[Long]): List[Long] =  registers(0) :: (registers(0) % registers(1)) :: (registers(0) / registers(1)) :: Nil }

class Clear extends StackOperation { override def apply(registers:List[Long], stack:List[Long]) = registers -> List() }
class Enqueue extends StackOperation { override def apply(registers:List[Long], stack:List[Long]) = registers -> (registers(2) :: stack) }
class Dequeue extends StackOperation { override def apply(registers:List[Long], stack:List[Long]) = (stack.head :: registers.tail) -> stack.tail }
class QueueRollLeft(val param:String) extends StackOperation with Parameter {
  def roll(stack:List[Long], i:Int):List[Long] = {
    val s = stack.tail :+ stack.head
    if (i > 0) roll(s, i-1) else s
  }

  override def apply(registers:List[Long], stack:List[Long]) = registers -> roll(stack, Try(param.toInt).toOption.getOrElse(1))
}

class QueueRollRight(val param:String) extends StackOperation with Parameter {
  def roll(stack:List[Long], i:Int):List[Long] = {
    val s = stack.last :: stack.iterator.sliding(2).map(_.head).toList
    if (i > 0) roll(s, i-1) else s
  }

  override def apply(registers:List[Long], stack:List[Long]) = registers -> roll(stack, Try(param.toInt).toOption.getOrElse(1))
}

class SetLabel(val param:String) extends SpecialOperation with Parameter
class JumpLabelIfZero(val param:String) extends SpecialRegisterOperation { override def apply(registers: List[Long]): Boolean = registers(2) == 0 }
class JumpLabelIfNotZero(val param:String) extends SpecialRegisterOperation { override def apply(registers: List[Long]): Boolean = registers(2) != 0 }

class Script(val instructions:Array[Operation],
             val labels:Map[String, Int]) {
  def execute() = {
    var registers = List[Long](0, 0, 0)
    var stack = List[Long]()
    var idx = 0;

    while(idx < instructions.length) {
      idx = instructions(idx) match {
        case i: SpecialRegisterOperation => if(i(registers)) labels(i.param) else idx + 1
        case i: RegisterOperation => { registers = i(registers); idx + 1 }
        case i: StackOperation => { val (zregisters, zstack) = i(registers, stack); registers = zregisters; stack = zstack; idx + 1 }
        case _ => idx + 1
      }
    }
  }
}

object Script {
  def apply(instructions: Seq[Operation]):Script = {
    new Script(instructions = instructions.toArray, labels = Map(instructions.zipWithIndex.flatMap {
      case (e:SetLabel, i) => Some(e.param -> i)
      case _ => None
    }.toList:_*))
  }
}

object Parser {
  def apply(input:String): Seq[Operation] = {
    case class Accumulator(val list: List[(Char, Option[String])] = List(), val char:Option[Char] = None, val str:String = "", val parsingVar:Boolean = false)

    (input + " ").foldLeft(Accumulator())((acc, next) => {
      next match {
        case i if i == ':' => if(acc.parsingVar) Accumulator(acc.list :+ (acc.char.get -> Some(acc.str)), None, "", false) else Accumulator(acc.list, acc.char, "", true)
        case i if acc.parsingVar => Accumulator(acc.list, acc.char, acc.str + i, true)
        case i if !acc.char.isDefined => Accumulator(acc.list, Some(i), "", false)
        case i => Accumulator(acc.list :+ (acc.char.get -> None), Some(i), "", false)
      }
    }).list.map(x => x._1 match {
      case '<' => new Move(x._2.getOrElse(""))
      case 'x' => new Swap
      case '}' => new SetLabel(x._2.getOrElse(""))
      case '|' => new InputNumber
      case '!' => new InputAscii
      case '%' => new PrintNumber
      case '$' => new PrintAscii
      case '~' => new RegisterRollLeft
      case '=' => new RegisterRollRight
      case '^' => new JumpLabelIfNotZero(x._2.getOrElse(""))
      case '#' => new JumpLabelIfZero(x._2.getOrElse(""))
      case '?' => new Clear
      case '>' => new Enqueue
      case '{' => new Dequeue
      case '@' => new QueueRollLeft(x._2.getOrElse(""))
      case '&' => new QueueRollRight(x._2.getOrElse(""))
      case '+' => new Add
      case '-' => new Subtract
      case '*' => new Multiply
      case '/' => new Divide
    })
  }
}

object Go extends App {
  Script(Parser(args(0))).execute()
}

```

# Answer
> 2 votes
## Python 3, ~~1573~~,1499 bytes

Runs the example programs at http://paulo-jorente.de/poncho/esolang/0815/ and implements all the instructions (even write ones, according to the original spec).

Executes the source file passed on the command line.

```
import sys
from collections import deque
class w:
    q=deque()
    X=Y=Z=c=0
    def __init__(k):k.s=open(sys.argv[1],'r').read()
    def a(k,l):
        i=k.s.find("}:"+l+":")
        if (i<0):sys.exit()
        return i
    def l(k):
        k.c+=1
        if k.s[k.c]!=":":sys.exit(":")
        k.c+=1
        return k.s[k.c:k.c+k.s[k.c:].find(":")]
    def u(k):
        k.c+=1
        if k.s[k.c]!=":":sys.exit(":")
        k.c+=1
        h=k.s[k.c:k.c+k.s[k.c:].find(":")]
        k.c+=len(h)
        return h
    def b(k):
        g=range
        j=input
        z=len
        w=sys.stdout.write
        o=k.s[k.c]
        y=k.q.rotate
        if o=='<':k.X=int(k.u(),16)
        elif o=='x':t=k.X;k.X=k.Y;k.Y=t
        elif o=='=':t=k.X;k.X=k.Z;v=k.Y;k.Y=t;k.Z=v;
        elif o=='$':
            if (k.Z==0x0d):w('\n')
            else:w(str(chr(k.Z%256)))
        elif o=='%':w(str(k.Z))
        elif o=='~':t=k.X;v=k.Y;k.X=v;k.Y=k.Z;k.Z=t;
        elif o=='?':k.q.clear()
        elif o=='>':k.q.append(k.Z)
        elif o=='{':k.X=k.q.popleft()
        elif o=='@':
            if k.s[k.c+1]==':':
                t=k.u()
                for i in g(0,int(t,16)):y(-1)
            else:
                y(-1)
        elif o=='&':
            if k.s[k.c+1]==':':
                t=k.u()
                for i in g(0,int(t,16)):y(1)
            else:
                y(1)
        elif o=='}':
            k.c+=z(k.l())
        elif o=='#':
            l=k.l()
            if (k.Z==0):
                k.c=k.a(l)-1
            else:
                k.c+=z(l)
        elif o=='^':
            l=k.l()
            if (k.Z!=0):
                k.c=k.a(l)-1
            else:
                k.c+=z(l)
        elif o=='|':k.X=int(j("?"),16)
        elif o=='!':k.X=ord(j(">")[0])
        elif o=='+':k.Z=k.X+k.Y
        elif o=='-':k.Z=k.X-k.Y
        elif o=='*':k.Z=k.X*k.Y
        elif o=='/':
            k.Z=int(k.X/k.Y)
            k.Y=k.X%k.Y
        k.c+=1
    def x(k):
        while k.c<len(k.s):k.b()
w().x()

```

# Answer
> 2 votes
## Flex/C++, ~~848~~ 838 bytes

```
%{
#include<map>
#include<deque>
using namespace std;typedef uint64_t I;I X,Y,Z,P,T,i;map<string,I>L;deque<I>Q;
#define YY_USER_ACTION P+=yyleng;
#define A for(i=0;i<(yyleng>2?stoull(yytext+2,0,16):1);++i
#define B fseek(yyin,L.at(yytext+1),0),yyrestart(yyin);
%}
H :[0-9A-F]+:
B :[0-9a-zA-Z_]+:
%x E
%%
<E>\}{B} L[yytext+1]=P;
<E>.|\n
\<{H} X=stoull(yytext+2,0,16);
x T=X;X=Y;Y=T;
\}{B}
\| scanf("%lx",&X);
! X=getchar();
% printf("%lx",Z);
\$ putchar(Z);
~ T=X;X=Y;Y=Z;Z=T;
= T=Y;Y=X;X=Z;Z=T;
\^{B} if(Z)B
#{B} if(!Z)B
\? Q.clear();
> Q.push_back(Z);
\{ X=Q.front();Q.pop_front();
@{H}? A)T=Q.front(),Q.pop_front(),Q.push_back(T);
&{H}? A)T=Q.back(),Q.pop_back(),Q.push_front(T);
\+ Z=X+Y;
- Z=X-Y;
\* Z=X*Y;
\/ Z=X/Y;Y=X%Y;
.|\n
%%
main(int,char**v){yyin=fopen(v[1],"r");BEGIN(E);yylex();rewind(yyin);yyrestart(yyin);BEGIN(0);yylex();}

```

Compiled with:

```
flex -o 0815.cpp 0815.ll
g++ -std=c++11 0815.cpp -o 0815 -ll

```

It might compile with other `lex`es as well, but I didn't check. It works in two passes, so forward jumps are handled correctly. Label names are allowed to start with a digit, as it happens more than once in the test cases. Hex literals can only be upper case, in accordance with the specs.

Passes all test cases, including those found on the Esolangs Wiki and the 0815 page. Error handling is non-existent and exit on an unknown label is not graceful, after all this is code-golf.

I am preparing the ungolfed (and much nicer) interpreter for a release, so that OP can keep tinkering with 0815. Stay tuned :)

# Answer
> 2 votes
# Common Lisp, 1088 bytes

```
(progn(defun r(s)(parse-integer s :radix 16))(defun h(k)(coerce(loop for c =(#7=read-char()())while(funcall k c)collect c finally(unread-char c))'string))(defun w(c)(find c"0123456789ABCDEFabcdef"))(defmacro c(s)(with-input-from-string(*standard-input* s)(labels((L()(intern(p #'u)))(o()(case(peek-char()())(#\:(r(q))(#7#))(t 1)))(q()(p #'w))(p(k)(prog2(#7#)(h k)(#7#)))(u(c)(char/= c #\:)))`(let((x 0)(y 0)(z 0)(q(list())))(labels((&(n)(q(nconc(last(car q)n)(butlast(car q)n))))(@(n)(q(nconc(nthcdr n(car q))(subseq(car q)0 n))))(q(x)(#3=setf q(cons x(last x)))))(prog(),@(loop for c =(#7#()())while c collect(case c(#\<`(#3#x,(r(q))))(#\x`(#5=rotatef x y))(#\}(L))(#\|`(#3#x(r(h'w))))(#\!`(#3#x(char-code(#7#))))(#\%`(format t"~x"z))(#\$`(princ(code-char z)))(#\~`(#5#x y z))(#\=`(#5#z y x))(#\^`(if(/= z 0)(go,(L))))(#\#`(if(= 0 z)(go,(L))))(#\?`(#3#q(q())))(#\>'(if(car q)(#3#(cddr q)(list z)(cdr q)(cddr q))(#3#(cdr q)(#3#(car q)(list z)))))(#\{'(#3#x(pop(car q))))(#\@`(@,(o)))(#\&`(&,(o)))(#\/'(#3#(values z y)(truncate x y)))(t`(#3#z(,(elt'(+ * -)(position c"+*-"))x y))))))))))))

```

## Ungolfed

With optional trace at runtime.

```
;;; Those auxiliary functions are needed both
;;; during macroexpansion and evaluation

(defun r(s)
  (parse-integer s :radix 16))

(defun h(k)
  (coerce (loop for c = (read-char nil nil)
                while (funcall k c)
                collect c
                finally (unread-char c))
          'string))

(defun w(c)
  (find c "0123456789ABCDEFabcdef"))

;;; C is a macro, it takes a string, replaces it by
;;; code, which is then evaluated.

(defmacro C(s &optional tracep)
  (with-input-from-string(*standard-input* s)
    (labels((L()(intern(p #'u)))
            (d()(assert(eql #\:(read-char))))
            (o(d)(case (peek-char () () ())
                   (#\:(r(q))(d))
                   (t d)))
            (q()(p #'w))
            (p(k)(prog2(d)(h k)(d)))
            (u(c)(not(eql c #\:))))
      `(let((x 0)(y 0)(z 0)(q(list())))
         (labels((&(n)(q(append(last(car q)n)(butlast(car q)n))))
                 (@(n)(q(nconc(nthcdr n(car q))(subseq(car q)0 n))))
                 (q(x)(setf q(cons x(last x)))))
           (tagbody
              ,@(loop for c =(read-char nil ())
                      while c
                      when tracep
                        collect '(fresh-line)
                        and collect `(print (list :c ,c :x x :y y :z z :q q :s (map'string'code-char(car q))))
                      collect
                      (ecase c
                        (#\<`(setf x ,(r(q))))
                        (#\x`(rotatef x y))
                        (#\}(L))
                        (#\|`(setf x(r(h'w))))
                        (#\!`(setf x(char-code(read-char))))
                        (#\%`(format t"~x"z))
                        (#\$`(princ(code-char z)))
                        (#\~`(rotatef x y z))
                        (#\=`(rotatef z y x))
                        (#\^`(if(not(zerop z))(go,(L))))
                        (#\#`(if(zerop z)(go,(L))))
                        (#\?`(setf q(q())))
                        (#\>'(if(car q)(setf(cddr q)(list z)(cdr q)(cddr q))(setf(cdr q)(setf(car q)(list z)))))
                        (#\{'(setf x(pop(car q))))
                        (#\@`(@,(o 1)))
                        (#\&`(&,(o 1)))
                        (#\/'(multiple-value-setq(z y)(truncate x y)))
                        ((#\+ #\* #\-)`(,(intern(string c)"CL")x y)))
                      when tracep
                        collect `(print (list :c ,c :x x :y y :z z :q q :s (map'string'code-char(car q)))))))))))

```

## Fibonnaci

```
(c "%<:0A:>~$<:01:~%>=<:68a3dd8e61eccfbd:>~>}:_s:{x{={~$x+%{=>~>x~-x<:0A:~>~>~^:_s:?")

```

### Macroexpansion

```
(LET ((X 0) (Y 0) (Z 0) (Q (LIST NIL)))
  (LABELS ((& (N)
             (Q (NCONC (LAST (CAR Q) N) (BUTLAST (CAR Q) N))))
           (@ (N)
             (Q (NCONC (NTHCDR N (CAR Q)) (SUBSEQ (CAR Q) 0 N))))
           (Q (X)
             (SETF Q (CONS X (LAST X)))))
    (PROG ()
      (FORMAT T "~x" Z)
      (SETF X 10)
      (IF (CAR Q)
          (SETF (CDDR Q) (LIST Z)
                (CDR Q) (CDDR Q))
          (SETF (CDR Q) (SETF (CAR Q) (LIST Z))))
      (ROTATEF X Y Z)
      (PRINC (CODE-CHAR Z))
      (SETF X 1)
      (ROTATEF X Y Z)
      (FORMAT T "~x" Z)
      (IF (CAR Q)
          (SETF (CDDR Q) (LIST Z)
                (CDR Q) (CDDR Q))
          (SETF (CDR Q) (SETF (CAR Q) (LIST Z))))
      (ROTATEF Z Y X)
      (SETF X 7540113804746346429)
      (IF (CAR Q)
          (SETF (CDDR Q) (LIST Z)
                (CDR Q) (CDDR Q))
          (SETF (CDR Q) (SETF (CAR Q) (LIST Z))))
      (ROTATEF X Y Z)
      (IF (CAR Q)
          (SETF (CDDR Q) (LIST Z)
                (CDR Q) (CDDR Q))
          (SETF (CDR Q) (SETF (CAR Q) (LIST Z))))
     |_s|
      (SETF X (POP (CAR Q)))
      (ROTATEF X Y)
      (SETF X (POP (CAR Q)))
      (ROTATEF Z Y X)
      (SETF X (POP (CAR Q)))
      (ROTATEF X Y Z)
      (PRINC (CODE-CHAR Z))
      (ROTATEF X Y)
      (SETF Z (+ X Y))
      (FORMAT T "~x" Z)
      (SETF X (POP (CAR Q)))
      (ROTATEF Z Y X)
      (IF (CAR Q)
          (SETF (CDDR Q) (LIST Z)
                (CDR Q) (CDDR Q))
          (SETF (CDR Q) (SETF (CAR Q) (LIST Z))))
      (ROTATEF X Y Z)
      (IF (CAR Q)
          (SETF (CDDR Q) (LIST Z)
                (CDR Q) (CDDR Q))
          (SETF (CDR Q) (SETF (CAR Q) (LIST Z))))
      (ROTATEF X Y)
      (ROTATEF X Y Z)
      (SETF Z (- X Y))
      (ROTATEF X Y)
      (SETF X 10)
      (ROTATEF X Y Z)
      (IF (CAR Q)
          (SETF (CDDR Q) (LIST Z)
                (CDR Q) (CDDR Q))
          (SETF (CDR Q) (SETF (CAR Q) (LIST Z))))
      (ROTATEF X Y Z)
      (IF (CAR Q)
          (SETF (CDDR Q) (LIST Z)
                (CDR Q) (CDDR Q))
          (SETF (CDR Q) (SETF (CAR Q) (LIST Z))))
      (ROTATEF X Y Z)
      (IF (/= Z 0)
          (GO |_s|))
      (SETF Q (Q NIL)))))

```

### Output

```
0
1
1
2
3
5
8
D
15
22
37
59
90
...
5D4D629E80D5489
96F75D79B354522
F444C01834299AB
18B3C1D91E77DECD
27F80DDAA1BA7878
40ABCFB3C0325745
68A3DD8E61ECCFBD

```

*Maybe more explanations later*

---
Tags: code-golf, interpreter
---