Making a coin fair

Question

You have a coin that produces 0 or 1. But you suspect the coin may be biased, meaning that the probability of 0 (or 1) is not necessarily 1/2.

A well known procedure to "transform" a biased coin into a fair coin (i.e. to obtain equally likely results), as proposed by von Neumann, is as follows. Produce (non-overlapping) blocks of two coin tosses until the two values of a block differ; and output the first value in that block (the second value would also do, but for the purposes of this challenge we choose the first). Intuitively, 1 may be more likely than 0, but 01 and 10 will be equally likely.

For example, the input 1110... would discard the first block, then produce a 1 from the second block, ...

This procedure is expensive, because several coin tosses are consumed to generate a single result.

The challenge

Take a finite sequence of zeros and ones, representing tosses of the original coin, and produce the maximum number of results according to the above procedure, until all the input is consumed.

The last block may be incomplete, if the number of input values is odd. For example, the input sequence 11111 would produce no result (the first two blocks have equal values, and the third block is incomplete).

Rules

The input can have any non-negative number of values, not necessarily positive or even.

The input format may be:

• an array of zeros and ones;
• a string of zeros and ones with an optional separator.

Output format may be:

• a string of zeros and ones, with or without separators;
• an array of zeros and ones;
• strings containing a single zero or one, separated by newlines;
• any similar, reasonable format that suits your language.

Code golf. Fewest bytes wins.

Test cases

Input and output are here assumed to be strings.

Input         -->  Output

'1110'        -->  '1'
'11000110'    -->  '01'
'1100011'     -->  '0'
'00'          -->  ''
'1'           -->  ''
''            -->  ''
'1101001'     -->  '0'
'1011101010'  -->  '1111'

Answer 1

Jelly, 6 bytes

s2Q€Ṗ€

Try it online!

How it works

s2Q€Ṗ€  Main link. Argument: S (string)

s2      Split the string into pairs of characters.
  Q€    Deduplicate each pair.
        This removes the second character iff it is equal to the first.
    Ṗ€  Pop each; remove the last character of each pair/singleton.

Answer 2

Retina, 16 14 bytes

(.)\1|(.)?.
$2

Try it online!

Explanation

This is fairly simple. The code defines a single regex substitution replacing all (non-overlapping) matches of (.)\1|(.)?. with whatever the second group captured. This combines three different cases into one:

(.)\1 --> <empty>

If two repeated digits are equal, we remove them from the string (because group 2 is unused).

(.).  --> $2

Otherwise, if we can match two characters, remove the second one, by replacing both of them with the first. If that's not the case the ? will omit the group:

.     --> <empty>

This only happens if there is an unpaired trailing character, which is also removed.

Answer 3

Labyrinth, 21 12 bytes

"(. :
""*$,@

A rare example of a compact Labyrinth program that also has no no-ops. The | in the previous version was completely unnecessary, and removing it massively reduced the size of the program. In fact, Lab's beating Retina!

Try it online!

The bottom-left " can also be a space, but having it there greatly simplifies the explanation.

Explanation

This one's a little trickier, so it's accompanied by images. But first, a quick primer:

• Labyrinth is a stack-based 2D language. Memory consists of a main stack and an auxiliary stack.
• Labyrinth's stacks are bottomless and filled with zeroes, so performing operations on an empty stack is not an error.
• At each junction, where there are two or more paths for the instruction pointer to go, the top of the main stack is checked to figure out where to go next. Negative is turn left, zero is straight ahead and positive is turn right. If a turn fails, the pointer tries to turn in the other direction.

Setup

The program starts at the top-left ", which is a no-op. Then we perform:

(        Decrement a bottom zero to -1. Since -1 is negative we try to turn 
         left at this junction, fail, and turn right instead.
"        No-op junction, turn left
*        Multiply top of stack (-1) with a 0 at bottom of stack, giving 0.
         This makes us go straight ahead at this junction.
$        Bitwise xor (of 0 and 0)

This leaves the stack with a single 0 on it, which is as good as empty for the purposes of Labyrinth.

Reading input and termination

, reads a char from input, returning 48 or 49 for 0 or 1 respectively, and -1 on EOF. Since this is nonzero, either way we turn into the :, which duplicates the top of the stack.

The : is at a dead-end, so we turn around and execute , once more. Now if the last input was EOF, then we turn left and terminate with @, else we turn right, with the stack looking like [a a b] (where a, b are the two chars).

Interpreting the coin toss

If we didn't terminate, our next move is to execute $ (bitwise xor) again. This yields 0 if the input chars were the same, 1 otherwise. We then multiply a with this result, giving either 0 or a. Since the * is at a junction, this top stack value determines what happens next.

In the 0 case, we go straight ahead and execute three " no-ops, before perform a ( decrement. Like the setup, this makes us turn and execute "*$, leaving us ready to read more chars.

Otherwise, in the a case, we turn right at the junction since a is positive (48 or 49). . outputs the char, leaving the stack empty, and ( decrements the top of the stack, turning a 0 to -1. Once again, this makes us turn left, executing "*$ like in the setup, also leaving us ready to read more input.

Answer 4

CJam, 10 8 bytes

l2/{)-}%

Test it here.

Explanation

This is a very simple solution: in each pair, remove all instances of the last character. Repeated digits and unpaired trailing digits will be removed, as will be the second digit in any pair of unequal digits:

"0"  --> ""
"1"  --> ""
"00" --> ""
"01" --> "0"
"10" --> "1"
"11" --> ""

This leaves only the digits we're looking for. Here's how the code computes this:

l     e# Read input.
2/    e# Split into pairs. Odd inputs will yield a single-character string at the end.
{     e# Map this block over the pairs...
  )   e#   Pull the last character off the string.
  -   e#   Remove all occurrences of that character from the remainder (which is either
      e#   an empty string to begin with or a single-digit string).
}%

When the list is auto-printed at the end of the program, the empty strings are simply omitted.

Answer 5

Perl, 19 18 17 bytes

@Martin Büttner Retina solution inspired a 2 byte gain

Includes +1 for -p

Run with the input on STDIN, e.g. perl -p fair.pl <<< 11000110

fair.pl:

s/(.)\1|.?\K.//g

Not much to explain here since it is an (indirect) translation of the specification:

• (.)\1 If the first 2 digits are the same, drop them
• .\K. Otherwise the first two digits are different. Keep (\K) the first one
• .?\K. Except that the first . is optional. This allows for a single match at the end of the string which then gets discarded since the kept part is empty

Answer 6

Mathematica, 36 38 bytes

-2 after stealing @LegionMammal978's function for determining if a 2-element list is {0,1} or {1,0}

#&@@@Select[#~Partition~2,Tr@#==1&]&

Argument is expected to be a list of integers.

Answer 7

Hexagony, 23 21 bytes

,){,/;(_\/'%<\{)/>~$>

Unfolded:

    , ) { ,
   / ; ( _ \
  / ' % < \ {
 ) / > ~ $ > .
  . . . . . .
   . . . . .
    . . . .

This terminates with an error, but the error message goes to STDERR.

Try it online!

Judging by the number of mirrors it might be just about possible to fit it into side-length 3 but I've had no luck so far.

Explanation

Here's the usual diagram, generated with Timwi's HexagonyColorer:

The program uses only three memory edges, labelled A, B, and C here (diagram courtesy of Timwi's EsotericIDE):

Execution starts on blue path. The / are just mirrors that redirect the instruction pointer (IP), the actual code is:

,   Read character from STDIN into memory edge A.
)   Increment.
{   Move to memory edge B.
,   Read character from STDIN into memory edge B.
)   Increment.
'   Move to memory edge C.
%   Compute A mod B in memory edge C.

The , will set the edge to -1 instead of the character code if we've hit EOF. Since we're incrementing both inputs that doesn't change whether they are equal or not, but it turns EOF into 0.

We use modulo to check for equality, because it's either 1 or 49 (positive) for unequal characters and 0 for equal characters. It also serves as the end of the program, because when we have the 0 from EOF, the attempted division by zero will cause an error.

Now the < distinguishes zeroes from positive results. The simple one first: if the characters are equal, the IP takes the red path. _ is a mirror, \ is also a mirror but gets ignored, and > deflects the IP such that it wraps around the edges and starts from the top again. However, on this iteration, the roles of A, B and C are swapped cyclically (C now takes the role of A and so on).

If the characters are different, the green path is taken instead. This one's a bit messier. It first jumps over a no-op with $, then wraps around to the / on the left edge, then traverses the second-to-last row from right to left and finally re-enters the interesting part of the source code at the {. There's an essentially linear bit of code, that I'll explain in a second, before the $ makes the IP jump over the > to merge the two paths again.

Here is that linear piece of code:

{    Move to memory edge A.
(    Decrement to recover the actual character we read.
;    Print the character back to STDOUT.
'    Move to memory edge B.
~    Multiply the value there by -1, making it negative. This is
     necessary to ensure that the path correctly wraps back to the top.

Note that in this case, the roles of the edges for the next iteration are also swapped cyclically, but with B taking the role of A and so on.

Answer 8

Haskell, 71 44 29 bytes

p(a:b:r)=[a|a/=b]++p r
p _=[]

Extreme golfing by nimi.

Answer 9

><>, 11 bytes

i:i:0(?;-?o

><> is pretty well suited to read-a-char-at-a-time challenges like this :) Try it online!

i:            Read char and duplicate
i             Read char
:0(?;         Halt if last char was EOF
-             Subtract
?o            Output first char if the subtraction was non-zero (i.e. not equal)

This all happens in a loop since the instruction pointer wraps around once it reaches the end of a line.

Answer 10

JavaScript (ES6), 33 bytes

s=>s.filter((c,i)=>++i%2&c!=s[i])

How it works

s=>s                // Take the input array.
.filter((c,i)=>   ) // Filter to only the chars that are both:
++i%2&              //  on an even index, and
c!=s[i]             //  not equal to the one after them.

Answer 11

Perl, 27 21 bytes

say grep$_-chop,/../g

Byte added for the -n flag.

                /../g  match groups of two chars
    grep       ,       select/filter on...
           chop        remove the last character, mutating the string
        $_-            is it different than the remaining char?
                         (subtract it, empty string is falsy)
say                    output if so

Test:

llama@llama:~$ perl -nE 'say grep$_-chop,/../g'
1110
1
11000110
01
1100011
0
00

1



1101001
0
1011101010
1111

Thanks to @TonHospel for 6 bytes!

Answer 12

Python, 42 bytes

f=lambda L:L[1:]and L[:L[0]^L[1]]+f(L[2:])

Fun with recursion and bitwise xor. Takes a list of 1s and 0s as input.

Answer 13

Prelude, 12 bytes

11(-(#!)?^?)

This assumes an interpreter that reads and prints characters. You can sort of try it online. But that interpreter prints integers, so for each 0 you'll get 48 and for each 1 you'll get 49 instead (and a linefeed).

Explanation

It's very rare that you can write a non-trivial program on a single line in Prelude (because Prelude needs more than one line to be Turing-complete).

11      Push two 1s. We need something non-zero on the stack to enter the loop, and by
        pushing the same value twice, we make sure that the loop doesn't print anything
        on the first iteration.
(       Main loop...
  -       Subtract the last two values. This will be zero for equal values, and non-zero
          otherwise...
  (       This "loop" is simply used as a conditional: if the last two values were
          were equal, skip the code inside...
    #       Discard the conditional.
    !       Print the value below.
  )       The loop is exited because the value below is always zero.
  ?       Read the first character of the next pair from STDIN.
  ^       Duplicate it, so the lower copy can be printed.
  ?       Read the second character of the pair. This returns 0 at EOF, which
          terminates the loop.
)

Answer 14

Befunge 93, 16 bytes

~:~:0`!#@_->#,_$

A one-liner for compactness. Tested using this online interpreter.

~:                     Read input char a and dup
  ~                    Read input char b (-1 on EOF)
   :0`!                Push 1 if b <= 0, 0 otherwise
       #@_             Halt if b <= 0 (i.e. EOF)
          -            Subtract to check whether a != b
           >#,_$       Output a if so

The last part makes use of the fact that popping from an empty Befunge-93 stack yields 0.

If a != b, we perform

>                      Move rightward
#                      Bridge: skip next
_                      Horizontal if - go right if 0, else left. But a != b, so we go left
,                      Output a
#                      Bridge: skip next
-                      Subtract (0 - 0 = 0)
_                      If: go right since 0 is popped
>#                     Go right and skip next
_                      If: go right since 0 is popped
$                      Pop top of stack, stack is now empty

Otherwise, if a == b, we perform:

>                      Move rightward
#                      Bridge: skip next
_                      If: go right since a == b (i.e. a-b is 0)
$                      Pop top of stack and discard, keeping stack empty

Answer 15

MATL, 11 9 8 bytes

`-?6MD]T

Input and output are numbers separated by newlines. Ends with an error (allowed by default) when all inputs have been consumed.

Try it online!

`         % do...while loop
  -       %   take two inputs implicitly. Compute difference
  ?       %   if nonzero
    6M    %     push first of the two most recent inputs again
    D     %     display (and remove from stack)
  ]       %   end if
  T       %   true. Used as loop condition, so the loop is infinite
          % end loop implicitly

Old approach, 11 bytes

2YCd9L)Xz0<

Input is a string. Output is numbers separated by newlines.

Try it online!

2YC      % implicitly take input as a string. Generate 2D array of length-2
         % overlapping blocks as columns, padding with a zero if needed.
d        % difference of the two values in each column of that array
9L       % predefined literal [1 2 0]. This corresponds to "1:2:end" indexing
)        % keep only values at indices 1, 3, 5, ... This reduces the set of blocks
         % to non-overlapping, and discards the last (padded) block if the input had
         % odd length
Xz       % keep only nonzero entries, corresponding to blocks that had different values
0<       % 1 if negative, 0 if possitive. Implicitly display

Answer 16

Pyth, 10 9 bytes

jkPM{Mcz2

Algorithm shamelessly stolen from Dennis's Jelly answer.

       z    input
      c 2   chunks of 2
    {M      dedup each chunk
  PM        all-but-last element of each chunk
jk          join on empty string; can't use `s' because that gives `0' for []

Answer 17

Python 2, 48 bytes

lambda n:[s for s,t in zip(*[iter(n)]*2)if s!=t]

Try it online

Thanks to Dennis and vaultah for pointing out stuff that I missed

Answer 18

sed, 34 33 bytes

s/../& /g;s/00\|11//g;s/.\b\| //g

Test:

llama@llama:~$ sed 's/../& /g;s/00\|11//g;s/.\b\| //g'             
1110
1
11000110
01
1100011
0
00

1



1101001
0
1011101010
1111

Answer 19

Mathematica, 41 39 bytes

Select[#~Partition~2,Tr@#==1&][[1]]&

Less complicated and shorter than the other answer. The box is a transpose character.

Answer 20

Labyrinth, 31 bytes

Not as short and neat as Sp3000's solution, but I thought I'd post this anyway as a different approach:

"" @
,, :{"
)  { $;
*"})";.
 ""

Explanation

The first loop is simply

""
,,

which reads in two characters at a time (the " are no-ops). After EOF, , will return -1, but only check for EOF at every second character. That means in any case the top of the stack will then be -1 and the value below is either -1 or some character code that we don't care about, because it's an unpaired coin toss.

Then )* turns the -1 and the value below into a single 0 which we need a) to get rid of those two values and b) to enter the next loop correctly. That next loop is simply

"}
""

Which shifts all the values over to the auxiliary stack. This is necessary because we want to start processing the pairs that we read first. Now the final loop:

:{"
{ $;
)";.

The ) just increments some dummy value to ensure that it's positive and the instruction pointer turns north. { pulls over the first digit of the next pair and : duplicates it. Now when we're done processing, this will have been a 0 from the bottom of the auxiliary stack. Otherwise it's either 48 or 49. In case of a zero, we exit the loop and terminate on @, otherwise, the IP turns east.

{ pulls over the other digit of the current pair. $ takes the XOR between them. If that is 0, i.e. the two are equal, the IP just continues moving south, ; discards the zero, and the IP turns west into the next iteration. If the XOR was 1, i.e. they were different, the IP turns west, discards the 1 with ; and prints the first digit with ..

Answer 21

JavaScript (ES6), 33 bytes

s=>s.replace(/(.)\1|(.)?./g,"$2")

Boring port of the Retina answer.

Answer 22

Ruby, 46 bytes

This separates l[0], l[1] and l[2..{end}] as a, b and c. Then it creates a string with a if a!=b or '' otherwise and f[c] if c[0] exists or '' otherwise.

f=->l{a,b,*c=l;"#{a!=b ?a:''}#{c[0]?f[c]:''}"}

Ungolfed:

def f(l)
  a = l[0]
  b = l[1]
  c = l[2..l.length]
  s = ''
  if a!=b
    s += a.to_s
  end
  if c[0]       # equivalent to !c.empty?
    s += f[c]   # no .to_s because the output will be a string
  end
  puts s
end

Answer 23

brainfuck, 33 bytes

,>,[<[->->+<<]>[[-]>.<]>[-]<<,>,]

Compared to Java, this is very compact, however, I'm afraid of brainfuck-golfer answerer. And feel free to mention if there's a bug. Assuming EOF is 0, input doesn't contain invalid input, the cell is initially zero, and the cell value range is finite and cyclic. No other assumption is present.

Explanation:

Memory Cell Map

+---------+---------+-----------------+
|1st input|2nd input|copy of 1st input|
+---------+---------+-----------------+

Instruction

,>,                               read two instruction at once | first to first cell |
                                  second to second cell
   [                              Until the input is EOF
    <                             look at first cell
     [->->+<<]                    move the first cell to additional cells while
                                  subtracting the second cell with this at same
                                  time
              >[                  if the second cell is nonzero (it means that first cell and
                                  the second cell is the same)
                [-]>.<            Print the copied first input
                      ]
                       >[-]       clear the first input to prevent it polluting next input
                           <<,>,  continue with next two input
                                ]

Answer 24

Mathematica, 41 bytes

Cases[#~Partition~2,a_/;Tr@a==1:>a[[1]]]&

Anonymous function that inputs and outputs lists of zeros and ones.

Answer 25

Pyth, 10 bytes

hMf!qFTcz2

Test suite

Answer 26

C, 66 bytes

main(char*p,char**x){for(p=x[1];*p&p[1];p+=2)write(1,p,*p^p[1]);}

Assuming sizeof(int) == sizeof(char *)

"clever" solution - 84 81 bytes

main(int c,short**x){while(!((c=*x[1]++-12336)&~511))c>>8^c&1&&putchar(48|c&1);}

Works on little-endian machine assuming short is 2 bytes. Input is passed as argument. The program iterates over pairs of characters and prints 0 for 0x3130 and 1 for 0x3031. On big-endian the result will be reversed (replace 48|c&1 with 49^c&1 to fix this).

Answer 27

DOS/Windows Batch, 201 162 bytes

@echo off
set/pi=
:a
for /f "tokens=2" %%a in ("%i%") do goto l
exit/b
:l
for /f "tokens=1,2" %%a in ("%i:~0,4%") do if %%a neq %%b echo %%a
set "i=%i:~4%"
goto a

Input is a space seperated string, for example 1 0 0 1 1. Start from cmd, otherwise the screen exits immediately

Answer 28

C, 57 bytes

f(char*p,char*r){for(;*p*p[1];)*r=*p++,r+=*r!=*p++;*r=0;}

We tentatively copy a character from input p to result r, but only advance the r pointer if it differs from the next character. If not, then we'll overwrite it at the next unmatched pair, or with NUL at the end.

Test program:

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
int main(int argc, char **argv) {
    while (*++argv) {
        char *result = malloc(1+strlen(*argv));
        f(*argv, result);
        printf("%s => %s\n", *argv, result);
        free(result);
    }
    return EXIT_SUCCESS;
}

Test output:

$ ./74864 1110 11000110 1100011 00 1 "" 1101001 1011101010
1110 => 1
11000110 => 01
1100011 => 0
00 => 
1 => 
 => 
1101001 => 0
1011101010 => 1111

Answer 29

Befunge-93, 40 bytes

v  ,-1<
      | -<
>~1+:~1+:|
^     <  @

You can try it here. Paste code in the space under the "show" button, press "show", define input, press "run". Our use the "step" button to see how the program works.

Answer 30

beeswax, 45 35 bytes

I could golf it down by 10 bytes—not too bad.

pgy~1z;L?gAF1<<?V_
>&?@yg&?~@ KQd{b

I took the reading a full string of coin tosses approach, which makes the program pretty large. Just reading single integers one by one would make the program smaller—maybe around 22 bytes or so—but also very inconvenient to use.

Examples:

julia> beeswax("FairCoin.bswx")
s1110
1
Program finished!

julia> beeswax("FairCoin.bswx")
s11000110
01
Program finished!

julia> beeswax("FairCoin.bswx")
s1100011
0
Program finished!

julia> beeswax("FairCoin.bswx")
s00

Program finished!

julia> beeswax("FairCoin.bswx")
s10101001010111111100000010011001110100010110101110100001011
1110001010000111100
Program finished!

My beeswax GitHub repository.

My beeswax examples on Rosetta Code.

Answer 31

Java 117 bytes

(or 10 if we consider numerical system with base 117)

String z(char[]s){String r="";for(int i=0,x=-1;++x<s.length/2;i+=2)r+=(s[i]==s[i+1]?"":s[i]=='0'?"0":"1");return r;}

Answer 32

GNU sed, 19 bytes

#!/bin/sed -rf
s/11|00|(.?)./\1/g

Simple and boring translation of Martin Büttner♦'s Retina solution. Except that I used 11|00 in place of .(\1) (for the same score). 18 bytes of code, plus one for the -r.

Answer 33

C#, 83 bytes

int[]M(int[]x)=>x.Select((v,i)=>i%2>0&&x[i-1]!=v?x[i-1]:2).Where(v=>v<2).ToArray();

First, replace odd-numbered items which are not equal to their predecessors with the predecessor, while setting all the rest to 2, then drop all items equal to 2.

Answer 34

Ruby, 66 bytes

initial attempt; likely room for improvement. Run with "ruby -n" and then enter input followed by enter key.

$_.chomp!;i,s=0,'';(s<<$_[i] if $_[i]!=$_[i+1];i+=2)until !$_[i+1];p s

Answer 35

Python, 72 bytes

This definitely won't be the shortest, but hopefully it'll at least give someone a headache.

lambda s:hex(int('110'+s[::-1],4))[:3:-1].translate({48:'',53:'',52:48})