https://community.wolfram.com RSS Feed for Wolfram Community showing questions tagged with Computer-Based Maths sorted by active. https://community.wolfram.com/groups/-/m/t/3665390 In the Wolfram Problem Generator Arithmetic summary Advanced, I keep seeing WPGDivide in the step-by-step solutions. Can't find anything about this anywhere. Is it a glitch? Edit:Oops I'm dumb, just realized "WPG" probably means "Wolfram Problem Generator". Regardless, why is this showing up and what does it mean? My apologies if this is something obvious. Could I please get help? It seems like im literally the ONLY person who has this problem. "expert" support is totally useless too. ugh retarded and infuriating. Arithmetic. Crazy this broken POS is $12 a month. I'm sorry but WOW! ![enter image description here][1] ![enter image description here][2] ![enter image description here][3] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot_20260317-150428_Chrome.jpg&userId=3662999 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2026-03-17003953.png&userId=3662999 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2026-03-16220458.png&userId=3662999 R L 2026-03-18T05:19:24Z https://community.wolfram.com/groups/-/m/t/1732367 ## Abstract This project is a visualization of Shephard's conjecture, which states that every convex polyhedron admits a self-nonoverlapping unfolding. The conjecture remains unsolved to this day. Currently, there exists unfolding data for several predefined polyhedra in the Wolfram Language, and my goal is to create a function that can do this for any random convex polyhedron. I chose this project because of my love for origami and art, and my interest in 3D visualization. ## Generating a Graph for Connectivity Between Faces The first step was to create a graph that captures the relationship between faces of the polyhedron so that it could be used later to generate the net. The built-in function DualPolyhedron converts the polyhedron to one where each vertex corresponds to a face on the original. I then extracted the vertices of the dual polyhedron and partitioned and sorted them, allowing me to create a graph using those vertices. polyhedronfacegraph[polyhedron_]:= Block[{dualpolyhedron, vertexlist, vertexpairings, sortedvertices}, dualpolyhedron = DualPolyhedron[polyhedron]; vertexlist = dualpolyhedron[[2]]; vertexpairings = Flatten[Table[Append[ Partition[vertexlist[[n]], 2, 1], {Last[vertexlist[[n]]], First[vertexlist[[n]]]}], {n, 1, Length[vertexlist]}], 1]; sortedvertices = Sort /@ vertexpairings // DeleteDuplicates; Graph[UndirectedEdge@@@sortedvertices,VertexLabels -> "Name"] ] A random polyhedron and the graph of its dual: ![enter image description here][1] ## Generating Spanning Trees I then used the graph to generate different paths in which a polyhedron could unfold. One way to do this is by using a spanning tree, a tree generated from a graph that retains the same amount of vertices while having the minimum amount of edges. This essentially creates a simple version of what the final net should look like. Each vertex represents a face, and connections between them signify that they are adjacent. It is important to note that not every spanning tree will correspond to a non-overlapping net, which is why I generate a spanning tree from every possible vertex. generatetrees[graph_] := Table[FindSpanningTree[{graph, n}], {n, 1, VertexCount[graph]}] Five of the spanning trees of the previous polyhedron: ![enter image description here][2] ## Generating Net Coordinates To create the net of the polyhedron, I had to implement an unfolding algorithm. My first approach was to extract each face individually, but that ended up complicating the transformations. My final algorithm consisted of applying one transformation to move one face to the xy plane, then unfolding using connections between vertices from the spanning tree. I first created a function to find the normal vector to a plane using the cross product. normvector[coords_] := Cross[coords[[2]] - coords[[1]], coords[[3]] - coords[[1]]]; I then use transformation matrices so that one face is lying on the xy plane, and convert the new mesh into a list of its primitives. The next step is to begin unfolding the polyhedron from its bottom face using the list of spanning trees. To perform an algorithm on each step of the unfolding process, I use the function BreadthFirstScan, which can call the unfold function (discussed next) whenever a new vertex is reached. Finally, the function returns a list of coordinates of the completed net. generatenetcoords[mesh_, tree_]:= Block[{transformations, transformedmesh, meshlist, transformedmeshlist, normals, polygonfaces, transformedrotation}, polygonfaces = Reap[ meshlist = MeshPrimitives[mesh, 2][[All, 1]]; transformations = RotationTransform[{normvector[meshlist[[1]]], {0, 0, -1}}] @* TranslationTransform[-PropertyValue[{mesh, {2, 1}}, MeshCellCentroid]]; transformedmesh = TransformedRegion[mesh, transformations]; transformedmeshlist = MeshPrimitives[transformedmesh, 2][[All, 1]]; normals = normvector[#] &/@ transformedmeshlist; Sow[transformedmeshlist[[1]], "flat"]; transformedrotation[1] = TransformationFunction[IdentityMatrix[4]]; BreadthFirstScan[tree, 1, "DiscoverVertex" -> unfold[transformedmeshlist, normals, transformedrotation]];, {"flat"}][[-1, All, 1]]; Chop[polygonfaces] ] The unfold function operates by finding the intersection of two polygons, calculating the angle between them, and applying transformations using normal vectors to unfold the face. The function returns coordinates of the transformed polygons. unfold[meshlist_, normals_, transformedrotation_][u_, v_, _] /; (u =!= v) := Block[{edgecoord1, edgecoord2, angle, rotation}, {edgecoord1, edgecoord2} = Intersection @@ meshlist[[{u, v}]]; angle = DihedralAngle[{edgecoord1, edgecoord2}, normals[[{u, v}]]]; rotation = RotationTransform[angle, edgecoord2 - edgecoord1, Mean[{edgecoord1, edgecoord2}]]; transformedrotation[u] = transformedrotation[v] @* rotation; Sow[transformedrotation[u] @ meshlist[[u]], "flat"]; ] ## Generating Possible Nets Finally, we put all the functions together. The program iterates through every spanning tree to produce nets using netcoordinates. The third element of each coordinate is deleted to convert the net to 2D. Each net is then tested for overlap by calculating the surface area of the original polyhedron and comparing it to the surface area of the net. Only nets where the two surface areas are equal are appended to the list that is returned. generateallnets[polyhedron_] := Block[{netcoords, trees, graph, mesh, surfacearea, netsurfacearea, goodnets}, mesh = BoundaryDiscretizeGraphics[polyhedron]; graph = polyhedronfacegraph[polyhedron]; trees = generatetrees[graph]; goodnets = {}; Table[ netcoords = First@generatenetcoords[mesh, trees[[treeposition]]]; netcoords = Table[Delete[netcoords[[n, m]], {3}], {n, 1, Length[netcoords]}, {m, 1, 3}]; surfacearea = SurfaceArea[polyhedron]; netsurfacearea = RegionMeasure[RegionUnion[Polygon /@ netcoords]]; If[surfacearea == netsurfacearea, AppendTo[goodnets, Graphics[{Hue[0.94, 0.22, 1.], EdgeForm[{Thin, Pink}], Polygon /@ netcoords}]] ];, {treeposition, 1, Length[trees]} ]; Row[{Graphics3D[polyhedron], goodnets}] ] ## Outputs Upon taking a polyhedron object in as its argument, the final output of the function is a 3D graphic of the original polyhedron and a list of all possible nets. <br> <br> An output of a random polyhedron: ![enter image description here][3] ## Summary With the help of my mentor, I was able to create a program that creates non-overlapping nets for random polyhedra. The process consisted of extracting graphs, creating spanning trees, generating nets, and checking for overlap. The function returns several successful results for every random polyhedron that I tested, although the program does run quite slowly for polyhedra with high numbers of faces, as the complexity of the graph and number of spanning trees increase drastically as the number of faces increase. From this project, I acquired knowledge of many aspects of three-dimensional modeling and geometric transformations, and I hope to work on extensions of this project in the future. ## Future Work A possible extension would be applying a similar algorithm to non-convex polyhedra and showing that it is impossible to generate a non-overlapping net in some cases. Additionally, optimization algorithms could also be implemented to speed up the unfolding process. For example, another function could also be created to generate the first net that is valid, which would greatly increase speed if only one net is desired. ## Acknowledgements I would like to sincerely thank my mentor, Jeremy Stratton-Smith, for providing invaluable advice and help throughout the entire project process. I would also like to thank Chip Hurst for his unfolding algorithm and tips for 3D transformations. Lastly, I would like to thank the Wolfram Summer Camp team for providing me with this opportunity to pursue a project of my choice. [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=polygraph.PNG&userId=1622104 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=graphs.PNG&userId=1622104 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=image.PNG&userId=1622104 Sunny Wang 2019-07-12T01:09:08Z https://community.wolfram.com/groups/-/m/t/2411433 In [this][1] message at Stack Exchange, there is an identity involving the Meijer G function for M2 found at https://oeis.org/A157852. My question here is how can I code a check to a few upper limits in place of infinity to see if we can make ![enter image description here][2] Of course, the proof is always best, particularly here where the Meijer G function for M2 is very sluggish for large upper limits! (I've never gotten over 20.) For all my work on this form of M2 see &[Wolfram Notebook][3] [1]: https://math.stackexchange.com/questions/4303385/can-we-find-sums-for-int-1-infty-e-pi-i-t-leftt1-t-1-right-dt [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2021-11-22063320.png&userId=366611 [3]: https://www.wolframcloud.com/obj/ba90a470-9cc6-4742-b089-613a6ee0d804 Marvin Ray Burns A.G.S. (cum laude) 2021-11-22T11:37:59Z https://community.wolfram.com/groups/-/m/t/896287 Hi, I'm trying to manipulate a Parametric Plot, but I clearly see its not working because I'm not able to fix it, that's why I would love some help. Regards Manipulate[ParametricPlot[{r Cos[x], r Sin[y]}, {y,1,k}, {x, 0, n}, Mesh -> Full], {n, 0, 2 Pi}, {k, 1, 2}] Muhammad Afzal 2016-07-30T07:33:09Z https://community.wolfram.com/groups/-/m/t/2131707 Hello, I used ParamtericPlot for obtaining curves by Euler elasticity theory. The shape of the curve depends on alpha variable which is initial angle in this issue. I am trying to use Manipulate in a ParametricPlot and changing alpha, but something is wrong (the shape of the curve is constant, but I don't know how to plot it without prior defining alpha). I would really appreciate your help and advise. Regards l = 300; \[Alpha] = 130 Degree; k = Sin[\[Alpha]/2]^2; m = 2; \[Lambda]L = (2*m*EllipticK[k])/l; x1L[s_] := -s + 2/\[Lambda]L (EllipticE[ JacobiAmplitude[s*\[Lambda]L + EllipticK[k], k], k] - EllipticE[JacobiAmplitude[EllipticK[k], k], k]); x2L[s_] := -2 k/\[Lambda]L (JacobiCN[EllipticK[k] + (s*\[Lambda]L), k]); Manipulate[ ParametricPlot[{x1L[s], x2L[s]}, {s, 0, l}, AxesLabel -> {x, y}, LabelStyle -> {FontSize -> 10, Darker[Black], Bold}, PlotLegends -> "xlocal"], {\[Alpha], 0, 2 Pi}] Alexandra Man 2020-12-07T16:51:19Z https://community.wolfram.com/groups/-/m/t/2168033 ![enter image description here][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=2021-01-19_19-16-12.gif&userId=23928 [2]: https://www.wolframcloud.com/obj/fb24fca0-a37b-4671-8d20-0ef23bb42762 Shenghui Yang 2021-01-20T04:18:41Z https://community.wolfram.com/groups/-/m/t/1930470 ![enter image description here][1] The resources in this post have now been released on WolframU with completion certificates available. Please visit https://www.wolfram.com/wolfram-u/catalog/computational-thinking/ [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=comp-thinking-icon.png&userId=778999 Alec Titterton 2020-04-09T13:32:00Z https://community.wolfram.com/groups/-/m/t/1933157 Hi there, if someone know why my plots are all gray, and could help me with my code, I will be extremely grateful! Have a nice evening! Michelle Gavilanez 2020-04-10T22:25:56Z https://community.wolfram.com/groups/-/m/t/1900786 Hello. Although I selected the s value differently in these two files, the same result came out. I couldn't understand the reason. I wonder if the results I get are correct. Where do you think I might have made a mistake? &[Wolfram Notebook][1] &[Wolfram Notebook][2] [1]: https://www.wolframcloud.com/obj/db2a2a27-339f-4abb-bd1f-dd70c573a80d [2]: https://www.wolframcloud.com/obj/52dba00d-7f6b-4358-8e42-8da468a5bf89 Meryem Aslı 2020-03-17T23:40:39Z https://community.wolfram.com/groups/-/m/t/1718762 ####*Please download the notebook at the end of the discussion including dynamic feature*#### ---------- ![simulation][1] July 4th is a fabulous holiday season for American families to enjoy the summer with road trip and BBQ party. You can use a deck of poker to entertain your kids and family friends with [James Grime's][2] new card trick on [Numberphile][3]. ##Background## You are given $10$ cards, from Ace to 10. Shuffle them and split them into $2$ rows with five cards in each. Sort one row in ascending order, the other in descending order. Both orders are oriented from left to right. Calculate the absolute values of the difference between two rows and add them up. You can play the poker game multiple times and you will find the sum is always $25$. If you do not have poker at hand, please take a look at the animation above. ##Code## Let's work on the problem with Mathematica to help us understand. In the code I use the icons from this website: $icon="https://www.iconfinder.com/icons/1331558/card_game_diamond_gambling_game_jewelry_poker_sport_icon"; then I directly assign them to `spade` and `diamond` in a notebook: ![spadediamond][4] Use `Framed` to create a nice and simple poker card: cardpicture1[{suit_, val_}] := Framed[Column[{val, suit}, Center, 0, ItemSize -> {6, 2}, ItemStyle -> Directive[24, "Label", Bold]], RoundingRadius -> 8] ![poker][5] Use `Map` to create a list of poker cards: n=10; numbers = Range[n]; pokers1 = AssociationMap[cardpicture1[{spade, #}] &, numbers]; differences = AssociationMap[cardpicture1[{diamond, #}] &, numbers]; Now lets shuffle the deck of 10 cards: shuffle=Permute[numbers,RandomPermutation[10]] (* {3,6,7,5,9,10,8,4,1,2} *) I use this generic permutation method because you can replace `numbers` with other list like 10 prime numbers. Then split it into two rows {row1,row2}={#[[1;;n/2]],#[[n/2+1;;]]}&[shuffle] (* {{3,6,7,5,9},{10,8,4,1,2}} *) Style[Grid[Map[pokers1, {row1, row2}, {2}]], ImageSizeMultipliers -> {1, 1}] ![deck][6] The last two steps are to sort two rows and find the sum of the absolute values of the pairwise differences between the two rows. I use `Grid` an `Style` to make the output neat. With[{r1=Sort@row1,r2=Sort[row2,Greater]}, Module[{sum},sum=Inactive[Plus]@@Abs[r2-r1]; Style[Grid[{ pokers1/@r1, pokers1/@r2, (differences/@Abs[r2-r1]), {Null,SpanFromLeft}, {Style[Row@{sum," = ",Activate[sum]},Large,Italic],SpanFromLeft}}], ImageSizeMultipliers->{1, 1}] ] ] ![sorteddeck][7] ##Proof## You might already notice I have variables like `pokers1` and `cardpicture1` in the code above. I am definitely hiding from something from you. The companion pokers I have, namely `pokers2`, is a deck of super power cards of which the styles get updated given the face value greater than $5$: pokers2 = AssociationMap[cardpicture2[{spade, #}] &, numbers]; where cardpicture2[{suit_, val_}] := Framed[Column[{val, suit}, Center, 0, ItemSize -> {6, 2}, ItemStyle -> Directive[24, "Label", Bold]], FrameStyle -> Directive[If[val > 5, Dashed, Black]], RoundingRadius -> 8] Once we use the super power card, we can see a pattern matches exactly what James claimed in the Numberphile video (using contradiction of stacking dashed/purple numbered card): ![hint][8] Lets take look at one frame: ![direction][9] The third diamond line is from the following flipping transition (dash-solid or purple-black) ![transition][10] $ 25 = 7 + 3 + 2 + 5 + 8$ $ = (10 - 3) + (8 - 5 ) + (6 - 4 )+ (7 - 2 ) + (9 - 1) $ $= (10 + 9 + 8 + 7 + 6) -(1 + 2 + 3 + 4 + 5)$ The sorted rows tells you that all dashed card must sit together. Same happens to the solid line cards. Therefore there is exactly one transition from solid -> dash or dash -> solid in each row. If dashed cards overlapping vertically means we either have at least 6 such cards or one row is not properly sorted. This is contradiction. ##Comment## There are nice functions used here - Use `Inactive[Plus]@@{...}` and then to active the sum expression with `Activate[]`: prints nice hold sum formula and delayed evaluation - `AssociationMap` to create key-poker face dictionary - Animation is generated by [Refresh][11]. Attached at the end of the thread. - Poker design code is from [this demonstration][12] Code snippet just for the calculation (minimum visualization): n = 12; {row1, row2} = {#[[1 ;; n/2]], #[[n/2 + 1 ;;]]} &[Permute[Range[n], RandomPermutation[n]]] f[m_] := If[m > n/2, Framed[m], m] {Grid[{row1,row2}],Sequence@@With[{r1=Sort@row1,r2=Reverse@Sort@row2},{Grid[Map[f,{r1,r2},{2}]],Abs[r1-r2]//Total}]} ![shortcode][13] Formula: Sum[k, {k, 2*m}] - 2*Sum[k, {k, m}] // Simplify (* m^2 *) [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=simulation.gif&userId=23928 [2]: http://bit.ly/grimevideos [3]: https://www.youtube.com/watch?v=_Wv_qw3nQnI [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=input.png&userId=23928 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=input2.png&userId=23928 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=usdeck.png&userId=23928 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=sdeck.png&userId=23928 [8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=simulation_hint.gif&userId=23928 [9]: https://community.wolfram.com//c/portal/getImageAttachment?filename=labeld2.png&userId=23928 [10]: https://community.wolfram.com//c/portal/getImageAttachment?filename=labeld3.png&userId=23928 [11]: https://reference.wolfram.com/language/ref/Refresh.html#Examples [12]: http://demonstrations.wolfram.com/Poker/ [13]: https://community.wolfram.com//c/portal/getImageAttachment?filename=quick.png&userId=23928 Shenghui Yang 2019-07-03T18:35:12Z https://community.wolfram.com/groups/-/m/t/1773727 Being a programmer, one of the challenges I find with math is unfamiliar notation. I'll use summation as an example (as I actually understand that one): ![enter image description here][1] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Sum.jpg&userId=186897 You could explain this formula fairly easily with a description (for all integers between 3 and 7, square each value and then add the squares together). The more complex the formula, however, the more complex the description. When I learn a new type of formula notation, I find it helps to create a "sudo code" version. Here's a sudo code example (again, very basic) for summation: `For each integer i between 3 and 7: CurrentValue = i^2 SummedValue = SummedValue + CurrentValue Print SummedValue` This not only provides an explanation of the notation, but allows my programmer mind to understand the process for performing the calculation. From a CBM perspective, are there any resources that provide this type of math-to-code examples? Les Fister 2019-08-23T21:36:24Z https://community.wolfram.com/groups/-/m/t/1752461 I should prepare some paper for a colloquium (kinda student-task) and it should cover the following points: (1) at least one notable discovery in theoretical informatics (or computer science) (2) at least one open problems in theoretical informatics (3) an example of short notable proof of some result in theoretical informatics I would like that it was related to computational linguistics. I have some basic knownledge (2 year cs student) but I don't know from what I should start to explore these questions. Can you draw some examples of it? Or some sources? Thank you Constantin Constantinov 2019-08-02T17:47:32Z https://community.wolfram.com/groups/-/m/t/1737790 My Mathematica code ran forever; it took me the whole day and finally returned 'Why the Beep?' message saying: "There appears to be an error in the file named below. You should close it without saving, then check the "Parse and load entire notebook into memory upon opening" checkbox in the Notebook Options dialog. File name: ...." What I'm trying to do is to 3D plot a maximization result of an definite integral under some constraints on the parameter values. Let me reproduce my code: s = 2; d = 4/5; t = 0; J= -((-(64/25) + 8/5 k (-1 + r) + k (k + 4 r + k (-3 + r) r))/(40 (-1 + r))) + c (((-1 + q) (16/25 (1 - 2 r) + (8 k r^2)/5 + k^2 r (1 + (-3 + r) r)))/(4 (-1 + r)^2) + (-(64/25) + 8/5 k (-1 + r) + k (k + 4 r + k (-3 + r) r))/(8 (-1 + r))) AA = (((1 - r)*x + r*y - J)*(1 - t) - (d - t))/s^2; BB = (((1 - r)*x + r*k - J)*(1 - t) - (d - t))/s^2; CC = (((1 - r)*x + r*(x - k) + r*y - J)*(1 - t) - (d - t))/s^2; DD = (((1 - r)*x + r*(x - k) + r*k - J)*(1 - t) - (d - t))/s^2; EE = (((1 - r)*x + r*(x - k) + r*y - J)*(1 - t) - (d - t))/s^2; FF = (((1 - r)*x + r*(x - k) + r*k - J)*(1 - t) - (d - t))/s^2; regAA = ImplicitRegion[AA > 0 && (d - r*k)/(1 - r) <= x <= k && (d + r*x - x)/r <= y <= k, {x, y}]; regBB = ImplicitRegion[BB > 0 && (d - r*k)/(1 - r) <= x <= k && k <= y <= s, {x, y}]; regCC = ImplicitRegion[CC > 0 && k <= x <= d + r*k && (d + r*k - x)/r <= y <= k, {x, y}]; regDD = ImplicitRegion[DD > 0 && k <= x <= d + r*k && k <= y <= s, {x, y}]; regEE = ImplicitRegion[EE > 0 && d + r*k <= x <= s && 0 <= y <= k, {x, y}]; regFF = ImplicitRegion[FF > 0 && d + r*k <= x <= s && k <= y <= s, {x, y}]; f2 = Integrate[AA, {x, y} \[Element] regAA] + Integrate[BB, {x, y} \[Element] regBB] + Integrate[CC, {x, y} \[Element] regCC] + Integrate[DD, {x, y} \[Element] regDD] + Integrate[EE, {x, y} \[Element] regEE] + Integrate[FF, {x, y} \[Element] regFF]; max2 = Flatten[ Table[{c, q, MaxValue[{f2, 0 <= c <= 1, 1 <= q <= 2, c*q <= 1, d <= k <= 2, 0 <= r*k < d}, {k, r}]}, {c, 0, 1, .1}, {q, 1, 2, .1}], 1]; maxk2 = Flatten[Table[{c, q, k /. Last@Maximize[{f2, 0 <= c <= 1, 1 <= q <= 2, c*q <= 1, d <= k <= 2, 0 <= r*k < d}, {k, r}]}, {c, 0, 1, .1}, {q, 1, 2, .1}], 1]; maxr2 = Flatten[Table[{c, q, r /. Last@Maximize[{f2, 0 <= c <= 1, 1 <= q <= 2, c*q <= 1, d <= k <= 2, 0 <= r*k < d}, {k, r}]}, {c, 0, 1, .1}, {q, 1, 2, .1}], 1]; {ListPlot3D[max2, AxesLabel -> {"c", "q", "f"}], ListPlot3D[maxk2, PlotRange -> {0, 2}, AxesLabel -> {"c", "q", "k"}], ListPlot3D[maxr2, PlotRange -> {0, 1}, AxesLabel -> {"c", "q", "r"}]} Can anyone help in figuring out any error in the code? Edit: I am attaching my Notebook file which will be helpful in understanding what I'm doing. Ian P 2019-07-16T03:06:38Z https://community.wolfram.com/groups/-/m/t/1728683 ![A test implementation of the package][1] **Abstract** In order to automatically grade student problems, one must identify the scope and level of the problem and then define equivalent answers appropriate to the context of the question and knowledge of the student. To this end, we first train a Neural Network Classifier on a data set of problems in Algebra 1, Algebra 2 and Calculus. Then, using a combination of rule-based checks and the theorem prover, we define equivalent answers, then check that particular rules were not used in order to maintain equivalence at the level of the student to prevent cheating. **Introduction** When providing questions to students online, the teacher is often left with a dilemma. Do you give the student a multiple choice problem that fails to properly test their ability by allowing guessing, or do you give them a long answer that will only accept one correct answer, when there might be multiple equivalent answers? To add in all possible answers would be an onerous task, thus it would be preferable to have the system automatically identify all possible answers. However, this presents a challenge in its own right. How does one limit the possible answers to those that the student would have reached based on the level of their knowledge, and how does one deal with problems that may limit the scope of the equivalent answers? To this end, we define a two-part problem: classification of the problem's level and scope and cross-checking for equivalent answers. **Classification and context identification** The problem of classification is often solved by machine learning techniques trained on large data sets. In this case, I retrained a series of models in the Wolfram language "Classify" function on an 1800 question data set in algebra 1, 2 and calculus, grouping all the problems and providing the problems and groupings to the network, i.e. training in a supervised manner. Then, the accuracy of each model was tested by comparing the probability of identification as the proper grouping to the highest probability of the other two groups, using: Clear[questionClassifier] questionClassifier = Classify[<|"algebra 1" -> algebra1Questions, "algebra 2" -> algebra2Qs|> , PerformanceGoal -> "Quality", Method -> "Markov"] algebra1IsAlgebra1 = questionClassifier[algebra1Questions, {"Probability", "algebra 1"}]; algebra1IsAlgebra2 = questionClassifier[algebra1Questions, {"Probability", "algebra 2"}]; algebra2IsAlgebra1 = questionClassifier[algebra2Qs, {"Probability", "algebra 1"}]; algebra2IsAlgebra2 = questionClassifier[algebra2Qs, {"Probability", "algebra 2"}]; lp = ListLogPlot[#right/#wrong &@ <|"right" -> algebra1IsAlgebra1, "wrong" -> algebra1IsAlgebra2|>, AxesLabel -> {"Data"}, PlotLabel -> "Algebra 1 ", GridLines -> {{}, {1}}, GridLinesStyle -> Red] ; lp1 = ListLogPlot[#right/#wrong &@ <|"right" -> algebra2IsAlgebra2, "wrong" -> algebra2IsAlgebra1|>, AxesLabel -> {"Data"}, PlotLabel -> "Algebra 2", GridLines -> {{}, {1}}, GridLinesStyle -> Red]; Where the data sets are drawn from "final_project_trainingdata.mx" (attached). All models were given the "Quality" goal to improve accuracy at the cost of training time, as the training is taking place ahead of time, and the system is not retrained live. However, when this was performed on data generated by the Wolfram|Alpha Problem Generator, where the addition of calculus made "What is 1+1" evaluate as calculus independent of the number of inputs. Thus, the calculus tag was removed, and this identification was moved to a context-based pattern matching. Total training inputs are 1302, with 651 each of algebra 1 and 2. ![Results of Classifier with different Models. Automatic attempts multiple models at different points, updating the model used live][2] From the above results, one can clearly see that the Markov model is superior on this data set, however, it may be worse for others. **Identification of Context** The context of the problem, however, does not get captured by the classifier above. The classifier simply finds the level, meanwhile the context, for example, would be "write your answer as a simplified fraction". These contexts are identified via pattern matching. These rules are then used to assign a specific tag: turnOffEquivFrac[question_] := StringMatchQ[question, {"*raction*implest form"}]; isMatrixQ[answer_] := MatchQ[answer, MatrixForm]; allpoints[question_] := StringMatchQ[question, {"*all points*"}]; eitherPointfirst[a_, b_, c_, d_] := {{"(", a, b, ")"}, {"(" c, d ")"}} -> {{"(" c, d ")"}, {"(", a, b, ")"}} isPoint[answer_] := StringMatchQ[answer, {"(*,*)"}]; improperFraction[question_] := StringMatchQ[question, "*mproper fraction*"]; decForm[question_] := StringMatchQ[question, "*ecimal form*"]; isCalcQ[question_] := StringMatchQ[ question, {"*erivative*", "*ifferniate*", "*ntegra*", "*aylor*xpand*", "*acLa*xpand*", "*imit*"}]; mixedNumber[question_] := StringMatchQ[question, "*ixed number*"]; ![Table of Tags corresponding to concepts][3] **Identifying Correct Answers** The identification of correct answers was performed by the implementation of the below code as part of a new package. correctAnswer[answer_, correct_]:=MatchQ[Interpreter["MathExpression"][answer], Interpreter["MathExpression"][correct]] turnOffEquivFrac[question_]:=StringMatchQ[question, {"*raction*implest form"}]; isMatrix[answer_]:=MatchQ[answer, MatrixForm]; allpoints[question_]:=StringMatchQ[question, {"*all points*"}]; eitherPointfirst[a_, b_,c_, d_]:= {{"(",a, b, ")"},{"("c, d ")"}}-> {{"("c, d ")"},{"(",a, b, ")"}} isPoint[answer_]:=StringMatchQ[answer, {"(*,*)"}]; improperFraction[question_]:=StringMatchQ[question, "*mproper fraction*"]; decForm[question_]:=StringMatchQ[question, "*ecimal form*"]; isCalc[question_]:=StringMatchQ[question, {"*erivative*", "*ifferniate*", "*ntegra*", "*aylor*xpand*", "*acLa*xpand*", "*imit*"}]; mixedNumber[question_]:=StringMatchQ[question, "*ixed number*"]; (*This is the wrong way to do it, patern matching is better here*) expandToSix[answer_, correct_, x_]:=If[Series[answer, {x, 0, 6}]==Series[correct, {x, 0, 6}], True, False] algebratheorems={ForAll[{a,b,c}, g[a, g[b,c]]==g[g[a, b], c]], ForAll[{a,b}, g[a, b]==g[b,a]], ForAll[{a,b}, f[a,b]==f[b,a]], ForAll[{a,b,c}, f[a,f[b,c]]==f[f[a,b],c]], ForAll[{a,b,c}, f[a, g[c,b]]==g[f[a,c], f[a,b]]], ForAll[a, g[a,e]==a], ForAll[a, f[a, e]==e], ForAll[a, f[a, n]==a], ForAll[a, g[a, inv[a]]==e], ForAll[a, f[a, inv1[a]]==n]} (*This defines an abelian ring w/ distributive property*) algebraandtrigtheorems={ForAll[{a,b,c}, g[a, g[b,c]]==g[g[a, b], c]], ForAll[{a,b}, g[a, b]==g[b,a]], ForAll[{a,b}, f[a,b]==f[b,a]], ForAll[{a,b,c}, f[a,f[b,c]]==f[f[a,b],c]], ForAll[{a,b,c}, f[a, g[c,b]]==g[f[a,c], f[a,b]]], ForAll[a, g[a,e]==a], ForAll[a, f[a, e]==e], ForAll[a, f[a, n]==a], ForAll[a, g[a, inv[a]]==e], ForAll[a, f[a, inv1[a]]==n], ForAll[{a,b}, sin[g[a,b]]==g[f[sin[a],cos[b]], f[sin[b], cos[a]]]], ForAll[ {a,b}, cos[g[a,b]]==g[f[cos[a],cos[b]], f[sin[inv[b]], sin[a]]]], ForAll[a, sin[inv[a]]==inv[sin[a]]], ForAll[a, cos[inv[a]]==cos[a]], ForAll[a, g[f[sin[a],sin[a]], f[cos[a], cos[a]]]==n]} theorems=<|"algebra 1"-> {algebratheorems}, "algebra 2"-> {algebraandtrigtheorems}, "calc"-> {algebraandtrigtheorems}|>; removeSinCos[given_]:=given/.{Sin->sin, Cos->cos} removeSinCos[Sin[5]+Cos[x]] replacePlus[given_]:=given/.{Plus-> g, Times[-1, amin_]->inv[amin]} replacePlus[a-b] replaceMulti[given_]:=given/.{Times-> f, Power[adiv_, -1]-> inv1[adiv]} replaceTanSecCscCot[given_]:=given/.{Tan[atan_]-> f[sin[atan],inv1[cos[atan]]], Sec[asec_]-> inv1[cos[asec]], Csc[acsc_]-> inv1[sin[acsc]], Cot[acot_]-> f[inv1[sin[acot]],cos[acot]]} replaceTanSecCscCot[Tan[y]+ Csc[x]] removeProperFormat[given_]:=replacePlus[replaceMulti[removeSinCos[replaceTanSecCscCot[given]]]] determinetags[question_]:=If[allpoints[question], If[turnOffEquivFrac[question], 5, If[decForm[question], 6, 3]], If[turnOffEquivFrac[question], 1, If[decForm[question], 2, If[isCalc[question], 4, If[mixedNumber[question], 7, If[improperFraction[question], 8, 0] ] ] ] ] ]; equivalentAnswer[level_, tags_, answer_, correct_]:= Module[{formattedanswer, formattedcorrectanswer, proof}, If[tags==4, level="calc"]; Switch[tags, 0| 3| 4, If[correctAnswer[answer, correct], True, If[Simplify[Interpreter["MathExpression"][answer]- Interpreter["MathExpression"][correct]]==0, If[UnsameQ[Head[Interpreter["MathExpression"][answer]], Failure], formattedanswer:=removeProperFormat[Interpreter["MathExpression"][answer]]; formattedcorrectanswer=removeProperFormat[Interpreter["MathExpression"][correct]]; proof=TimeConstrained[FindEquationalProof[formattedanswer==formattedcorrectanswer , theorems[level]],10]; If[proof["Logic"]=="EquationalLogic", If[Complement[Query[Key[{"SubstitutionLemma", All}proof["ProofDataset"]["Statement"]]], theorems[level]]=={}, True, False], False], False], False]], 1, If[correctAnswer[answer, correct], True, False], 2, If[correctAnswer[answer, correct], True, False], 5, If[Complement[StringSplit[answer, "),("], StringSplit[correct, "),("]]=={}, True, False], 6, If[Complement[StringSplit[answer, "),("], StringSplit[correct, "),("]]=={}, True, False], _, MatchQ[answer, correct] (*exact match is default case*) ]] checkforEquivlentanswers[question_, answer_, correct_, level_]:= Module[{t}, t=determinetags[question]; equivalentAnswer[level, t, answer, correct]] **Conclusions and Future Work** This project has developed a Classifier and a Package that may be implemented in a variety of applications. Ideally, one can consider two exemplars. One has the student submits an answer to a randomly selected question from a database that has been built using Wolfram|Alpha's Problem Generator. The student may select one of the three levels, receive a question, submit an answer and check that it is correct. After the correct answer has been submitted, the system automatically pulls a new question from the list in the selected type. The second allows for the teacher to create a quiz and store it as a new database, which will then be fed to the first exemplar. Thus, we see this project as a quiet server-side application, and as a service that would be deliverable to a client. Further work could encompass the addition of further levels of questions, the use of graphical data as a selected answer or the inclusion of a retraining function in the neural net to improve classification accuracy, as well as the integration of the data into the described GUIs. ![Further tests of the check equivalent answers function][4] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=working_versions.PNG&userId=1726808 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Training_Model.png&userId=1726808 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Tags.png&userId=1726808 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=more_tests.PNG&userId=1726808 Silas Grossberndt 2019-07-10T17:41:19Z https://community.wolfram.com/groups/-/m/t/1703100 A video at http://www.wolfram.com/broadcast/video.php?c=91&v=2367 tells how to install the "CMB [Computer-based Math] Resources" to use with *Mathematica*. But what and where are these resources? Murray Eisenberg 2019-06-12T20:56:34Z https://community.wolfram.com/groups/-/m/t/1670664 Mathematica does not simplify Sqrt[x^2] in expressions. Even if attempting: Simplify[Sqrt[x^2]] or FullSimplify[Sqrt[x^2]] The result remains: Sqrt[x^2] instead of just x. Am I missing something? Do I need to specify a condition like x belongs to R for it to work? LV VS 2019-04-27T07:52:09Z https://community.wolfram.com/groups/-/m/t/1258865 Hello, I am very very new in Mathematica. I am deriving equations for a system of pendulums using the Lagrange function. As you can see, I wrote down the equations of the coordinates of the pendulums, and the output then is the Lagrange function, but I do not quite understand it. Can someone introduce me? Jonas Hamp 2018-01-04T18:15:49Z https://community.wolfram.com/groups/-/m/t/1140640 <h1>Introduction</h1><br> My name is Taha Shaikh and I attended the 2017 Wolfram Alpha High School Summer Camp. At this camp, I researched and created a project about many-valued logic. In this exploration, I implemented multivalued logic with the Wolfram language. Multivalued logic is a branch of propositional calculus in which there are more than two truth values. Multivalued logic contrasts with traditional two-valued logic in which only two truth values exist: <i>True</i> and <i>False</i>. The most popular types of many-valued logic are three-valued Kleene and Priest logic, which incorporate an additional <i>Indeterminate</i> value. The truth function for conjunction, for example, is given by: ![Ternary Logic Conjunction Table][1] <hr> <h2>Procedure</h2> <br> The first step in this project was understanding the aim of the investigation and doing research on the topics at hand. Next, support for the new truth value <i>Undecided</i> was added to the basic boolean operations. I used Kleene and Priest logic tables to redefine the boolean operations. ![Different Logic Tables][2] Undecided = Undecided; Unprotect[And]; And[Undecided, True] := Undecided And[Undecided, Undecided] := Undecided Protect[And]; Unprotect[Boole]; Boole[Undecided] := 0 Boole[False] := -1 Protect[Boole]; Unprotect[Or]; Or[Undecided, False] := Undecided Or[Undecided, Undecided] := Undecided Protect[Or]; Unprotect[Not]; Not[Undecided] := Undecided Unprotect[Implies]; Implies[True, Undecided] := Undecided Implies[Undecided, Undecided] := True Implies[False, Undecided] := True Implies[Undecided, True] := True Implies[Undecided, False] := Undecided Protect[Implies]; Unprotect[Nand]; Nand[Undecided, Undecided] := Undecided Protect[Nand]; Unprotect[Nor]; Nor[Undecided, Undecided] := Undecided Protect[And]; <br> These functions ensured that the rest of the functions created worked smoothly. The next step was creating a function that would generate truth tables based on a given operation and the list of the variables used. The TernaryTable function used an input of a logic expression and the list of used variables and converts it into a truth table. Where Boolean logic has $2^2 = 4$ unary operators, the addition of a third value in ternary logic leads to a total of $3^3 = 27$ distinct operators on a single input value. It uses the Tuples function to run through all of the possible permutations of the three truth values and runs them through the given expression. <br> <br> TernaryTable[expr_, vars__] := ReplaceAll[expr, Thread[vars -> #]] & /@ Tuples[{True, False, Undecided}, {Length[vars]}] <br> An example of TernaryTable in action: ![enter image description here][3] This function uses the Tuples function to run through the various combinations and permutations of the three different truth values. The truth table generated has length $3^n$ in which $n$ is the number of variables used in the logic expression. In the case of this example, since four variables are present (x, y, z, w), the length of its truth table is $3^4$ or 81. This is because all possible permutations of the three truth values are considered when generating the truth table. Even though many of the outputs are the same, their individual logic expressions were unique. Creating a function that created truth tables was a good first step and helped me better visualize and understand the topic. <hr> <h2>Cooking Up Some Functions</h2><br> The main strategy for determining the identity of the truth table was brute-force-esque. All of the possible arrangements of the basic logic functions were ran through the tuples of the three logic values. Their logic expression was also calculated and correlated to their truth table. First, I made a function called LotsOfTernaryTables that produces a lot of ternary tables. Given the number of variables, it produces every possible truth table for every possible arrangement of the functions And, Or, Nand, Nor, and Not for the given variables. <br> LotsOfTernaryTables[x_] := MatrixForm[ Groupings[#, {And -> 2, Or -> 2, Nand -> 2, Nor -> 2, Not -> 1}, HoldForm] & /@ Tuples[{True, False, Undecided}, {x}]] <br> In this function, Groupings was used in coordination with Tuples to produce a huge number of different tables. <br><br> In order to visualize these massive tables, I created a function called TernaryPlot that generates a colorful plot of the different logic truth tables. It converts the outputs from LotsOfTernaryTables into numerical values and creates a colorful array plot. It uses similar mechanics to the previous function.<br> TernaryPlot[x_] := ArrayPlot[ Boole[Groupings[#, {And -> 2, Or -> 2, Nand -> 2, Nor -> 2, Not -> 1}]] & /@ Tuples[{True, False, Undecided}, {x}], ColorRules -> {1 -> Green, 0 -> LightBlue, -1 -> Red}] <br> The array plot created by this function has several visible patterns and sequences and makes very interesting art. A ternary plot with 3 variables, for example, looks like so:<br> ![enter image description here][4] <br><br> In this plot, every column represents an individual truth table. In this case, since there are three variables, each column contains $3^3=27$ values. When creating ternary plots with more variables, patterns become crazier and the resulting image has some pretty appealing qualities. The ternary plot for 6 variables looks like so:<br> ![enter image description here][5] <br> Finally, the last function I created was called TernaryFunction and was based off of the pre-existing BooleanFunction. When given a ternary truth table, this function would return the logic expression associated with it. After generating a list of truth tables and a list of logic expressions, the two lists were then correlated with each other. After retrieving the correct truth table, its corresponding logic expression was derived and returned. In order to assist with this process, the logarithm base 3 of the length of the truth table was calculated and used to narrow down the number of arguments that had to be processed. The function still works with an unlimited number of arguments as long as $log_3n$ is an integer with $n$ representing the length of the inputted truth table. <br><br> This is an example of TernaryFunction in action:<br> ![enter image description here][6] <br> The logic function is returned with the given variables as defined by the user. <hr> <h2>Differences From Binary Logic</h2><br> <p>Multi-valued logics are intended to preserve the property of designationhood, or being designated. Since there are more than two truth values, rules of inference may be intended to preserve more than just whichever corresponds to truth. For example, in a three-valued logic, sometimes the two greatest truth-values (when they are represented as e.g. positive integers) are designated and the rules of inference preserve these values. Precisely, a valid argument will be such that the value of the premises taken jointly will always be less than or equal to the conclusion.</p> <br> <hr> <h2>Applications of Ternary Logic</h2> <br> <p>An application of many valued logic is geared towards the design of electronic circuits which employ more than two discrete levels of signals, such as many-valued memories, arithmetic circuits, and field programmable gate arrays. Many-valued circuits have a number of theoretical advantages over standard binary circuits. For example, the interconnect on and off chip can be reduced if signals in the circuit assume four or more levels rather than only two. In memory design, storing two instead of one bit of information per memory cell doubles the density of the memory in the same die size. Applications using arithmetic circuits often benefit from using alternatives to binary number systems. For example, residue and redundant number systems can reduce or eliminate the ripple-through carries which are involved in normal binary addition or subtraction, resulting in high-speed arithmetic operations.</p> [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=tablemyb.png&userId=1138154 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=allthetables.png&userId=1138154 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=terntable.png&userId=1138154 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=plotarry.png&userId=1138154 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ternarylogic6-1.png&userId=1138154 [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ternfunc.png&userId=1138154 Taha Shaikh 2017-07-07T11:10:37Z https://community.wolfram.com/groups/-/m/t/1007307 Hello All I’ll be brief - I am looking for math students to teach. I’m hoping that you can help spread the word. The course would be online and will start in September. (And, of course, I am doing this for my own interest and there is no fee.) I am a teacher with over twenty years of teaching high school math. I have developed a new math curriculum based on the ideas and precepts of “Computer Based Math” (CBM). You can watch a great short video by Conrad Wolfram describing CBM here: https://www.youtube.com/watch?v=60OVlfAUPJg The basic idea is that math teaching has not evolved much in the last 100 years. In fact, the main emphasis, in nearly all schools, is the teaching of symbolic manipulation (solving for x). The irony is that this is the one and only thing that computers can do better than humans. We should have our students analyzing solutions, proposing methods of solution, analyzing results, and applying knowledge to new and difficult problems. I have developed a curriculum that shifts the paradigm from solving for x to big and complex thinking. I am looking for three to five students who would like to learn math the way it is really used by mathematicians, scientists, and engineers. I will work with these students personally each day. If you have such a student in mind, please contact me at: markstevenlawton@gmail.com All students should be Algebra I ready. Please feel to read all about me at www.markslawton.com Thank You, Mark Lawton Educator Mark Lawton 2017-02-02T19:29:54Z https://community.wolfram.com/groups/-/m/t/994225 I have plotted `ChromaticityPlot["sRGB"]` but the color space boundary does not show up..though the legend is there. What shall I do? anyone please help. Thanks in advance. Timun Mas 2017-01-12T22:09:24Z