#Experimental Mathematics Project: 2048 Solver #This program is an implementation of an algorithm designed #to solve the game 2048. Given that this program does not #interact with any website or app, it also simulates the game #environment. #Current Progress #The game mechanics have been established and can be played by typing the proper #commands. The heurisitic value function has also been established. The last that #is left to do is to implement the alpha-beta pruning, which I am currently #encountering some difficulty. I am not quite sure how to pass off the proper #information between plays. Once this step is finished, I can experiment by #controlling the percentage of 2's to 4's versus the probability of winning. ################################################################################### #Game Description #The objective of the game 2048 is to get achieve a value of 2048. #The game first starts of with two blocks which can be 2's or 4's. #To get to 2048, you must combine the blocks together by 'sliding' #the blocks to any one side of the game grid. When two adjacent #blocks are of the same value, they combine and create a new block #that is sum of the values of the two blocks. All of the blocks #are some power of two. With each 'slide' a new block will appear #in one of the unoccupied squares in the grid, allowing for more #combinations. Note: if there are no possible moves that result #in at least one empty square, then there are no possible moves #left and you lose. ################################################################################### #Game environment #The original game environment is a 4x4 grid, and is represented by #matrix Game. This matrix will be constantly updated as the game #progresses. Game:=Matrix(4,4): ################################################################################### #Introducing the random block #The game also spawns a 2-block or a 4-block randomly in a nonempty #square in the grid. The function placeBlock randomly inserts a #2-block or a 4-block into the square. emptySquare takes in the #Matrix A and returns a list with the coordinates of empty squares. emptySquare:=proc(A) local empty, i, j: empty:=[]: for i from 1 to 4 do for j from 1 to 4 do if A(i,j) = 0 then empty:=[op(empty), [i,j]]: fi: od: od: empty: end: placeBlock:=proc(A, list) local randNum, randPlace, x, y: randNum:=RandomTools[Generate](integer(range = 1..100)): randPlace:=RandomTools[Generate](integer(range = 1..nops(list))): x:=list[randPlace][1]: y:=list[randPlace][2]: if randNum <= 90 then A(x,y):= 2: else A(x,y):= 4: fi: end: insertBlock:=proc(A, coord) local x, y: randNum:=RandomTools[Generate](integer(range = 1..100)): x:=coord[1]: y:=coord[2]: if randNum <= 90 then A(x,y):= 2: else A(x,y):= 4: fi: end: removeBlock:=proc(A, coord) local x, y: x:= coord[1]: y:= coord[2]: A[x,y]:= 0: end: ################################################################################### #Game Mechanics #One of the key features of this game is the ability to 'slide' the blocks from left #To right. Moreover, if there are two adjacent blocks of the same value, they combine #to create a new block with a value equal to the sum of the original blocks. More #importantly, it leads the creation of an empty square. How the blocks combine depends #on the direction in which the blocks slide. The function validMoves checks for the #valid moves in the game. If there are valid moves, the function will return the #direction of the slides. The function moveBlocks moves all the tiles in the specified #direction. This function combineBlocks, combines all of the blocks in the proper order #The function shiftBlocks shifts the blocks in the proper direction. moveBlocks makes #sure that the blocks are combined before they are shifted. Also, every time the player #performs a move, a new block appears randomly in one of the empty squares. moveBlocks #moves and shifts blocks properly. validMoves:=proc(A) local valid, moveEmpty, numEmpty, i, j: valid:={}: moveEmpty:=EmptySquare(Game): for i from 1 to nops(moveEmpty) do if moveEmpty[i] = [1,1] then valid:= valid union {'left','up'}: elif moveEmpty[i] = [1,4] then valid:= valid union {'right','up'}: elif moveEmpty[i] = [4,1] then valid:= valid union {'left','down'}: elif moveEmpty[i] = [4,4] then valid:= valid union {'right','down'}: elif moveEmpty[i] = [1,2] or moveEmpty[i] = [1,3] then valid:= valid union {'left','right','up'}; elif moveEmpty[i] = [4,2] or moveEmpty[i] = [4,3] then valid:= valid union {'left','right','down'}: elif moveEmpty[i] = [2,1] or moveEmpty[i] = [3,1] then valid:= valid union {'left','up','down'}: elif moveEmpty[i] = [2,4] or moveEmpty[i] = [3,4] then valid:= valid union {'right','up','down'}: else valid:= {'left','right','up','down'}: fi: od: for i from 1 to 3 do for j from 1 to 3 do if A[i+1,j] = A[i,j] then valid:= valid union {'left','right'}: elif A[i,j+1] = A[i,j] then valid:= valid union {'up','down'}: fi: od: od: if nops(valid) = 0 then RETURN('FALSE'): else valid: fi: end: combineBlocks:=proc(A, direction) local i, j: if direction = 'left' then for i from 1 to 4 do for j from 1 to 3 do if A[i,j+1] = A[i,j] then A[i,j]:= 2*A[i,j]: A[i,j+1]:= 0: fi: od: od: elif direction = 'right' then for i from 1 to 4 do for j from 4 by -1 to 2 do if A[i,j-1] = A[i,j] then A[i,j]:= 2*A[i,j]: A[i,j-1]:= 0: fi: od: od: elif direction = 'up' then for j from 1 to 4 do for i from 1 to 3 do if A[i+1,j] = A[i,j] then A[i,j]:= 2*A[i,j]: A[i+1,j]:= 0: fi: od: od: elif direction = 'down' then for j from 1 to 4 do for i from 4 by -1 to 2 do if A[i-1,j] = A[i,j] then A[i,j]:= 2*A[i,j]: A[i-1,j]:= 0: fi: od: od: fi: A: end: shiftBlocks:=proc(A, direction) local i, j, k, temp, count: temp:=[0,0,0,0]: count:= 0: if direction = 'left' then count := 1: for i from 1 to 4 do for j from 1 to 4 do if A[i,j] <> 0 then temp[count]:= A[i,j]: count:= count + 1: fi: od: for k from 1 to 4 do A[i,k]:= temp[k]: od: count:= 1; temp:= [0,0,0,0]: od: elif direction = 'right' then count:= 4: for i from 1 to 4 do for j from 4 by -1 to 1 do if A[i,j] <> 0 then temp[count]:= A[i,j]: count:= count - 1: fi: od: for k from 1 to 4 do A[i,k]:= temp[k]: od: count:= 4; temp:= [0,0,0,0]: od: elif direction = 'up' then count:= 1: for j from 1 to 4 do for i from 1 to 4 do if A[i,j] <> 0 then temp[count]:= A[i,j]: count:= count + 1: fi: od: for k from 1 to 4 do A[k,j]:= temp[k]: od: count:= 1; temp:= [0,0,0,0]: od: elif direction = 'down' then count:= 4: for j from 1 to 4 do for i from 4 by -1 to 1 do if A[i,j] <> 0 then temp[count]:= A[i,j]: count:= count - 1: fi: od: for k from 1 to 4 do A[k,j]:= temp[k]: od: count:= 4; temp:= [0,0,0,0]: od: fi: A: end: moveBlocks:=proc(A, direction): shiftBlocks(A,direction): combineBlocks(A,direction): shiftBlocks(A,direction): #placeBlock(Game, emptySquare(Game)); A: end: ################################################################################### #Win/Lose Criteria #You lose if there are no more valid moves. You win if you get to 2048 isLose:=proc(A): if nops(validMoves(A)) = 0 then RETURN('TRUE'): else RETURN('FALSE'): fi: end: isWin:=proc(A): if max(A) = 2048 then RETURN('TRUE'): else RETURN('FALSE'): fi: end: ################################################################################### #Solution Algorithm Implementation #This game is a discrete space game, with perfect information, and is turn-based like #chess and checkers. There are methods that have proven to work in those games, one #of them being minimax search with alpha-beta pruning. Minimax search starts with the #current game state as the initial set up and tries to predict which is the best move #given that we look at some number of moves ahead. The program will do so by considering #which of the possible future states is best by minimizing the possible loss for the #worst case scenario. Alpha-beta pruning is implemented with minimax search to reduce #the number of possible scenarios that we need to consider. The heuristic function that #we shall consider is monotonicity and smoothness. Monotonicity is ensure that the tiles #are either increasing or decreasing along the rows and columns. This captures the idea #that the larger values are clustered to a corner to keep the board organized and so as #to not isolate any small value square. Smoothness measures the differences between a #tile and its adjacent tiles. We also need to keep track of the number of free squares. #By rewarding positions that create or maintain the number of free tiles, we can keep #our options open. Of course, the objective of this game is to get to 2048, and our #program should reward new states that increase the maximum value of the board. with(MTM): heuristic:=proc(A) local smoothWeight, monoWeight, emptyWeight, maxWeight: smoothWeight:= 0.1: monoWeight:= 1.0: emptyWeight:= 2.7: maxWeight:= 1.0: smoothness(A)*smoothWeight + monotone(A)* monoWeight + log(nops(emptySquare(A)))*emptyWeight + max(A)*maxWeight: end: smoothness:=proc(A) local copy, smooth, i, j, k: smooth:= 0: copy:=shiftBlocks(A,'left'): for i from 1 to 4 do for j from 1 to 3 do if copy[i,j] <> 0 then if copy[i,j+1] <> 0 then smooth:= smooth - abs(log2(copy[i,j]) - log2(copy[i,j+1])): fi: fi: od: od: copy:=shiftBlocks(A,'up'): for j from 1 to 4 do for i from 1 to 3 do if copy[i,j] <> 0 then if copy[i+1,j] <> 0 then smooth:= smooth - abs(log2(copy[i,j]) - log2(copy[i,j+1])): fi: fi: od: od: smooth: end: monotone:=proc(A) local trend, copy, i, j: trend:= [0,0,0,0]: copy:=shiftBlocks(A,'left'): for i from 1 to 4 do for j from 1 to 3 do if copy[i,j] <> 0 then if copy[i,j+1] <> 0 then if copy[i,j] > copy[i,j+1] then trend[0] := trend[0] + log2(copy[i,j]) - log2(copy[i,j+1]): elif copy[i,j] < copy[i,j+1] then trend[1] := trend[1] + log2(copy[i,j+1]) - log2(copy[i,j]): fi: fi: fi: od: od: for j from 1 to 4 do for i from 1 to 3 do if copy[i,j] <> 0 then if copy[i+1,j] <> 0 then if copy[i,j] > copy[i+1,j] then trend[2] := trend[2] + log2(copy[i,j]) - log2(copy[i+1,j]): elif copy[i,j] < copy[i+1,j] then trend[3] := trend[3] + log2(copy[i+1,j]) - log2(copy[i,j]): fi: fi: fi: od: od: max(trend[1], trend[2]) + max(trend[3], trend[4]): end: alphabeta:=proc(A, turn, depth, alpha, beta, positions, cutoffs) local copy, newcopy, bestScore, bestMove, result, direction, temp, choice, empty, value, i: temp:={'left','right','up','down'}: bestMove:= -1: bestScore:=alpha: copy:= A: if turn = 'Player' then for direction in temp do newcopy:= copy: newcopy:= moveBlocks(newcopy, direction): position:= position + 1: if isWin(A) = 'TRUE' then RETURN({direction, 10000, positions, cutoffs}): fi: if depth = 0 then result:= {direction, heuristic(newcopy)}: else result:= alphabeta(newcopy, 'Player', depth-1, bestScore, beta, positions, cutoffs): if result[2] > 9900 then result[2]:= result[2] - 1: fi: positions = result[3]: cutoff = result[4]: fi: if result[2] > bestScore then bestScore:= result[2]: bestMove:= result[1]: fi: if bestScore > beta then cutoff:= cutoff + 1: return {bestMove, beta, positions, cutoffs}: fi: od: else bestScore:= beta: choice:= []: empty:= emptySquare(copy): scores:={}: for i in empty do insertBlock(A, coord): end: #### AB:=proc(A, depth, alpha, beta, Player) local copy, direction, valid, child, empty: valid:=validMoves(A): copy:= A: if MaxPlayer = 'Max' then for direction in valid do child:= moveBlocks(copy, direction): if max(A) = 2048 then RETURN({direction, 10000}): fi: if nops(valid) = 0 then RETURN({direction, -10000}): fi: if depth = 0 then RETURN(heuristic(A)): fi: alpha:= max(alpha, AB(child, depth - 1, alpha, beta, FALSE)): #getBest:=