User Portlet
Featured Contributor
Sander Huisman
University of Twente
LOCATION: Enschede, Netherlands
WEBSITE: http://shuisman.com
INTERESTS IN JOBS & 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...
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 -> {} ];
STAFF PICKS:
- GPS Mountainbike analysis
- Solving a KenKen puzzle using logic
- Solving the UK Intelligence Agency's Christmas Puzzle
- How to make 360 degree videos
- [GIF] Creating an animated Dragon curve fractal
- How to Lego-fy your plots and 3D models...
- [GIF] Walking cube
- [GiF] Creating an Inception like intro logo animation
- [GiF] Transit of Mercury 2016
- [GIF] Jumping cube completion
- Walking strandbeest dynamics
- Roads to Lyon - done in the Wolfram Language
- [GIF] Circle - Gecko - triangular tiling transformation inspired by Escher
- Solving Hidato, Beehive, and Numbrix puzzles
- [GIF] Waves of hexagonal columns
- A short exploration of the featured contributors
- Seam carving (liquid or content aware rescaling) in Wolfram Language
- Exploration of polyhedron resistor networks
- Merry Christmas!
- The Chaos Game - Sierpinski triangles and beyond - part I
- The Chaos Game - infinitygon and Markov-chains - part III
- The Chaos Game - part II
- [Numberphile] - The Illumination Problem
- [Numberphile] - Frog Jumping - Solving the puzzle
- [Numberphile] - Abelian Sandpiles - Done in the Wolfram Language
- Solving Suguru (Tectonic) puzzles
- BinListsBy - Binning data with associate data
- Improvement on the magic number 0x5f3759df
- [ViZ] Formula One (F1) race: positions change over time
- [Reddit-DiBB0118] Bubble chart for 4D data
- [Numberphile] - The Square-Sum Problem
- Analysis of the Wolfram Community
- Phase unwrapping
- [Numberphile] - How to make a binary prime logo
- [Numberphile] - Amazing Graphs II
- [Numberphile] - Amazing Graphs III
- Factorio - Visualizing construction material dependencies
- [GIF] Moving bars illusion
- Estimation of energy yield of 2020 Beirut port explosion
- Peaceful chess queen armies
- [GiF] Bouncing rays in a grid of cylinders: 20-trillionth degree difference
- [GiF] Genuary 2022 Dithering: randomizing and discretizing the digits
- [Gif] Genuary 2022 Space: traveling tubes forming the digits
- Genuary 2022 Fidenza: stream plot with digits regions
- Genuary 2022: Destroy a square - iteratively breaking up a quadrilateral
- [GiF] Genuary 2022: trade styles with a friend
- [GiF] Genuary 2022: Sol LeWitt Wall Drawing
- [GiF] Genuary 2022: Architecture - Courtyard with 4 houses
- [GiF] Genuary 2022: 800x80 - distribution of points with Lloyd's algorithm
- [GiF] Genuary 2022: Color gradients gone wrong - xkcd's painbow
- [GiF] Genuary 2022: VHS
- [Gif] Genuary 2022: Abstract vegetation
- Circular sunset/sunrise calendar
- Approaching drums: simulating drops being ejected from drums
- [ART] An infinite amount of wolves: chaos game with an exclusion region
- [GiF] Chasing trefoil: varying a space-curve over time
- [GiF] Hilbert chasers: two lines following rotated curves
- [GiF] - Spawning regular polygons
- Sonify: NASA Webb Telescope Pillars of Creation & Cellular Automata Rule 30