Inspirado por xkcd .

Seu desafio é determinar se um número faria uma boa combinação no jogo 2048 . Sua entrada será um número, como:

8224

E a saída será se esse número seria uma boa 2048 de combinação, que para esta entrada seria trueou yesou 1ou qualquer outra forma de indicar um resultado positivo.

Para aqueles não familiarizados com o jogo, aqui está uma explicação simples: potências de dois são organizados em uma grade, como este: [2] [2]. As peças podem ser movidas em qualquer direção e, se duas peças idênticas se encontrarem, elas se tornarão a próxima potência de duas (assim, [2] [2]quando movidas para a esquerda ou direita [4]). Ou você pode apenas tentar o jogo aqui .

O que significa "uma boa combinação 2048"? Significa qualquer número que, se estivesse no jogo "2048", poderia ser combinado em um único número. (Um zero significa um espaço vazio e pode ser ignorado, se necessário.) Observe que os números podem ter vários dígitos! No entanto, os números não devem mudar entre os movimentos. Aqui estão alguns exemplos / casos de teste (com "Bom" indicando uma boa combinação e "Ruim" significando não bom):

• Bom: 8224 (8224 -> 844 -> 88 -> 16)
• Bom: 2222 (2222 -> 44 -> 8)
• Bom: 22048 (22048 -> 448 -> 88 -> 16)
• Ruim: 20482 (não é possível combinar os 2 externos, nem os 2048 e os 2)
• Bom: 20482048 (20482048 -> 4096)
• Ruim: 210241024 (210241024 -> 22048, mas agora é [2] [2048] e não pode ser combinado, pois os números não podem mudar entre os movimentos)
• Bom: 2048 (já é um número)
• Ruim: 2047 (não é um poder de 2)
• Ruim: 11 (não há 1's no jogo)
• Bom: 000040000000 (zeros são espaços vazios)

Regras diversas:

• A entrada pode ser de qualquer lugar razoável, como STDIN, argumento da função, arquivo, etc.
• A saída também pode ser razoável em qualquer lugar, ou seja, STDOUT, valor de retorno da função, arquivo etc.
• Ignore o tamanho da grade - 22222222ainda deve ser verdadeiro.
• O número não é máximo para o número s, desde que seja uma potência de dois. Portanto, os números possíveis são qualquer potência de dois maior que 0.
• Para aqueles preocupados com zeros causando ambiguidade, esse não é o caso. Por exemplo, 22048pode ser analisado como [2] [2048]ou [2] [2] [0] [4] [8]. O primeiro não funciona, mas o segundo, por isso deve ser verdadeiro.
• Isso é código-golfe , então o código mais curto em bytes vencerá!

GolfScript, 137 caracteres

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

A entrada deve ser fornecida no STDIN. A saída é 0/ 1para números ruins / bons. A maior parte do código é necessária para analisar as possíveis entradas.

Esta versão mais curta (113 caracteres) executa um teste de mudança simples que não funcionaria corretamente para entradas como 224422.

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

Todos os casos de teste podem ser verificados online .

Python: 457 422 caracteres

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')

A função f (s) obtém uma sequência de dígitos e gera 'bom' ou 'ruim' de acordo. Optei por não usar 0 como espaços, porque os espaços não têm sentido no jogo e eles criam ambiguidade ao analisar as strings (22048 é bom ou ruim?). Isso usa apenas números até 2048, mas isso pode ser alterado sem adicionar caracteres. Com o custo de 10 caracteres ou mais, também posso imprimir todas as etapas da combinação dos números. E eu percebo que esse código ainda não é suficiente para o golfe; não se preocupe, as edições estão chegando.

Haskell: 285 254 253 237 230 227

uso - basta carregá-lo no ghci e passar a string para h.

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

Código:

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)

Comentário: ié a verificação se um número é uma potência de 2; isso será superado por idiomas com pequenos ajustes. %gera recursivamente todas as análises que são listas de potências de 2 ou 0. creduz as peças. ltesta recursivamente se as peças são dobráveis ​​à esquerda ou boas. gtesta se as peças são dobráveis ​​à esquerda ou à direita Não há limite para os números nas peças - por exemplo, h ((show (2^200))++(show (2^200)))retorna verdadeiro para 2 peças marcadas "1606938044258990275541962092341162602522202993782792835301376".

Editado para corrigir um erro que não ocultava corretamente "88222288888" à direita, mas também encontrou mais oportunidades de golfe.

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}

Mantendo intactos apenas os elementos essenciais:

$_=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 .. legal ..

2

oooh ... 2 ... legal ...

22

oooh ... 22 ... 4 ... legal ...

42.

ooh .. nada ..

422

ooh .. 422 .. 44 .. 8 .. legal ..

322

ah nada.

336

ah nada.

4224

ooh .. nada ..

4228

ooh .. 4228 .. 448 .. 88 .. 16 .. legal ..

16022481602248

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

[ 64 e 256 levam a algumas ambiguidades pouco resolvíveis com as quais a correspondência gananciosa não consegue lidar ... mas essas são boas contagens de bytes. ]

2048

oooh ... 2048 ... legal ...

Delphi 572 582 caracteres

Código editado, o limite é definido como 2 ^ 30, portanto não excederá o valor MaxInt no Delphi.

Golfe

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.

EDITAR

Então fiquei curioso e me perguntei quantas dessas combinações se encaixariam no quebra-cabeça e fiz um teste nele.

Para outros que também são curiosos, faça um teste também;)

Mas ok, aqui estão os resultados:
20736 combinations were tested and 1166 were great combinations

Devo dizer combinações com 3 ou mais zeros foram ignorados (faz sentido certo?)
Combinações são quase única, ou seja, as combinações 2248, 8224, 8422e 4228todos foram contados como uma grande combinação.

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}]&

Versão não destruída:

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}
]

A Internal\mágica PartitionRagged` é retirada dessa pergunta .

Esta solução lida com tamanhos de grade arbitrários e números arbitrariamente grandes.

Aqui está uma versão de 195 bytes que funciona como o jogo real, com até 4 blocos apenas (o que f[22222222]é 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}]&

onde eu substituí

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

com

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

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é a função Exemplos:

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

Uma pequena explicação:
pretorna todas as maneiras de dividir uma lista.
qfiltra aqueles que consistem apenas de potências de 2 (excluindo 1, mas incluindo 0).
ctenta recolher uma sequência.
ritera o colapso direito e esquerdo até restar apenas 1 elemento ou a cadeia é incobrável.