Натхненний xkcd .

Ваше завдання полягає в тому, щоб визначити, чи вдало б число поєднати в грі 2048 . Вашим вкладом буде число, наприклад:

8224

І вихід буде це число зробити хорошу 2048 комбо, який для цього входу буде trueабо yesабо 1або будь-яким іншим способом вказівки позитивного результату.

Для тих , хто не знайомий з грою, ось просте пояснення: повноваження двох розташовані на сітці, як це: [2] [2]. Плитку можна переміщувати в будь-якому напрямку, і якщо зустрічаються дві однакові плитки, вони стають наступною силою двох (так, [2] [2]коли рухається ліворуч або праворуч стає [4]). Або ви можете просто спробувати гру тут .

Що означає "хороша комбінація 2048 року"? Це означає будь-яке число, яке, якби воно було в грі «2048», його можна було б об'єднати в одне єдине число. (Нуль означає порожній простір , і при необхідності його можна ігнорувати.) Зверніть увагу, що цифри, можливо, можуть бути багатозначними! Однак числа не повинні змінюватися між ходами. Ось кілька прикладів / тестових випадків ("Добре" вказує на хорошу комбінацію, а "Погано" означає недобре):

• Добре: 8224 (8224 -> 844 -> 88 -> 16)
• Добре: 2222 (2222 -> 44 -> 8)
• Добре: 22048 (22048 -> 448 -> 88 -> 16)
• Погано: 20482 (не можна комбінувати зовнішні 2-х, також не можна поєднувати 2048 та 2)
• Добре: 20482048 (20482048 -> 4096)
• Погано: 210241024 (210241024 -> 22048, але це зараз [2] [2048] і не може бути поєднано, оскільки числа не можуть змінюватися між ходами)
• Добре: 2048 (це вже одне число)
• Погано: 2047 (це не сила 2)
• Погано: 11 (у грі немає жодної)
• Добре: 000040000000 (нулі - порожні пробіли)

Різні правила:

• Введення даних може бути з будь-якого розумного, наприклад, STDIN, аргументу функції, файлу тощо.
• Вихід також може бути де завгодно розумним, тобто STDOUT, значення повернення функції, файл тощо.
• Ігноруйте розмір сітки - 22222222все одно слід виводити правдою.
• Максимальне значення не може бути числом, доки це сила двох. Тому можливі числа - будь-яка потужність на дві більше 0.
• Для тих, хто переживає нулі, що викликають неоднозначність, це не так. Наприклад, 22048можна розібрати як [2] [2048]або [2] [2] [0] [4] [8]. Перший не працює, але другий, так що він повинен виводити істину.
• Це код-гольф , тому найкоротший код у байтах виграє!

GolfScript, 137 символів

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

Вхід повинен бути вказаний на STDIN. Вихід 0/ 1для поганих / хороших чисел. Більша частина коду необхідна для розбору можливих входів.

Ця коротша версія (113 символів) виконує простий тест зміни, який би не працював правильно для введення 224422.

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

Усі тестові справи можна перевірити в Інтернеті .

Пітон: 457 422 символів

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

Функція f (s) отримує рядок цифр і відповідно виводить "добре" або "погано". Я вирішив не використовувати 0 як пробіли, оскільки пробіли є безглуздими в грі, і вони створюють неоднозначність при синтаксичному аналізі рядків (добре чи погано 22048?). Для цього використовуються лише цифри до 2048 року, але це можна змінити без додавання символів. Ціною 10 символів або близько того я також можу надрукувати всі етапи комбінування цифр. І я усвідомлюю, що цей код ще недостатньо гольф; не хвилюйтесь, редагування надходять.

Haskell: 285 254 253 237 230 227

використання - просто завантажте його в ghci та передайте рядок h.

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

Код:

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)

Коментар: iце перевірка, якщо число є потужністю 2, це буде виокремлено мовами з бітним подвійністю. %рекурсивно генерує всі синтаксиси, які є списками потужностей 2 або 0. cзгортає плитки. lрекурсивно перевіряє, чи плитка збірна зліва чи добре. gперевіряє, чи плитка збірна ліворуч або праворуч. Не існує обмежень для цифр на плитках - наприклад, h ((show (2^200))++(show (2^200)))повернення відповідає 2 плиткам з позначкою "1606938044258990275541962092341162602522202993782792835301376".

Відредаговано, щоб виправити помилку, що вона неправильно збігла "88222288888" праворуч, але також знайшла більше можливостей для гольфу.

Perl, 175-336 байт

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}

Залишаючи недоторканні лише найважливіші речі:

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

оо .. 1 .. приємно ..

2

ооо ... 2 ... приємно ...

22

ооо ... 22 ... 4 ... приємно ...

42

оо .. нічого ..

422

оо .. 422 .. 44 .. 8 .. приємно ..

322

ой. нічого.

336

ой. нічого.

4224

оо .. нічого ..

4228

оо .. 4228 .. 448 .. 88 .. 16 .. приємно ..

16022481602248

оо .. 1604481602248 .. 16088160448 .. 1601616088 .. 3216016 .. 3232 .. 64 .. приємно ..

[ 64 і 256 призводять до деяких погано вирішених неоднозначностей, з якими жадібне співставлення не може впоратися ... але це хороші підрахунки байтів. ]

2048 рік

ооо ... 2048 ... приємно ...

Delphi 572 582 символів

Відредагований код, ліміт встановлено на 2 ^ 30, тому він не перевищує значення MaxInt в Delphi.

Гольф

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.

Безумовно

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

Тож мені стало цікаво і поцікавилося, скільки з цих комбінацій підійде до головоломки і провів її тест.

Для інших, які також цікаві, зробіть тест теж;)

Але добре ось результати:
20736 combinations were tested and 1166 were great combinations

Я повинен сказати комбінації з 3 - ма або більше нулів були пропущені (має сенс правильно?)
Комбінація майже унікальна, тобто комбінації 2248, 8224, 8422і 4228всі були підрахована як велика комбінація.

Mathematica - 218 байт

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

Негольована версія:

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

Internal\Магія PartitionRagged` береться з цього питання .

Це рішення обробляє довільні розміри сітки та довільно великі числа.

Ось 195 байт версія , яка працює як реальна гра з тільки до 4 -х плиток (так 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}]&

де я замінив

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

з

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

Хаскелл - 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є функцією. Приклади:

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

Невелике пояснення:
pповертає всі способи поділу списку.
qфільтрує ті, які складаються лише з потужностей 2 (крім 1, включаючи 0).
cнамагається згортати рядок.
rітераціює праворуч і ліворуч згортання, поки не залишиться лише 1 елемент, або рядок не стане розбірним.