28
|
39265 Views
|
5 Replies
|
67 Total Likes
View groups...
Share

# 2048 game - suggestions?

Posted 11 years ago
 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]]]
5 Replies
Sort By:
Posted 11 years ago
 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:
Posted 11 years ago
 Wow very neat. I case someone is curios - these are some interesting links:Turns out, there is AI written in Mathematica to win the game - by two mathematicians, Hein Hundal and Carl Cotner, at the Pennsylvania State University. Below are sample plots from their analysis. Source code:Mathematica 2048 SimulatorMath behind:An AI for 2048  Part 1An AI for 2048  Part 2 Cyclic Blind StrategiesAn AI for 2048  Part 3 Biased Random Blind StrategiesAnd some basic links:Wikipedia page of 2048http://en.wikipedia.org/wiki/2048_(video_game)Developing AI algorithm to win the game from Stack Overflow What is the optimal algorithm for the game, 2048?BTW I could not hyperlink the Wikipedia URL.@Rojo - beautiful variant! - but after some large number of moves interface breaks. Code or Dynamic issue? Analysis of random vs Greedy players from Hein Hundal and Carl Cotner blog:
Posted 11 years ago
 Very nice. You could use key handlers. Perhaps one could also handle the winning and losing cases. You made me google this game and waste a lot of minutes . The version I googled didn't allow you to slide to a side where no tiles would slide, I am not sure if this is general behaviour.Btw, in general it's a good habit to use lowercase for your symbols, or at least localize themIn any case, here is a possible modification with imo nicer visuals and the key events. It just replaces your Visual function. Also, I changed the second arguments of Slide to strings 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_, "Left"] := Table[SlideRow[list[[j]]], {j, 1, 4}]; Slide[list_, "Right"] :=    Table[Reverse[SlideRow[Reverse[list[[j]]]]], {j, 1, 4}]; Slide[list_, "Up"] :=    Transpose[Table[SlideRow[Transpose[list][[j]]], {j, 1, 4}]];Slide[list_, "Down"] :=   Transpose[   Table[Reverse[SlideRow[Reverse[Transpose[list][[j]]]]], {j, 1, 4}]];RandInsert[list_] := ReplacePart[list,   RandomChoice[Position[list, 0]] -> RandomChoice[{2, 4}]]Col[n_] :=   Blend[{Yellow, Cyan, Purple, Red}, ((Log[n + 1]/Log[2]))/11];(*the tiles,with colors and numbers*)Nex[list_, move_] := If[FreeQ[list, 0], ConstantArray[Infinity, {4, 4}],   RandInsert[Slide[list, move]]](*the update rule*)tile[n_] :=Graphics[{{Col[n],    Rectangle[RoundingRadius -> 0.1]}, {Text[     Style[n, FontSize -> 20], {0.5, 0.5}]}}]Visual[game_] :=Style[Grid[Map[tile, game, {2}],  Frame -> True,   Selectable -> False],  "GraphicsBoxOptions" :> {AspectRatio -> 1, ImageSize -> Tiny}]With[{game :=   CurrentValue[SelectedNotebook[], {TaggingRules, "game"}]},With[{nb =    CreateDialog[{      Button["Restart", game = ConstantArray[0, {4, 4}]],      Dynamic@Visual[game]      },     Background -> White,     NotebookEventActions -> (       Function[key,         key <> "ArrowKeyDown" :> (game =            Nex[game, key])] /@ {"Left", "Down", "Up", "Right"})     ]},  CurrentValue[nb, {TaggingRules, "game"}] = ConstantArray[0, {4, 4}];  ]]If you add the required definitions to the Initialization section of the dialog, then you can save it an open it and start playing at any time without running any code.
Posted 11 years ago
 Wow, thanks for cleaning up my post! I'll keep those tips in mind, and definitely add the EventHandlers tonight.
Posted 11 years ago