https://community.wolfram.com RSS Feed for Wolfram Community showing any discussions tagged with Computer Science sorted by most viewed. https://community.wolfram.com/groups/-/m/t/404292 Does anyone have an idea for an efficient implementation of [Jaro–Winkler distance][1]? If there is a built in function with a different name it would be great, please let me know. If not, perhaps a modification of [Levenshtein][2] or similar would do or a compiled version (not sure which functions to use to make it compilable). I know good etiquette is to show some code, but I have to compare millions of strings pairwise and need the most efficient approach. Any advice would be appreciated - thanks in advance! BTW does anyone see any link between Shannon Entropy and Levenshtein and similar distances? Is it possible to talk about distance metric between strings in terms of information change needed to turn one string into the other? [1]: https://en.wikipedia.org/wiki/Jaro%E2%80%93Winkler_distance [2]: http://reference.wolfram.com/language/ref/EditDistance.html Sam Carrettie 2014-12-09T02:00:25Z https://community.wolfram.com/groups/-/m/t/3118205 ![enter image description here][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=heroimage.png&userId=1539902 [2]: https://www.wolframcloud.com/obj/5b3b5265-f1e2-406c-aef4-45a5f9ec363b Mohammad Bahrami 2024-02-07T19:21:52Z https://community.wolfram.com/groups/-/m/t/1077888 ![enter image description here][1] Above is the starting grid of a so called Suguru puzzle (also known as Tectonic or number block puzzles). See https://krazydad.com/suguru/ for many more puzzles. The rules are simple: 1. each cell (thin lines) contains a single integer. 2. each container (cage, block) (thick lines) contains the non-repeating integer starting from 1 to the size of the container. 3. adjacent (including diagonally touching) cells do not have the same number So, for example, this means that in the bottom we have a container of size 2 that those cells will contain the numbers 1 and 2 or 2 and 1. Let's set up the candidates for each cell, and the containers (I called them tectons): tectons = { {{1, 1}, {1, 2}, {2, 1}, {2, 2}, {3, 1}}, {{1, 3}, {1, 4}, {1, 5}, {2, 3}, {2, 4}}, {{1, 6}, {1, 7}, {2, 5}, {2, 6}, {3, 5}}, {{1, 8}, {2, 7}, {2, 8}, {3, 6}, {3, 7}}, {{1, 9}, {2, 9}, {3, 9}, {4, 8}, {4, 9}}, {{3, 8}}, {{5, 8}}, {{5, 9}, {6, 8}, {6, 9}, {7, 8}, {7, 9}}, {{4, 6}, {4, 7}, {5, 6}, {5, 7}, {6, 7}}, {{5, 5}, {6, 5}, {6, 6}, {7, 4}, {7, 5}}, {{5, 2}, {5, 3}, {6, 3}, {6, 4}, {7, 3}}, {{3, 3}, {3, 4}, {4, 4}, {4, 5}, {5, 4}}, {{3, 2}, {4, 1}, {4, 2}, {4, 3}, {5, 1}}, {{6, 1}, {6, 2}, {7, 1}, {7, 2}}, {{7, 6}, {7, 7}} }; givens = <| {1, 1} -> 1, {2, 2} -> 2, {3, 1} -> 4, {1, 4} -> 1, {2, 8} -> 3, {3, 3} -> 4, {3, 9} -> 4, {4, 4} -> 1, {5, 1} -> 4, {5, 3} -> 5, {5, 5} -> 4, {5, 7} -> 5, {6, 8} -> 3, {7, 5} -> 2, {7, 9} -> 5 |>; Let's create the database (db) of candidates, and process the given hints: If[! DuplicateFreeQ[Join @@ tectons], Print["Cells have to be unique among tectonics"]; Abort[];]; canddb = With[{x = #}, {#, Range[Length[x]]} & /@ x] & /@ tectons; canddb = Association[Rule @@@ (Join @@ canddb)]; KeyValueMap[(canddb[#1] = {#2}) &, givens]; Now we need a way to visualize them: ClearAll[VisualizeTectonic, VisualizeTectonicSideHelper, VisualizeTectonicNumberHelper] VisualizeTectonicNumberHelper[{row_, column_}, cand_List] := Module[{p, l, poss, t}, l = Length[cand]; p = {column, -row}; If[l == 1, Text[Style[First[cand], Black, 17], p] , MapThread[Text[Style[#1, 12, Red], #2] &, {cand, CirclePoints[p, 0.2, l]}] ] ] VisualizeTectonicSideHelper[tecton_List] := Module[{p, sides}, p = {#2, -#1} & @@@ tecton; sides = Partition[{# + {-0.5, -0.5}, # + {0.5, -0.5}, # + {0.5, 0.5}, # + {-0.5, 0.5}}, 2, 1, 1] & /@ p; sides = Join @@ sides; sides = Tally[Sort /@ sides]; Table[If[Last[s] == 1, {Thickness[0.01], Line[First[s]]}, Line[First[s]]], {s, sides}] ] VisualizeTectonic[canddb_Association, tectons_List] := Module[{nums, sides, cb}, nums = KeyValueMap[VisualizeTectonicNumberHelper, canddb]; sides = VisualizeTectonicSideHelper /@ tectons; cb = #2 - #1 & @@@ CoordinateBounds[Transpose[Join @@ tectons]]; Graphics[{nums, sides}, ImageSize -> Norm[cb] 15] ] Trying out: VisualizeTectonic[canddb, tectons] gives: ![enter image description here][2] The red numbers now indicates possible candidates for each cell, black numbers are solved. Now it is time to eliminate numbers until we find the correct answer for each cell. We will start by defining two helper functions: ClearAll[NeighbourQ, Neighbours] NeighbourQ[p : {x_, y_}, p2 : {x2_, y2_}] := ChessboardDistance[p, p2] === 1 Neighbours[p : {x_, y_}] := Transpose[p + Transpose[{{-1, -1}, {-1, 0}, {-1, 1}, {0, -1}, {0, 1}, {1, -1}, {1, 0}, {1, 1}}]] to test if two cells are neighbours, and what the neighbours of a cell are, respectively. Now we can easily create a new function to delete candidates around cells that are solved: Do[ {k, v} = List @@ Part[Normal[canddb], i]; If[Length[v] == 1, neighbours = Neighbours[k]; Do[ If[KeyExistsQ[canddb, nb], canddb[nb] = DeleteCases[canddb[nb], First[v]]; ]; , {nb, neighbours} ] ]; , {i, Length[canddb]} ]; Executing this and then calling `VisualizeTectonic[canddb, tectons]` gives: ![enter image description here][3] We can also delete any candidate that matches a solved number inside a container: (* delete candidates from singles in same tecton *) Do[ values = canddb /@ t; If[Length[values] > 1, singles = Select[Transpose[{t, values}], Length[Last[#]] == 1 &]; nonsingles = Complement[t, singles[[All, 1]]]; (canddb[#1] = Complement[canddb[#1], Join @@ singles[[All, 2]]]) & /@ nonsingles ] , {t, tectons} ]; VisualizeTectonic[canddb, tectons] ![enter image description here][4] If a candidate only appears once inside a container then that must be the position: (* hidden singles *) Do[ values = canddb /@ t; values = Tally[Join @@ values]; values = Select[values, Last[#] == 1 &][[All, 1]]; If[Length[values] > 0, Do[ If[ContainsAny[canddb[c], values], canddb[c] = Intersection[canddb[c], values] ]; , {c, t} ]; ] , {t, tectons} ]; VisualizeTectonic[canddb, tectons] ![enter image description here][5] We can even try some more elaborate tests in order to eliminate candidates: (* in each tecton search for cells with numbers that appear at least twice then look at their common neighbours: eliminate that number from the common neighbours *) Do[ values = canddb /@ t; values = Tally[Join @@ values]; values = Select[values, Last[#] > 1 &][[All, 1]]; Do[ cells = Select[t, MemberQ[canddb[#], v] &]; nb = Neighbours /@ cells; nb = Intersection @@ nb; nb = Complement[nb, cells]; (*strictly speaking not necessary I think *) nb = Intersection[nb, Join @@ tectons]; If[Length[nb] > 0, Do[ canddb[n] = DeleteCases[canddb[n], v]; , {n, nb} ]; ]; , {v, values} ] , {t, tectons} ]; VisualizeTectonic[canddb, tectons] ![enter image description here][6] Lastly we can look at pairs of cells, if two adjacent cells both have the same 2 candidates left, then one can eliminate those two candidates from their common neighbours: (* naked pairs *) paircells = GatherBy[KeyValueMap[List, Select[canddb, Length[#] == 2 &]], Sort@*Last][[All, All, 1]]; pairedpaircells = Select[paircells, Length[#] > 1 &]; pairedpaircells = Join @@ (Subsets[#, {2}] & /@ pairedpaircells); pairedpaircells = Select[pairedpaircells, NeighbourQ @@ # &]; neigbours = Intersection[##, Keys[canddb]] & @@@ Map[Neighbours, pairedpaircells, {2}]; vals = canddb /@ pairedpaircells[[All, 1]]; del = Transpose[{neigbours, vals}]; Do[ {nb, v} = d; Do[ canddb[n] = Complement[canddb[n], v] , {n, nb} ] , {d, del} ]; VisualizeTectonic[canddb, tectons] ![enter image description here][7] We can now execute the above code-pieces repeatedly to further eliminate all the candidates and solve the puzzle: ![enter image description here][8] Here is all the code and a while loop that iterates the candidate-elimination functions until there is not progress any more: ClearAll[VisualizeTectonic, VisualizeTectonicSideHelper, VisualizeTectonicNumberHelper, NeighbourQ, Neighbours] VisualizeTectonicNumberHelper[{row_, column_}, cand_List] := Module[{p, l, poss, t}, l = Length[cand]; p = {column, -row}; If[l == 1, Text[Style[First[cand], Black, 17], p] , MapThread[Text[Style[#1, 12, Red], #2] &, {cand, CirclePoints[p, 0.2, l]}] ] ] VisualizeTectonicSideHelper[tecton_List] := Module[{p, sides}, p = {#2, -#1} & @@@ tecton; sides = Partition[{# + {-0.5, -0.5}, # + {0.5, -0.5}, # + {0.5, 0.5}, # + {-0.5, 0.5}}, 2, 1, 1] & /@ p; sides = Join @@ sides; sides = Tally[Sort /@ sides]; Table[If[Last[s] == 1, {Thickness[0.01], Line[First[s]]}, Line[First[s]]], {s, sides}] ] VisualizeTectonic[canddb_Association, tectons_List] := Module[{nums, sides, cb}, nums = KeyValueMap[VisualizeTectonicNumberHelper, canddb]; sides = VisualizeTectonicSideHelper /@ tectons; cb = #2 - #1 & @@@ CoordinateBounds[Transpose[Join @@ tectons]]; Graphics[{nums, sides}, ImageSize -> Norm[cb] 15] ] NeighbourQ[p : {x_, y_}, p2 : {x2_, y2_}] := ChessboardDistance[p, p2] === 1 Neighbours[p : {x_, y_}] := Transpose[p + Transpose[{{-1, -1}, {-1, 0}, {-1, 1}, {0, -1}, {0, 1}, {1, -1}, {1, 0}, {1, 1}}]] tectons = { {{1, 1}, {1, 2}, {2, 1}, {2, 2}, {3, 1}}, {{1, 3}, {1, 4}, {1, 5}, {2, 3}, {2, 4}}, {{1, 6}, {1, 7}, {2, 5}, {2, 6}, {3, 5}}, {{1, 8}, {2, 7}, {2, 8}, {3, 6}, {3, 7}}, {{1, 9}, {2, 9}, {3, 9}, {4, 8}, {4, 9}}, {{3, 8}}, {{5, 8}}, {{5, 9}, {6, 8}, {6, 9}, {7, 8}, {7, 9}}, {{4, 6}, {4, 7}, {5, 6}, {5, 7}, {6, 7}}, {{5, 5}, {6, 5}, {6, 6}, {7, 4}, {7, 5}}, {{5, 2}, {5, 3}, {6, 3}, {6, 4}, {7, 3}}, {{3, 3}, {3, 4}, {4, 4}, {4, 5}, {5, 4}}, {{3, 2}, {4, 1}, {4, 2}, {4, 3}, {5, 1}}, {{6, 1}, {6, 2}, {7, 1}, {7, 2}}, {{7, 6}, {7, 7}} }; givens = <| {1, 1} -> 1, {2, 2} -> 2, {3, 1} -> 4, {1, 4} -> 1, {2, 8} -> 3, {3, 3} -> 4, {3, 9} -> 4, {4, 4} -> 1, {5, 1} -> 4, {5, 3} -> 5, {5, 5} -> 4, {5, 7} -> 5, {6, 8} -> 3, {7, 5} -> 2, {7, 9} -> 5 |>; If[! DuplicateFreeQ[Join @@ tectons], Print["Cells have to be unique among tectonics"]; Abort[];]; canddb = With[{x = #}, {#, Range[Length[x]]} & /@ x] & /@ tectons; canddb = Association[Rule @@@ (Join @@ canddb)]; KeyValueMap[(canddb[#1] = {#2}) &, givens]; VisualizeTectonic[canddb, tectons] oldcanddb = 1; While[oldcanddb =!= canddb, oldcanddb = canddb; (* delete from neighbours of singles *) Do[ {k, v} = List @@ Part[Normal[canddb], i]; If[Length[v] == 1, neighbours = Neighbours[k]; Do[ If[KeyExistsQ[canddb, nb], canddb[nb] = DeleteCases[canddb[nb], First[v]]; ]; , {nb, neighbours} ] ]; , {i, Length[canddb]} ]; (* delete candidates from singles in same tecton *) Do[ values = canddb /@ t; If[Length[values] > 1, singles = Select[Transpose[{t, values}], Length[Last[#]] == 1 &]; nonsingles = Complement[t, singles[[All, 1]]]; (canddb[#1] = Complement[canddb[#1], Join @@ singles[[All, 2]]]) & /@ nonsingles ] , {t, tectons} ]; (* hidden singles *) Do[ values = canddb /@ t; values = Tally[Join @@ values]; values = Select[values, Last[#] == 1 &][[All, 1]]; If[Length[values] > 0, Do[ If[ContainsAny[canddb[c], values], canddb[c] = Intersection[canddb[c], values] ]; , {c, t} ]; ] , {t, tectons} ]; (* in each tecton search for cells with numbers that appear at least \ twice then look at their common neighbours: eliminate that number \ from the common neighbours *) Do[ values = canddb /@ t; values = Tally[Join @@ values]; values = Select[values, Last[#] > 1 &][[All, 1]]; Do[ cells = Select[t, MemberQ[canddb[#], v] &]; nb = Neighbours /@ cells; nb = Intersection @@ nb; nb = Complement[nb, cells]; (* strictly speaking not necessary I think *) nb = Intersection[nb, Join @@ tectons]; If[Length[nb] > 0, Do[ canddb[n] = DeleteCases[canddb[n], v]; , {n, nb} ]; ]; , {v, values} ] , {t, tectons} ]; (* pairs *) paircells = GatherBy[KeyValueMap[List, Select[canddb, Length[#] == 2 &]], Sort@*Last][[All, All, 1]]; pairedpaircells = Select[paircells, Length[#] > 1 &]; pairedpaircells = Join @@ (Subsets[#, {2}] & /@ pairedpaircells); pairedpaircells = Select[pairedpaircells, NeighbourQ @@ # &]; neigbours = Intersection[##, Keys[canddb]] & @@@ Map[Neighbours, pairedpaircells, {2}]; vals = canddb /@ pairedpaircells[[All, 1]]; del = Transpose[{neigbours, vals}]; Do[ {nb, v} = d; Do[ canddb[n] = Complement[canddb[n], v] , {n, nb} ] , {d, del} ]; ] VisualizeTectonic[canddb, tectons] # Brute force solver # This however does not solve all puzzles: tectons = { {{1, 1}, {1, 2}, {2, 1}, {3, 1}, {4, 1}}, {{1, 3}, {1, 4}, {2, 2}, {2, 3}, {3, 2}}, {{1, 5}, {2, 4}, {2, 5}, {3, 3}, {3, 4}}, {{1, 6}, {1, 7}, {2, 7}, {2, 8}, {3, 8}}, {{1, 8}, {1, 9}, {1, 10}, {1, 11}, {2, 9}}, {{1, 12}, {2, 12}}, {{2, 6}, {3, 5}, {3, 6}, {3, 7}, {4, 5}}, {{2, 10}, {2, 11}, {3, 11}, {3, 12}, {4, 12}}, {{3, 9}, {3, 10}, {4, 8}, {4, 9}, {4, 10}}, {{4, 2}, {4, 3}, {5, 1}, {5, 2}, {6, 1}}, {{4, 4}, {5, 4}, {5, 5}, {5, 6}, {6, 5}}, {{4, 6}, {4, 7}, {5, 7}, {5, 8}, {6, 8}}, {{4, 11}, {5, 10}, {5, 11}, {5, 12}, {6, 11}}, {{5, 3}, {6, 3}, {6, 4}, {7, 4}, {7, 5}}, {{6, 6}}, {{6, 7}, {7, 7}, {8, 7}, {8, 8}, {9, 7}}, {{7, 8}, {7, 9}, {8, 9}, {8, 10}, {9, 10}}, {{8, 11}}, {{5, 9}, {6, 9}, {6, 10}, {7, 10}, {7, 11}}, {{6, 12}, {7, 12}, {8, 12}, {9, 11}, {9, 12}}, {{10, 12}}, {{9, 8}, {9, 9}, {10, 9}, {10, 10}, {10, 11}}, {{9, 6}, {10, 5}, {10, 6}, {10, 7}, {10, 8}}, {{9, 1}, {10, 1}, {10, 2}, {10, 3}, {10, 4}}, {{7, 1}, {8, 1}, {8, 2}, {9, 2}, {9, 3}}, {{6, 2}, {7, 2}, {7, 3}, {8, 3}, {8, 4}}, {{7, 6}, {8, 5}, {8, 6}, {9, 4}, {9, 5}} }; givens = <| {1, 1} -> 3, {3, 1} -> 1, {1, 3} -> 4, {1, 5} -> 3, {1, 10} -> 2, {2, 12} -> 2, {3, 11} -> 5, {5, 1} -> 2, {5, 8} -> 5, {5, 11} -> 4, {6, 3} -> 2, {7, 1} -> 5, {7, 11} -> 5, {7, 12} -> 3, {8, 6} -> 3, {9, 9} -> 5, {9, 12} -> 5, {10, 2} -> 5, {10, 8} -> 3 |>; Which can be solved till the following state using the above techniques: ![enter image description here][9] We can now define this depth-first recursive backtracking algorithm: ClearAll[ValidGridQ, BackTrackHelper, BackTrack] ValidGridQ[canddb_Association, tectons_, lastkey_] := Module[{vals, tecton, nbs}, nbs = Neighbours[lastkey]; nbs = Intersection[nbs, Keys[canddb]]; (* neighbours that exist *) nbs = First /@ Select[canddb /@ nbs, Length[#] == 1 &]; (* get the values of neighbours with a single value *) If[FreeQ[nbs, First@canddb[lastkey]], (* if this does not contain the 'set' one *) tecton = SelectFirst[tectons, MemberQ[lastkey]]; vals = canddb /@ tecton; If[ContainsAll[Flatten[vals], Range[Length[tecton]]], (* each tecton still has all its values in it *) vals = First /@ Select[vals, Length[#] == 1 &]; DuplicateFreeQ[vals] (* and these set values does not have duplicates *) , False ] , False ] ] BackTrackHelper[candidatesdb_Association, tectons_] := Module[{nextkey, options, copy}, nextkey = First[Keys[Select[candidatesdb, Length[#] > 1 &]], Missing[]]; If[Not[MissingQ[nextkey]], options = candidatesdb[nextkey]; Do[ copy = candidatesdb; copy[nextkey] = {o}; If[ValidGridQ[copy, tectons, nextkey], BackTrackHelper[copy, tectons]] , {o, options} ] , Throw[candidatesdb]; ] ] BackTrack[candidatesdb_Association, tectons_] := Catch[BackTrackHelper[candidatesdb, tectons]; Missing[]] Calling the function and visualizing the output: canddb = BackTrack[canddb, tectons]; VisualizeTectonic[canddb, tectons] ![enter image description here][10] Which is correct! I hope you enjoyed this little solver code. Some related solvers I made can be found here: - [Solving a KenKen puzzle using logic][11] - [Solving the UK Intelligence Agency's Christmas Puzzle][12] - [Solving Hidato, Beehive, and Numbrix puzzles][13] Most of these solvers work in a similar manner: elimination of candidates. [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=11951.png&userId=73716 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=83692.png&userId=73716 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=70763.png&userId=73716 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=36914.png&userId=73716 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=86955.png&userId=73716 [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=45396.png&userId=73716 [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=72907.png&userId=73716 [8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=86068.png&userId=73716 [9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=70249.png&userId=73716 [10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1033810.png&userId=73716 [11]: http://community.wolfram.com/groups/-/m/t/613040 [12]: http://community.wolfram.com/groups/-/m/t/755538 [13]: http://community.wolfram.com/groups/-/m/t/892653 Sander Huisman 2017-04-30T23:03:19Z https://community.wolfram.com/groups/-/m/t/148287 I am an artist, drawing and working with 3d. Since long time, I am missing a method to form realistic folds and wrinkles into virtual sheets of paper, metal or cloth. I found some attempts within 3d-programs, but I never saw something that was not very limited or looked like rubber. Because it is so easy at reality, but so difficult at the computer, I think there is just little mathematical base.First of all: Could anybody tell me, what field of mathematics this is? [img=width: 800px; height: 1132px; ]/c/portal/getImageAttachment?filename=Folds-01.jpg&userId=145842[/img] [img=width: 800px; height: 1132px; ]/c/portal/getImageAttachment?filename=Folds-02.jpg&userId=145842[/img] Dietmar Klein 2013-11-03T23:03:23Z https://community.wolfram.com/groups/-/m/t/897081 I'd like to introduce the OOP environment for Mathematica, with no-additional packages. Mathematica has many style of paradigm, however, the programming style of OOP is an old but not sufficient backed-up environment. Let's consider the function group UpSet. UpSet has been seemed the basic idea relating OOP and the function group being equipped from the first version, but you can see the description of the function group is so small and short in the manual. Now, the UpSet function becomes the most important function because the function group is the key parts to establish the OOP environment. With very small size pattern of CLASS constructed with SetDelayed UpSetDelayed, and Module leads to the OOP paradigm. This paradigm includes Encapsulation, inheritance, and Polymorphism in very straight forward style. OOP on the Mathematica suits for Graphics, Events, and the Dynamic directly and give us new kind of power for Mathematica programming. The method is very easy as follows. Basically, you define the CLASS which is "SetDelayed definition of Module-d UpSetDelyaed functions", you construct INSTANCES distinguished by the name having each local values, and each INSTANCE functions when you send name conbined MESSAGES defined in the CLASS. In the following code, class name is "pclass", two method named "set" and "get", object list name is "object". In my definition, OBJECT is the group name of INSTANCE created from CLASS. (*prepare class*) pclass[nam_] := Module[{local = 0}, set[nam[x_]] ^:= local = x; get[nam] ^:= local^2;] (*prepare object list*) object = Table[Unique[], {10}]; (*create instances*) Table[pclass[object[[i]]], {i, 10}]; (*send message to set local values of instances*) Table[set[object[[i]][i]], {i, 10}]; (*send message to get results of instances*) Table[get[object[[i]]], {i, 10}] {1, 4, 9, 16, 25, 36, 49, 64, 81, 100} I hope you enjoy the new paradigm. In [Google slide][1], you can see more detailed OOP discussion. [1]: https://docs.google.com/presentation/d/1U9m4k0Z5KMmulgPRTPWUPbePY1MB2t3FMG4aCxk34uM/pub?start=false&loop=false&delayms=3000 Hirokazu Kobayashi 2016-08-01T02:15:54Z https://community.wolfram.com/groups/-/m/t/1112012 [Shadow mapping][1] is a process of applying shadows to a computer graphic. `Graphics3D` allows the user to specify lighting conditions for the surfaces of 3D graphical primitives, however, visualising the shadow an object projects onto a surface requires the processes of shadow mapping. Each pixel of the projection surface must check if it is visible from the light source; if this check returns false then the pixel forms a shadow. This becomes a problem of geometric intersections, i.e., for this case, the intersection between a line and a triangle. For a 3D model with 100s and more of polygons, repeated intersection tests across the entire model for each pixel is an extremely costly (and inefficient) task. Now this becomes a problem of search optimisation. ![enter image description here][2] Obtaining Data -------------- This project uses 3D models from [SketchUp's online repository][3] which are converted to COLLADA files using SketchUp. The functions used are held in a package, accessible via [github][4] along with all the data referenced throughout. (* load package and 3D model *) << "https://raw.githubusercontent.com/b-goodman/\ GeometricIntersections3D/master/GeometricIntersections3D.wl"; modelPath = "https://raw.githubusercontent.com/b-goodman/\ GeometricIntersections3D/master/Demo/House/houseModel4.dae"; (* vertices of model's polygons *) polyPoints = Delete[0]@Import[modelPath, "PolygonObjects"]; (* import model as region *) modelRegion = Import[modelPath, "MeshRegion"]; (* use region to generate minimal bounding volume *) cuboidPartition = Delete[0]@BoundingRegion[modelRegion, "MinCuboid"]; (* verify *) Graphics3D[{ Polygon[polyPoints], {Hue[0, 0, 0, 0], EdgeForm[Black], Cuboid[cuboidPartition]} }, Boxed -> False] ![imported model data][5] Generate a Bounding Volume Hierarchy (BVH) ------------------------------------------ Shadow mapping (and more generally collision testing) may be optimised via space partitioning achieved by dividing the 3D model's space into a hierarchy of bounding volumes (BV) stored as a graph, thus forming a [bounding volume hierarchy][6]. The simplest case uses the result of an intersection between a ray and a single BV for the entire model to discard all rays which don't come close to any of the model's polygons. Of course, those which do pass the first test must still be tested against the entire model so the initial BV is subdivided with each sub BV assigned to a particular part of the model hence reducing the total amount of polygons to be tested against. The initial BV forms the root of the tree and it's subdivisions (leaf boxes) are joined via edges. We can add more levels to the tree by repeating the subdivision for each of the leaf boxes and ultimately refining the search for potential intersecting polygons. (* Begin tree. Initial AABB is root. Subdivide root AABB and link returns to root *) newBVH[cuboidPartitions_,polyPoints_]:=Block[{ newLevel,edges }, newLevel=Quiet[cullIntersectingPartitions[cuboidSubdivide[cuboidPartitions],polyPoints]]; edges=cuboidPartitions\[DirectedEdge]#&/@newLevel; Return[<| "Tree"->TreeGraph[edges], "PolygonObjects"->polyPoints |>]; ]; bvh = newBVH[{cuboidPartition}, polyPoints]; The BVH is a tree graph with the model's polygon vertices encapsulated within an association Keys[bvh] {"Tree", "PolygonObjects"} The BVH consists of a root box derived from the model's minimal bounding volume and it's 8 sub-divisions bvh["Tree"] ![enter image description here][7] The boxes at the lowest level of the BVH are the leaf boxes leafBoxesLV1 = Select[VertexList[bvh["Tree"]], VertexOutDegree[bvh["Tree"], #] == 0 &]; Graphics3D[{ Polygon[polyPoints], {Hue[0, 0, 0, 0], EdgeForm[Black], Cuboid /@ leafBoxesLV1} }, Boxed -> False] ![enter image description here][8] Adding a new level sub-divides each leaf box into 8 sub-divisions. With[{ testCuboid = {{0, 0, 0}, {10, 10, 10}} }, Manipulate[ Graphics3D[{ If[n == 0, Cuboid[testCuboid], Cuboid /@ Nest[cuboidSubdivide, testCuboid, n]] }, Boxed -> False, Axes -> {True, False}], {{n, 0}, 0, 4, 1} ] ] ![enter image description here][9] The time needed for each addition to the BVH increases dramatically. Length /@ NestList[cuboidSubdivide, {{{0, 0, 0}, {1, 1, 1}}}, 5] {1, 8, 64, 512, 4096, 32768} 1-2 added levels is usually enough for the models used in this project. (* Each new subdivision acts as root. For each, subdivide further and remove any non-intersecting boxes. Link back to parent box as directed edge *) addLevelBVH[BVH_]:=Block[{ tree=BVH["Tree"],polyPoints=BVH["PolygonObjects"],returnEdges }, Module[{ subEdges=Map[ Function[{levelComponent},levelComponent\[DirectedEdge]#&/@Quiet@cullIntersectingPartitions[cuboidSubdivide[levelComponent],polyPoints]], Pick[VertexList[tree],VertexOutDegree[tree],0]] }, returnEdges=ConstantArray[0,Length[subEdges]]; Do[returnEdges[[i]]=EdgeAdd[tree,subEdges[[i]]],{i,1,Length[subEdges],1}]; ]; returnEdges=DeleteDuplicates[Flatten[Join[EdgeList/@returnEdges]]]; Return[<| "Tree"->TreeGraph[returnEdges], "PolygonObjects"->polyPoints |>] ]; bvh2 = addLevelBVH[bvh]; bvh2["Tree"] ![enter image description here][10] Any subs which don't intersect with the model don't contribute to the BVH and so are removed as part of the process. cullIntersectingPartitions=Compile[{ {cuboidPartitions,_Real,3}, {polyPoints,_Real,3} }, Select[cuboidPartitions,Function[{partitions},MemberQ[ParallelMap[Quiet@intersectTriangleBox[partitions,#]&,polyPoints],True]]], CompilationTarget->"C" ]; Visualising the leaf boxes shows that empty BVs are removed. leafBoxesLV2 = Select[VertexList[bvh2["Tree"]], VertexOutDegree[bvh2["Tree"], #] == 0 &]; Graphics3D[{ Polygon[polyPoints], {Hue[0, 0, 0, 0], EdgeForm[Black], Cuboid /@ leafBoxesLV2} }, Boxed -> False] ![enter image description here][11] Once all levels are added, the BVH is finalised by linking each leaf box to its associated polygons. This does not effect the tree structure as the link association is held seperate. (*For each outermost subdivision (leaf box), find intersecting polygons. Link to intersecting box via directed edge. Append to graph *) finalizeBVH[BVH_]:=Block[{ (* all leaf boxes for BVH *) leafBoxes=Select[ VertexList[BVH["Tree"]], VertexOutDegree[BVH["Tree"],#]==0& ], (* setup temp association *) temp=<||>, (* block varaibles *) leafPolygons, leafPolygonsEdges }, (* For each BVH leaf box *) Do[ (* 3.1. intersecitng polygons for specified BVH leaf box *) leafPolygons=Select[ BVH["PolygonObjects"], Quiet@intersectTriangleBox[leafBoxes[[i]],#]==True& ]; (* 3.2. associate each specified BVH leaf box to its intersecting polygon(s) *) AppendTo[temp,leafBoxes[[i]]->leafPolygons], {i,1,Length[leafBoxes],1} ]; Return[<| "Tree"->BVH["Tree"], "LeafObjects"->temp, "PolygonObjects"->BVH["PolygonObjects"] |>] ]; bvh2 = finalizeBVH[bvh2]; While it only needs doing once, generating the BVH is often the longest part of the procedure so it's a good idea to export it on completion. Generating The Scene -------------------- The scene is an encapsulation of all data and parameters used for the ray caster. It's initially structured as: scene=<| "BVH"->BVHobj, -- (*The BVH previously generated*) "SourcePositions"->lightingPath, -- (*The 3D position(s) of the light source*) "FrameCount"->frameCount, -- (*A timestep for animation and a parameter if lightingPath is continuous*) "Refinement"->rayRefinement, -- (*Ray density; smaller values give finer results.*) "ProjectionPoints"->planeSpec, -- (*3D points forming surface(s) that shadow(s) are cast onto.*) "FrameData"-><||> -- (*Initially empty, data from the ray caster will be stored here.*) |> Generating The Projection Surface ----------------------------- The house should look like its casting it's shadow onto the earth so we define a list of points which represent the discrete plane it stands on. Each ray is a line drawn between each point on the projection surface and the position of the scene's light source. (* rayRefinement *) ref = 20; (* the height of the projection surface *) planeZoffset = 0; (* the discrete projection surface - each point is the origin of a \ ray *) projectionPts = Catenate[Table[{x, y, planeZoffset}, {x, -900, 1200, ref}, {y, -600, 1000, ref}]]; Graphics3D[{ Polygon[polyPoints], Cuboid /@ ({##, ## + {ref, ref, 0}} & /@ projectionPts) }, Axes -> True, AxesLabel -> {"X", "Y", "Z"}, ImageSize -> Large] ![enter image description here][12] Specifying A Light Source ------------------------- The light source is typically a continuous BSplineFunction which is sampled according to the number of frames the user wants. But it may also be a discrete list of 3D points too (in which case the number of frames is equal to the length of the list). Using a modification of a `SunPosition` example in the documentation, a list of the 3D Cartesian positions of the sun between sunrise and sunset, with a time step 30 minutes, is produced. ![enter image description here][13] solarPositionPts0[location_:Here, date_:DateValue[Now,{"Year","Month","Day"}],tSpec_:{30,"Minute"}]:= Evaluate[CoordinateTransformData["Spherical"->"Cartesian","Mapping",{1,\[Pi]/2-(#2 Degree),2Pi-(#1 Degree)}]]&@@@(Function[{series},Map[QuantityMagnitude,series["Values"],{2}]]@SunPosition[location,DateRange[Sunrise[#],Sunset[#],tSpec]&[DateObject[date]]]) solarPositionPts[Here, DateObject[{2017, 6, 1}], {30, "Minute"}] {{0.4700, -0.88253, -0.0155}, {0.4026, -0.91178, 0.0809},...,{0.4219, 0.90493, 0.0554}} It's easier to rotate the sun's path rather than the model and projection plane. Different transforms may also be applied to best-fit the path into the scene. solarXoffset = 0; solarYoffset = 0; solarZoffset = 0; zRotation = \[Pi]/3.5; scale = 1300; sourceSpec = RotationTransform[zRotation, {0, 0, 1}][ # + {solarXoffset, solarYoffset, solarZoffset} & /@ (solarPositionPts[Here, DateObject[{2017, 6, 1}], {30, "Minute"}] scale) ]; lightingPath = BSplineCurve[sourceSpec]; Specify A Frame Count --------------------- A frame count must be specified to discretize the light path into 3D points. Each of these points forms the end of each ray. If the light source is a discrete list, then its length is used to infer the frame count instead and does not need specifying by the user. frameCount = 30; Constructing The Scene ---------------------- Now we can preview the scene Graphics3D[{ Polygon[polyPoints], Cuboid /@ ({##, ## + {ref, ref, 0}} & /@ projectionPts), lightingPath, {Darker@Yellow, PointSize[0.03], Point[BSplineFunction[sourceSpec] /@ Range[0, 1, N[1/frameCount]]]} }, Axes -> True, AxesLabel -> {"X", "Y", "Z"}, ImageSize -> Large] ![enter image description here][14] All paramaters have been set, it's time to construct the scene. Specifying a continuous lighting path must be done using a `BSPlineCurve`. scene = newScene[bvh2, lightingPath, frameCount, ref, projectionPts] ![enter image description here][15] Processing A Scene For Shadow Mapping ------------------------------------- The BVH optimises the ray caster by reducing the number of polygons to search against for an intersection. If the ray intersects with the BVH root box then a breadth-first search along the BVH tree is initiated. Starting with the root box,the out-components are selected by their intersection with a ray and are used as roots for the search's next level. (* select peripheral out-components of root box that intersect with ray *) intersectingSubBoxes[BVHObj_,initialVertex_,rayOrigin_,raySource_]:=Select[Rest[VertexOutComponent[BVHObj["Tree"],{initialVertex},1]],intersectRayBox[#,rayOrigin,raySource]==True&]; (* for root box intersecting rays, find which leaf box(es) intersect with ray *) BVHLeafBoxIntersection[BVHObj_,rayInt_,rayDest_]:=Block[{v0}, (*initialize search *)v0=intersectingSubBoxes[BVHObj,VertexList[BVHObj["Tree"]][[1]],rayInt,rayDest]; (* breadth search *) If[v0=={},Return[v0], While[ (* check that vertex isn't a polygon - true if !0. Check that intersection isn't empty *) AllTrue[VertexOutDegree[BVHObj["Tree"],#]&/@v0,#=!=0&], v0=Flatten[intersectingSubBoxes[BVHObj,#,rayInt,rayDest]&/@v0,1]; If[v0==={},Break[]] ]; Return[v0]; ] ]; The code below generates a visualisation of this process using the input data from the scene generated. raySource = scene["ProjectionPoints"][[3700]]; rayDestination = scene["FrameData"][16]["SourcePosition"]; lv1Intersection = BVHLeafBoxIntersection[bvh, raySource, rayDestination]; lv2Intersection = BVHLeafBoxIntersection[bvh2, raySource, rayDestination]; lv1Subgraph = Subgraph[Graph[EdgeList[bvh2["Tree"]]], First[VertexList[bvh2["Tree"]]] \[DirectedEdge] # & /@ lv1Intersection]; lv2Subgraphs = Subgraph[Graph[EdgeList[bvh2["Tree"]]], Flatten[Table[ lv1Intersection[[ i]] \[DirectedEdge] # & /@ (Intersection[#, lv2Intersection] & /@ ((Rest@ VertexOutComponent[bvh2["Tree"], #] & /@ lv1Intersection)))[[i]], {i, 1, Length[lv1Intersection], 1} ], 1]]; lbl = ((#[[1]] -> #[[2]]) & /@ (Transpose[{lv2Intersection, ToString /@ Range[Length[lv2Intersection]]}])); edgeStyle = Join[ ReleaseHold@ Thread[(# -> HoldForm@{Thick, Blue}) &[EdgeList[lv2Subgraphs]]], ReleaseHold@ Thread[(# -> HoldForm@{Thick, Red}) &[EdgeList[lv1Subgraph]]] ]; rayBVHTraversal = Graph[EdgeList[bvh2["Tree"]], EdgeStyle -> edgeStyle, VertexLabels -> lbl, GraphHighlight -> lv2Intersection, ImageSize -> Medium]; rayModelIntersection = Graphics3D[{ {Green, Thickness[0.01], Line[{raySource, rayDestination - {220, -400, 400}}]}, {Hue[0, 0, 0, 0], EdgeForm[{Thick, Red}], Cuboid /@ lv1Intersection}, {Hue[.6, 1, 1, .3], EdgeForm[{Thick, Blue}], Cuboid /@ lv2Intersection}, {Opacity[0.5], Polygon[polyPoints]}, Inset @@@ Transpose[{ToString /@ Range[Length[lv2Intersection]], RegionCentroid /@ Cuboid @@@ lv2Intersection}] }]; Column[{ Row[ Show[rayModelIntersection, ViewPoint -> #, Boxed -> False, ImageSize -> Medium] & /@ {{-\[Infinity], 0, 0}, {0, -\[Infinity], 0}} ], rayBVHTraversal }] ![enter image description here][17] At the centre of the graph lies the vertex representing the root BV where all searches originate from. The search continues out form all vertices which have intersected with the ray. (* test intersection between ray and object polygon via BVH search *) intersectionRayBVH[BVHObj_,rayOrigin_,rayDest_]:=With[{ intersectionLeafBoxes=BVHLeafBoxIntersection[BVHObj,rayOrigin,rayDest] }, Block[{i},If[intersectionLeafBoxes=!={}, Return[Catch[For[i=1,i<Length[#],i++, Function[{thowQ},If[thowQ,Throw[thowQ]]][intersectRayTriangle[#[[1]],#[[2]],#[[3]],rayOrigin,rayDest]&@#[[i]]] ]&[DeleteDuplicates[Flatten[Lookup[BVHObj["LeafObjects"],intersectionLeafBoxes],1]]]]===True], Return[False] ]] ]; Once the tree has been fully searched, the remaining boxes are used to lookup their associated polygons. Since the same polygon may intersect more than one box, any duplicates are deleted. A line-triangle intersection test is iteratively applied over the resultant list, breaking at the first instance of a True return. This ray has now been found to intersect a part of the 3D model thus its origin point (from the `projectionPts` list) will represent a single point of shadow on the projection surface. This point is stored in a list which will be used to draw the shadow for a single frame. candidatePolys = DeleteDuplicates[Flatten[Lookup[ bvh2["LeafObjects"], BVHLeafBoxIntersection[bvh2, raySource, rayDestination] ], 1]]; intersectingPolys = Select[candidatePolys,PrimitiveIntersectionQ3D[Line[{raySource, rayDestination}],Triangle[#]] &]; rayModelIntersectionPolys = Graphics3D[{ {Green, Thickness[0.01], Line[{raySource, rayDestination - {220, -400, 400}}]}, {Hue[1, 1, 1, .5], EdgeForm[Black], Polygon[candidatePolys]}, {Hue[0.3, 1, 1, .5], Polygon[intersectingPolys]} }, Boxed -> False]; Row[Show[rayModelIntersectionPolys, ViewPoint -> #, ImageSize -> Medium] & /@ {{0, 0, \[Infinity]}, {0, \[Infinity], 0}}] Highlighted in green, the ray has been found to intersect with 2 polygons. ![enter image description here][18] The BVH search is performed for each ray, for each frame. A scene is the input for the ray caster. If a scene is to be re-processed with different parameters then a new scene must be made. The output of the ray caster is held within a scene object. The data for each frame is associated to its frame index and is all held in the scene's "FrameData" field. Begin processing. A status bar will indicate progress in terms of frames rendered. scene = renderScene[scene]; it's best to save any progress by exporting afterwards. Export["House_scene.txt", Compress[scene]] Reviewing Processed Scenes -------------------------- Each frame holds the shadow and ground data separately and have been expressed as zero-thickness cuboids (tiles) and each with side length equal to the `rayRefinement` parameter (recall that smaller values yield finer results). Individual frames are accessed by their frame index. This examines frame 10. Keys[scene["FrameData"][10]] {"ShadowPts", "SourcePosition", "GroundPts"} Accessing the processed scene's "FrameData" field allows a single specified frame to be drawn in Graphics3D. Graphics3D[{ Polygon[scene["BVH"]["PolygonObjects"]], {GrayLevel[0.3], EdgeForm[], Cuboid /@ scene["FrameData"][10]["ShadowPts"]}, {EdgeForm[], Cuboid /@ scene["FrameData"][10]["GroundPts"]}, {Darker@Yellow, PointSize[0.04], Point[scene["FrameData"][10]["SourcePosition"]]} }, Boxed -> False, Background -> LightBlue] ![enter image description here][23] `viewSceneFrame` does the task above for any processed scene and specified frame. It inherits Graphics3D options as well as custom ones affecting the scene elements (shadow and ground style, toggle source drawing and gridlines). viewSceneFrame[scene, 10, DrawGrid -> False, ShadowColor -> GrayLevel[0.3], SurfaceColor -> Lighter@Orange, DrawSource -> True, Boxed -> False, Background -> LightBlue] ![enter image description here][24] Show[viewSceneFrame[scene, 10, DrawGrid -> False, ShadowColor -> GrayLevel[0.3], SurfaceColor -> Lighter@Orange, DrawSource -> True, Boxed -> False, Background -> LightBlue], ViewPoint -> {0, 0, \[Infinity]}] ![enter image description here][25] sceneBounds = Join[ Most[MinMax /@ Transpose[scene["ProjectionPoints"]]], {MinMax[ Last /@ Values[scene["FrameData"][[All, "SourcePosition"]]]]} ]; viewSceneFrame[scene, 10, DrawGrid -> False, ShadowColor -> GrayLevel[0.3], SurfaceColor -> Lighter@Orange, DrawSource -> True, Boxed -> False, Background -> LightBlue, Axes -> True, AxesLabel -> {"X", "Y", "Z"}, PlotRange -> sceneBounds] ![enter image description here][26] Retaining the same options, the scene may also be animated. To ensure a smooth playback, each frame is exported as .gif into `$TemporaryDirectory`, imported back as a list and animated. The animation is also exported for future use. animateScene[scene, DrawGrid -> False, ShadowColor -> GrayLevel[0.3], SurfaceColor -> Lighter@Orange, DrawSource -> True, Boxed -> False, Background -> LightBlue, PlotRange -> sceneBounds, ImageSize -> {{800}, {600}} ] ![enter image description here][27] We can also plot the cumulative solar exposure. All points from the projection plane which don't intersect with the model (i.e, aren't shadow points) are extracted from the scene's frames exposure = Values[scene["FrameData"][[All, "GroundPts"]]] ![enter image description here][28] The occurrences of each exposure point is tallied tally = Tally[Flatten[exposure, 1]] ![enter image description here][29] And the range of frequencies from which is generated tallyRange = Range @@ Insert[MinMax[Last /@ SortBy[tally, Last]], 1, -1] {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, \ 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30} A color scale corresponding to the range of frequencies from above will be used to colorize the plot colorScale = ColorData["SolarColors", "ColorFunction"] /@ Rescale[tallyRange] ![enter image description here][30] Replacement rules are used to replace each exposure point's frequency with it's corresponding color colorScaleRules = Thread @@ {tallyRange -> colorScale} ![enter image description here][31] The resultant exposure map is a list of tiles, each coloured according to it's positional frequency. heatMap = Insert[MapAt[Cuboid, Reverse@MapAt[Replace[colorScaleRules], #, -1], -1], EdgeForm[], 2] & /@ tally ![enter image description here][32] Finally, the map is drawn. It's still a `Graphics3D` object so it may be rotated and viewed from any angle. Row[{ Show[Graphics3D[{ {Opacity[0.3], Green, Polygon[scene["BVH"]["PolygonObjects"]]}, heatMap }, Boxed -> False, ImageSize -> Large], ViewPoint -> Above], BarLegend[{"SolarColors", MinMax[tallyRange]}] }] ![enter image description here][33] The process of generating an exposure map forms a function within the `GeometricIntersections3D` package. Alternative color schemes may also be specified. sceneExposureMap[scene, "TemperatureMap"] ![enter image description here][34] The bar scale for the exposure plot measures duration in frames but a time scale may be recovered. Given that the solar path used to light the scene lasts about 14 hours and the scene was rendered for 30 frames, that gives about 30 minutes per frame. dailySunHours = UnitConvert[DateDifference[Sunrise[], Sunset[]], MixedRadix["Hours", "Minutes", "Seconds"]] ![enter image description here][35] dailySunHours/30 ![enter image description here][36] This has been a very rewarding project with some exciting potentials beyond computer graphics. Indeed, much optimisations can be made to the intersections package. The different methods of space partitioning for BVH construction should be investigated as the one currently employed is rather rudimentary. Anti-aliasing methods to be investigated also. Both the House and Sundial processes are documented in the notebooks attached. All necessary data may also be downloaded to save time. [1]: https://en.wikipedia.org/wiki/Shadow_mapping [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=animation.gif&userId=605083 [3]: https://3dwarehouse.sketchup.com/ [4]: https://github.com/b-goodman/GeometricIntersections3D [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_Import.png&userId=605083 [6]: https://en.wikipedia.org/wiki/Bounding_volume_hierarchy [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_TreeLV1.png&userId=605083 [8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_leafBoxesLV1.png&userId=605083 [9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=cuboidSubdivide.gif&userId=605083 [10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_TreeLV2.png&userId=605083 [11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_leafBoxesLV2.png&userId=605083 [12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_projectionPoints.png&userId=605083 [13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=solarPosition.PNG&userId=605083 [14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_scenePreview.png&userId=605083 [15]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_sceneConstructor.png&userId=605083 [16]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_projectionPoints.png&userId=605083 [17]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_raySearch.png&userId=605083 [18]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_rayIntersection.png&userId=605083 [19]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_projectionPoints.png&userId=605083 [20]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_projectionPoints.png&userId=605083 [21]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_projectionPoints.png&userId=605083 [22]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_projectionPoints.png&userId=605083 [23]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_singleFrame_1.png&userId=605083 [24]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_singleFrame_2.png&userId=605083 [25]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_singleFrame_3.png&userId=605083 [26]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_singleFrame_4.png&userId=605083 [27]: http://community.wolfram.com//c/portal/getImageAttachment?filename=animation_House.gif&userId=605083 [28]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_exposureStep_A.png&userId=605083 [29]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_exposureStep_B.png&userId=605083 [30]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_exposureStep_C.png&userId=605083 [31]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_exposureStep_D.png&userId=605083 [32]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_exposureStep_E.png&userId=605083 [33]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_solarMap_A.png&userId=605083 [34]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Process_House_solarMap_B.png&userId=605083 [35]: http://community.wolfram.com//c/portal/getImageAttachment?filename=sunHours.png&userId=605083 [36]: http://community.wolfram.com//c/portal/getImageAttachment?filename=sunHoursPerFrame.png&userId=605083 Benjamin Goodman 2017-06-01T07:01:10Z https://community.wolfram.com/groups/-/m/t/1298554 I look at the blog post with the 11.3 word cloud with 'Blockchain' as the BIG center and ask how important is that? As I run the exact same data science GPU code on identical hardware software configuration except for the change from Mathematica 11.2 to Mathematica 11.3 and see my neural network performance go from 295 seconds on 11.2 to 2038 seconds on 11.3. Again NO change other than Mathematica version. And then I see that Mathematica 11.3 still does not support current XCode LLVM/GCC compiler or NVIDIA for CUDA tools (watch it move back to old paclet for Mathematica 10.5 after you upgrade your XCode command line tools to current version, am I expected to pay money to figure this out?) . This is my experience as I explore the value of Mathematica since release 10 to today for data science and at the same time see the massive improvements and quality of Python, Jupyter, NVIDIA, iOS CoreML, Vulkan, Tensorflow and core GPU computing on MacOS, iOS and Linux. Really questioning the value proposition of Wolfram for data science going forward. Sad. David Proffer 2018-03-10T04:14:59Z https://community.wolfram.com/groups/-/m/t/454405 Clustering decomposition is a data-mining and data processing technique for large datasets grouping into simple representative objects. Although clustering is less known approach than other grouping methods (factor analysis in particular), it comes particularly handy when we face large sets of data and trying to identify patterns and features common to each cluster. We demonstrate the case on the financial data where we analyse a large multi-asset portfolio with unique financial returns. We compare decomposition methods and provide cluster characteristics using statistical and probabilistic analysis including risk. ![Clustering image][1] #Cluster analysis - brief introduction Cluster analysis is a data-mining and data processing approach for determining grouping patterns in the data structure. It is less known than other exploratory techniques, but still powerful and valid method for large dataset classification, pattern recognition, information retrieval and image analysis. It is generally referred as is an unsupervised learning technique used for classification of data where individual elements are partitioned into groups called clusters that represent proximate collections of data elements based on a **distance** or **dissimilarity** function. Identical element pairs have zero distance or dissimilarity, and all others have positive distance or dissimilarity. What is special about clusters? It is a method for determining how cases rather than variables group together. Structural features are handled though the distance function. Elements with similar proximity are grouped into clusters with consistent distance characteristics. ##Clusters in financial data analysis Clusters are ideal method for classifying large sets of data into meaningful groups that can be further analysed using standard exploratory techniques. Clusters can be effectively used to reduce the dimensionality of data to be analysed. Each cluster can be effectively used as a *combined variable* with its own grouped characteristic. Clustering is closely linked to statistical distributions and represents *multi-objective optimisation problems* that naturally arise in finance. #Clustering of financial returns We look at clustering application on financial returns and consider the following case: We have collected large multi-asset portfolios with computed financial returns. Our objective is to divide the total portfolio into groups with similar characteristics and obtain meaningful statistics of each group. ###Simulation of financial returns portA = RandomVariate[NormalDistribution[-0.01, 0.008], {1600, 2}]; portB = RandomVariate[LogisticDistribution[0.007, 0.01], {1200, 2}]; portC = RandomVariate[StudentTDistribution[0.015, 0.01, 4], {1200, 2}]; portD = RandomVariate[LaplaceDistribution[-0.007, 0.01], {1000, 2}]; ###Creating combined portfolio portret = Join[portA, portB, portC, portD]; Total size of combined portfolio: Total[Length /@ portret] > 10000 With distributional patterns showing skewed distribution of combined portfolio returns Histogram[Flatten[portret], 40, ChartStyle -> "Rainbow"] ![enter image description here][2] ###This is confirmed in the 3D image Histogram3D[portret, 50, ColorFunction -> "Rainbow"] ![enter image description here][3] ##Defining clustering of financial returns: Clusters are built on the notion of similarity / proximity amongst individual returns. Mathematica 10 offers several measures to choose from - we test four of them: 1. Euclidean distance: Sqrt[\[Sum](u-v)^2] 2. Squared Euclidean distance: \[Sum](u-v)^2 3. Manhattan distance: \[Sum]\[LeftBracketingBar]u-v\[RightBracketingBar] 4. Canberra distance: \[Sum]\[LeftBracketingBar]u-v\[RightBracketingBar]/(\[LeftBracketingBar]u\[RightBracketingBar]+\[LeftBracketingBar]v\[RightBracketingBar]) . iSize = 250; {ListPlot[ FindClusters[portret, 4, DistanceFunction -> EuclideanDistance], PlotLabel -> "Eucld Dist", ImageSize -> iSize], ListPlot[FindClusters[portret, 4, DistanceFunction -> SquaredEuclideanDistance], PlotLabel -> "Sq Eucld Dist", ImageSize -> iSize], ListPlot[FindClusters[portret, 4, DistanceFunction -> ManhattanDistance], PlotLabel -> "Manht Dist", ImageSize -> iSize], ListPlot[FindClusters[portret, 4, DistanceFunction -> CanberraDistance], PlotLabel -> "Canberra Dist", ImageSize -> iSize]} ![enter image description here][4] We can see that each distance function partitions clusters in a distinct way. #Working with clusters ##Selecting the cluster Let's select the Manhattan distance method for clustering of our mega-portfolio: mclust = FindClusters[portret, 4, DistanceFunction -> ManhattanDistance]; ListPlot[mclust, PlotMarkers -> Automatic, PlotLegends -> {"Clust 1", "Clust 2", "Clust 3", "Clust 4"}] ![enter image description here][5] ##Analysing each cluster profile Clusters size: BarChart[Map[Length, mclust], PlotLabel -> Style["Clusters size", 16], ChartStyle -> "DarkRainbow", BarOrigin -> Left, LabelingFunction -> After] ![enter image description here][6] We can observe unequal distribution of cluster sizes => cluster 1 is just half of the cluster 4. This is due to the distancing distribution of clusters specification. ###Cluster Norm Cluster norm provides valuable information about the distance function inside each cluster. BarChart[Map[Norm, mclust], PlotLabel -> Style["Clusters norm", 16], ChartStyle -> "RoseColors", BarOrigin -> Right, LabelingFunction -> Before] ![enter image description here][7] #Statistical analysis of clusters Clusters are treated as 'objects' and we can perform any statistical analysis on them. For example - we can compute descriptive statistics to identify moments of each cluster. ##Location and dispersion measures size = Length[mclust]; legnd = {"Cluster 1", "Cluster 2", "Cluster 3", "Cluster 4"}; clmean = Table[Mean[Flatten[mclust[[i]]]], {i, size}]; clvol = Table[StandardDeviation[Flatten[mclust[[i]]]], {i, size}]; {BarChart[clmean, ChartStyle -> "Pastel", PlotLabel -> "Clusters means", LabelingFunction -> Above, ImageSize -> 320, ChartLegends -> legnd], BarChart[clvol, ChartStyle -> "FallColors", PlotLabel -> "Clusters vols", LabelingFunction -> Above, ImageSize -> 320, ChartLegends -> legnd]} ![enter image description here][8] First two clusters reside in the negative return territory, but are less volatile than the ones which show positive returns. We can get further insight into each cluster dispersion by looking at quartile deviation and inter quartile range: clqdev = Table[QuartileDeviation[Flatten[mclust[[i]]]], {i, size}]; cliqrng = Table[InterquartileRange[Flatten[mclust[[i]]]], {i, size}]; {BarChart[clqdev, ChartStyle -> "LakeColors", PlotLabel -> Style["Clusters Quartile Deviation", 16], LabelingFunction -> Above, ImageSize -> 320, ChartLegends -> legnd], BarChart[cliqrng, ChartStyle -> "SunsetColors", PlotLabel -> Style["Clusters vols", 16], LabelingFunction -> Above, ImageSize -> 320, ChartLegends -> legnd]} ![enter image description here][9] The above dispersion statistics is confirmed also in the quartile domain - quartile deviation is the lowest for negative returns clusters, but higher for the positive one. This indicates higher risk in the positive return segments. ##Clusters shape measures cskew = Table[Skewness[Flatten[mclust[[i]]]], {i, size}]; ckurt = Table[Kurtosis[Flatten[mclust[[i]]]], {i, size}]; {BarChart[cskew, ChartStyle -> "MintColors", PlotLabel -> Style["Clusters skewness", 16], LabelingFunction -> Above, ImageSize -> 320, ChartLegends -> legnd], BarChart[ckurt, ChartStyle -> "LakeColors", PlotLabel -> Style["Clusters kurtosis", 16], LabelingFunction -> Above, ImageSize -> 320, ChartLegends -> legnd]} ![enter image description here][10] Moments statistics reveal non-normality pattern in all clustered data. #Probabilistic analysis of clustered returns Extension to the probabilistic calculations on the clusters is trivial: For example - we may want to determine each cluster probability of financial return < 0 Table[Probability[x < 0, x \[Distributed] Flatten[mclust[[i]]]], {i, size}] // N; BarChart[%, PlotLabel -> Style["Clusters return probability < 0", 16], ChartStyle -> "Rainbow", LabelingFunction -> Above] ![enter image description here][11] Being in the negative return domain, the first two clusters show the highest probability of negative returns. ##Clusters risk measure We can easily calculate Value at Risk threshold for each cluster: varT = Table[Quantile[Flatten[mclust[[i]]], 0.01], {i, size}]; BarChart[varT, ChartStyle -> "SolarColors", PlotLabel -> Style["VaR threshold at 99% level", 16], LabelingFunction -> Below] ![enter image description here][12] and then using the above measure to obtain the Tail VaR statistics: tVaR = Table[ NExpectation[x \[Conditioned] x < varT[[i]], x \[Distributed] Flatten[mclust[[i]]]], {i, size}]; BarChart[tVaR, ChartStyle -> "TemperatureMap", PlotLabel -> Style["Tail VaR threshold at 99% level", 16], LabelingFunction -> Below] ![enter image description here][13] Tail VaR (Expected shortfall) reveals the same risk as the VaR above. The first cluster is the most riskiest whilst the last one in the least riskiest cluster. ##Cluster distributions Creating clusters objects allow us to visualise and work with cluster distributions Table[Histogram[Flatten[mclust[[i]]], 25, ColorFunction -> Function[{height}, ColorData["Rainbow"][height]], ImageSize -> 225], {i, size}] ![enter image description here][14] Clusters one and four generate highly skewed profiles - cluster 1 negative and cluster 4 positive. Clusters two are three are more symmetrical. The distribution patterns can also be analysed in the 3D format as they provide richer insight into the distributions in higher dimensions. As we can see below, the low-frequency outliers are still present in each cluster and add to the risk of each group. clr = {"Pastel", "LightTemperatureMap", "RedBlueTones", "AvocadoColors"}; Table[Evaluate@ Histogram3D[mclust[[i]], 50, "PDF", ImageSize -> 250, ColorFunction -> clr[[i]]], {i, size}] // Quiet ![enter image description here][15] #Summary ##Why clusters? - Ideal tool for knowledge discovery and pattern recognition in datasets. - Great technique for automatic data classification and numerical taxonomy. - Well-suited tool for financial data analysis: - Patterns detection - Drivers recognition - Characteristics extraction Great technique for automatic data classification and numerical taxonomy [1]: /c/portal/getImageAttachment?filename=DClustersImage.jpg&userId=387433 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Clusteringfiancialdata.png&userId=95400 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=p2.png&userId=95400 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=p3.png&userId=95400 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=p4.png&userId=95400 [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=p5.png&userId=95400 [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=p6.png&userId=95400 [8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=p7.png&userId=95400 [9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=p8.png&userId=95400 [10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=p9.png&userId=95400 [11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=p10.png&userId=95400 [12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=p11.png&userId=95400 [13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=p12.png&userId=95400 [14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=p13.png&userId=95400 [15]: http://community.wolfram.com//c/portal/getImageAttachment?filename=p14.png&userId=95400 Igor Hlivka 2015-03-07T00:17:13Z https://community.wolfram.com/groups/-/m/t/374658 Please, read the following article to appear in next month's issue of the Notices of the American Mathematical Society: http://www.ams.org/notices/201410/rnoti-p1249.pdf Thank you! Gilmar Rodriguez-Pierluissi 2014-10-22T17:24:13Z https://community.wolfram.com/groups/-/m/t/218587 Hi all, one of my friends shared the following link, which I found interesting to share with you and by the way, ask the community if it is to do something like the machine enigma that is on that page, I hope someone has any idea how to do it. [url=http://enigmaco.de/enigma/enigma.swf]http://enigmaco.de/enigma/enigma.swf[/url] Luis Ledesma 2014-03-13T23:51:00Z https://community.wolfram.com/groups/-/m/t/394537 Hello all, I am writing to tell you my idea. The process of splitting up a triangle either in four smaller triangles, do so by the larger angle as shown below: Graphics[Line[{{0, 0}, {7, -5}, {8, 10}, {0, 0}}]] After analyze the angles of the triangle we see that the larger angle is what is at the point {0,0}, subsequently we construct a straight line to the midpoint of the opposite side to the point {0,0 } Finally we estimate the midpoints of the sides adjacent to the point {0,0 } and the join by a straight line to the midpoint of the opposite side that we calculated above ,for finally getting the following figure: ![first step][1] If we do the same steps with each of the four triangles, we will be able to obtain more triangles 16 in total ![second step][2] Can anyone help me to do what I say, I have made some progress but I am having some problems in order to apply it several times on a initial triangle [1]: /c/portal/getImageAttachment?filename=montanafr.bmp&userId=133435 [2]: /c/portal/getImageAttachment?filename=montanagh.bmp&userId=133435 Luis Ledesma 2014-11-22T19:26:37Z https://community.wolfram.com/groups/-/m/t/568332 Hello all, I am having confusion with the IF statement because I have seen that in other languages there is ELSEIF or ELIF, and when searching for something similar in Mathematica didn't find it, it is for this reason that I am turning to you to ask them if there is something similar to ELSEIF or ELIF or definitely should i use WHICH, I share with you some images of what I am talking about. By its aid, a thousand thanks,greetings ![elifmaple][1] HERE IN MATLAB ![elseifmatlab][2] [1]: /c/portal/getImageAttachment?filename=elifmaple.PNG&userId=133435 [2]: /c/portal/getImageAttachment?filename=elseifmatlab.PNG&userId=133435 Luis Ledesma 2015-09-21T00:35:50Z https://community.wolfram.com/groups/-/m/t/434905 This hackathon is intended to propose some challenges around the Smart City Concept and offer the participants to showcase its skills, learn emerging technologies and share ideas. Main objective is to promote the usage of the iCity platform building new services based on PC or embedded systems such as simple platforms like Raspberry Pi or Galileo boards. In particular, to develop applications through iCity Platform, interacting with opened city’s Information Systems to provide public interest services. In particular, Information Services offered by Municipality of Barcelona. Main topics are Data acquisition and actuation, Monitoring and management, Security, Transport and Mobility, e-Government, Environment, Tourism and culture, Sustainability. The Hackathon is opened to developers, students, researchers, business thinkers, policy analysts, journalists, designers, community organizers, urban planners, or anyone else who is interested in solving the biggest urban challenges today. Bernat Espigule will be available during the event to teach you the Wolfram language for projects developed with Raspberry Pi. Global event: http://www.global.datafest.net/ Local event: http://www.global.datafest.net/cities/barcelona-spain Anna Calveras 2015-02-04T13:35:43Z https://community.wolfram.com/groups/-/m/t/550504 ![Look familiar...?][1] When last did you solve a quadratic equation by hand? Probably not since school, I'm guessing. It's an open secret that maths education is way behind the times, failing to equip kids with skills they need in the real world. As a Wolfram Community member, you may well have come across the [Computer-Based Maths initiative][2], driven by Conrad Wolfram. For those who don't know, it's a programme designed to bring coding and computers into school maths curricula worldwide, using Wolfram technology. And now the CBM team wants *your* ideas ahead of the fourth [CBM Summit in London on 19-20 November][3]. We already have Jaak Aaviksoo, Simon Peyton Jones and Raspberry Pi's Eben Upton, who [spoke at the last CBM Summit][4] in 2013. Now we'd like to hear from you... - Who would *you* like to hear speaking on this subject? - Do you have something you'd like to present yourself? - What are the most important topics that should be covered? Think about your country and your workplace too: - Are there thought leaders, education revolutionaries or forward-thinking math education projects the CBM team should know about? I'm looking forward to your comments...and maybe see you in London! [![CBM Summit, London, 19-20 November][5]][6] [1]: /c/portal/getImageAttachment?filename=_thumb_117376.png&userId=383623 [2]: https://www.computerbasedmath.org/ [3]: http://www.computerbasedmath.org/events/maths-education-summit-2015/ [4]: https://www.youtube.com/watch?v=NZvttwpeVrc&list=PLzKFBYmW-UKpLGkkprg5LkHUVPaCV85R1&index=35 [5]: /c/portal/getImageAttachment?filename=SummitFooterFullSize.jpg&userId=383623 [6]: http://www.computerbasedmath.org/events/maths-education-summit-2015/ Richard Asher 2015-08-20T15:52:37Z https://community.wolfram.com/groups/-/m/t/1045419 I was reading an [online article about using the Pandas package of Python][1]. I think it might be fun to see how Wolfram Language can handle these tasks in manageable amount of code. Lets begin: (*code source*) url = "https://archive.ics.uci.edu/ml/machine-learning-databases/pima-indians-diabetes/pima-indians-diabetes.data" #Import Data# ###Python### import matplotlib.pyplot as plt import pandas names = ['preg', 'plas', 'pres', 'skin', 'test', 'mass', 'pedi', 'age', 'class'] data = pandas.read_csv(url, names=names) ###Wolfram Language### (* $Version 11.1.0 for Mac OS X x86 (64-bit) (March 16, 2017)*) data = Import[url]; names = {"preg", "plas", "pres", "skin", "test", "mass", "pedi", "age", "class"}; dataset = Dataset[Map[Association @@ Thread[names -> #] &, data]] (* turns {6,148} to <| preg -> 6 , plas -> 148 |>, row-wisely *) ![ds][2] #Univariate Plots# ## Histogram ## ### Python ### data.hist() plt.show() ###Wolfram Language### width["class"] = {0.1}; (* Very flexible to adjust the width of the bins on the fly *) width[item_] := Automatic; Histogram[dataset[All, #], width[#], PlotLabel -> #] & /@ names ![conv][3] ![plot0][4] ## Density Plot ## > The plots look like an abstracted histogram with a smooth curve drawn through the top of each bin, much like your eye tried to do with the histograms. So in Wolfram Language this is done by using a automatic smoothing kernel in `SmoothHistogram`. Just to be clear here, `DensityHistogram` in Mathematica means something different, which is like a 2D density plot with discrete color scale. ###Python### data.plot(kind='density', subplots=True, layout=(3,3), sharex=False) plt.show() ###Wolfram Language### SmoothHistogram[dataset[All, #], PlotRange -> Full, PlotLabel -> #] & /@ names ![plt2][5] ##Box Whisker Plot ## ###Python### data.plot(kind='box', subplots=True, layout=(3,3), sharex=False, sharey=False) plt.show() ###Wolfram Language### BoxWhiskerChart[dataset[All, #], PlotLabel -> #] & /@ names ![plt3][6] # Multivariate Plot # ##Correlation Matrix Plot## ###Python### correlations = data.corr() # plot correlation matrix fig = plt.figure() ax = fig.add_subplot(111) cax = ax.matshow(correlations, vmin=-1, vmax=1) fig.colorbar(cax) ticks = numpy.arange(0,9,1) ax.set_xticks(ticks) ax.set_yticks(ticks) ax.set_xticklabels(names) ax.set_yticklabels(names) plt.show() ###Wolfram Language### You are allowed to tweak the data with simple code here to have more control: n = Length[names] corr[dataset_, tuple_] := Correlation[ N@Normal@dataset[All, tuple[[1]]], N@Normal@dataset[All, tuple[[2]]] ] Generate some tuple of name pair grid = Partition[Tuples[names, 2], n] (*{{{preg,preg},{preg,plas},{preg,pres},{preg,skin},{preg,test} ... }}}*) res = Map[corr[dataset, #] &, grid, {2}] (* create correlation matrix : {{1., 0.129459, 0.141282, -0.0816718,...},...} *) Control label display by yourself xLabel=yLabel=Transpose[{Range[n],names}] (* {{1,preg},{2,plas},{3,pres},{4,skin},{5,test},{6,mass},{7,pedi},{8,age},{9,class}} *) Use `MatrixPlot` to create a color grid: MatrixPlot[res, FrameTicks -> {{yLabel, None}, {None, xLabel}}, FrameStyle -> Directive[14, Italic] ] ![plt4][7] ##Scatterplot Matrix## ###Python### scatter_matrix(data) #default settings plt.show() ###Wolfram Language### The plot is broken down to a combo of `ListPlot` and `Histogram` according to the python article I was reading. For each factor pair, I use the following function to create data points and plot them together: pair[dataset_, tuple_] := Transpose[{ N@Normal@dataset[All, tuple[[1]]], N@Normal@dataset[All, tuple[[2]]] }] ListPlot[pair[dataset, {"age", "skin"}], PlotStyle -> PointSize[0.02], AspectRatio -> 1] (*customized settings*) ![scatter1][8] So I create a plot function as a wrapper upon the `pair` and `corr` function with the similar signature plotfun[dataset_, tuple_] := If[tuple[[1]] === tuple[[2]], Histogram[dataset[All, tuple[[1]]], Ticks -> None],(*histogram on diagonal*) ListPlot[pair[dataset, tuple], PlotStyle -> PointSize[0.03], AspectRatio -> 1, Ticks -> None, Axes -> None, ImageSize -> {80, 80}] ] The `ListPlot` is somewhat longer than the Python plot function because I think I can show some beautification settings in Mathematica to have the plot a professional look. Python users can point out how to do this with matplotlib in the comment. The action code to implement the plot over a grid is one-liner: Grid[Map[plotfun[dataset, #] &, grid, {2}]] // Rasterize ![scattergrid][9] The working notebook is attached. Please download and play around. The test data is also provided in `testdata.m` in the form of `Dataset[...]` in case the url above is dead. You can just import this file with `data=Import["<path>/<to>/testdata.m"]` and the dataset is ready to be used in Mathematica. [1]: http://machinelearningmastery.com/visualize-machine-learning-data-python-pandas/ [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=datset.png&userId=23928 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=conv.png&userId=23928 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=plt0.png&userId=23928 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=plt2.png&userId=23928 [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=plt3.png&userId=23928 [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=plt4.png&userId=23928 [8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=plt5.png&userId=23928 [9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=plt6.png&userId=23928 Shenghui Yang 2017-03-28T01:47:16Z https://community.wolfram.com/groups/-/m/t/897811 **Introduction to the Problem** While a gate-based quantum computer has yet to be implemented at the level of more than a handful of qubits, and some worry that the decoherence problem will remain an obstacle to real-world use of these machines; the field of theoretical quantum computing has its own virtue apart from these problems of construction and implementation. The theory of quantum computation and quantum algorithms have been used as powerful tools to tackle long-standing problems in classical computation such as proving the security of certain encryption schemes and refining complexity classifications for some approaches to the Traveling Salesman problem. Moreover, learning how to apply quantum effects like superposition, interference, and entanglement in a useful, computational, manner can help students gain a better understanding of how the quantum world really works. These educational and research advantages of quantum computing, along with the ever-present goal of designing new quantum algorithms that can provide us with speedups over their classical counterparts, furnish ample reason to make the field as accessible as possible. The goal of this project was to do just that by using the Wolfram language to design functionality that allows for researchers and students alike to engage with quantum computing in a meaningful way. **Getting it Done** This project involved the design and development of a suite of functions that allows for the simulation of quantum computing algorithms. The overarching goal was a framework that allows for easy implementation of quantum circuits, with minimal work done by the user. The specific design challenges were to have a tool simple enough to be used as an educational aide and powerful enough for researchers. To this end circuits can be built iteratively, allowing students, and those new to quantum computing, to build a working knowledge of the field as they increase the complexity of the algorithms. The system has a universal set of gates allowing it to carry out any operation possible for a quantum computer (up to limits on the number of qubits due to the size of the register). ---------- *Short note on this: I have not rigorously tested the system yet, but unless you want to wait several hours for your computation to complete, I suggest not attempting computations with more than ~20 qubits. To classically simulate an N-qubit register, requires a state vector of length 2<sup>N</sup>. Interestingly, it is this insight into the computational difficulty of simulating a quantum state that led Feynman to realize the power that quantum computing could have.* ---------- The project has functionality for the following gates: Hadamard, X, Y, Z, Rotation (any angle, about any axis), C-NOT, C-anything, SWAP, and QFT. It takes input in standard quantum circuit notation, and can output circuit diagrams, and the corresponding unitary transformation matrix as well as return the probabilities for results of measurements on a given qubit. Moreover, there is built in functionality for easy circuit addition, allowing one to stitch together large circuits from smaller ones, a boon for comprehension and testing. **A Simple Example** We initialize some random circuit by specifying it's corresponding circuit notation. For sake of brevity, we start with a medium-sized circuit that is already formed, and perform operations on it, but one can easily build a circuit up qubit-by-qubit and gate-by-gate with the applyQ and circuitQ functions. Below we name some variable `quantumCircuit` using the function `circuitQ` to which we pass some circuit notation. This notation is just a matrix representing the quantum logic circuit, with the gates and qubits arranged schematically. quantumCircuit= circuitQ[{{"H", "R[1,Pi/2]", "N", "SWAP1"}, {"H", 1, "C", "SWAP2"}, {"X", 1, "C", 1}}]; `circuitQ` outputs the circuit diagram corresponding to the notation given: ![enter image description here][1] But, say I wish to alter the circuit. We can add in as many layers of gates or extra qubits as we wish, without having to deal with the pesky notation matrix. Here I add a Hadamard gate to the second qubit after the SWAP using the function `applyQ`: applyQ[quantumCircuit, "H", 2] the output of which is: ![enter image description here][2] One can also use `Append`, `Join`,`Nest` and a variety of other Wolfram language functions to build up highly complex circuits. However, the `circuitQ` function is overloaded, and one can also perform computations with it. We will now build the actual unitary transformation matrix that corresponds to the circuit diagram: unitar=matrixBuild@quantumCircuit which, for our circuit, produces: ![enter image description here][3]. Now we can easily perform operations with circuit. Let's specify some random 3 qubit initial state (in the computational basis): initalState = {1, 0, 0, 1, 0, 0, 1, 0} // Normalize ![enter image description here][4] We can pass this initial state to the circuit easily with: premeasure=unitar.initialState which gives back the state of the quantum register (in this case our 3 qubits) after they have been operated on by the circuit, but pre-measurement: ![enter image description here][5] We can now sample our state using the `projection` function. Here we will calculate the probability of getting state |0> when measuring qubit #3: projection[2,0,premeasure] which, for our case, gives back a probability of 2/3. **Wrap Up** This was only a very simple example. Using `applyQ` and `circuitQ` one can build and modify highly complex quantum circuits easily. `matrixBuild` does all the math of calculating the corresponding unitary transformation matrix for you. All that is left is for the user to pass an initial state and see the output. A good learning technique is to start with a very simple circuit and initial state, and slowly build up in complexity, performing measurements at each step, to build an intuition and working knowledge of any given quantum circuit. An obvious next step for the project would be to add functionality that allows for the easy implementation of a general quantum oracle. I would also like to add more gates to the gate library, including: $\sqrt{SWAP}$, Tofolli, and QFT<sup>-1</sup> which were left out due to lack of time and are trivial to implement. These tools would make it significantly easier for researchers to model any given quantum circuit. **Where is the NKS?** Finding quantum algorithms that perform useful tasks faster than their classical counterparts is an open area of research. However, it is often quite difficult to design these algorithms to take advantage of interference, as well as the structure in a given computational problem that may be useful to exploit. As such, there are only a small number of important quantum algorithms that are currently known. Hopefully this tool will allow for NKS-style search experiments for interesting behavior in quantum circuits. Similar searches have been carried out for classical circuits, and the tools I built will make it easy to generate vast sets of random quantum circuits that follow certain rules. What remains is to build useful analytic tools for combing the space. [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=circuit.jpeg&userId=896802 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=circuit2.jpeg&userId=896802 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=unitar.jpeg&userId=896802 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=3114initialstate.jpeg&userId=896802 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=finalstate.jpeg&userId=896802 Aaron Tohuvavohu 2016-08-02T02:35:38Z https://community.wolfram.com/groups/-/m/t/943405 Recently I wrote a toy [Wolfram Language][1] interpreter as a way to learn more about Wolfram Language. I have implemented some basic language structure and built-in functions. I have hosted it on [github][2]. ![enter image description here][3] # A simple term rewriting system with Wolfram Language's syntax Inspired by the book [Write Yourself a Scheme in 48 Hours](https://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours). I decide to write myself a simple `Wolfram Language`-like interpreter to learn more about `Haskell` as well as achieve a deeper understanding about `Wolfram Language`. ## Running (Using [Stack](https://github.com/commercialhaskell/stack)) git clone https://github.com/jyh1/mmaclone.git cd mmaclone/mmaclone stack setup stack build stack exec mmaclone-exe Prebulid binary files are available on the [release page](https://github.com/jyh1/mmaclone/releases) ## Features This interpreter is intended to mimic every exact detail of `Wolfram Language`, including but not limited to its syntax, semantic, expression structure, evaluation details, etc. (All the scripts below were executed in the REPL session of the `mmaclone` program) 1. The program support nearly all `Wolfram Language`'s syntax sugar, infix operators as well as their precedence. Inequality expression chain is parsed in the same way with `Wolfram Language`. In[1]:= FullForm[a==b>=c<=d<e] Out[1]= Inequality[a,Equal,b,GreaterEqual,c,LessEqual,d] Some more complicated examples. In[2]:= FullForm[P@1@2//3] Out[2]= 3[P[1[2]]] In[3]:= FullForm[P''''[x]] Out[3]= Derivative[4][P][x] In[4]:= FullForm[Hold[(1 ##&)[2]]] Out[4]= Hold[Function[Times[1,SlotSequence[1]]][2]] 2. `Wolfram Language`'s powerful pattern matching is also implemented with scrupulous. (*The famous bubble sort implementation*) In[1]:= sortRule := {x___,y_,z_,k___}/;y>z -> {x,z,y,k} In[2]:= {64, 44, 71, 48, 96, 47, 59, 71, 73, 51, 67, 50, 26, 49, 49}//.sortRule Out[2]= {26,44,47,48,49,49,50,51,59,64,67,71,71,73,96} (*Symbolic manipulation*) In[3]:= rules:={Log[x_ y_]:>Log[x]+Log[y],Log[x_^k_]:>k Log[x]} In[4]:= Log[a (b c^d)^e] //. rules Out[4]= Log[a]+e (Log[b]+d Log[c]) Currently, the derivative function `D` is not built-in supported, but you could easily implement one with the powerful pattern matching facilities. In[5]:= D[a_,x_]:=0 In[6]:= D[x_,x_]:=1 In[7]:= D[a_+b__,x_]:=D[a,x]+D[Plus[b],x] In[8]:= D[a_ b__,x_]:=D[a,x] b+a D[Times[b],x] In[9]:= D[a_^(b_), x_]:= a^b(D[b,x] Log[a]+D[a,x]/a b) In[10]:= D[Log[a_], x_]:= D[a, x]/a In[11]:= D[Sin[a_], x_]:= D[a,x] Cos[a] In[12]:= D[Cos[a_], x_]:=-D[a,x] Sin[a] (*performing derivative*) In[13]:= D[Sin[x]/x,x] Out[13]= -x^(-2) Sin[x]+Cos[x] x^(-1) In[14]:= D[%,x] Out[14]= -Cos[x] x^(-2)-(-2 x^(-3) Sin[x]+Cos[x] x^(-2))-x^(-1) Sin[x] Pattern test facility is of the same semantic with `Wolfram Language`'s. In[15]:= {{1,1},{0,0},{0,2}}/.{x_,x_}/;x+x==2 -> a Out[15]= {a,{0,0},{0,2}} In[16]:= {a, b, c, d, a, b, b, b} /. a | b -> x Out[16]= {x,x,c,d,x,x,x,x} In[17]:= g[a_*b__]:=g[a]+g[Times[b]] In[18]:= g[x y z k l] Out[18]= g[k]+g[l]+g[x]+g[y]+g[z] In[19]:= q[i_,j_]:=q[i,j]=q[i-1,j]+q[i,j-1];q[i_,j_]/;i<0||j<0=0;q[0,0]=1;Null In[20]:= q[5,5] Out[20]= 252 3. Some interesting scripts In[1]:= ((#+##&) @@#&) /@{{1,2},{2,2,2},{3,4}} Out[1]= {4,8,10} In[2]:= fib[n_]:=fib[n]=fib[n-1]+fib[n-2];fib[1]=fib[2]=1;Null In[3]:= fib[100] Out[3]= 354224848179261915075 In[4]:= fib[1000000000000] Iteration Limit exceeded, try to increase $IterationLimit In[5]:= Print/@fib/@{10,100} 55 354224848179261915075 Out[5]= {Null,Null} ## More For more information please refer to the project [wiki](https://github.com/jyh1/mmaclone/wiki) (still under construction). ## Features that are likely to be added in future versions: (Some serious design errors are exposed during development, which I consider are inhibiting the project from scaling up. So currently my primary focus would be on refactor rather than adding new features/functions) 1. More mathematical functions (`Sin`, `Cos`, `Mod` etc...) 2. Arbitrary precision floating arithmetic using GMP(GNU Multiple Precision Arithmetic Library), currently arbitrary integer, double and rational number are supported. 2. More built-in functions (`Level`, `Import`, `Derivative`etc...) 3. More sophisticated pattern matching * ~~head specification (of the form Blank[*Head*], currently it only support list type)~~(**Implemented**) * ~~Pattern Test~~(**Implemented**) * ~~BlankSequence, BlankNullSequence~~(**Implemented**) * Other pattern matching expression, like `Verbatim`, `Longest` 4. ~~RecursionLimit~~(**Implemented**) 5. Negative index e.g. in `Part` 6. Negative level specification 7. Curried function e.g. `f[a][b]` (currently it will throw an error if one is trying to attach value to the curried form through `Set` or `SetDelayed`) 8. Use iPython as front end 9. ~~Replace String implementation with more efficient Text~~(**Implemented**) [1]: https://www.wolfram.com/language/ [2]: https://github.com/jyh1/mmaclone [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=demo.png&userId=943384 Yonghao Jin 2016-10-14T15:20:34Z https://community.wolfram.com/groups/-/m/t/1421180 Two months ago, Albert Rich posted ["What's the hardest integral Mathematica running Rubi can find?"](http://community.wolfram.com/groups/-/m/t/1343015) here on the Wolfram Community. You might have also seen that I responded in detail, and pointed out a few things that could help improve Rubi (Rule-based integrator). While it appears nothing really happened afterward, this is far from reality. Since then, Albert and I have worked closely together to make Rubi more accessible and user-friendly. If you would like to learn how our productive collaboration evolved, let me invite you to read [my latest blog-post](http://halirutan.de/programming/Rubi/). However, here, we want to share an update that should serve as an overview of what we have done to improve Rubi. First of all, Rubi has got a new home under [rulebasedintegration.org](https://rulebasedintegration.org/), and its old website will no longer be updated. On the new website, you will find information, installation instructions, and links to the source-code and test-suites. Secondly, we created a [Rubi Organization](https://github.com/RuleBasedIntegration) on GitHub that serves as the headquarters for all things Rubi. It contains all Rubi's code, notebooks, and test-suites nicely structured into several repositories. At the moment, we provide repositories for the * loadable package files and notebook source files defining over 6700 integration rules, * PDF files displaying the rules in human-readable mathematical notation alongside the Mathematica code, and * test-suite files containing over 71000 integration problems and their solutions. The integration test files are available in the syntax used by 4 popular computer algebra systems (Mathematica, Maple, Maxima, and Axiom). The test-suite can be used to compare Rubi's results with other symbolic integrators, including Mathematica's `Integrate` function. In addition to the transition to GitHub, we recently released version 4.16.0.3 of Rubi which significantly expands the class of expressions the system can integrate. But the most noticeable change for users is the completely reworked display of the rules and intermediate steps Rubi uses to integrate expressions. Although installation, usage, and examples are given on [Rubi's website](https://rulebasedintegration.org/), let me show you how easy it is to install and run Rubi 4.16.0.3 using Mathematica 11.3: The command PacletInstall["https://github.com/RuleBasedIntegration/Rubi/releases/download/4.16.0.3/Rubi-4.16.0.3.paclet"]; installs the Rubi-4.16.0.3 paclet on your computer. After that, to load Rubi into Mathematica all you have to do is issue the `Get` command << Rubi` Then to integrate an expression with respect to a variable, use Rubi's `Int` command similar to Mathematica's `Integrate` command. For example, evaluating Int[(Sec[x]^2 + Sec[x]^2*Tan[x])/((2 - Tan[x])*Sqrt[1 + Tan[x]^3]), x] returns the antiderivative (a.k.a. the indefinite integral) ![enter image description here][1] Rubi's unique ability to display the steps it uses to integrate expressions is a great feature of the system. For example, the `Steps` command Steps@Int[(Sec[x]^2 + Sec[x]^2*Tan[x])/((2 - Tan[x])*Sqrt[1 + Tan[x]^3]), x] displays ![enter image description here][2] Here, in red are the rules used to integrate the expression, and in blue are the intermediate results. Each rule can be expanded to show the rule number, which directly corresponds to the index of the rule in `Int`'s list of DownValues. More importantly, you can see the conditions that have to be satisfied so the rule can be applied. ![enter image description here][3] Rubi's `Stats` command provides statistics about the integration. For example, Stats[Int[(Sec[x]^2 + Sec[x]^2*Tan[x])/((2 - Tan[x])*Sqrt[1 + Tan[x]^3]), x]] displays ![enter image description here][4] The leaf-count size of an antiderivative is a crude measure of its complexity. As you can see, Rubi's antiderivative for this integral has a leaf-count of 25. Now compare Rubi's antiderivative with that produced by Mathematica 11.3 for the same integral: Integrate[(Sec[x]^2 + Sec[x]^2*Tan[x])/((2 - Tan[x])*Sqrt[1 + Tan[x]^3]), x] ![enter image description here][5] LeafCount[%] (* 290 *) Note that not only is Mathematica's result more than 11 times the size of Rubi's, it unnecessarily involves elliptic integral functions *and* the imaginary unit. Skeptics might be inclined to ask if Rubi's dramatically simpler result is actually a valid antiderivative. Since symbolic differentiation is much easier than integration, antiderivatives can be verified correct by seeing if its derivative equals the original integrand as follows: expr = (Sec[x]^2 + Sec[x]^2*Tan[x])/((2 - Tan[x])*Sqrt[1 + Tan[x]^3]); FullSimplify[D[Int[expr, x], x] == expr] FullSimplify[D[Integrate[expr, x], x] == expr] ![enter image description here][6] As you can see Mathematica easily verifies Rubi's antiderivative correct, but has a hard time verifying its own antiderivative correct... Albert and I are working on publishing the program used to thoroughly test each new version of Rubi before being released. The test program ensures Rubi's result equals the optimal antiderivative for the over 71000 problems in the test-suite. And yes, the optimal antiderivatives have all been verified correct by differentiation. Of course, the optimal antiderivatives stored in the test-suite are actually just the simplest ones found so far. If you should find a substantially simpler antiderivative than the one in the test-suite, please report it so the test-suite can be made even harder on Rubi! If all that has got you interested in joining Rubi's community of users, check out its website or talk to us in our [Gitter chatroom](https://gitter.im/Rule-Based-Integration/Lobby). [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=10564sSs5M.png&userId=11733 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=qDtIH.png&userId=11733 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=vQ4GR.png&userId=11733 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=43t8e.png&userId=11733 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=xjKTJ.png&userId=11733 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=eCoWB.png&userId=11733 Patrick Scheibe 2018-08-24T02:50:37Z https://community.wolfram.com/groups/-/m/t/126665 Could anyone help? Always getting errors when export simple data to FITS format. I'm using Macbook Air, OS X 10.8.4. Not sure if it's machine dependent.    e.g.,  [mcode]d = First@ Import["http://exampledata.wolfram.com/messier61.fits.gz", "RawData"]; Export["image.fits", d] ConstantArray::ilsmn: Single or list of non-negative machine-sized integers expected at position 2 of ConstantArray[32,{-17}]. >> Join::heads: Heads List and ConstantArray at positions 1 and 3 are expected to be the same. >> BinaryWrite::nocoerce: Join[{83,73,77,80,76,69,32,32,61,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,84,32,47,32,78,111,114,109,97,108,32,70,73,84,83,32,102,105,108,101,32,<<750>>},<<3>>,{32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,<<13>>,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,<<27>>}] cannot be coerced to the specified format. >>[/mcode] XIN Wang 2013-09-19T19:44:31Z https://community.wolfram.com/groups/-/m/t/504085 Hello colleagues... I'm afraid that this is an easy question, but I found no solution yet Here it goes: I have a list of points, and a list of colors (both of the same length), say: aList = {{1, 1}, {2, 3}, {4, 5}, {6, 7}}; colorList = {Black, Red, Blue, Yellow}; I want to plot the points using ListPlot, but taking care that each point should have a different color, according to the colorList. So, the point {1,1} should be colored black, the point {2,3} should be red, and so on.... In the actual problem I'm solving, the length of the list is about 30.000, so I need an efficient way to construct the plots... Thank you very much!!! :-) Daniel Daniel Branco 2015-05-26T15:49:06Z