# 2048 game - suggestions?

GROUPS:
 Brady Pelkey 28 Votes Hey all, I'm a student and am just starting to get the hang of Mathematica. I tried to make a Mathematica version of the game 2048. My program works now, so I thought I'd share. I'd love to hear if there are any better ways to do it, or any suggestions you have to make it better. I originally wanted to see the distribution of how many moves a random game would last. So, now you can use all the normal Mathematica tools to discover cool patterns in 2048. Thanks, hope you enjoy! Shift[list_]:=PadRight[Cases[list,Except[0]],4]; Merge[list_]:=Flatten[list//.{x___,c_,c_,y___}->{x,{2*c},y}]; SlideRow[list_]:=Shift[Merge[Shift[list]]]; Slide[list_,l]:=Table[SlideRow[list[[j]]],{j,1,4}]; Slide[list_,r]:=Table[Reverse[SlideRow[Reverse[list[[j]]]]],{j,1,4}]; Slide[list_,u]:=Transpose[Table[SlideRow[Transpose[list][[j]]],{j,1,4}]]; Slide[list_,d]:=Transpose[Table[Reverse[SlideRow[Reverse[Transpose[list][[j]]]]],{j,1,4}]]; RandInsert[list_]:=ReplacePart[list,RandomChoice[Position[list,0]]->RandomChoice[{2,4}]]  (*these functions slide each row in the given direction,combine like terms,and add one random number to an empty tile*)Col[n_]:=Graphics[{Blend[{Yellow,Cyan,Purple,Red},((Log[n+1]/Log[2]))/11],Rectangle[]}];Visual[list_]:=ImageCompose[GraphicsGrid[Table[Table[Col[list[[j,i]]],{i,1,4}],{j,1,4}]],GraphicsGrid[list,Frame->All]](*the tiles,with colors and numbers*)Nex[list_,move_]:=If[FreeQ[list,0],ConstantArray[Infinity,{4,4}],RandInsert[Slide[list,move]]](*the update rule*)(*the game itself.input from {u,d,l,r} to move*)game=ConstantArray[0,{4,4}];Print[Dynamic[Visual[game]]];While[game!=ConstantArray[Infinity,{4,4}],game=Nex[game,Input[]]]Edit: When I compared my results with the excellent artent article below, I noticed two important bugs. A random tile was added even after moves that didn't change anything. And the game ended after the board was full, even if further moves were possible. To fix this, I changed the Nex update rule. It's a little clunky, but should work. Uh, right now for the sake of analysis I have the final state be the total score instead of the grid, but you can change it easily enough. Thanks everyone for the comments!Nex[list_, move_] := Piecewise[{{RandInsert[list], Total[Flatten[list]] == 0}, {Total[Flatten[list]], Slide[list, u] == Slide[list, d] == Slide[list, l] == Slide[list, r] == list}, {list, Slide[list, move] == list}}, RandInsert[Slide[list, move]]]
4 years ago
5 Replies
4 years ago
 Wow, thanks for cleaning up my post! I'll keep those tips in mind, and definitely add the EventHandlers tonight.
 Daniel Fortunato 12 Votes Very nice! I like the use of CreateDialog as well. I recently made a similar one myself, with some different stylings: one where I scraped the CSS from the original, and one where I used spikeys instead of numbers! You can download the spikey images here (the code looks for the images at ~/Downloads/Spikeys/, but you can change it). Also a notebook is attached to this post which you can simply run and the game will start - all images are already inside.Spikey images look like this once imported:Here's the code (the bulk of it is styling stuff, and I put everything inside of the Initialization of the DynamicModule):  start2048[] := With[{size = 4},    CreateDialog[     DynamicModule[      {board = Table[$empty, {size}, {size}], tile, score = 0, s, oldBoard, gameover = False, won = False}, Dynamic[ Column[{ Row[{ "Styling: ", Button["Default", ($emptyColor = RGBColor[0.75436, 0.701427, 0.642634];            $backgroundColor = RGBColor[0.676677, 0.616403, 0.559747]; drawTile = drawTileDefault;)], Button["Wolfram", ($backgroundColor = LightGray; $emptyColor = Lighter[$backgroundColor, .6];             drawTile = drawTileWolfram;)],        Spacer[220],        Button["Reset", (board = Table[$empty, {size}, {size}]; score = 0; gameover = False; won = False; Do[tile = newTile[board]; board[[Sequence @@ tile[[2]]]] = tile[[1]], {2}];)] }], Row[{ Which[ gameover, Overlay[{#, Text[Style["Gameover", Red, Bold, FontFamily -> "Helvetica", FontSize -> Scaled[0.1]]]}, Alignment -> Center] &, won, Overlay[{#, Text[Style["You win!", Yellow, Bold, FontFamily -> "Helvetica", FontSize -> Scaled[0.1]]]}, Alignment -> Center] &, True, Identity ] @ drawGrid[board], Spacer[50], Column[{ Style[score, Bold, colorForNumber[2, "Color"], FontFamily -> "Helvetica", FontSize -> 70], Show[drawTile[Max[board /.$empty -> 0]], ImageSize -> Small]},          Alignment -> Center, Spacings -> 5]       }]      }]     ],     Initialization :> (       SetOptions[EvaluationNotebook[], NotebookEventActions ->         {"KeyDown" :>           With[{key = ToCharacterCode[CurrentValue["EventKey"]][[1]]},             If[MemberQ[keymap[[All, 1]], key],               If[!gameover && !won,                 oldBoard = board;                 {board, s} = Reap[shift[board, key /. keymap]];                 If[board =!= oldBoard,                   tile = newTile[board];                   board[[Sequence @@ tile[[2]]]] = tile[[1]]                 ];                 If[s =!= {}, score += Total[s[[1]]]];                 Which[Max[board /. $empty -> 0] >= 2048, won = True, !movesAvailable[board], gameover = True]; ] ] ] }];$empty = "";       keymap = {28 -> "Left", 29 -> "Right", 30 -> "Up", 31 -> "Down"};       newTile[board : {{__} ..}] := With[{pos = Position[board, $empty]}, If[pos === {}, {}, {RandomChoice[{.9, .1} -> {2, 4}], RandomChoice[pos]}]]; combineLeft[l_List] := Flatten[Split[ Cases[l, Except[$empty]]] //. {a___, x_Integer, x_Integer, b___} :> (Sow[x + x]; {a, {x + x}, b})];       combineRight[l_List] := Reverse[combineLeft[Reverse[l]]];       shift[board : {{__} ..}, "Left"] := PadRight[combineLeft[#], Length[board], $empty] & /@ board; shift[board : {{__} ..}, "Right"] := PadLeft[combineRight[#], Length[board],$empty] & /@ board;       shift[board : {{__} ..}, "Up"] := Transpose[shift[Transpose[board], "Left"]];       shift[board : {{__} ..}, "Down"] := Transpose[shift[Transpose[board], "Right"]];       matchesAvailable[board : {{__} ..}] :=            Or @@ (Cases[#, {___, x_Integer, x_Integer, ___}, {1}] =!= {} &) /@ {board, Transpose[board]};       movesAvailable[board : {{__} ..}] := !FreeQ[board, $empty] || matchesAvailable[board]; logos = Import[FileNameJoin[{$HomeDirectory, "Downloads", "Spikeys", # <> ".png"}]] &            /@ {"1", "1b", "2", "3", "4", "5", "6", "7", "8", "9", "alpha"};       roundedLogos = SetAlphaChannel[#, ColorNegate@Graphics@Rectangle[{0, 0}, ImageDimensions[#],            RoundingRadius -> 20]] & /@ logos;       drawTileWolfram[$empty] := Graphics[{$emptyColor, Rectangle[RoundingRadius -> 0.05]}, ImageSize -> 250,            ContentSelectable -> False, PlotRangePadding -> 0];       drawTileWolfram[n_Integer] /; IntegerQ[Log2[n]] := Image[roundedLogos[[Log2[n]]], ImageSize -> 250];       hexToRGB[s_String] := RGBColor @@ (IntegerDigits[FromDigits[StringTake[s, -6], 16], 256, 3]/255.);       css = Import["http://gabrielecirulli.github.io/2048/style/main.css", "XHTML"];       colors = StringCases[css, ".tile.tile-" ~~ b : Alternatives @@ ToString /@ Table[2^i, {i, 11}] ~~ " " ~~           Shortest[___] ~~ "{" ~~ Shortest[a___] ~~ "}"           :> (Flatten[{b, StringCases[a, {"color: " ~~ Shortest[c__] ~~ ";" :> ("Color" -> c),                "background: " ~~ Shortest[d__] ~~  ";" :> ("Background" -> d)}]}] /. {_} -> Sequence[])];       defaultColor = First@StringCases[css, "body {" ~~ Shortest[Except["{"] ..] ~~ "color: " ~~            Shortest[c__] ~~ ";" ~~ Shortest[Except["}"] ..] ~~ "}" :> c];       colors = If[!MemberQ[#, "Color", Infinity], #~Join~{"Color" -> defaultColor}, #] & /@ colors;       colorForNumber[n_Integer, s : "Background" | "Color"] /; MemberQ[Table[2^i, {i, 11}], n] :=            hexToRGB[First[Cases[colors, {ToString[n], r___} :> (s /. {r})]]];       colorForNumber[_Integer, "Background"] := hexToRGB["#3c3a32"];       colorForNumber[_Integer, "Color"] := hexToRGB["#f9f6f2"];       $emptyColor = RGBColor[0.75436, 0.701427, 0.642634];$backgroundColor = RGBColor[0.676677, 0.616403, 0.559747];       drawTileDefault[$empty] := Graphics[{$emptyColor, Rectangle[RoundingRadius -> 0.05]},           ImageSize -> 250, ContentSelectable -> False];       drawTileDefault[n_Integer] := Graphics[{colorForNumber[n, "Background"],          Rectangle[{-1/2, -1/2}, RoundingRadius -> 0.05],          colorForNumber[n, "Color"],          Text[Style[n, Bold, FontFamily -> "Helvetica",             FontSize -> Scaled[Switch[IntegerLength[n], 1 | 2, .5, 3, .4, _, .34]]], {0, 0}]},           ImageSize -> 250, ContentSelectable -> False];      drawGrid[board : {{__} ..}] := Framed[GraphicsGrid[Map[drawTile, board, {2}],         ContentSelectable -> False, ImageSize -> 450],          FrameMargins -> 10, Background -> $backgroundColor, RoundingRadius -> 10, FrameStyle -> None]; drawTile = drawTileDefault; If[MatchQ[board, {{$empty ..} ..}],          Do[tile = newTile[board]; board[[Sequence @@ tile[[2]]]] = tile[[1]], {2}]      ];    )   ],   WindowSize -> {800, 520},   Background -> White  ]] Attachments: