https://community.wolfram.com RSS Feed for Wolfram Community showing any discussions tagged with Game Development sorted by most replies. https://community.wolfram.com/groups/-/m/t/2445356 ![enter image description here][1] The popular game Wordle can take up a lot of your time. The author designed it so that it you can only play it once a day, thus saving us from ourselves :-). [Wordle][2] [NYTimes article on Wordle][3] But I couldn't resist the challenge to create a version of it in Mathematica, just for fun and because I was bored this past weekend. See the attached notebook and enjoy. Alas, since you can run it any number of times you are only to blame for yourself it you spend too much time on it. After executing the notebook just execute MWordle[Deploy] to bring up the game. A few additional comments. The notebook MWordle.nb has the option AutoGeneratedPackage -> Automatic which causes it, when saved, to create an MWordle.m package file in its same directory. The code in MWordle.nb is set up as a package with the context MWordle`Mwordle` If you want to set things up so that the package gets loaded and the MWordle game is automatically launched, do the following. Create a directory MWordleGame on your disk (The name MWordleGame can actually be whatever you wish.) And in the MWordleGame directory create a new directory called MWordle. (This name must be exactly that so that the MWordle`Mwordle` Context is property respected.) Put the MWordle.nb notebook in the MWordle dierectory, open it in Mathematica and save it so that the MWordle.m file is created in the MWordle directory. Then you can close the MWordle.nb notebook. Now in your MWordleGame directory save a new notebook -- you can call it whatever you wish, but something like LaunchMwordle.nb is a sensible choice. In that notebook create a button with the following command: CellPrint[TextCell[Button["Launch MWordle", Monitor[ If[! MemberQ[$Path, NotebookDirectory[]], AppendTo[$Path, NotebookDirectory[]]]; Needs["MWordle`MWordle`"]; MWordle`MWordle`MWordle[Deploy], Row[{ProgressIndicator[Appearance -> "Necklace", ImageSize -> Small], Spacer[5], Style["Launching MWordle...", 12, Blue, FontFamily -> "Arial"]}]], Method -> "Queued"], "Text", GeneratedCell -> False, CellAutoOverwrite -> False]] You now have a button in your LaunchMwordle.nb notebook which you can use any time you want to launch MWordle without having to execute the cells in the MWordle.nb notebook. Download the actual notebook from the link at the end of this post. The following is a version here to read. &[Wolfram Notebook][4] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Wordle.gif&userId=20103 [2]: https://www.powerlanguage.co.uk/wordle/ [3]: https://www.nytimes.com/2022/01/03/technology/wordle-word-game-creator.html [4]: https://www.wolframcloud.com/obj/08c015e2-0d65-4634-bf54-4b73e518f6d5 David Reiss 2022-01-13T21:47:44Z https://community.wolfram.com/groups/-/m/t/478669 Here's today's New York Times 4x4 KenKen solved in Mathematica. The approach is to first construct all possible arrays with different numbers in each row, from that select all arrays that have different numbers in each column, then apply the constraints on various cells. For this particular example, it was not necessary to apply all the constraints to get the unique answer. It is necessary to take the absolute value of some difference and ratio constraints, since it the order of the difference or ratio is not known. Dimensions[p4 = Permutations[Range[4]]] Out[1]= {24, 4} Dimensions[a1 = Flatten[Outer[List, p4, p4, p4, p4, 1], 3]] Out[2]= {331776, 4, 4} Dimensions[ a2 = Select[ a1, (And @@ (And @@ Unequal[Sequence @@ #] &) /@ Transpose[#]) &]] Out[3]= {576, 4, 4} Dimensions[a3 = Select[a2, #[[1, 1]]*#[[1, 2]]*#[[2, 2]] == 12 &]] Out[4]= {112, 4, 4} Dimensions[a4 = Select[a3, Abs[Log[#[[1, 3]]/#[[1, 4]]]] == Log[2] &]] Out[5]= {64, 4, 4} In[6]:= Dimensions[ a5 = Select[ a4, #[[2, 1]] + #[[3, 1]] + #[[3, 2]] + #[[4, 1]] == 11 &]] Out[6]= {8, 4, 4} In[7]:= Dimensions[a6 = Select[a5, Abs[#[[2, 3]] - #[[3, 3]]] == 2 &]] Out[7]= {6, 4, 4} In[8]:= Dimensions[a7 = Select[a6, #[[2, 4]] == 2 &]] Out[8]= {1, 4, 4} In[10]:= a7 Out[10]= {{{1, 3, 2, 4}, {3, 4, 1, 2}, {4, 2, 3, 1}, {2, 1, 4, 3}}} Frank Kampas 2015-04-13T20:56:51Z https://community.wolfram.com/groups/-/m/t/974303 It is fairly straight forward to solve a Sudoku as an integer programming problem, by creating 9 binary variables for each cell, only one of which is one in the solution. The walk-through below and attached notebook illustrates this for the problem shown. ![enter image description here][1] # Implementation Given values, as `{row, column, value}` input = { {1,4,4},{1,5,9},{1,8,5},{2,1,6},{2,5,3},{3,1,4}, {3,2,5},{3,4,6},{3,5,2},{3,7,3},{3,9,7},{4,1,5}, {4,3,2},{4,4,7},{4,7,9},{4,8,8},{5,1,3},{5,3,6}, {5,7,2},{5,9,1},{6,2,9},{6,3,1},{6,6,2},{6,7,6}, {6,9,5},{7,1,2},{7,3,5},{7,5,1},{7,6,4},{7,8,3}, {7,9,8},{8,5,8},{8,9,9},{9,2,1},{9,5,7},{9,6,3}}; Display given values viewmat = Table["", {9}, {9}]; Do[viewmat[[input[[i, 1]], input[[i, 2]]]] = ToString[input[[i, 3]]], {i, Length[input]}] Grid[viewmat, Frame -> All] ![enter image description here][2] Variables, as 9 x 9 x 9 matrix varmat = Table[m[i, j, k], {i, 9}, {j, 9}, {k, 9}]; Variables as a list vars = Flatten[varmat]; Constrain the input cells to their value cons1 = (varmat[[Sequence @@ #]] == 1 &) /@ input ![enter image description here][3] The sum of the binary variables for each cell is 1 cons2 = Flatten @ Table[ (Sum[varmat[[i, j, k]], {k, 9}] == 1), {i, 9}, {j, 9}]; All different constraint for the rows cons3 = Flatten @ Table[ (Sum[varmat[[i, j, k]], {i, 9}] == 1), {j, 9}, {k, 9}]; All different constraint for the columns cons4 = Flatten @ Table[ (Sum[varmat[[i, j, k]], {j, 9}] == 1), {i, 9}, {k, 9}]; All different constraint for the submatrices sm[di_, dj_] := Flatten [Table[{i, j}, {i, 1 + 3*(di - 1), 3*di}, {j, 1 + 3*(dj - 1), 3*dj}],1] cons5 = Flatten @ Table[(Total[m[Sequence @@ #, k] & /@ sm[i, j]] == 1), {i, 3}, {j, 3}, {k, 9}]; Confine the variables to the range 0 to 1 cons6 = Thread[0 <= vars <= 1]; Combine the constraints Length[allcons = Join[cons1, cons2, cons3, cons4, cons5, cons6]] `1089` Solve the problem, specifying that the variables are integers. AbsoluteTiming[sol = FindMinimum[{0, allcons, Element[vars, Integers]}, vars];] `{0.0946335, Null}` Find the values for each cell resmat = Table[Sum[k*m[i, j, k], {k, 9}], {i, 9}, {j, 9}] /. sol[[2]] ![enter image description here][4] Display the input and result {Grid[viewmat, Frame -> All], Grid[resmat, Frame -> All]} ![enter image description here][5] Check the result And @@ Table[Unequal[Sequence @@ resmat[[i]]], {i, 9}] `True` And @@ Table[Unequal[Sequence @@ Transpose[resmat][[i]]], {i, 9}] `True` And @@ Flatten @ Table[Unequal[resmat[[Sequence @@ #]] & /@ sm[i, j]], {i, 3}, {j, 3}] `True` [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=sukoku_problem.jpg&userId=29126 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=sdsdf4qehtrngfsbdvsd.png&userId=11733 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=sdafq4356y4trett4egqrafzgber.png&userId=11733 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=dfg657q43wregdfsbdg.png&userId=11733 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=afgdfgtyuiytouuyrter24356.png&userId=11733 Frank Kampas 2016-12-05T14:23:11Z https://community.wolfram.com/groups/-/m/t/870698 **Easy Cube** is a reflexion game from Japan. It consists of a set of 7 pieces which are "tetris"-like (each piece is a simple geometrical shape made from 3,4 or 5 cubes), and a collection of 48 problems, where the goal is to use the pieces to fill a given shape (in 2d, or in 3d for the hardest problems). The game box ![enter image description here][1] The 7 pieces ![enter image description here][2] 2 examples of problems ![enter image description here][3] It is pleasant to play, with the difficulty slowly increasing whit the hardest problems. I decided to try to solve it using Mathematica. I did not use any advanced mathematics for this (which anyway I would not know :-)), and I wanted a method general enough so it could solve all the problems without any specific adpatation. I went for a purely random method, where the program places a first piece at random, then try to put a second piece, etc. When it fails to add a piece after a fixed number of attemps, it simply starts the whole process again. So this program does not learn anything... It just tries many many different possibilities, until it finds a solution ! Using Wolfram language, the code to make it and to vizualize to result was quite simple and effective (I show the code details at the end of this post for people interested). In particular, going from the 2d case to the 3d case needed very small changes only. The two followings animations show the program in action for a 2d problem and a 3d problem ![enter image description here][4] ![enter image description here][5] The number of attempts needed to reach a solution is of course random, and depends on the difficulty of the problem. Typically, it takes between a few hundreds and a few thousands iterations, which takes between a few seconds to 1-2 minutes. Here a sample of 4 solutions found for a 2d problem : ![Sample solutions from a 2d problem][6] And 2 solutions from a 3d problem : ![Sample solutions from a 2d problem][7] Finally, I considered it if was possible to use this method to find **all solutions** for a given problem (the number of different solutions is an info given on the description of each problem). In principle, because the method is random, it is not well suited for this (one can never be sure that all solutions have been found). However, since the method is quite fast, I decided to try anyway. For a given problem, I computed 10000 solutions. Here is a plot of the number of attempts needed for each solution, and a histogram of this: ![Number of attempts for 10000 solutions][8] On average, finding a solution to this problem requested 2882 attempts... From the 10000 solutions, one wants only different solutions. This is easily done with the **DeleteDuplicates** command: SolgridQ26ListMReduced = DeleteDuplicates@SolgridQ26ListM; Length@SolgridQ26ListMReduced 362 which gives 362 different solutions. However, since this problem geometry has a simple central symmetry, one also want to get rid of "symmetric copies" of the solutions. Defining the symmetry operation as the GsymGrid function, this is again done with a **DeleteDuplicates** command : SolgridQ26ListMReducedSym = DeleteDuplicates[ SolgridQ26ListMReduced, #2 == GSymGrid[#1] &]; Length@SolgridQ26ListMReducedSym 188 which gives 188 unique solutions. This is precisely the number which is given in the problem description ! So the method was able to find all solutions. Here is plot with the 188 solutions: ![all solutions][9] ---------- Details of the code ------------------- **Definition of the pieces** (2d case). Each piece is a simple list of the points make the piece. When then construct, for each piece, a list of copies of it with all possible orientations. Pieces Definitions PTriangle = {{0, 0}, {0, 1}, {1, 0}}; PSquare = {{0, 0}, {0, 1}, {1, 0}, {1, 1}}; PLine = {{0, 0}, {0, 1}, {0, 2}}; PL = {{0, 0}, {0, 1}, {1, 0}, {2, 0}}; PPodium = {{0, 0}, {0, 1}, {-1, 0}, {1, 0}}; PSnake = {{0, 0}, {0, 1}, {1, 0}, {-1, 1}}; PBulky = {{0, 0}, {1, 0}, {0, 1}, {1, 1}, {-1, 1}}; (* Rotation by angle \[Pi]/2 matrix*) Mrot = {{0, 1}, {-1, 0}}; (* Reflection by y-axis matrix *) Mref = {{-1, 0}, {0, 1}}; MUnit = {{1, 0}, {0, 1}}; (*Operators which perform a given number of rotation, and of \ reflection*) RotatePiece[piece_, n_] := Nest[Mrot.# &, #, n] & /@ piece ReflectPiece[piece_, n_] := If[n == 0, (MUnit.#) & /@ piece, (Mref.#) & /@ piece] Each piece with all the possible orientations PTriangleAll = {PTriangle, RotatePiece[PTriangle, 1], RotatePiece[PTriangle, 2], RotatePiece[PTriangle, 3]}; PSquareAll = {PSquare}; PLineAll = {PLine, RotatePiece[PLine, 1]}; PLAll = Module[{PLr = ReflectPiece[PL, 1]}, {PL, RotatePiece[PL, 1], RotatePiece[PL, 2], RotatePiece[PL, 3], PLr, RotatePiece[PLr, 1], RotatePiece[PLr, 2], RotatePiece[PLr, 3]}]; PPodiumAll = {PPodium, RotatePiece[PPodium, 1], RotatePiece[PPodium, 2], RotatePiece[PPodium, 3]}; PSnakeAll = {PSnake, RotatePiece[PSnake, 1], ReflectPiece[PSnake, 1], RotatePiece[ReflectPiece[PSnake, 1], 1]}; PBulkyAll = Module[{PBulkyr = ReflectPiece[PBulky, 1]}, {PBulky, RotatePiece[PBulky, 1], RotatePiece[PBulky, 2], RotatePiece[PBulky, 3], PBulkyr, RotatePiece[PBulkyr, 1], RotatePiece[PBulkyr, 2], RotatePiece[PBulkyr, 3]}]; tPieces = {PBulkyAll, PLAll, PPodiumAll, PSnakeAll, PSquareAll, PLineAll, PTriangleAll}; tPiecesNames = {"Bu", "Ll", "Po", "Sn", "Sq", "Li", "Tr"}; **Functions which place the pieces** Piece placement functions PutPiece[piece_, piecename_, grid_] := Module[{IniPt, IniPtxy, Pts, Vcheck, PtsinGrid, Pos, i, gridx}, gridx = grid; IniPt = RandomChoice[Position[gridx, 0]]; Pts = Map[IniPt + # &, RandomChoice[piece]]; PtsinGrid = gridx[[Sequence @@ #]] & /@ Pts; Vcheck = If[PtsinGrid == Table[0, Length[PtsinGrid]], "success", "failure"]; If[Vcheck == "success", Do[gridx[[Sequence @@ Pts[[i]]]] = piecename, {i, Length[Pts]}]; {"success", gridx}, {"failure", gridx}] ] AddOnePiece[gridin_, piece_, piecename_, nmax_] := Module[{cc = "failure", nn = 0, aa}, While[(cc != "success") && (nn < nmax), aa = PutPiece[piece, piecename, gridin]; cc = aa[[1]]; nn = nn + 1]; aa] **Grid definition, and plotting functions** The initial grid is a ensemble of 0, embedded in a series of 1, forming a matrix. When a piece is placed the 0's it occupies are replaced by the name of the piece General Grid Definitions TheGrid0 = Table[1, {i, -6, 6, 1}, {j, -6, 6, 1}]; GridDefine[coord_] := Module[{gridout}, gridout = TheGrid0; Do[gridout[[Sequence @@ (coord[[i]] + {7, 7}) ]] = 0, {i, Length[coord]}]; gridout] DrawPieceRectangle[piecename_, grid_, color_] := {color, Map[Rectangle[{#[[1]] - 0.5 - 7, #[[2]] - 0.5 - 7}, {#[[1]] + 0.5 - 7, #[[2]] + 0.5 - 7}, RoundingRadius -> 0.] &, Position[grid, piecename]]} mycolors = ColorData[24]; PlotGrid[grid_, plotrange_] := Graphics[{{White, Rectangle[{-6, -6}, {6, 6}]}, DrawPieceRectangle[0, grid, White], DrawPieceRectangle[1, grid, Black], DrawPieceRectangle[tPiecesNames[[#]], grid, mycolors[If[# != 6, #, # + 4]]] & /@ Range[7]}, PlotRange -> plotrange] **The final solving functions** Full solving function Get the solution, and at each step provides a plot named p, which can be dynamically visualized using a cell with Dynamic[p] SolveGrid[InitGrid_, plotrange_] := Module[{imax, nattempt, grid, i, vc}, imax = 0; nattempt = 0; While[imax < 8, grid[1] = InitGrid; i = 1; vc = "success"; While[(i < 8) && (vc == \!\(\* TagBox[ StyleBox["\"\<success\>\"", ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], FullForm]\)), {vc, grid[i + 1]} = AddOnePiece[grid[i], tPieces[[i]], tPiecesNames[[i]], 30]; p = PlotGrid[grid[i + 1], plotrange]; If[vc == "success" || i < 7, i++; imax = i, i++]]; nattempt++]; Print[nattempt]; PlotGrid[grid[8], plotrange]; grid[8]] Get ony the solution, without final plot, nor dynamical vizualisation SolveGridBare[InitGrid_] := Module[{imax, nattempt, grid, i, vc}, imax = 0; nattempt = 0; While[imax < 8, grid[1] = InitGrid; i = 1; vc = "success"; While[(i < 8) && (vc == \!\(\* TagBox[ StyleBox["\"\<success\>\"", ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], FullForm]\)), {vc, grid[i + 1]} = AddOnePiece[grid[i], tPieces[[i]], tPiecesNames[[i]], 30]; If[vc == "success" || i < 7, i++; imax = i, i++]]; nattempt++]; Print[nattempt]; grid[8]] SolveGridBare2[InitGrid_] := Module[{imax, nattempt, grid, i, vc}, imax = 0; nattempt = 0; While[imax < 8, grid[1] = InitGrid; i = 1; vc = "success"; While[(i < 8) && (vc == \!\(\* TagBox[ StyleBox["\"\<success\>\"", ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], FullForm]\)), {vc, grid[i + 1]} = AddOnePiece[grid[i], tPieces[[i]], tPiecesNames[[i]], 30]; If[vc == "success" || i < 7, i++; imax = i, i++]]; nattempt++]; {grid[8], nattempt}] **Example of use** coordQ35 = Join[Table[{i, 2}, {i, -2, 3}], Table[{i, -2}, {i, -2, 3}], Table[{i, 1}, {i, 0, 3}], Table[{i, 0}, {i, 0, 3}], Table[{i, -1}, {i, 0, 3}], Table[{-2, j}, {j, -1, 1}]]; TheGridQ35 = GridDefine[coordQ35]; SolgridQ35ex1 = SolveGridBare[TheGridQ35]; PlotGrid[SolgridQ35ex1, {{-3.5, 4.5}, {-3.5, 3.5}}] A dynamic view of the process (similar to the animations shown above) is obtained by running a cell "**Dynamic[p]**" before calling SolveGrid[TheGridQ35,{{-3.5, 4.5}, {-3.5, 3.5}}] **Pieces definition for the 3 case** (here all the possible orientations are obtained by applying randomly rotations and reflection on the initial piece) Pieces Definitions PTriangle = {{0, 0, 0}, {0, 1, 0}, {1, 0, 0}}; PSquare = {{0, 0, 0}, {0, 1, 0}, {1, 0, 0}, {1, 1, 0}}; PLine = {{0, -1, 0}, {0, 0, 0}, {0, 1, 0}}; PL = {{0, 0, 0}, {0, 1, 0}, {1, 0, 0}, {2, 0, 0}}; PPodium = {{0, 0, 0}, {0, 1, 0}, {-1, 0, 0}, {1, 0, 0}}; PSnake = {{0, 0, 0}, {0, 1, 0}, {1, 0, 0}, {-1, 1, 0}}; PBulky = {{0, 0, 0}, {1, 0, 0}, {0, 1, 0}, {1, 1, 0}, {-1, 1, 0}}; (* Rotation by angle \[Pi]/2 matrix*) Mrotz = {{0, 1, 0}, {-1, 0, 0}, {0, 0, 1}}; Mrotx = {{1, 0, 0}, {0, 0, 1}, {0, -1, 0}}; Mrotx = {{0, 0, -1}, {0, 1, 0}, {1, 0, 0}}; (* Reflection matrix *) Mrefx = {{-1, 0, 0}, {0, 1, 0}, {0, 0, 1}}; Mrefy = {{1, 0, 0}, {0, -1, 0}, {0, 0, 1}}; Mrefz = {{1, 0, 0}, {0, 1, 0}, {0, 0, -1}}; MUnit = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}; (*Operators which perform a given number of rotation, and of \ reflection*) RotatePiecex[piece_, n_] := Nest[Mrotx.# &, #, n] & /@ piece RotatePiecey[piece_, n_] := Nest[Mrotx.# &, #, n] & /@ piece RotatePiecez[piece_, n_] := Nest[Mrotz.# &, #, n] & /@ piece ReflectPiecex[piece_, n_] := If[n == 0, (MUnit.#) & /@ piece, (Mrefx.#) & /@ piece] ReflectPiecey[piece_, n_] := If[n == 0, (MUnit.#) & /@ piece, (Mrefy.#) & /@ piece] ReflectPiecez[piece_, n_] := If[n == 0, (MUnit.#) & /@ piece, (Mrefz.#) & /@ piece] Each piece with all the possible orientations MakeAllPieces[piece_] := DeleteDuplicates@ Table[Module[{Rota, Rotb, Rotc, Refa, Refb, Refc, na, nb, nc, ma, mb, mc}, Rota = RandomChoice[{RotatePiecex, RotatePiecey, RotatePiecez}]; Rotb = RandomChoice[{RotatePiecex, RotatePiecey, RotatePiecez}]; Rotc = RandomChoice[{RotatePiecex, RotatePiecey, RotatePiecez}]; Refa = RandomChoice[{ReflectPiecex, ReflectPiecey, ReflectPiecez}]; Refb = RandomChoice[{ReflectPiecex, ReflectPiecey, ReflectPiecez}]; Refc = RandomChoice[{ReflectPiecex, ReflectPiecey, ReflectPiecez}]; na = RandomInteger[{0, 3}]; nb = RandomInteger[{0, 3}]; nc = RandomInteger[{0, 3}]; ma = RandomInteger[{0, 1}]; mb = RandomInteger[{0, 1}]; mc = RandomInteger[{0, 1}]; Refc[Rotc[Refb[Rotb[ Refa[Rota[piece, na], ma], nb], mb], nc], mc]], {i, 1, 2000}] PTriangleAll = MakeAllPieces[PTriangle]; Length@PTriangleAll 24 PSquareAll = MakeAllPieces[PSquare]; Length@PSquareAll 24 PLineAll = MakeAllPieces[PLine]; Length@PLineAll 6 PLAll = MakeAllPieces[PL]; Length@PLAll 24 PPodiumAll = MakeAllPieces[PPodium]; Length@PPodiumAll 24 PSnakeAll = MakeAllPieces[PSnake]; Length@PSnakeAll 24 PBulkyAll = MakeAllPieces[PBulky]; Length@PBulkyAll 24 tPieces = {PBulkyAll, PLAll, PPodiumAll, PSnakeAll, PSquareAll, PLineAll, PTriangleAll}; tPiecesNames = {"Bu", "Ll", "Po", "Sn", "Sq", "Li", "Tr"}; **Grid definition and visualisation for the 3d case** General Grid Definitions TheGrid0 = Table[1, {i, -6, 6, 1}, {j, -6, 6, 1}, {k, -6, 6, 1}]; GridDefine[coord_] := Module[{gridout}, gridout = TheGrid0; Do[gridout[[Sequence @@ (coord[[i]] + {7, 7, 7}) ]] = 0, {i, Length[coord]}]; gridout] DrawPieceCube[piecename_, grid_, color_] := {Glow[color], Opacity[0.75], Specularity[0], EdgeForm[Thick], Map[Cuboid[{#[[1]] - 0.5 - 7, #[[2]] - 0.5 - 7, #[[3]] - 0.5 - 7}] &, Position[grid, piecename]]} mycolors = ColorData[24]; PlotGrid3D[grid_, plotrange_] := Graphics3D[{(*{White,Cuboid[{-6,-6,-6},{6,6,6}]},*) DrawPieceCube[0, grid, White],(*DrawPieceCube[1,grid,Black],*) DrawPieceCube[tPiecesNames[[#]], grid, mycolors[If[# != 6, #, # + 4]]] & /@ Range[7]}, PlotRange -> plotrange, Lighting -> None, Boxed -> False] PlotGrid3D[grid_, plotrange_, pov_] := Graphics3D[{(*{White,Cuboid[{-6,-6,-6},{6,6,6}]},*) DrawPieceCube[0, grid, White],(*DrawPieceCube[1,grid,Black],*) DrawPieceCube[tPiecesNames[[#]], grid, mycolors[If[# != 6, #, # + 4]]] & /@ Range[7]}, PlotRange -> plotrange, Lighting -> None, Boxed -> False, ViewPoint -> pov] [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=IMG_3757small.JPG&userId=867329 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=IMG_3758small.JPG&userId=867329 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=IMG_3756small.JPG&userId=867329 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=PlacePieces_Q35_anim.gif&userId=867329 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=PlacePieces_Q48_anim.gif&userId=867329 [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=solutionExample1.png&userId=867329 [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=solutionExample2.png&userId=867329 [8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=solutionHisto.jpg&userId=867329 [9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=PlacePieces_Q26_allsoluces.gif&userId=867329 Thibaut Jonckheere 2016-06-11T13:29:52Z https://community.wolfram.com/groups/-/m/t/1731686 Early in the summer of 2019, I attended the Wolfram High School Summer Camp. I worked on a project for two weeks which generates a crossword with random words that the user can solve and check. In this post, I will give a general outline of my project, then go into detail about my though process, and finally show the finished product. How it Works ========== My project is basically a grid of variables, with the variables containing strings. This may seem simple, but it isn't as easy at it looks. The tricky part is having the strings change to very specific things based on random data each time the user evaluates. This makes the words in the crossword random each time in order to truly generate new crosswords each time. ------------------------------------------------- Initial Start -------------- I started by simply trying to overlay two words, but that didn't work out well... ![enter image description here][1] After that attempt, I tried a completely different approach by using grid, variables, and then associations to make a primitive crossword with a few words in it. Grid[Join[{{Black, Black, AsNwWord[1], Black, Black, Black}}, {SmpWord}, Table[{Black, Black, AsNwWord[n], Black, Black, Black}, {n, RevAsNwWord[AsSmpWord[3]] + 1, Length[NwWord], 1}]], Frame -> All] This made the nice output of the following: ![enter code here][2] -------------------------------------------- Preparation --------------- Firstly, I filtered out all profane words, just to be safe... lotswords = Pick[WordData[], First /@ Values[ KeyTake[Classify["Profanity", WordData[], "Probabilities"], True]], p_ /; p < 0.5] Then I defined functions to make associations and character lists for all of the words in the crossword. charwordprep[Word_] := Flatten[Characters[Word]] aswordprep[Word_] := With[{wWord = Flatten[Characters[Word]]}, AssociationThread[Range[Length[wWord]], wWord]] hintwordprep[Word_] := Part[Flatten[ Part[WordData[StringDrop[StringDrop[ToString[Word], 1], -1], "Definitions"], 1]], 2] lengthwordprep[Word_] := ToString@Length[charwordprep[Word]] After that, I made variables for hints, hint helpers, and the correct solution. Then came the really fun part: I made the actual crossword. This could be done with such little code; I was amazed beyond belief! fillercross = Framed[Grid[Partition[ MapIndexed[If[#1 == 1, BlackSquare, WhiteSquares[#2[[1]]]] &, Flatten[pattern]], 10], Background -> Black], Background -> Black]; This had an output that looked like a crossword and that the user could type into which stored the data: ![enter image description here][3] I then created a variable that checked the solution that the user typed in by using a simple if statement. solvecheck = Dynamic[If[ StringReplace[ToString[input], "Null" -> " "] == StringDrop[StringDrop[ToLowerCase[ToString[correctlist]], 1], -1], Style[colorize2["This is correct!", ColorData["Rainbow"]], Bold, 140], Style["Sorry... try again...", Bold, 40]]] --------------------------------------------------- Final Input ========= After making all the variables and functions in preparation for this, I finally made the manipulate! The code follows: Framed[Manipulate[ Column[{ Style["Crossword Creator!", Bold, 50], "", "", "Please fill the generated crossword.", "You can type in the words, but make sure to click on each box and insert only one letter per box.", "Fill the crossword with words which have the following HINTS: ", "", horizhintz, "", verthintz, "", HintFirstLetters, "", HintLength, "", Wordbank, "", minicross, "", fillercross, "", SolutionChecker, "", Answers , "", Style["Thank you for playing and have a great day!" , 50, Italic]}], {HintFirstLetters, {"" -> "Hide", firstletters -> "Show"}}, {HintLength, {"" -> "Hide", hintlength -> "Show"}}, {Wordbank, {"" -> "Hide", wordbank -> "Show"}}, {Answers, {"" -> "Hide", showanswers -> "Show"}}, {SolutionChecker, {"" -> "Not Yet", solvecheck -> "Check!"}}, ImageMargins -> Large], FrameMargins -> 0] --------------------------------------------------------- The Final Output ============= Here is the project's summative output:![enter image description here][4] --------------------------------------------------------- Reflection ======== Throughout the process of the development of my project, I learned a few very valuable things. I learnt that even if one sets impossible goals, with time, one will accomplish said goals. Also, I realized that hard problems can be overcome with relatively simple solutions, it's just a matter of choosing the correct approach. I would like to thank my mentor Sylvia Haas for helping me in so many ways throughout the stressful and difficult process of making this project. https://github.com/SimeonButtery/WSS-Template [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-07-11at2.50.19PM.png&userId=1725103 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-07-11at3.07.00PM.png&userId=1725103 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-07-11at3.27.00PM.png&userId=1725103 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-07-11at4.28.52PM.png&userId=1725103 Simeon Buttery 2019-07-11T20:59:58Z https://community.wolfram.com/groups/-/m/t/2435403 ![Designing Townscaper town on computable base-grid][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=frames2.gif&userId=20103 [2]: https://www.wolframcloud.com/obj/0d953f64-4678-4d55-9d6b-17997fa2f42a Silvia Hao 2022-01-02T11:23:53Z https://community.wolfram.com/groups/-/m/t/1214169 ![enter image description here][1] Dear all, from the resemblance of a Voronoi mesh to a jigsaw puzzle I came to the idea for the following little program I want to share. The essential function is (* in: points p1, p2; out: BSplineCurve = jigsaw side if distance > minLength; *) jigsawSide[minLength_][pts : {p1_, p2_}] := Module[{m, u, o, vx, vy, n, dist, r, c, angle0, cPts}, dist = EuclideanDistance @@ pts; If[dist < minLength, Return[Line[pts]]]; (* avoid borders: *) If[Times @@ (p2 - p1) == 0, Return[Line[pts]]]; m = Mean[pts]; {u, o} = SortBy[pts, Last]; (* lower/upper point *) {vx, vy} = o - u; n = {vy, -vx}; (* normal vector *) r = .15 dist; (* radius *) c = m + n/4.; (* center *) angle0 = Sign[Last[n]] VectorAngle[{1, 0}, n]; (* points on circle: *) cPts = c + r {Cos[angle0 + #], Sin[angle0 + #]} & /@ (60 \[Degree] {-2, -1, 0, 1, 2}); Return[BSplineCurve[{u, m, Sequence @@ cPts, m, o}]] ] which connects two points with a `BSplineCurve` having the typical elementary shape of a jigsaw puzzle. If the distance is too short then the connection becomes a straight line. The same happens if the points share the same x- or y-coordinate to exclude the jigsaws borders. Here is a simple test of the function: ![enter image description here][2] Anything else is straightforward: - start with "randomized" lattice points; - from these a Voronoi mesh is created; - extract its polygons; - convert the polygon sides into the new (puzzle) shape; - build new polygons out of these sides; - apply a texture. The result is a bunch of jigsaw pieces one can play with: ![enter image description here][3] I was impressed by the consistent behavior of `Texture`. The whole (short) code is attached. Best regards -- Henrik [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=9927ezgif.com-optimize.gif&userId=11733 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=PieceSide.gif&userId=32203 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=JigsawsExample.png&userId=32203 Henrik Schachner 2017-11-04T19:25:59Z https://community.wolfram.com/groups/-/m/t/2420295 ![enter image description here][1] If we were to develop three dimensional voxel shanshui (山水) art, then we would definitely need three dimensional voxelized creator and collector stamps when processing transactions. I almost didn't say anything, but Erik Mahieu and Frederick Wu brought up ambigrams in [another recent successful team effort][2]. The purpose of this memo (at min) is to uncover a new mathematical conjecture, which occurs when creating composite ambigrams from Chinese characters in the voxelverse. Here's the scenario. An exercise involving a $3 \times 3$ matrix. 九gram = "道江湖金水木山自然"; dat = Rasterize[#] & /@ Characters[九gram]; RastToBitmap[im_, trim_] := With[{ rect = Map[Mod[Mean[#] + 1, 2] &, Round[ImageData[im]], {2}]}, Map[Join[{0, 0, 0}, #, {0, 0, 0}] &, rect][[1 + trim ;; -1 - trim, 1 + trim ;; -1 - trim]]] bitmaps = RastToBitmap[#, 2] & /@ dat; bitmapIms = Image[Mod[# + 1, 2]] & /@ bitmaps; Partition[bitmapIms, 3] // Grid ![nine gram][3] The mission objective that shows up on the teleprompter is to encipher this matrix into the form of $8$ & an extra perfectly decodable voxel ambigrams. The problem (as mentioned by Fredrick) is that the symbols are too high genus for monotonic data to suffice. Here's the solution I came up with, using the chosen topology of rows + columns + diagonals + knight moves from Square $1$. The lexicon is over three symbols $\{R,G,B\}$ plus another for clear space. After encoding, we can check partial projections: Partials[gram1_, gram2_, gram3_] := With[{ dat123 = Position[Outer[ gram1[[#1, #2]] gram2[[#2, #3]] gram3[[#3, #1]] & , Range[14], Range[14], Range[14], 1], 1]}, MapIndexed[Function[{grams, ind}, Complement[RotateRight[#, ind] & /@ Position[ Outer[grams[[1, #1, #2]] grams[[2, #2, #3]] & , Range[14], Range[14], Range[14], 1], 1], dat123] ][#1, #2[[1]] - 1] &, Partition[{gram1, gram2, gram3}, 2, 1, 1]]] imDat[partials_] := Outer[Image[ReplacePart[ Table[1, {i, 1, 14}, {j, 1, 14}], # -> 0 & /@ #1[[All, #2]]]] &, partials[[{2, 3, 1}]], {{1, 2}, {2, 3}, {3, 1}}, 1] rowDat = Partition[bitmaps, 3]; colDat = Transpose[Partition[bitmaps, 3]]; xDat = {bitmaps[[{1, 5, 9}]], bitmaps[[{3, 5, 7}]], bitmaps[[{1, 6, 8}]]}; rows = Map[imDat[Partials[Sequence @@ #]] &, rowDat]; cols = Map[imDat[Partials[Sequence @@ #]] &, colDat]; diags = Map[imDat[Partials[Sequence @@ #]] &, xDat]; TableForm /@ rows TableForm /@ cols TableForm /@ diags ![partials][4] These matrices in themselves have some interesting structure and are worth more detailed analysis, but for now, we need only one superposition function Superpose[mat_] := Map[ImageMultiply@mat[[Complement[Range[3], {#}], #]] &, Range[3]] TableForm[Superpose /@ #] & /@ {rows, cols, diags} ![valid outs][5] These look correct, but for sake of rigor ++ QA + MapThread[ImageSubtract[#1, #2] &, {Flatten[Superpose /@ rows], bitmapIms}] MapThread[ImageSubtract[#1, #2] &, {Flatten[Superpose /@ cols], Flatten[Transpose[Partition[bitmapIms, 3]]]}] MapThread[ImageSubtract[#1, #2] &, {Flatten[Superpose /@ diags], bitmapIms[[{1, 5, 9, 3, 5, 7, 1, 6, 8}]]}] ![blackbox1][6] ![blackbox2][7] ![blackbox3][8] These $9 \times 3$ black boxes mean proof complete, and it may even be possible to recover the secret extra data "knight's move" by comparing regular first two prints, with odd third (proof unknown). More importantly, since this experiment was successful on 9 varied attempts, we have a new mission objective to prove the conjecture that the same process produces perfectly decodable data for any possible bitmap input. We can also formulate another similar conjecture for fully layered projections. Using the following functions, we obtain [new results in three colors][9]: Ambigram[TriadData_] := With[ {partials = Partials[Sequence @@ #] &@TriadData}, Graphics3D[ Transpose[{{Blue, Red, Green}, Map[Cuboid, partials, {2}]}]]] OrthoProj[Ambigram_] := GraphicsGrid[ Transpose[Partition[MapThread[Show[Ambigram, Boxed -> False, ViewProjection -> "Orthographic", ViewPoint -> #1, ViewVertical -> #2] &, {{{0, 0, 1}, {0, 0, -1}, {1, 0, 0}, {-1, 0, 0}, {0, 1, 0}, {0, -1, 0}}, {{-1, 0, 0}, {-1, 0, 0}, {0, -1, 0}, {0, -1, 0}, {0, 0, -1}, {0, 0, -1}}}], 2]]] RGBResults[TriadData_] := With[{amb = Ambigram[TriadData]}, GraphicsRow[Show[#, ImageSize -> 400] & /@ { Show[amb, ViewProjection -> "Orthographic", ViewPoint -> {1, 1, 1}, Boxed -> False], OrthoProj[amb]}]] ![amb1][10] ![amb2][11] ![amb3][12] ![amb4][13] ![amb5][14] ![amb6][15] ![amb7][16] ![amb8][17] ![amb9][18] Face first projections appear to be correct, but is this always the case? Does correctness of Black and White projections imply correctness of RGB projections? These questions must be answered, and theorems proven before we can even begin to think about making voxel NFTs for certain choices of three ASCII characters (or about 玄学X). [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=AmbAnim.gif&userId=234448 [2]: https://community.wolfram.com/groups/-/m/t/2419704 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=NineGram.png&userId=234448 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=PartialsOut.png&userId=234448 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ValidOuts.png&userId=234448 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=BlackBox.png&userId=234448 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=BlackBox.png&userId=234448 [8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=BlackBox.png&userId=234448 [9]: https://github.com/bradklee/OpenAssets/tree/main/Ambigrams [10]: https://community.wolfram.com//c/portal/getImageAttachment?filename=amb1.png&userId=234448 [11]: https://community.wolfram.com//c/portal/getImageAttachment?filename=amb2.png&userId=234448 [12]: https://community.wolfram.com//c/portal/getImageAttachment?filename=amb3.png&userId=234448 [13]: https://community.wolfram.com//c/portal/getImageAttachment?filename=amb4.png&userId=234448 [14]: https://community.wolfram.com//c/portal/getImageAttachment?filename=amb5.png&userId=234448 [15]: https://community.wolfram.com//c/portal/getImageAttachment?filename=amb6.png&userId=234448 [16]: https://community.wolfram.com//c/portal/getImageAttachment?filename=amb7.png&userId=234448 [17]: https://community.wolfram.com//c/portal/getImageAttachment?filename=amb8.png&userId=234448 [18]: https://community.wolfram.com//c/portal/getImageAttachment?filename=amb9.png&userId=234448 Brad Klee 2021-12-07T21:44:48Z https://community.wolfram.com/groups/-/m/t/1032663 Teaching programing and assessing learning progress is often a very custom task. I wanted to create a completely automated "practically" infinite stream of random puzzles that guide a leaner towards improving programing skills. I think the major problem is content creation. To test whether the learner knows a programming concept, an exercise needs to be wisely designed. And it is better to have a randomized set of such exercises to definitely test the knowledge and exclude guesses and cheating and so on. Often creating such educational materials is very tedious, time consuming, and manual. Exactly like creating good documentation. I will explain one simple idea of using docs to make an educational game. This is just a barebone prototype to clearly follow the inner workings (try it out & share: https://wolfr.am/bughunter ). Please comment with feedback on how we can develop this idea further. [![enter image description here][1]][3] # Introduction: efficient use of resources The docs are the finest wealth and depth of information and should be explored beyond their regular usage. Manual painstaking time consuming effort of creating good programing documentation should be used to its fullest potential. An automated game play would be a novel take on docs. We can use existing code examples in docs to randomly pull pieces of code and make programing exercises automatically. Being able to read code and find bugs is, in my experience, one of the most enlightening practices. The goal of the linked above game is to find a defect of the input code (bug) and fix it. Hence, the "bug hunter". There are just 2 possible outcomes of a single game cycle, --- and after each you can "try again": ![enter image description here][4] # Core game code: making puzzles Wolfram Language (WL) documentation is one of the best I've seen. It has pages and pages of examples starting from simple ones and going though the all details of the usage. Moreover the docs are written in WL itself and furthermore, WL can access docs and even has internal self-knowledge of its structure via WolframLanguageData. For instance, this is how you can show a relationship community graph for symbols related to `GatherBy`: WolframLanguageData["GatherBy", "RelationshipCommunityGraph"] ![enter image description here][5] We can use `WolframLanguageData` to access docs examples and then drop some parts of the code. The puzzle is then for the learner to find what is missing. For the sake of clarity designing a small working prototype lets limit test WL functions and corresponding docs' pages to some small number. So out of ~5000 (and we [just released a new addition][6]): WolframLanguageData[] // Length `4838` built in symbols I just take 30 functions = {"Append", "Apply", "Array", "Cases", "Delete", "DeleteCases", "Drop", "Except", "Flatten", "FlattenAt", "Fold", "Inner", "Insert", "Join", "ListConvolve", "Map", "MapThread", "Nest", "Outer", "Partition", "Prepend", "ReplacePart", "Reverse", "RotateLeft", "RotateRight", "Select", "Sort", "Split", "Thread", "Transpose"}; functions // Length 30 that are listed on a [very old but neat animated page][7] of some essential core-language collection. I will also add some "sugar syntax" to potential removable parts of code: sugar = {"@@", "@", "/@", "@@@", "#", "^", "&"}; So, for instance, out of the following [example in docs][8] we could remove a small part to make a puzzle: ![enter image description here][9] Here is an example of "sugar syntax" removal, which for novice programmers would be harder to solve: ![enter image description here][10] Next step is to define a function that can check if a string is a built-in symbol (function, all 5000) or if it is some of sugar syntax we defined above: ClearAll[ExampleHeads]; ExampleHeads[e_]:= Select[ Cases[e,_String, Infinity], (NameQ["System`"<>#]||MemberQ[sugar,#])&&#=!="Input"& ] Next function essentially makes a single quiz question. First it randomly picks a function from list of 30 symbols we defined. Then it goes to the doc page of that symbol to the section called "Basic Examples". It finds a random example and removes a random part out of it: ranquiz[]:=Module[ {ranfun=RandomChoice[functions],ranexa,ranhead}, ranexa=RandomChoice[WolframLanguageData[ranfun,"DocumentationBasicExamples"]][[-2;;-1]]; ranhead=RandomChoice[ExampleHeads[ranexa[[1]]]]; { ReplacePart[#,Position[#,ranhead]->""]&@ranexa[[1]], ranexa[[2]], ranhead, ranfun } ] Now we will define a few simple variables and tools. # Image variables I keep marveling how convenient it is that Mathematica front end can make images to be part of code. This makes notebooks a great IDE: ![enter image description here][11] # Databin for tracking stats It is important to have statistics of your learning game: to understand how to improve it where the education process should go. [Wolfram Datadrop][12] is an amazing tool for these purposes. [![enter image description here][13]][14] We define the databin as bin = CreateDatabin[<|"Name" -> "BugHunter"|>] # Deploy game to the web To make an actual application usable by everyone with internet access I will use [Wolfram Development Platform][15] and [Wolfram Cloud][16]. First I define a function that will build the "result of the game" web page. It will check is answer is wrong or right and give differently designed pages accordingly. quiz[answer_String,check_String,fun_String]:= ( DatabinAdd[Databin["kd3hO19q"],{answer,check,fun}]; Grid[{ {If[answer===check, Grid[{{Style["Right! You got the bug!",40,Darker@Red,FontFamily->"Chalkduster"]},{First[imgs]}}], Grid[{{Style["Wrong! The bug got you!",40,Darker@Red,FontFamily->"Chalkduster"]},{Last[imgs]}}] ]}, {Row[ {Hyperlink["Try again","https://www.wolframcloud.com/objects/user-3c5d3268-040e-45d5-8ac1-25476e7870da/bughunter"], "|", hyperlink["Documentation","http://reference.wolfram.com/language/ref/"<>fun<>".html"], "|", hyperlink["Fun hint","http://reference.wolfram.com/legacy/flash/animations/"<>fun<>".html"]}, Spacer[10] ]}, {Style["===================================================="]}, {hyperlink["An Elementary Introduction to the Wolfram Language","https://www.wolfram.com/language/elementary-introduction"]}, {hyperlink["Fast introduction for programmers","http://www.wolfram.com/language/fast-introduction-for-programmers/en"]}, {logo} }] ) This function is used inside `CloudDeploy[...FormFunction[...]...]` construct to actually deploy the application. `FormFunction` builds a query form, a web user interface to formulate a question and to get user's answer. Note for random variables to function properly `Delayed` is used as a wrapper for `FormFunction`. CloudDeploy[Delayed[ quizloc=ranquiz[]; FormFunction[ {{"code",None} -> "String", {"x",None}-><| "Input"->StringRiffle[quizloc[[3;;4]],","], "Interpreter"->DelimitedSequence["String"], "Control"->Function[Annotation[InputField[##],{"class"->"sr-only"},"HTMLAttrs"]]|>}, quiz[#code,#x[[1]],#x[[2]]]&, AppearanceRules-> <| "Title" -> Grid[{{title}},Alignment->Center], "MetaTitle"->"BUG HUNTER", "Description"-> Grid[{ {Style["Type the missing part of input code",15, Darker@Red,FontFamily->"Ayuthaya"]}, {Rasterize@Grid[{ {"In[1]:=",quizloc[[1]]}, {"Out[1]=",quizloc[[2]]}},Alignment->Left]} }] |>]], "bughunter", Permissions->"Public" ] The result of the deployment is a cloud object at a URL: CloudObject[https://www.wolframcloud.com/objects/user-3c5d3268-040e-45d5-8ac1-25476e7870da/bughunter] with the short version: URLShorten["https://www.wolframcloud.com/objects/user-3c5d3268-040e-45d5-8ac1-25476e7870da/bughunter", "bughunter"] https://wolfr.am/bughunter And we are done! You can go at the above URL and play. # Further thoughts Here are some key points and further thoughts. ## Advantages: - Automation of content: NO new manual resource development, use existing code bases. - Automation of testing: NO manual labor of grading. - Quality of testing: NO multiple choice, NO guessing. - Quality of grading: almost 100% exact detection of mistakes and correct solutions. - Fight cheating: clear to identify question type "find missing code part" helps to ban help from friendly forums (such as this one). - Almost infinite variability of examples if whole docs system is engaged. - High range from very easy to very hard examples (exclusion of multiple functions and syntax can make this really hard). ## Improvements: - Flexible scoring system based on function usage frequencies. - Optional placeholder as hint where the code is missing. - Using network of related functions (see above) to move smoothly through the topical domains. - Using functions frequency to feed easier or harder exercises based on test progress. ***Please comment with your own thoughts and games and code!*** [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-03-17at10.37.46AM.png&userId=11733 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-03-16at6.49.58PM.png&userId=11733 [3]: https://www.wolframcloud.com/objects/user-3c5d3268-040e-45d5-8ac1-25476e7870da/bughunter [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-03-16at6.58.45PM.png&userId=11733 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=sgfq354ythwrgsf.png&userId=11733 [6]: http://blog.wolfram.com/2017/03/16/the-rd-pipeline-continues-launching-version-11-1/ [7]: http://reference.wolfram.com/legacy/flash/ [8]: http://reference.wolfram.com/language/ref/Except.html [9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-03-16at7.21.05PM.png&userId=11733 [10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-03-16at7.25.52PM.png&userId=11733 [11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-03-16at7.34.59PM.png&userId=11733 [12]: https://datadrop.wolframcloud.com/ [13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-03-16at7.41.35PM.png&userId=11733 [14]: https://datadrop.wolframcloud.com/ [15]: https://www.wolfram.com/development-platform/ [16]: http://www.wolfram.com/cloud/ Vitaliy Kaurov 2017-03-17T01:13:24Z https://community.wolfram.com/groups/-/m/t/307516 Knowing that it is horizontal and vertical sums, find the value of each fruit, you can actually do this?, as you would do because I give a long code and I think to do some shorter way, greetings to all ![enter image description here][1] [1]: /c/portal/getImageAttachment?filename=Pantallazo-3.png&userId=133435 Luis Ledesma 2014-07-29T23:50:31Z https://community.wolfram.com/groups/-/m/t/2983903 ![enter image description here][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=SudokuBlog-heroimage.png&userId=2028758 [2]: https://www.wolframcloud.com/obj/b9ea0b6a-1200-4c69-bd69-1e27edaa0a1b Alejandra Ortiz Duran 2023-08-04T23:54:58Z https://community.wolfram.com/groups/-/m/t/2552665 In [recent investigations of multiway games][1], we generated more content than was really necessary to get the point across. In addition to [RandomSierpinskiMaze][2] (the subject of [another post][3]) the list of omissions also includes a few insightful results about the [Project L board game][4]. The purpose of this memo is to pose a problem about polyomino tilings in which summer school students have a chance of joining our efforts by reproducing our findings. If verifying reproducibility is not enough for the terribly ambitious, there is also chance for innovation and originality. My personal solution of the following problem did not use an optimal time algorithm, and more comprehensive analysis remains to be done if we can improve efficiency of our methodology. From a mathematical viewpoint the board game "Project L" simply asks players to solve exact cover problems given limited resources and time constraints. It is an "engine building" game in the sense that, as time progresses, players build up a collection of tiles, which are used as resources for completing puzzles. So let's start there, with a complete depiction of all available resources, the polyomino pieces which are used to solve tiling puzzles: ![project L pieces ][5] What we see here is a particularly nice, almost-symmetrical tiling comprised of yellow monominos, green dominos, orange and blue trominos, and five colors of tetrominos (yes, the tetris pieces). No one player ever has control over all pieces, so such an aggregation could never be created in game. In fact, the rules state that each player starts with one yellow monomino and one green domino, and it takes time and puzzles solved to build up a larger hand of tiles (probably not exceeding 20 pieces). Just to give you readers an idea how small and relatively easy the puzzles are, here is a sample of five taken from the entire set of 52 (digitized by yours truly): ![puzzles][6] When a player solves such a puzzle by filling it in with polyomino pieces, they are awarded a new polyomino for their collection (top right) and possibly points toward their total score (top left). At the end of the game the player with the highest score wins (but the winning player can also be expected to have collected a pretty nice and diverse protfolio of tiles). If you look closely, each puzzle is characterized by three weight metrics: The number of points awarded in the top left corner, the grid size (or weight) of the polyomino reward piece, and the total "cost" to solve the puzzle, which is counted by the grid size of the recessed, white, inner regions. There is definitely a cost ~= reward balance in each of these puzzles, which we will return to shortly. Now before going any farther into game mechanics, let's talk about classical mechanics. When someone gives you a finite, spendable resource, the first physical quantity you should think of is *energy*. Indeed, during the game, tiles are a form of energy, which are spent toward completing patterns at variable rates of *power*. When considering points taken per turn, and gauging against power, it also becomes possible to define *efficiency*. Luck aside, we generally assume that the most efficient players are the ones who should win the engine building games. Now, let us get to the games basic per turn mechanic. Each player's turn consists of three consecutive actions, which are chosen from a list of energy-rated alternatives: 0. A puzzle is drawn from the bank at no cost. 1. A tile of weight N is played into a puzzle. 2. A tile of weight 1 is drawn from the bank. 3. A tile of weight N is traded to the bank for another of max weight N+1. 4. Multiple tiles of total weight X can be played into consecutive puzzles. The fourth alternative is the odd one out, and may only be used once per turn. Since total weight is a summation of up to four individual tile weights (players can have at max four puzzles on board), the play of X per one time interval is usually the player's maximum power action. If used properly, "master actions" should lead to advantageous gains. But dominant play also requires one to know which are the best pieces to have in hand, and which are the best puzzles to have on board. Now for some insight toward winning the game, let's define efficiency with regard to gaining points. Assume that every point value P is in fact an expected time T = P to completion. The weight W of the interior puzzle can be considered an energy E = W, such that the nominal power rating of a puzzle is E / T = W / P. Now let's call the actual time to completion T' and the actual completion power W / T', such that the efficiency of solving is simply P / T'. In this definition, efficiency can also be thought of as a scale factor: actual completion power = efficiency * nominal completion power [W/T' = (P/T')*W/P ]. According to my comprehensive data analysis, most puzzles in the game are balanced such that P / T' is less than or equal to one. However, all 5-point puzzles (and a few more at 3, 4 points) allow that P / T' can be greater than one. Quite obviously, such puzzles are desirable to have on board during the end game when "engine building" is no longer as important as "engine spending". So finally, we're done with a practical, real-life example set up, and we are motivated to find out all the possible ways that five point puzzles from Project L can be solved with a relative efficiency greater than one. Here they are, the particular five point puzzles: ![enter image description here][7] rawData={{{1, 0, 0, 1, 1}, {1, 0, 0, 0, 0}, {1, 0, 0, 0, 0}, {0, 0, 0, 0, 1}, {1, 1, 0, 0, 1}}, {{0, 0, 0, 0, 1}, {0, 0, 0, 0, 1}, {1, 0, 0, 0, 0}, {1, 0, 0, 0, 0}, {1, 1, 1, 1, 1}}, {{1, 0, 0, 0, 1}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {1, 0, 0, 0, 1}, {1, 1, 1, 1, 1}}, {{0, 0, 0, 0, 1}, {1, 0, 0, 0, 0}, {1, 0, 0, 0, 0}, {0, 0, 0, 0, 1}, {1, 1, 1, 1, 1}}, {{0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {1, 1, 0, 1, 1}, {1, 1, 1, 1, 1}}}; But the challenge is not only to solve these puzzles in all possible ways (assuming maximum efficiency), but also to give a quantitative comparison of the most useful tetrominos when attempting to do so! Which tetromino is most useful in the end game of Project L? HINT: it is possible to modify [MultiwayDeletionsGraph][8] to solve this problem (what I did), but it would probably be faster to implement D. Knuth's [Dancing Links][9]. Extra Credit: If it is possible to implement DLX, what is the graph structure on which the DLX backtracker operates? [1]: https://writings.stephenwolfram.com/2022/06/games-and-puzzles-as-multicomputational-systems/ [2]: https://resources.wolframcloud.com/FunctionRepository/resources/RandomSierpinskiMaze/ [3]: https://community.wolfram.com/groups/-/m/t/2506196 [4]: https://www.youtube.com/watch?v=nCOJigSozSE [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=peices.png&userId=234448 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=puzzles.png&userId=234448 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=fivepointers.png&userId=234448 [8]: https://resources.wolframcloud.com/FunctionRepository/resources/MultiwayDeletionsGraph/ [9]: https://arxiv.org/abs/cs/0011047 Brad Klee 2022-06-18T02:18:56Z https://community.wolfram.com/groups/-/m/t/2417276 ![Graphics3D with anchored rotation axis][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ViewPoint.gif&userId=93201 [2]: https://www.wolframcloud.com/obj/586d1953-bb18-4697-aa0a-6fe757a33fa3 [Original NB]: https://www.wolframcloud.com/obj/a3f6b88f-6f46-4015-b64d-9b824b36ee10 Silvia Hao 2021-12-01T19:32:46Z https://community.wolfram.com/groups/-/m/t/2164714 ![enter image description here][1] I'm sure there have been many proposals on how to do this. I gave it a try, and after a few painful attempts I came up with a visually decent result, without too much code (IMHO). Also I really wanted to use unicode symbols, not drawing of pieces found on the web. &[chess.nb][2] TODO: - Avoid using a hard-coded font size ; - White pieces should not look "transparent" on a dark square. [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2021-01-20at11.26.07AM.jpg&userId=11733 [2]: https://www.wolframcloud.com/obj/d1a7c97f-e00d-4519-ac7c-7d953f8c96aa Lucien Grondin 2021-01-16T13:12:04Z https://community.wolfram.com/groups/-/m/t/596537 Every year our family makes costumes, and this time we are making "the world" and an "oak tree". Does anyone have any ideas for doing these in Wolfram Language? Maybe for the world, I am thinking of projecting the map of the world onto two halves of an icosahedron. One half attached to the front of a shirt and the other half attached to the back. I am close on this part, but maybe it has become too complicated. Something Is wrong here, and this approach also involves more cutting and taping than I would prefer. ToMapCoordinates[v_] := N[ToPolarCoordinates[v][[{3, 2}]]/Degree] verts = Map[ToMapCoordinates, PolyhedronData["Icosahedron", "VertexCoordinates"]]; GeoTriangle[{a_, b_, c_}] := GeoGraphics[Polygon[{a, b, c}]] GeoTriangle[verts[[#]]] & /@ PolyhedronData["Icosahedron", "FaceIndices"] For the oak tree, I was trying to make oak leaves and acorns using PolarPlot. Does anyone have an Oak leaf? Here is my attempt at an acorn. PolarPlot[1.4 - CubeRoot[1 + Sin[x]], {x, 0, 2 Pi}] ![acorn][1] [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=acorn-fruit-image.jpg&userId=23275 Todd Rowland 2015-10-24T14:51:08Z https://community.wolfram.com/groups/-/m/t/1380021 ![Cover][1] ## Goal ## There are many ways to generate music and one of them is algorithmic, where music is generated with the help of a list of handcrafted rules. The approach in this project is different - I build a neural network that knows nothing about music but learns it from thousands of songs given in MIDI format. _Apart from just generating a meaningful sequence of notes I also wanted to add **dynamics** in loudness and humanlike mistakes in timing with **no restrictions for note durations**._ - **Why dynamics and timing?** There is no human who is able to play on a musical instrument with precisely the same loudness and strictly in time with a metronome(at least I can't). People do mistakes, but in the case of music, they are helping in creating what we call more alive music. It is a fact that dynamic music with slight time shifts sounds more interesting, so even when you write music in a program you supposed to add these "mistakes" by yourself. - **Why performances?** The dataset that I use for the project contains performances of [Yamaha e-piano competition][2] participants. This gives us a possibility to learn the dynamics and mistakes in timings. __Here's an [example][3] generated by the model.__ All the code, data and trained models can be found on [GitHub][32]. The examples will be attached to this post as files just in case. ---------- ## Inspiration ## This is not an original work and mostly it's an attempt to recreate the work of [Magenta][4] team from their blog [post][5]. Nevertheless, in this post, I will try to add more details to the **preprocessing** steps and how you can build a similar neural network model in Wolfram Language. ## Data ## I've used a [site][6] that has the Yamaha e-piano performances but also contains a set of classic and jazz compositions. In the original [work][7] Magenta team has used only the Yamaha dataset but with a heavy augmentation on top of that: Time-stretching (making each performance up to 5% faster or slower), Transposition (raising or lowering the pitch of each performance by up to a major third). Also, you can create your own list of MIDI files and build a dataset with the help of the code provided below in the post. Here are links to find a lot of free MIDI songs: [The Lakh MIDI Dataset][8](very well prepared a dataset for ML projects), [MidiWorld][9] and [FreeMidi][10] ## MIDI ## MIDI is short for Musical Instrument Digital Interface. It’s a language that allows computers, musical instruments, and other hardware to communicate. MIDI carries event messages that specify musical notation, pitch, velocity, vibrato, panning, and clock signals (which set tempo). _For the project, we need only events that denote where is every note starts/ends and with what are velocity and pitch._ ## Preprocessing The Data ## Even though MIDI is already a digital representation of music, we can't just take raw bytes of a file and feed it to an ML model as in the case of the models working with images. First of all, images and music are conceptually different tasks: the first is a single event(data) per item(an image), the second is a sequence of events per item(a song). Another reason is that raw MIDI representation and a single MIDI event itself contain a lot of irrelevant information to our task. Thus we need a special data representation, a MIDI-like stream of musical events. Specifically, I use the following set of events: - 88 **note-on** events, one for each of the 88 MIDI pitches of piano range. These events start a new note. - 88 **note-off** events, one for each of the 88 MIDI pitches of piano range. These events release a note. - 100 **time-shift** events in increments of 10 ms up to 1 second. These events move forward in time to the next note event. - 34 **velocity** events, corresponding to MIDI velocities quantized into 32 bins. These events change the velocity applied to subsequent notes. The neural network operates on a one-hot encoding over these 310 different events. This is the very same representation as in the original work but the number of note-on/note-off is fewer, I encode 88 notes in piano range instead of 127 notes in MIDI pitch range to reduce one-hot encoding vector size and make the process of learning easier. **For example**, if you want to encode 4 notes from C major with durations of a half second and with different velocities your sequence of events would be somewhat like this(for clarity I use only indices instead of the whole one-hot encoding): `{288, 60, 226, 148, 277, 62, 226, 150, 300, 64, 226, 152, 310, 67, 226, 155}` ![Preprocessing encoding C major example][11] In this particular example: - _60, 62, 64, 67_ are **note on** events(C5, D5, E5, G5). Values in a range from 1 to 88. - _148, 150, 152, 155_ are **note off** events. Values in a range from 89 to 176. - _226_ is a half second **time shift** event. Values in a range from 177 = 10 ms to 276 = 1 sec. - _288, 277, 300, 310_ are **velocity** events. Values in a range from 277 to 310. In this way, you can encode music that is expressive in dynamics and timing. Now, let's take a look on another example with a chord from the same notes but with different durations: `{300, 60, 62, 64, 67, 226, 152, 155, 226, 150, 226, 148}` ![C major chord][12] As you can see, if you want to play more than one note at once you just need to put them in a single bunch of note-on events(60, 62, 64, 67). Then you add time shift and note-off events as you needed. If you need a duration longer than 1 sec you can stack together more than one time-shift events({310, 310} = 2 sec time-shift). **WL and MIDI** Wolfram Language has a **built-in** support of MIDI files what is really simplifying initial work. To get data from MIDI file you need to import it with specific elements: ![WL MIDI Import Elements][13] In the code below I also extract and calculate needed information related to a tempo of a song. {raw, header} = Import[path, #]& /@ {"RawData", "Header"}; tempos = Cases[Flatten[raw], HoldPattern["SetTempo" -> tempo_] :> tempo]; microsecondsPerBeat = If[Length@tempos > 0, First[tempos], 500000]; (* If there is no explicit tempo we use default 120 bpm *) timeDivision = First@Cases[header, HoldPattern["TimeDivision" -> division_] :> division]; (* Convert timeDivision value to base of 2 *) timeDivisionBits = IntegerDigits[timeDivision, 2]; (* Pad zeros at the beginning if the value takes less then 16 bits *) timeDivisionBits = If[Length@timeDivisionBits < 16, PadLeft[timeDivisionBits, 16], timeDivisionBits]; (* The top bit responsible for the type of TimeDivision *) timeDivisionType = timeDivisionBits[[1]]; framesPerSecond = timeDivisionBits[[2 ;; 8]]; ticksPerFrame = timeDivisionBits[[9 ;; 16]]; ticksPerBeat = If[timeDivisionType == 0, timeDivision, 10^6 /(framesPerSecond * ticksPerFrame)]; secondsPerTick = (microsecondsPerBeat / ticksPerBeat) * 10^-6.; An example of raw data and header info from MIDI file in Wolfram Language: ![Raw MIDI output][14] **SetTempo** is a number of microseconds per beat(microseconds per quarter note). **Time Division** has two type of interpreting. If the top bit is 0 then the type is "ticks per beat" (or “pulses per quarter note”) otherwise, the type is "frames per second". We need those two values to calculate time per one **MIDI tick** that used in MIDI events as a time measurement. One MIDI event in WL representation looks like this `{56, {9, 0}, {46, 83}}` - 56 is a number of **MIDI ticks** that means the total amount of time that must pass from the previous MIDI event. It represents our **time-shift** event by simple multiplication of this number with **secondsPerTick**. - 9 is a status byte of MIDI events(9,8 are **note-on**, **note-off** respectively). - 0 is MIDI channel(irrelevant for us). - 46 indicates what is a pitch of this note(related to **note-on**/**note-off** events). - 83 is a number we encode in a **velocity** event. If you want to understand how a real raw MIDI data structured, this [blog][15] is specifically useful. Now, what we need is to parse a sequence of MIDI events and filter them only for events that are **note-on**, **note-off** and all the events that have the number of **MIDI ticks** greater than 0. Some of the meta-messages have irrelevant MIDI ticks thus we need to exclude them from final sequence - we just skip the events with value **F**(Meta message) in the MIDI status byte. After filtering MIDI data you get a sequence that is ready to be encoded to the final representation and will be fed to the model. ![Filtered MIDI events][16] To encode the sequence of MIDI events to the final representation I use the code below: EncodeMidi[track_, secondsPerTick_] := Block[{lastVelocity = 0}, ClearAll[list]; Flatten[ Map[ Block[{list = {}}, (* Add time shifts when needed *) If[TimeShiftByte[#, secondsPerTick] > 0, list = Join[list, EncodeTimeShift[TimeShiftByte[#, secondsPerTick]]]]; (* Proceed with logic only if it's a note event *) If[StatusByte[#] == NoteOnByte || StatusByte[#] == NoteOffByte, (* Add velocity if it's different from the last seen *) If[lastVelocity != QuantizedVelocity[VelocityByte[#]] && StatusByte[#] == NoteOnByte, lastVelocity = QuantizedVelocity[VelocityByte[#]]; list = Join[list, List[EncodeVelocity[VelocityByte[#]]]]; ]; (* Add note event *) list = Join[list, List[EncodeNote[NoteByte[#], StatusByte[#] == NoteOnByte]]]; ]; (* Return encoded list*) list ]&, track] , 1]]; This code has a lot of functions that I've written during the summer school but they are mostly utility short functions. You can check them and complete implementation on [GitHub][17]. When the code for the preprocessing is ready it's time to build a dataset. **Building Dataset** I've made a [notebook][18] that takes care of preprocessing of MIDI files and encode them into the final representation. (* Take all files names in Midi folder *) files = FileNames["*", NotebookDirectory[] <> "Midi"]; dataset = Flatten[EncodeTrack /@ files, 1]; During the encoding, each track is partitioning into smaller segments: encodings = Partition[EncodeMidi[GetMidiEvents[raw, secondsPerTick], secondsPerTick], 500]; In the original work, Magenta team split each song into 30-second segments to keep each example of manageable size. The problem is that partition by equal time doesn't give you the equal size of examples. Even though you can use varying input size in sequence models I wanted to use a static size of examples to speed up the training process. I was told that internally in WL(or maybe everywhere) it's more efficient to have the same size of every example for a model. However, I believe this kind of partition has a drawback, in a way that an equal number of encoded events could have a different duration in time thus adding inconsistency in the dataset. In my case, I've divided each song into segments of 500 encoded events. ![One Song Final Encoding][19] To reduce the size of the final dataset I use only indices for one-hot encodings. As the result, the final dimension of my dataset was **{99285, 500}** If you want to try partition by the time you need to edit `EncodeTrack` function in [`Midi.m`][20]. With this code, you will find positions of where to split a sequence on equal time segments: GetTimePositions[track_, seconds_, secondsPerTick_] := Block[{positions = {}, time = 0}, Do[ time = time + track[[i]][[1]] * secondsPerTick; If[time > seconds, positions = Append[positions, i]; time = 0;], {i, Length@track}]; positions ] Where parameter `track` is a sequence of MIDI events. Then you split the same `track` with the positions you've got from the function. segments = FoldPairList[TakeDrop, track, positions]; After that, you need to encode `segments` with the help of `EncodeMidi` function. If you do that there is one thing left - rework the model to accept varying input size but the next part will cover how to build a model with a static size of example. ---------- ## Building a Model ## Because music data is a sequence of events we need an architecture that knows how to remember, and predicts what is the next event based on all previous. This is exactly what Recurrent Neural Networks try to do - RNNs can use their internal state (memory) to process sequences of inputs. If you want to check more details I would recommend to watch this [introduction][21] video. On the abstract level, RNN learns the probabilities of events that follow after each other. Take for example this language model from Wolfram Neural Repository, it predicts the next character of a given sequence. NetModel["Wolfram English Character-Level Language Model V1"]["hello worl"] The output is **d**. You can get top 5 probabilities if you want. NetModel["Wolfram English Character-Level Language Model V1"]["hello worl", {"TopProbabilities", 5}] You will get: {"d" -> 0.980898, "e" -> 0.00808785, "h" -> 0.0045687, " " -> 0.00143807, "l" -> 0.000681855} In my work, I needed similar behavior but instead of characters, I wanted to predict encoded MIDI events. That is why the basis of the model I build is [Wolfram English Character-Level Language Model V1][22]. Also, after reading a [guide][23] about sequence learning with neural networks in WL I've decided to improve the training process with "teacher forcing" technique. **Teacher Forcing** In a simple language model, a model takes the last prediction from an input sequence and compute the class of it. But for "teacher forcing" we need to get classes of all predictions. ![Model comparison][24] Comparatively to the language model I've removed one `GatedReccurentLayer` and `Dropoutlayer` due to the not so big dataset(as precautions to avoid overfitting). Another benefit of using "teacher forcing" is that you don't need to separately create labels for every example. To compute the loss we make out of an input example two sequences: 1. Everything but the **last** element(Sequence**Most**Layer) 2. Everything but the **first** element(Sequence**Rest**Layer) ![Teacher Forcing Net][25] As you can notice the input is only one vector of indices with size 500 and labels for computing the loss are generating inside of a `NetGraph`. Here is a visualized example of the flow with simple input: ![Input flow explanation][26] You can find the code for creating the model in this [PerfrormanceRnnModel][27] notebook. After all the data is ready and the model is finalized we can start training. NetTrain[teacherForcingNet, <|"Input" -> dataTrain|>, All, TrainingProgressCheckpointing -> {"File", checkPointDir, "Interval" -> Quantity[5, "Minutes"]}, BatchSize -> 64, MaxTrainingRounds -> 10, TargetDevice -> "GPU", (* Use CPU if you don't have Nvidia GPU *) ValidationSet -> <|"Input" -> dataValidate|> ] A friendly advice - it's better to use **"Checkpoining"** during the training. This will keep your mental health safe and will work as assurance that all training progress is saved. I was training the model 30 rounds and it took around 4-5 hours on AWS' GPUs. First 10-15 rounds weren't showing any sight of problems but later training clearly started to overfit. ![Training loss][28] Unfortunately, I haven't had time to fix this problem because of the limited time but to overcome this problem I might reduce the size of GRUs from 512 to 256 and return Dropout layer. ## Generate Music ## To generate music we need a model that predicts the next event in a sequence as it was in the language model. To do that I take the trained model and extract out of it "PerformanceRNN Predict Model" part. predictNet = NetExtract[trainedNet, "predict"]; Next step is to convert this `predictNet` to a model that takes varying input size and return the class of the next event. generateModel = NetJoin[NetTake[predictNet, 3], { SequenceLastLayer[], NetExtract[predictNet, {4, "Net"}], SoftmaxLayer[]}, "Input" -> Automatic, "Output" -> NetDecoder[{"Class", Range[310]}] ] The resulting architecture is pretty the same as the language model from which I've started - it takes a sequence with varying size of encoded MIDI events `{177, 60, 90}` and predicts what could be next event `{177, 60, 90, ?}`. ![Model Comparison(Generation)][29] **Now, let's the fun begin!** generateDemo[net_, start_, len_] := Block[{obj = NetStateObject[net]}, Join@NestList[{obj[#, "RandomSample"]} &, start, len] ] This small function is all we need to generate a sequence of the desired length. `NetStateObject` helps to keep track of all sequences that were applied to the network, meaning every next prediction is the result of all previous events not only the recent one. `start` should be a sequence of encoded MIDI events. It also can be a single item sequence, say you want to start from a pause or a particular note. This is a possibility to some extent put the generation process in a particular direction. Okay, two lines of code left and you can hear play with generating of music: generatedSequence = Flatten[generateDemo[generateModel, {60, 216, 148, 62, 200, 150, 64, 236, 152, 67, 198, 155}, 500]]; ToSound[generatedSequence] These are other examples: [2][30], [3][31]. You can generate your own demos if download [repository][32] and open [PerformanceRNN][33] notebook. ## Further Work ## That was a very fun and challenging task for me. I can't say that I'm satisfied with the results but this a good start and I have a direction now. What I want to explore is Variational Autoencoder, especially [MusicVAE][34] that is made by the same Magenta team. However, I'll start with improving the existing model by changing the architecture and cleaning the dataset to have only performances from the Yamaha dataset. Thank you for reading the post, and feel free to ask any questions. ![Peace!][35] [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2433article_cover.png&userId=1352227 [2]: http://www.piano-e-competition.com [3]: https://drive.google.com/open?id=1I7l6hrecWsuMxqvEdUiRWtg6N6NCW34R [4]: https://magenta.tensorflow.org/ [5]: https://magenta.tensorflow.org/performance-rnn [6]: http://www.kuhmann.com/Yamaha.htm [7]: https://github.com/tensorflow/magenta/tree/master/magenta/models/performance_rnn [8]: http://colinraffel.com/projects/lmd/ [9]: http://www.midiworld.com/ [10]: https://freemidi.org/ [11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5707Preprocessing_explanation.png&userId=1352227 [12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=6109Prep_ex_2.png&userId=1352227 [13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=MIDIimportelements.png&userId=1352227 [14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=7717raw_midi_output.png&userId=1352227 [15]: http://www.recordingblogs.com/wiki/musical-instrument-digital-interface-midi [16]: http://community.wolfram.com//c/portal/getImageAttachment?filename=filtered_midi_events.png&userId=1352227 [17]: https://github.com/Apisov/Performance-RNN-WL/blob/master/Project/Midi.m [18]: https://github.com/Apisov/Performance-RNN-WL/blob/master/BuildData.nb [19]: http://community.wolfram.com//c/portal/getImageAttachment?filename=One_track_final_encoding.png&userId=1352227 [20]: https://github.com/Apisov/Performance-RNN-WL/blob/master/Project/Midi.m [21]: http://www.wolfram.com/wolfram-u/catalog/wl036/ [22]: https://resources.wolframcloud.com/NeuralNetRepository/resources/Wolfram-English-Character-Level-Language-Model-V1 [23]: http://reference.wolfram.com/language/tutorial/NeuralNetworksSequenceLearning.html#1013067167 [24]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Modelcomparison.png&userId=1352227 [25]: http://community.wolfram.com//c/portal/getImageAttachment?filename=3750Teacher_forcing.png&userId=1352227 [26]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Teacher_forcing_explanation.png&userId=1352227 [27]: https://github.com/Apisov/Performance-RNN-WL/blob/master/PerformanceRNNModel.nb [28]: http://community.wolfram.com//c/portal/getImageAttachment?filename=raw_midi.png&userId=1352227 [29]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Modelcomparison%28Generation%29.png&userId=1352227 [30]: https://drive.google.com/open?id=1GtlaOtTF_9rHiDVsrqmLnUaKCSAva1dP [31]: https://drive.google.com/open?id=1sEihbFJw4XbVZveYl8efoM8Ivq8781ar [32]: https://github.com/Apisov/Performance-RNN-WL [33]: https://github.com/Apisov/Performance-RNN-WL/blob/master/PerformanceRNN.nb [34]: https://magenta.tensorflow.org/music-vae [35]: http://community.wolfram.com//c/portal/getImageAttachment?filename=d2eedc8a1ea8fc6a62e23b151c7fb3675c8153cc.png&userId=1352227 Pavlo Apisov 2018-07-11T21:20:56Z https://community.wolfram.com/groups/-/m/t/587562 Are there solar systems with chaotic orbits? When astronomers look for exoplanets they look for periodic signals in the brightness of the central star. The analysis relies on predictable behaviors. But I have always wondered whether there are unpredictable solar systems out there. The reason for posting this now is the [news][1] of a star whose signal appears to be unpredictable (KIC 8462852). Some articles have suggested this is due to [aliens][2]. On the other hand, Stephen Wolfram has said many times (e.g. in his [New Kind of Science][3] book) that it is pretty easy for nature to produce unpredictable sequences, and regular signals would be a better sign of civilization. You can simulate hypothetical solar systems relatively easily in Wolfram language (search the demonstrations for [three body problem][4]). At the [Wolfram Science Summer School][5] in 2013, [Nicholas Lucas][6] did a systematic survey. He produced a nice phase-space type of diagram and in the process found a class of behaviors which were not regular in any sense except that all of the planets did not fly away. The possibility of planets zooming off to infinity is a possible explanation for the prevalence of regularity and order (at least when stars are far apart). This is an example of an irregular solution: ![irregular paths of 3 bodies][7] This code is a simple two body version: s = NDSolve[{x''[t] == 8 (y[t] - x[t])/Norm[y[t] - x[t]]^3, y''[t] == 8 (x[t] - y[t])/Norm[x[t] - y[t]]^3, x[0] == {-2, 0, 0}, y[0] == {2, 0, 0}, x'[0] == {0, 1, 0}, y'[0] == {0, -1, 0}}, {x, y}, {t, 0, 4}][[1]]; ParametricPlot3D[{Evaluate[x[t] /. s], Evaluate[y[t] /. s]}, {t, 0, 4}] Theoretically, from the study of simple rules (see Wolfram's [book][8]), one expects the possibility of [long transients][9], but also that most transients are short. From Wolfram's [principle of computational equivalence][10], one expects that solar system dynamics can be computationally universal even from simple initial conditions (for more see Wolfram's [note][11]). Maybe someone on Community knows more about this star. Is there data out there for KIC 8462852? In principle one should be able to take the orbital paths from a simulation and derive the brightness signal that someone would see from Earth, and do it systematically. [1]: http://www.skyandtelescope.com/astronomy-news/curious-case-of-kic-8462852-102020155/ [2]: http://www.nbcnews.com/tech/innovation/have-scientists-discovered-alien-civilization-not-so-fast-n445161 [3]: http://www.wolframscience.com/nksonline/page-822 [4]: http://demonstrations.wolfram.com/search.html?query=three%20body [5]: https://www.wolframscience.com/summerschool/ [6]: https://www.wolframscience.com/summerschool/2013/alumni/lucas.html [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=alien-Kepler.png&userId=23275 [8]: http://www.wolframscience.com/nksonline/toc.html [9]: http://www.wolframscience.com/nksonline/page-754 [10]: http://www.wolframscience.com/nksonline/page-715 [11]: http://www.wolframscience.com/nksonline/page-972d-text Todd Rowland 2015-10-21T18:00:43Z https://community.wolfram.com/groups/-/m/t/328726 <a target="_blank" href="http://imageshack.com/f/f0Ut7L49p"><img src="http://imagizer.imageshack.us/v2/280x200q90/540/Ut7L49.png" border="0"></a> Can someone help me? I've solved a simple first order conditions system with different values of A. I get then a equilibrium couple of X and Y for each value of A i'm interested in. What i want to add in my last computation is the value of p for each equilibrium couple! Is it possible? Mathematica should understand to substitute, for each value of A, the equilibrium value of X and Y in the p formula, to get the result... How can i do that? Thanks Filippo Roda 2014-08-26T13:21:40Z https://community.wolfram.com/groups/-/m/t/3092013 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/14c707de-aa89-4876-84dc-95263be13c7c Andrea Li 2023-12-27T21:54:55Z https://community.wolfram.com/groups/-/m/t/2413178 ![enter image description here][1] In [another recent thread][2] we announced the existence of voxel chess pieces originally painted in [MagicaVoxel][3], but could not access them in Mathematica because of a fail case involving ".vox" file format. The purpose of this memo is to show how files exported to OBJ can be converted back to voxels, and to give away [a few more free assets][4]. Pull down the [OBJ files from github][5], then import and print: PieceData = Import["~/mathfun/" <> # <> ".obj"] & /@ {"pawn", "rook", "knight", "bishop", "queen", "king"}; GraphicsGrid[ Partition[Show[Region@#, Graphics3D[Arrow[{{0, 0, 0}, 6 #}] & /@ IdentityMatrix[3]], ViewVertical -> {0, 1, 0}, ViewPoint -> {2, 0, 2}, PlotRange -> {{-6, 6}, {-1, 20}, {-6, 6}}] & /@ PieceData, 3]] ![Chess Regions][6] Validation data RegionMember[Region[PieceData[[6]]], {0, 0, 0}] RegionMember[Region[PieceData[[6]]], {0, 1, 0}] RegionDimension@Region[PieceData[[6]]] SolidRegionQ@Region[PieceData[[6]]] Out[]:= True Out[]:= False Out[]:= 2 Out[]:= False We would rather that this output read T,T,3,T, and are unaware whether or not region management is built out to this capability (?). That leaves us the task of identifying boundaries, surface normals, and putting voxel blocks in place, hopefully with color. Assuming the OBJ file is consistent with a VOX decomposition, we can use preexisting region functions to identify control points on the two-dimensional surface: BoundaryPoints[GeoOBJ_] := With[{SlabPts = Flatten[ Table[{i/2, j/2, k/2}, {i, -6, 6}, {j, 0, 32}, {k, -6, 6}], 2]}, Select[SlabPts, Element[#, Region[GeoOBJ]] &]] In this case, we know the size of the slab, the origin of coordinates, and the length of the line element, so we don't need too much automation or corner finding. There are at least two good reasons for using halves in discretization of the slab, but you can think of those for yourself. To get out square facets, we look for nearest neighbors and next nearest neighbors in the sub lattice found by intersection with whichever GeoOBJ. ListEdges[BoundaryPts_] := With[{EdgeSet = Edge[#, Nearest[Complement[BoundaryPts, {#}], #]] & /@ BoundaryPts}, {EdgeSet, Edge[#[[1]], Nearest[Complement[ BoundaryPts, # /. Edge[x_, y_] :> Append[y, x]], #[[1]] ] ] & /@ EdgeSet}] Facet[pt_, nNeighbors_, nnNeighbors_] := MapIndexed[ ReplaceAll[ Flatten[Position[#1, 1/2, 1]], {{x_Integer, y_Integer} :> Polygon[ {pt, nNeighbors[[x]], nnNeighbors[[#2[[1]] ]], nNeighbors[[y]] }], _ -> {}}] &, Outer[EuclideanDistance, nnNeighbors, nNeighbors, 1]] BoundaryDiscretize[GeoOBJ_] := Union[Flatten[ MapThread[Facet[#1[[1]], #1[[2]], #2[[2]]] &, ListEdges[BoundaryPoints[GeoOBJ ]] ]]]; AbsoluteTiming[AllFacets = BoundaryDiscretize[#] & /@ PieceData;] Out[]={48.1591, Null} It seems to take too long, but we are not yet at the finalization stage of needing to optimize. Actually, we have just started (as C.H. was saying yesterday, sort of). Printing Again: GraphicsGrid[Partition[Show[Graphics3D[#], Graphics3D[Arrow[{{0, 0, 0}, 6 #}] & /@ IdentityMatrix[3]], ViewVertical -> {0, 1, 0}, ViewPoint -> {2, 0, 2}, Boxed -> False, PlotRange -> {{-6, 6}, {-1, 20}, {-6, 6}}] & /@ AllFacets, 3], ImageSize -> 500] ![Faceted Chess Pieces][7] These should be relatively easy to color, facet by facet, except that we may still have duplicate facets in the extracted data. If we just print some random coloring, that doesn't matter: lens = Length /@ AllFacets; cols = Table[Blend[{Hue[RandomReal[{0, 1}]], Pink}], {#}] & /@ lens; Show[Graphics3D[Transpose[{cols[[3]], AllFacets[[3]]}]], Graphics3D[Arrow[{{0, 0, 0}, 6 #}] & /@ IdentityMatrix[3]], ViewVertical -> {0, 1, 0}, ViewPoint -> {2, 0, 2}, Boxed -> False, PlotRange -> {{-6, 6}, {-1, 12}, {-6, 6}}, ImageSize -> 700] ![pink rainbow knight][8] Okay this looks too much like a discothèque, so for the sake of simplicity, we next need to refine until the facets of each voxel share the same color. More work to be done in the next few days or weeks, but we seem to be making progress. [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Image20211130000517.png&userId=20103 [2]: https://community.wolfram.com/groups/-/m/t/2407317 [3]: https://ephtracy.github.io/ [4]: https://github.com/bradklee/OpenAssets [5]: https://github.com/bradklee/OpenAssets/tree/main/WorldChess/OBJ [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ChessPieceRegions.png&userId=234448 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ChessPieceFacets.png&userId=234448 [8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=PinkKnight.png&userId=234448 Brad Klee 2021-11-24T15:37:34Z