User Portlet

Welcome to my profile at the Wolfram Community

You'll see me drop by the forums frequently, to broaden my knowledge and to help out others. I'm using Mathematica since 2003 (V5), and have mainly used it to do all my analysis and all my programming tasks. I have a variety of interests: math, photography, photo-editing, mountain biking, vector-based drawing, traveling, anything GPS, math puzzles, data-mining, and many others...

Please enjoy a game of '2048' that I made where you can change the grid size: (code below)

Code:

SetOptions[InputNotebook[],NotebookEventActions->{
"LeftArrowKeyDown":>(stat=Coalesce[stat];AddNew[]),
"RightArrowKeyDown":>(stat=Reverse/@Coalesce[Reverse/@stat];AddNew[]),
"UpArrowKeyDown":>(stat=Coalesce[stat\[Transpose]]\[Transpose];AddNew[]),
"DownArrowKeyDown":>(stat=(Reverse/@(Coalesce[Reverse/@(stat\[Transpose])]))\[Transpose];AddNew[])
}
];

n=4;
bgcolor=GrayLevel[0.84];
colorfunc=Blend[{{0,Gray},{1/2,Red},{1,Blend[{Yellow,Orange}]}},#]&;

ClearAll[AddNew,PrintStat,Coalesce,SubCoalesce,AddRandomNumber]
AddNew[]:=(stat=AddRandomNumber[stat])
PrintStat[stat_]:=Module[{gr1,gr2,gr3,dr=0.2,cols,nstat=stat,positions},
gr1={bgcolor,Rectangle[-dr{1,1},n+dr{1,1},RoundingRadius->dr]};
cols=Map[If[#==0,0,Log2[#]]&,nstat,{2}];
cols=Map[If[#==0,Lighter@bgcolor,colorfunc[#/Max[cols]]]&,cols,{2}];
positions=Table[{i,n-j+1},{j,n},{i,n}];
gr2=MapThread[{#2,Rectangle[#3-{1,1}(1-dr/3),#3-{1,1}dr/3,RoundingRadius->dr/2]}&,{stat,cols,positions},2];
gr3=MapThread[If[#1>0,Style[Text[#1,#2-0.5{1,1}],20,White],{}]&,{stat,positions},2];
Graphics[{gr1,gr2,gr3},PlotRange->{{-0.5,n+0.5},{-0.5,n+0.5}},ImageSize->500]
]
Coalesce[stat_]:=SubCoalesce/@stat
SubCoalesce[statlist_]:=Module[{st=statlist,n=Length[statlist],pairs},
st=Split[DeleteCases[st,0]];
st=Partition[#,2,2,1,{}]&/@st;
st=Map[If[Length[#]==2,Total[#],#]&,st,{2}];
Join[Flatten[st],ConstantArray[0,n-Length[Flatten[st]]]]
]
AddRandomNumber[stat_,n_:2]:=With[{pos=Position[stat,0,{2}]},If[Length[pos]>0,ReplacePart[stat,RandomChoice[pos]->n],stat]]

stat=Nest[AddRandomNumber[#,RandomChoice[{2,4}]]&,ConstantArray[0,{n,n}],4];
Dynamic[PrintStat@stat]

And to stop the keyboard input:

SetOptions[InputNotebook[],
  NotebookEventActions -> {}
  ];

Wolfram Innovator Award 2023