Would this number make a good 2048 combo?

Question

Inspired by xkcd.

Your challenge is to determine whether a number would make a good combination in the game 2048. Your input will be a number, such as:

8224

And the output will be whether that number would make a good 2048 combo, which for this input would be true or yes or 1 or any other way of indicating a positive result.

For those not familiar with the game, here's a simple explanation: powers of two are arranged on a grid, like this: [2] [2]. Tiles can be moved in any direction, and if two identical tiles meet, they become the next power of two (so [2] [2] when moved left or right becomes [4]). Or, you could just try the game here.

What does "a good 2048 combination" mean? It means any number that, if it was in the game "2048", it could be combined into one single number. (A zero means an empty space, and can be ignored if needed.) Note that numbers could possibly be multiple digits! However, the numbers must not change between moves. Here are some examples/test cases (with "Good" indicating a good combination, and "Bad" meaning not good):

• Good: 8224 (8224 -> 844 -> 88 -> 16)
• Good: 2222 (2222 -> 44 -> 8)
• Good: 22048 (22048 -> 448 -> 88 -> 16)
• Bad: 20482 (cannot combine the outer 2's, nor can you combine a 2048 and a 2)
• Good: 20482048 (20482048 -> 4096)
• Bad: 210241024 (210241024 -> 22048, but this is now [2] [2048] and cannot be combined since numbers cannot change between moves)
• Good: 2048 (it's already one number)
• Bad: 2047 (it's not a power of 2)
• Bad: 11 (there are no 1's in the game)
• Good: 000040000000 (zeroes are empty spaces)

Miscellaneous rules:

• Input can be from anywhere reasonable, i.e. STDIN, function argument, file, etc.
• Output can also be anywhere reasonable, i.e. STDOUT, function return value, file, etc.
• Ignore the grid size - 22222222 should still output true.
• The is no maximum to what s number could be, as long as it's a power of two. Therefore the possible numbers are any power of two greater than 0.
• For those worried about zeroes causing ambiguity, that is not the case. For example, 22048 can be parsed as either [2] [2048] or [2] [2] [0] [4] [8]. The first one doesn't work, but the second one does, so it should output true.
• This is code-golf, so the shortest code in bytes will win!

Answer 1

GolfScript, 137 characters

[0`]1$,4*,{2\)?`}%+:W;[]\]][]\{{:A;W{A 1=\?!},{[.A~@,>\@~+\].~!{0-.,/@+\0}*;}%~}%.}do+.{~}%,{{.-1%}%.&{[{.2$={+)}*}*]{1|(}%}%}*{,1=},!!

Input must be given on STDIN. The output is 0/1 for bad/good numbers. Most of the code is necessary for parsing the possible inputs.

This shorter version (113 characters) performs a simple shift test which would not work correctly for input like 224422.

[0`]1$,4*,{2\)?`}%+:W;[]\]][]\{{:A;W{A 1=\?!},{[.A~@,>\@~+\].~!{0-.,/@+\0}*;}%~}%.}do+{W{~[.:S]/[S.+]*}/,1=},!!

All test cases can be checked online.

Answer 2

Python: 457 422 characters

z=range
def c(n):
 for x in z(1,12): 
  if int(n)==2**x:return 1
 return 0
def p(s):
 if s=='':return[]
 for i in z(len(s),0,-1):
  if c(s[:i])>0and p(s[i:])!=1:return [int(s[:i])]+p(s[i:])
 return 1
def r(a):
 if len(a)==1:return 1
 i,t=1,a[:1]
 while i<len(a):
  if a[i]==t[-1]:t[-1]*=2
  else:t+=[a[i]]
  i+=1
 if len(t)==len(a):return 0
 return r(t) 
def f(s):
 if p(s)==1or r(p(s))==0:print('bad')
 else:print('good')

The function f(s) gets a string of digits and outputs 'good' or 'bad' accordingly. I chose not to use 0 as spaces because spaces are meaningless in the game and they create ambiguity when parsing strings (is 22048 good or bad?). This only uses numbers up to 2048, but that can be changed without adding characters. At the cost of 10 characters or so I can also print all the steps of combining the numbers. And I realize that this code isn't golfed enough yet; don't worry, edits are coming.

Answer 3

Haskell: 285 254 253 237 230 227

usage - just load it into ghci, and pass the string to h.

*Main> h "210241024"
False
*Main> h (replicate 1024 '2') -- very long string
True
*Main> h (replicate 1023 '2') -- odd one out
False

Code:

t=i 0
i n=mod n 2<1&&(n<3||i(div n 2))
a%[]|i a=[[a]]|t=[];a%(b:c)=[a:d|d<-b%c,i a]++(a*10+b)%c
c(0:a)=c a;c(a:b:d)|a==b=(a+a):c d|t=a:c(b:d);c a=a
l a=c a/=a&&(g.c)a
g[a]=t;g a=l a||(l.reverse)a
h b=any g$0%(map(read.(:[]))b)

Commentary: i is the check if a number is a power of 2, this will be outplayed by languages with bit twiddling. % recursively generates all parses that are lists of powers of 2 or 0. c collapses tiles. l recursively tests if tiles are collapsible left or good. g tests if tiles are collapsible left or right. There is no limit to the numbers on the tiles - eg h ((show (2^200))++(show (2^200))) returns true for 2 tiles marked "1606938044258990275541962092341162602522202993782792835301376".

Edited to fix a bug that it didn't correctly collapse "88222288888" to the right, but also found more golfing opportunities.

Answer 4

Perl, 175-336 bytes

while(<>){chomp;$n="nothing";$\=("."x(1+/^[2048]+$/+/^((\d+)0*\2)+$/+((sprintf"%b",
$_)!~/1.*1/)))."\n";($o=$\)=~y/.\n/oh/;print$o;$m=length;for$i(1..$m){$a=$_;$r=
qr((\d*[2468])0*\2)0*/;($b=substr$a,0,$i,"")=~s/$r/$2+$2/ge;@n=$"="$b$a";push@n,$"while$"
=~s/$r/$2+$2/ge;($"%2&&next)||($">>=1)while$">1;$n="nice";(print)for@n;last}print$n}

Keeping just the essentials intact:

$_=shift;$m=length;for$i(1..$m){$a=$_;$r=qr/((\d*[2468])0*\2)0*/;($b=substr$a,0,$i,"")=~
s/$r/$2*2/ge;$"="$b$a";1while$"=~s/$r/$2*2/ge;($"%2&&next)||($">>=1)while$">1;exit}die;

1

ooh.. 1.. nice..

2

oooh... 2... nice...

22

oooh... 22... 4... nice...

42

ooh.. nothing..

422

ooh.. 422.. 44.. 8.. nice..

322

oh. nothing.

336

oh. nothing.

4224

ooh.. nothing..

4228

ooh.. 4228.. 448.. 88.. 16.. nice..

16022481602248

ooh.. 1604481602248.. 16088160448.. 1601616088.. 3216016.. 3232.. 64.. nice..

[64 and 256 lead to some poorly resolvable ambiguities that greedy matching can't cope with... but these are nice byte counts.]

2048

oooh... 2048... nice...

Answer 5

Delphi 572582 characters

Edited code, limit is set to 2^30 so it wont exceed the MaxInt value in Delphi.

Golfed

uses SysUtils,Classes;var t,j,c:integer;s,n:string;L:TStringList;function p(x:string):boolean;var r,i:int64;begin if x='0'then exit(1>0);i:=2;r:=StrToInt(x);while i<r do i:=i*2;p:=i=r;end;begin read(s);t:=0;L:=TStringList.Create;j:=1;while j<=Length(s)do begin for c:=9downto 1do begin n:=copy(s,j,c);if p(n)then break;end;if n>'0'then L.Add(n);j:=j+Length(n);end;for j:=0to L.Count-1do t:=t+StrToInt(L[j]);j:=0;repeat if j=L.Count-1then break;if L[j]=L[j+1]then begin L[j]:=IntToStr(StrToInt(L[j])*2);L.Delete(j+1);j:=0;end else inc(j);until L.Count=1;write(strtoint(L[0])=t);end.

Ungolfed

uses
  SysUtils,
  Classes;

var
  t,j,c:integer;
  s,n:string;
  L:TStringList;
  function p(x:string):boolean;
  var
    r,i:int64;
  begin
    if x='0'then exit(1>0);
    i:=2;r:=StrToInt(x);
    while i<r do
      i:=i*2;
    p:=i=r;
  end;
begin
    read(s);
    t:=0;L:=TStringList.Create;
    j:=1;
    while j<=Length(s)do
    begin
      for c:=9downto 1do
      begin
        n:=copy(s,j,c);
        if p(n)then break;
      end;
      if n>'0'then L.Add(n);
      j:=j+Length(n);
    end;
    for j:=0to L.Count-1do
      t:=t+StrToInt(L[j]);
    j:=0;
    repeat
      if j=L.Count-1then break;
      if L[j]=L[j+1]then
      begin
        L[j]:=IntToStr(StrToInt(L[j])*2);
        L.Delete(j+1);j:=0
      end
      else
        inc(j);
    until L.Count=1;
    write(strtoint(L[0])=t);
end.

EDIT

So I got curious and wondered how many of these combinations would fit the puzzle and ran a test one it.

For others that are also curious, make a test too ;)

But ok here are the results:
20736 combinations were tested and 1166 were great combinations

I must say combinations with 3 or more zeroes were skipped (makes sense right?)
Combinations are almost unique, meaning the combinations 2248,8224,8422 and 4228 were all counted as a great combination.

Answer 6

Mathematica - 218 bytes

f=MemberQ[DeleteCases[Map[FromDigits,l~Internal`PartitionRagged~#&/@Join@@Permutations/@IntegerPartitions@Length[l=IntegerDigits@#],{2}],{___,x_,___}/;!IntegerQ[2~Log~x]||x<2]//.{a___,x_,x_,b___}:>{a,2x,b},{_Integer}]&

Ungolfed version:

f[n_] := MemberQ[
  DeleteCases[
      Map[
        FromDigits, 
        Internal`PartitionRagged[l, #] & /@ 
          Join @@ Permutations /@ IntegerPartitions[Length[l = IntegerDigits[n]]], 
        {2}
      ],
      {___, x_, ___} /; x < 2 || ! IntegerQ[2~Log~x]
    ]
  ] //. {a___, x_, x_, b___} :> {a, 2 x, b}, 
  {_Integer}
]

The Internal\PartitionRagged` magic is taken from this question.

This solution handles arbitrary grid sizes and arbitrarily large numbers.

Here is a 195 byte version that works like the actual game with up to 4 tiles only (so f[22222222] is False):

f=MemberQ[(d=DeleteCases)[d[ReplaceList[IntegerDigits@#,{a__,b___,c___,d___}:>FromDigits/@{{a},{b},{c},{d}}],0,2],{___,x_,___}/;!IntegerQ[2~Log~x]||x<2]//.{a___,x_,x_,b___}:>{a,2x,b},{_Integer}]&

where I've replaced

Map[
  FromDigits, 
  Internal`PartitionRagged[l, #] & /@ 
    Apply[
      Join, 
      Permutations /@ IntegerPartitions[Length[l = IntegerDigits@#]]
    ], 
  {2}
]

with

ReplaceList[
  IntegerDigits[n], 
  {a__, b___, c___, d___} :> FromDigits /@ {{a}, {b}, {c}, {d}}
]

Answer 7

Haskell - 260 263

import Data.Bits
p[x]=[[[x]]]
p(x:s)=do r@(h:t)<-p s;[[x]:r,(x:h):t]
q=filter(and.map(\n->(n::Integer)/=1&&n.&.(-n)==n)).map(filter(/=0)).map(map read).p
c(x:y:s)
 |x==y=2*x:c s
 |True=x:(c$y:s)
c x=x
r[x]=True
r l=c l/=l&&(r(c l)||r(c$reverse l))
f=or.map r.q

f is the function. Examples:

> f"22228"
True
> f"20482044"
False

A little explanation:
p returns all ways to split a list.
q filters those that consist of only powers of 2 (excluding 1 but including 0).
c tries to collapse a string.
r iterates right and left collapsion until there's only 1 element left, or the string is incollapsable.