User Portlet User Portlet

Sander Huisman
Sander Huisman
École Normale Supérieure de Lyon
LOCATION: Lyon, France
INTERESTS IN JOBS & NETWORKING:
Collaboration Consulting Volunteering Meet ups Mentorships Networking
ABOUT ME:

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

I got a PhD degree in Physics from the University of Twente (Netherlands) for research on high Reynolds number Taylor-Couette turbulence. I'm currently doing a PostDoc in Lyon (France) researching Lagrangian turbulence.

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

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 -> {}
  ];