แรงบันดาลใจจาก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 (ไม่มี 1 ในเกม)
• ดี: 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=},!!

กรณีทดสอบทั้งหมดสามารถตรวจสอบออนไลน์

Python: 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

oooh ... 2 ... ดี ...

22

oooh ... 22 ... 4 ... ดี ...

42

โอ้ .. ไม่มีอะไร ..

422

โอ้ .. 422 .. 44 .. 8 .. ดี ..

322

โอ้ ไม่มีอะไร

336

โอ้ ไม่มีอะไร

4224

โอ้ .. ไม่มีอะไร ..

4228

โอ้ .. 4228 .. 448 .. 88 .. 16 .. ดี ..

16022481602248

ooh .. 1604481602248 .. 16088160448 .. 1601616088 .. 3216016 .. 3232 .. 64 .. ดี ..

[ 64 และ 256 นำไปสู่ความคลุมเครือที่แก้ไขไม่ได้บางอย่างที่การจับคู่โลภไม่สามารถรับมือกับ ... แต่สิ่งเหล่านี้นับเป็นไบต์ที่ดี ]

2048

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

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.

แก้ไข

ดังนั้นฉันอยากรู้อยากเห็นและสงสัยว่าชุดค่าผสมเหล่านี้จะพอดีกับปริศนาและทดสอบชุดใดชุดหนึ่ง

สำหรับคนอื่นที่มีความอยากรู้อยากเห็นก็ทำแบบทดสอบเช่นกัน;)

แต่ตกลงนี่คือผลลัพธ์:
20736 combinations were tested and 1166 were great combinations

ผมต้องบอกว่าอยู่รวมกันพร้อม 3 หรือมากกว่า zeroes ถูกข้าม (ทำให้รู้สึกใช่ไหม?)
การรวมจะไม่ซ้ำกันเกือบจะหมายถึงชุด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}}
]

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เป็นฟังก์ชั่น ตัวอย่าง:

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

คำอธิบายเล็กน้อย:
pคืนค่าทุกวิธีในการแยกรายการ
qกรองสิ่งที่ประกอบด้วยพลังเพียง 2 (ไม่รวม 1 แต่รวมถึง 0)
cพยายามยุบสตริง
rวนซ้ำทางขวาและซ้ายจนกว่าจะเหลือเพียง 1 องค์ประกอบเท่านั้นหรือสตริงไม่สามารถยุบได้