Would this number make a good 2048 combo?

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 , so the shortest code in bytes will win!
• can I have a server supplying answer and just upload input download answer from it? total downloaded bytes will be 1 – Bryan Chen Mar 20 '14 at 4:30
• @Geobits 2048 is already ambiguous as either one number or four. – John Dvorak Mar 20 '14 at 5:41
• A zero should not mean an empty space; is 1024 a legal number or not? Empty spaces should be unambiguous... and therefore having them at all does not contribute to the question, in my opinion. – Tal Mar 20 '14 at 7:18
• Your third example shows 22048 should output good but thats not true. You cant combine 2 with 2048 and the grid is 4x4 if all numbers should be seperate you'll get 5 cells. so maybe you should remove the 0? Also your 5th example seems to be invalid since the game stops at 2048 :) – Teun Pronk Mar 20 '14 at 8:43
• @undergroundmonorail I can confirm there is a 4096 tile in the game. – Kendall Frey Mar 20 '14 at 12:14

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. 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. • You can use the space and tab trick to save some characters on the indentation. SO markdown will break it though. – gcq Mar 20 '14 at 18:41 • I think it doesn't work on Python 3.x. There's quite a lot I can do, but not sure I could compete with that Haskell answer :) – Tal Mar 20 '14 at 21:53 • Yep, i forgot about that. – gcq Mar 20 '14 at 21:54 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.

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...

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
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;
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.

Mathematica - 218 bytes

f=MemberQ[DeleteCases[Map[FromDigits,l~InternalPartitionRagged~#&/@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,
InternalPartitionRagged[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,
InternalPartitionRagged[l, #] & /@
Apply[
Join,
Permutations /@ IntegerPartitions[Length[l = IntegerDigits@#]]
],
{2}
]


with

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

• Just wondering if this has the same bug my code did - the DeleteCases looks like it removes leftmost pairs, so f[88222288888] would fail? – bazzargh Mar 21 '14 at 10:20
• @bazzargh no, the DeleteCases just remove zeros and numbers that aren't power of two. The actual collapsing of pairs is done by the rule //. {a___, x_, x_, b___} :> {a, 2 x, b}, which works for that number and the reverse of it. I'm actually not entirely sure about the order Mathematica applies those replacements in, but it works. – Martin Ender Mar 21 '14 at 10:30

import Data.Bits
p[x]=[[[x]]]
p(x:s)=do r@(h:t)<-p s;[[x]:r,(x:h):t]
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.

• Nice. There's a bug in c though, try "222244442222" - it returns true, but that's not collapsable in the game. Needs to recurse with (2*x):c s. – bazzargh Mar 21 '14 at 16:10
• @bazzargh fixed – mniip Mar 21 '14 at 16:26