Community RSS Feed
http://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Wolfram Scienceshowthread.php?threadid=153 sorted by activeWhat distance function does FindClusters use?
http://community.wolfram.com/groups/-/m/t/1288262
My list contains numbers from 0-40k. The figure shows data distribution:
![enter image description here][1]
I tried `FindClusters[list] `
The output is two clusters as seen here:
{{4169, 7114, 5025, 7316, 4977, 10411, 9352, 16438, 8719, 14330,
10277, 7144, 11950, 18572, 10471, 4915, 4958, 7556, 5145, 13862,
8466, 14138, 10861, 11815, 5638, 15242, 16666, 23564, 4256, 13014,
9865, 3729, 5980, 7740, 14290, 14067, 12038, 14125, 6436, 14240,
19054, 9622, 13876, 8362, 5983, 7163, 4908, 12856, 15923, 14368,
14467, 9393, 9555, 8537, 9149, 10272, 8228, 6525, 6596, 10401, 6244,
16576, 15262, 12593, 16128, 13189, 13508, 14206, 15115, 24985,
19442, 18195, 14522, 9103, 8781, 9394, 4716, 6760, 9281, 6958,
10581, 10862, 11518, 11508, 5691, 8567, 9797, 10897, 9535, 8723,
7645, 7035, 7186, 7392, 6913, 7549, 18990, 12778, 15982, 5145,
14650, 14468, 13480, 20918, 14713, 17319, 22983, 20166, 9464, 23675,
8466, 9598, 9698, 7082, 18233, 15193, 11804, 10285, 25290, 17428,
11320, 6441, 11868, 14666, 18505, 11778, 12131, 9275, 6347, 13024,
19351, 14984, 14150, 18093, 7455, 20572, 14041, 23137, 12763, 14986,
11280, 13584, 17583, 14394, 17540, 18123, 16960, 9344, 20265,
21251, 19206, 25316, 17411, 17123, 17137, 11778, 19055, 15926,
18753, 19731, 14524, 21106, 12309, 12357, 17689, 23076, 20067,
10224, 16353, 7571, 8493, 8927, 15024, 18869, 14585, 16099, 18462,
14361, 15621, 15584, 20522, 18542, 13220, 19124, 16885, 10800,
20395, 18752, 17369, 21940, 14893, 14939, 25153, 19275, 15273,
18337, 18835, 17250, 26872, 15279, 14366, 15319, 20846, 15711,
18547, 20289, 22089, 17250, 18777, 21723, 17813, 21230, 24460, 8375,
14843, 18409, 4854, 10552, 13598, 14440, 14707, 17834, 18916,
22908, 7045, 20264, 20317, 6742, 8589, 15747, 17136, 12764, 18185,
6882, 8867, 7009, 13119, 10461, 11362, 14844, 14337, 9780, 7170,
8486, 8538, 8758, 8383, 5024, 7285, 10365, 5239, 7644, 8675, 7909,
8781, 7353, 6439, 9123, 8136, 11655, 18012, 8834, 11400, 8248, 8207,
9232, 11126, 24912, 12578, 8352, 13299, 6344, 8347, 6876, 14591,
11316, 18416, 11233, 8438, 20095, 10800, 7596, 5791, 7083, 7931,
6021, 6088, 13472, 9212, 6992, 8428, 9336, 11558, 10948, 8795, 6353,
11253, 9172, 15023, 6512, 7775, 11892, 7908, 7545, 8135, 10378,
8896, 7302, 12794, 10991, 10490, 7240, 9780, 4285, 4694, 6847, 9383,
6969, 7879, 12737, 5840, 5550, 12252, 9034, 8661, 10347, 11444,
8241, 11445, 11539, 14462, 17701, 13711, 8229, 7458, 12440, 13455,
12092, 13517, 12047, 10099, 18228, 14068, 17192, 18021, 12252,
11070, 11711, 12952, 12144, 9109, 6563, 4531, 7438, 8839, 15560,
11478, 18469, 14584}, {35494, 32082, 27490, 29077, 31458, 31198}}
My second try was to specify the number of clusters using `FindClusters[list,4] `. The output was:
{{4169, 7114, 5025, 7316, 4977, 10411, 9352, 16438, 8719, 14330,
10277, 7144, 11950, 18572, 10471, 4915, 4958, 7556, 5145, 13862,
8466, 14138, 10861, 11815, 5638, 15242, 16666, 23564, 4256, 13014,
9865, 3729, 5980, 7740, 14290, 14067, 12038, 14125, 6436, 14240,
19054, 9622, 13876, 8362, 5983, 7163, 4908, 12856, 15923, 14368,
14467, 9393, 9555, 8537, 9149, 10272, 8228, 6525, 6596, 10401, 6244,
16576, 15262, 12593, 16128, 13189, 13508, 14206, 15115, 19442,
18195, 14522, 9103, 8781, 9394, 4716, 6760, 9281, 6958, 10581,
10862, 11518, 11508, 5691, 8567, 9797, 10897, 9535, 8723, 7645,
7035, 7186, 7392, 6913, 7549, 18990, 12778, 15982, 5145, 14650,
14468, 13480, 20918, 14713, 17319, 22983, 20166, 9464, 23675, 8466,
9598, 9698, 7082, 18233, 15193, 11804, 10285, 17428, 11320, 6441,
11868, 14666, 18505, 11778, 12131, 9275, 6347, 13024, 19351, 14984,
14150, 18093, 7455, 20572, 14041, 23137, 12763, 14986, 11280, 13584,
17583, 14394, 17540, 18123, 16960, 9344, 20265, 21251, 19206,
17411, 17123, 17137, 11778, 19055, 15926, 18753, 19731, 14524,
21106, 12309, 12357, 17689, 23076, 20067, 10224, 16353, 7571, 8493,
8927, 15024, 18869, 14585, 16099, 18462, 14361, 15621, 15584, 20522,
18542, 13220, 19124, 16885, 10800, 20395, 18752, 17369, 21940,
14893, 14939, 19275, 15273, 18337, 18835, 17250, 15279, 14366,
15319, 20846, 15711, 18547, 20289, 22089, 17250, 18777, 21723,
17813, 21230, 24460, 8375, 14843, 18409, 4854, 10552, 13598, 14440,
14707, 17834, 18916, 22908, 7045, 20264, 20317, 6742, 8589, 15747,
17136, 12764, 18185, 6882, 8867, 7009, 13119, 10461, 11362, 14844,
14337, 9780, 7170, 8486, 8538, 8758, 8383, 5024, 7285, 10365, 5239,
7644, 8675, 7909, 8781, 7353, 6439, 9123, 8136, 11655, 18012, 8834,
11400, 8248, 8207, 9232, 11126, 12578, 8352, 13299, 6344, 8347,
6876, 14591, 11316, 18416, 11233, 8438, 20095, 10800, 7596, 5791,
7083, 7931, 6021, 6088, 13472, 9212, 6992, 8428, 9336, 11558, 10948,
8795, 6353, 11253, 9172, 15023, 6512, 7775, 11892, 7908, 7545,
8135, 10378, 8896, 7302, 12794, 10991, 10490, 7240, 9780, 4285,
4694, 6847, 9383, 6969, 7879, 12737, 5840, 5550, 12252, 9034, 8661,
10347, 11444, 8241, 11445, 11539, 14462, 17701, 13711, 8229, 7458,
12440, 13455, 12092, 13517, 12047, 10099, 18228, 14068, 17192,
18021, 12252, 11070, 11711, 12952, 12144, 9109, 6563, 4531, 7438,
8839, 15560, 11478, 18469, 14584}, {35494}, {24985, 25290, 25316,
27490, 25153, 29077, 26872, 24912}, {32082, 31458, 31198}}
Could you explain me how this function works? I don't want to have a huge cluster with most of the values. Instead, I expect that the function recognises a cluster for values near 10k, 15k, 20k and 30k.
**What is the distance function used in FindingClusters()?**
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=histo.jpg&userId=1123184Veronica Estrada2018-02-19T16:36:27ZLittle pieces of code for graph and networks theory
http://community.wolfram.com/groups/-/m/t/98022
I thought it would be nice to have a discussion of little pieces of Mathematica code that can help when working with graphs and networks. Here for example, one to undirect graphs when needed:
[mcode]ToUndirectedGraph[dirGraph_] :=
Graph[VertexList@dirGraph, #[[1]] \[UndirectedEdge] #[[2]] & /@
Union[Sort[{#[[1]], #[[2]]}] & /@ EdgeList@dirGraph]][/mcode]or what about a graph planarity check function (i.e. adding any edge would destroy its planarity):[mcode]MaxPlanarQ[graph_] :=
PlanarGraphQ[graph] &&
With[{pos =
Select[Position[Normal@AdjacencyMatrix@graph,
0], #[[1]] < #[[2]] &],
vertex = VertexList[graph],
edges = EdgeList[graph]
},
val = True;
Do[If[PlanarGraphQ[
Graph[Append[edges,
vertex[[i[[1]]]] \[UndirectedEdge] vertex[[i[[2]]]]]]],
val = False; Break[]], {i, pos}]; Return[val]][/mcode]And one to produce random permutations for a given graph with the indicated number n of nodes:[mcode]PermuteGraph[g_, n_] :=
Table[AdjacencyMatrix@
Graph[RandomSample[VertexList@g], EdgeList@g], {n}][/mcode]What about code for counting sizes of graph automorphism groups? I have some, but it uses Saucy, an open-source software that has been tested to be (surprisingly) in practice very fast, despite the NP question underlying this task (unknown whether it has a polynomial time algorithm or it is NP-complete). There is a function in Combnatorica but you can read about its drawbacks in the [url=http://mathworld.wolfram.com/GraphAutomorphism.html]graph automorphism[/url] page in MathWorld.Hector Zenil2013-08-15T18:51:44ZMathematica One Liner Competition
http://community.wolfram.com/groups/-/m/t/1288883
I would like to suggest a twist to the Mathematica One Liner Competition.
The idea of this version of the challenge is to make use of the meta-programming capabilities in WL to create a one-liner generator. Some suggested competition rules:
1. The Generator would need to be written in WL, but would not itself have to comprise a single line of WL code, although that would be a really neat trick!
2. The output of the Generator would be a single executable line of WL code, or a single-line function taking one or more arguments. In other words, the output has to comprise valid WL syntax and be executable.
3. The output code produced by the Generator would itself produce some kind of result. There are no stipulations as to what that result might be, although graphical output tends to be heavily favored. But it could be, for instance, a famous number sequence, a mathematical equation, or something else entirely. All that is stipulated is that the output produced by the generated one-liner is "interesting".
4. The challenge solution could include code (e.g. machine learning/DNN code) to determine whether the generated one-liner is capable of producing an "interesting" result. One liners that are not valid WL syntax, or which produce no output, for example, would be classified as "uninteresting". A one-liner that generated large prime numbers, or cool animations, might be classified as "interesting". And so on.Jonathan Kinlay2018-02-20T18:08:49ZBasic Neworks - is there a problem with Mathematica?
http://community.wolfram.com/groups/-/m/t/1288902
I have a rather basic problem where I am asked to create a network of 300 nodes that can be clustered into 100-node chunks. Essentially, the nodes have many connections within a chunk and comparatively few between different100-node chunks.
For example, if I made the connections with a chunk occur with 100% probability and between chunks occur 0% I get the following:
edges = {};
For[l = 1, l <= 3 , l++, h = 100*l;
For[n = 100 (l - 1) + 1, n < 100*l + 1, n++,
For[m = n + 1, m <= 300, m++,
If[m <= h,
If[RandomReal[{0, 1}] > 0.0, AppendTo[edges, n <-> m]],
If[RandomReal[{0, 1}] > 0.99, AppendTo[edges, n <-> m]]]]]]
![enter image description here][1]
which is expected and gives a corresponding MatrixPlot of the Adjacency Matrix as:
![enter image description here][2]
Which is also all well and good. Now, something very strange seems to be going on when I try to make the connections between the 100-node chunks be non zero. For example, if I made the probability be 1%, the folowing is obtained:
![enter image description here][3]
This looks ok, but it becomes very evident that there is a problem when one looks at the corresponding Matrix Plot of the Adjacency Matrix
![enter image description here][4]
Evidently, there is a very big problem somewhere. I did try to check this in a bit more detail and it seems that everything is working properly with the Matrix Plot. It seems that there is somewhere a problem with my code - but where? The code, in my opinion, seems rather simple and straightforward. I am really confused with what the issue is and could use assistance, it doesn't seem possible that Mathematica would have a problem with something so basic.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Capture1.PNG&userId=1288488
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Capture2.PNG&userId=1288488
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Capture3.PNG&userId=1288488
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Capture4.PNG&userId=1288488Boris Barron2018-02-20T16:41:48ZSystem Modeler crashes when performing basic functions. Can anyone help?
http://community.wolfram.com/groups/-/m/t/1289004
Hi,
I've just downloaded a free-trial version of System Modeler. I've validated it OK but it crashes every time I try to perform basic operations like opening a file. The error message it gives is:
"A critical error has occurred and Model Center must be restarted. Any unsaved Modelica classes will be restored if possible.
Click OK to restart Model Center, or Cancel to exit."
Does anyone know why? My OS is Windows 7 Professional, 64-bit.
Thanks, ArchieArchie Watts-Farmer2018-02-20T16:39:45Z[✓] Control the precision of the result with FindMinimum?
http://community.wolfram.com/groups/-/m/t/1287379
Dear all,
I have an issue with a constrained minimization and FindMinimum.
Consider two cylinders of length L and radius R: the center of the first is located at the origin and its axis is parallel to the z axis, the center of the second is located at {xT, 0, xz}, and its axis is oriented according to the polar angles \theta and \phi.
Given two vectors {r[1],..,r[3]} and {s[1],..,s[3]}, I want to find the minimum of the square distance between them
f(r,s) = (r[1] - s[1])^2 + (r[2] - s[2])^2 + (r[3] - s[3])^2,
with the constraint that the vector {r[1],r[2],r[3]} lies within the first cylinder, and {s[1],..,s[3]} lies within the second cylinder:
In[1]:= R = 1/2;
L = 4;
xT = 78/100;
xz = -4/10;
\[CurlyTheta] = 8/10;
\[Phi] = 3;
In[7]:= FindMinimum[{(r[1] - s[1])^2 + (r[2] - s[2])^2 + (r[3] -
s[3])^2, r[1]^2 + r[2]^2 <= R^2, L + 2 r[3] >= 0,
2 r[3] <=
L, (Sin[\[Phi]] (xT - s[1]) +
Cos[\[Phi]] s[
2])^2 + (Cos[\[CurlyTheta]] (Cos[\[Phi]] (-xT + s[1]) +
Sin[\[Phi]] s[2]) + Sin[\[CurlyTheta]] (xz - s[3]))^2 <= R^2,
2 Cos[\[Phi]] Sin[\[CurlyTheta]] (xT - s[1]) +
2 Cos[\[CurlyTheta]] (xz - s[3]) <=
L + 2 Sin[\[CurlyTheta]] Sin[\[Phi]] s[2],
2 Sin[\[CurlyTheta]] Sin[\[Phi]] s[2] <=
L + 2 Cos[\[Phi]] Sin[\[CurlyTheta]] (xT - s[1]) +
2 Cos[\[CurlyTheta]] (xz - s[3])}, {{r[1], 0}, {s[1], xT}, {r[2],
0}, {s[2], 0}, {r[3], 0}, {s[3], xz}}]
Out[7]= {1.7518957310232823*10^-15, {r[1] -> 0.24200719173126448,
s[1] -> 0.24200723086912757, r[2] -> 0.0173827341902361,
s[2] -> 0.01738274867534208, r[3] -> -0.0952795259719789,
s[3] -> -0.0952795227618218}}
In this example the two cylinders overlap, the minimum is r = s, and the value of the objective function at the minimum must be zero. However, FindMinimum returns some small, but nonzero value ˜ 1e-15.
Is there a way to make sure that, if the minimum is x=y, then the minimum for the objective function is exactly zero, i.e., `0.`?
Thank you.Joao Porto2018-02-18T14:37:20ZSolve Pdes in cylinder coordinates? ( Infinity error due to 1/r )
http://community.wolfram.com/groups/-/m/t/1288801
I have been trying to solve the following equations(Eq.1) in cylinder coordinates. And I want my solution domain is r>=0. Because of the 1/r and 1/r^2 terms in Eq.1, I ran into the Infinity error problem when using NDSolve . Then I rewrote my equations by multiplying them by r or r^2 to remove 1/r and 1/r^2 terms and got Eq.2, but I still met the Infinite problem using NDSolve. So is it possible to get solutions if my solution domain is r>=0. I believe this solution is physically real but I do not know how to get it using NDSolve. Any help would be great.
![enter image description here][1]
![enter image description here][2]
And my codes for Eq.2 are:
TMax = 1.615; S = 1/Pi^2/2; rMin = 0; rMax = 2;
{usol, hsol} =
NDSolveValue[{D[u[t, r], t]*r^2 == -D[u[t, r], r]*u[t, r]*r^2 +
3*1/h[t, r]^4*D[h[t, r], r]*r^2 +
3*S*(D[h[t, r], r, r, r]*r^2 - D[h[t, r], r] +
r*D[h[t, r], r, r]) +
4/h[t, r]*(h[t, r]*r^2*D[u[t, r], r, r] +
D[u[t, r], r]*D[h[t, r], r]*r^2 + h[t, r]*r*D[u[t, r], r] -
h[t, r]*u[t, r] - u[t, r]*r/2*D[h[t, r], r]),
D[h[t, r], t]*r == -h[t, r]*u[t, r] - u[t, r]*r*D[h[t, r], r] -
h[t, r]*r*D[u[t, r], r], u[0, r] == 0,
h[0, r] == 1 - 0.2*Cos[Pi*r], h[t, rMin] == h[t, rMax]}, {u,
h}, {t, 0, TMax}, {r, rMin, rMax}, PrecisionGoal -> Infinity,
AccuracyGoal -> 10, MaxSteps -> 10^6,
Method -> {"MethodOfLines",
"SpatialDiscretization" -> {"TensorProductGrid",
"MaxPoints" -> 5000, "MinPoints" -> 5000,
"DifferenceOrder" -> 4}}]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=20180220110517.jpg&userId=1266560
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=20180220104746.jpg&userId=1266560Yixin Zhang2018-02-20T11:03:08ZConsistent foreign exchange options
http://community.wolfram.com/groups/-/m/t/1278848
Consistency in foreign exchange derivatives is being discussed in the below note where we look at the problem from the probability measure perspective. We review option valuation from both sides of the FX contract and conclude that investors' preferences are subject to different probability measures when the FX rate inverts. Following this we prove the validity of Siegel's paradox.
![enter image description here][1]
**Introduction**
------------
Foreign exchange options are the oldest options in the market with a long history of trading. As such, they have been deeply-researched and are well-understood. Nevertheless, we return to this topic to look at the product consistency, since this may still not be entirely clear. We review this consistency from both - domestic and foreign perspectives and show what adjustments are required to ensure the options are arbitrage-free when the investor's position changes
**Foreign exchange options - 1st currency measure**
-----------------------------------------------
Foreign e change options are financial contracts on FX rate -i.e. rate of exchange of currency 1 fro currency 2. GBP/USD or EUR/USD are examples of such currency pairs. Options are essentially contracts on the future spot FX rate. We will demonstrate the exposition to this subject using EUR/USD exchange rate. This is the rate that sets the exchange equation of $X = \[Euro]1
A reader familiar with the equity derivatives market will immediately spot the similarity between these two products. If the equity growth rate under the risk-neutral measure is the risk-free rate r, the equity pays a continuous dividend yield q and the price process is assumed log-normal, this is identical to the FX when we express r and the USD risk-free rate and q as the equivalent EUR risk-free rate.
Looking at his from the USD-perspective, we can express the EUR/USD FX process as:
$$dF = F (r-q) dt + σ F dW$$
This is a well-known log-normal process for the exchange rate where F represents the EUR/USD rate, \[Sigma] is the FX rate volatility and W represents a Wiener process under the USD-measure.
Pricing option on this future rate is trivial - this is an option buy \[Euro] 1 for K USD and time T. Therefore from the USD-perspective, the option pays: Max[0,F-K] where K is the strike exchange rate. Pricing this option in Mathematica is easy - we build the standard Ito Process for initial value F0.
ipUSD = Refine[
ItoProcess[{(r - q)*F, \[Sigma]*F}, {F, F0}, t], {\[Sigma] > 0,
F[t] > 0, t > 0}];
{Mean[ipUSD[t]], Variance[ipUSD[t]]}
{E^((-q + r) t) F0, E^(-2 q t + 2 r t) (-1 + E^(t $[Sigma]^2)) F0^2}
The option premium from the USD-perspective is an expectation of the above Ito Process.
usdOpt = Exp[-r*t]*
Expectation[Max[F[t] - K, 0], F \[Distributed] ipUSD,
Assumptions ->
F0 > 0 && K > 0 && \[Sigma] > 0 && t > 0 && r > 0 && q > 0] //
Simplify
-(1/2) E^(-r t) (-2 E^((-q + r) t) F0 +
E^((-q + r) t)
F0 Erfc[(t (-2 q + 2 r + \[Sigma]^2) + 2 Log[F0] - 2 Log[K])/(
2 Sqrt[2] Sqrt[t] \[Sigma])] +
K Erfc[(t (2 q - 2 r + \[Sigma]^2) - 2 Log[F0] + 2 Log[K])/(
2 Sqrt[2] Sqrt[t] \[Sigma])])
**Foreign exchange options - 2nd currency measure**
-----------------------------------------------
Now we touch upon a part that is less clear - what if the option buyer (seller) thinks from the the EUR-perspective? This is quite legitimate as option buyers or sellers can have different preferences when entering into the option contract. How do we ensure that the option contract is consistent from each side-perspective?
Let's spell out the EUR investor position by replicating the USD investor side
- EUR riskless process is dP = P q dt and not dB = B r dt representing USD process
- The exchange-rate is now 1/F and not F
- When SDE for the exchange rate from the USD-point of view is the one above, then for the process 1/F this becomes - using Ito lemma:
f = 1/F;
ip02 = Refine[
ItoProcess[{(r - q)*F, \[Sigma]*F, f}, {F, F0}, t], {\[Sigma] > 0,
F[t] > 0, t > 0, r > 0, q > 0}];
ipEUR = ItoProcess[ip02] // Simplify
ItoProcess[{{(-q + r) F[t], (q - r + \[Sigma]^2)/
F[t]}, {{\[Sigma] F[t]}, {-(\[Sigma]/F[t])}}, \[FormalX]1[
t]}, {{F, \[FormalX]1}, {F0, 1/F0}}, {t, 0}]
The inverted FX rate (USD/EUR) produces different Ito Process than the one observed on the USD-side. This is clear from the definition below:
$$d(1/F) = (1/F) (q-r+σ^2) dt -σ (1/F) d W$$
Our objective is to find probability measure under which the FX option priced in the first section from the USD-perspective will be identical to the one priced from the EUR-perspective. Let's take all tradable components of the trade: (i) USD risk-free discount factor B , (ii) FX rate EUR/USD F and (iii) EUR discount factor P. Based on this we define:
- USD-risk-free process converted to EUR: B/F
- Discounted value of the above : B/ (F P)
So, we need a multi-dimensional Ito process to model B/(F P)
ip03 = Refine[
ItoProcess[{{0, r B, q P}, {F \[Sigma], 0, 0},
B/(P F)}, {{F, B, P}, {F0, B0, P0}}, t], {\[Sigma] > 0, r > 0,
q > 0, t > 0}] // Simplify;
ipEUR2 = ItoProcess[ip03]
ItoProcess[{{0, r B[t], q P[t], (-q B[t] + r B[t] + \[Sigma]^2 B[t])/(
F[t] P[t])}, {{\[Sigma] F[t]}, {0}, {0}, {-((\[Sigma] B[t])/(
F[t] P[t]))}}, \[FormalX]1[t]}, {{F, B, P, \[FormalX]1}, {F0, B0,
P0, B0/(F0 P0)}}, {t, 0}]
From the above Ito Formula, we extract two coefficients - drift and volatility of B/(F P) and create new ItoProcess that reflects the changes when FX inversion occurs.
Flatten[ipEUR2[[1]]];
dr = %[[4]] /. {F[t] -> 1, B[t] -> 1, P[t] -> 1}
vl = %%[[8]] /. {F[t] -> 1, B[t] -> 1, P[t] -> 1}
ItoProcess[{dr F, vl F}, {F, F0}, t];
ipEUR3 = ItoProcess[%]
-q + r + \[Sigma]^2
-Sigma
ItoProcess[{{(-q + r + \[Sigma]^2) F[t]}, {{-\[Sigma] F[t]}},
F[t]}, {{F}, {F0}}, {t, 0}]
It is quite clear that the inverted FX rate process USD/EUR is indeed different to the one observed in the EUR/USD case.
In order to prove this consistency, we need to show that FX call option on EUR/USD from EUR point of view is identical to the one priced from the USD-perspective. So, we need to prove that:
E^(-r t) Subscript[E, USD] ( Max[ Subscript[F, t]-K,0]) = E^(-q t) Subscript[F, 0] Subscript[E, EUR] ( (1/Subscript[F, t]) Max[1/Subscript[F, t]-K,0] )
This is because the expectation of the option payoff has to be converted back into EUR. All we need to price this option is use the following expectation:
eurOpt = F0 Exp[-q t] Expectation[Max[F[t] - k, 0]/F[t],
F \[Distributed] ipEUR3,
Assumptions ->
F0 > 0 && k > 0 && \[Sigma] > 0 && t > 0 && r > 0 && q > 0] //
Simplify
1/2 E^(-(q + r) t) (E^(r t) F0 - E^(q t) k +
E^(r t) F0 Erf[(
t (-2 q + 2 r + \[Sigma]^2) + 2 Log[F0] - 2 Log[k])/(
2 Sqrt[2] Sqrt[t] \[Sigma])] +
E^(q t) k Erf[(t (2 q - 2 r + \[Sigma]^2) - 2 Log[F0] + 2 Log[k])/(
2 Sqrt[2] Sqrt[t] \[Sigma])])
To finalise this exercise, we compute both option premiums:
usdNum = usdOpt /. {F0 -> 1.35, t -> 0.5, K -> 1.36, \[Sigma] -> 0.2,
r -> 0.01, q -> 0.012}
eurNum = eurOpt /. {F0 -> 1.35, t -> 0.5, k -> 1.36, \[Sigma] -> 0.2,
r -> 0.01, q -> 0.012}
usdNum - eurNum // Chop
0.070452
0.070452
0
Both option premium are the same. This proves they are ***consistent***.
**Siegel's paradox**
----------------
In the context of the above discussion, it is worth mentioning ***Siegel's paradox*** as it directly links the FX processes to probability measures. Let's start again with the definition of FX evolution from the USD-perspective . Under the USD probability measure (USD risk-neutral process) we showed earlier that this was:
$$dF = F (r-q) dt + σ F dW$$
The expected future FX rate - the ***FX Forward*** at time t is an expectation of Subscript[F, t] under the USD measure:
usdExp = Expectation[F[t], F \[Distributed] ipUSD,
Assumptions -> F0 > 0 && \[Sigma] > 0 && t > 0 && r > 0 && q > 0] //
Simplify
E^((-q + r) t) F0
Let's look now at EUR-investor point of view. (S)he can do similar calculation and under her/his neutral measure the USD/EUR process follows:
$$d(1/F) = (1/F) (q-r) dt + (1/F) σ dW$$
So, the forward rate of 1/F (EUR per USD) is:
eurExp2 =
Expectation[1/F[t], F \[Distributed] ipEUR3,
Assumptions -> F0 > 0 && \[Sigma] > 0 && t > 0 && r > 0 && q > 0] //
Simplify
E^((q - r) t)/F0
This seems logical, since inverted FX is simply :1/F. Here lies the problem: since 1/F is essentially a convex function, by Jensen's inequality:
(E[F])^-1 < E [F^-1]
when both expectations are taken w.r.t to same probability measure = i.e. calculated with the same distribution and F is non-constant. This runs contrary to our assertion above where we outlined the conditions for consistency - i.e. different probability measure.
Siegel's paradox is simply a statement confirming that the spot rate inversion does not extrapolate to the forward space and the forward FX rate in general ***cannot*** be an unbiased estimate of future spot FX rate. At least not *simultaneously* for both sides of the contract due to *'convexity'* effect in the inverted FX function. This is due to the Jensen's inequality statement above. If the property holds for the USD-investor, it cannot be true for the EUR investor and vice-versa since their forward expectation are subject to ***different probability measures***.
We prove this on the simple case - define standard Ito process and then take the expectations for for F and 1/F
ip05 = Refine[
ItoProcess[{(r - q)*F, \[Sigma]*F}, {F, F0}, t], {\[Sigma] > 0,
F[t] > 0, t > 0, r > 0, q > 0}];
usdFwrd =
Expectation[F[t], F \[Distributed] ip05,
Assumptions -> F0 > 0 && \[Sigma] > 0 && t > 0 && r > 0 && q > 0] //
Simplify
eurFwrd =
Expectation[1/F[t], F \[Distributed] ip05,
Assumptions -> F0 > 0 && \[Sigma] > 0 && t > 0 && r > 0 && q > 0] //
Simplify
E^((-q + r) t) F0
E^(t (q - r + \[Sigma]^2))/F0
We see that the FX forwards are different as their are taken from different probabilities (with different mean and variance). The forward of 1/F depends also on volatility whereas F does not. Let's show the validity of Jensen's inequality: 1/ Subscript[F, USD] and Subscript[F, EUR]
fxMeanDiff = 1/usdFwrd - eurFwrd // Simplify
-((E^((q - r) t) (-1 + E^(t \[Sigma]^2)))/F0)
Since the above quantity is negative, this shows that indeed
(E[Subscript[F, t]])^-1 < E[Subsuperscript[F, t, -1]]
Plot[fxMeanDiff /. {F0 -> 1.35, r -> 0.01, q -> 0.0045,
t -> 0.5}, {\[Sigma], 0.1, 0.3},
PlotLabel ->
Style["Jensen's inequality and FX forward rates", {15, Bold}, Blue],
PlotStyle -> {Thick, Red}]
![enter image description here][2]
Jensen's inequality effects increases with volatility. On the other hand, the only instance when both forwards will be consistent w.r.t the same probability occurs when \[Sigma]=0. Since this is never the case, we conclude that Siegel's paradox holds.
**Conclusion**
----------
The objective of this note was to present the FX derivatives - forwards and options from different perspective. Whilst the FX spot market is reasonably simple, derivatives are more complicated, especially when we start looking at them from each contractual perspective. Change of probability measure, and hence different probabilities are required to ensure consistency. Existence of Siegel's paradox proves this.
Change of probability measure is handled implicitly by Mathematica once the FX process is correctly defined. The same applies to proving of Siegel's paradox.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Jensinequality.png&userId=387433
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Jensinequality.png&userId=387433Igor Hlivka2018-02-04T20:12:16ZInterest rates derivatives in multi-curves framework
http://community.wolfram.com/groups/-/m/t/1273892
We discuss the changes to the interest rates processes when we move from mono-curve setting to multi-curve framework. This is characterised by presence of several curves – a dedicated discount curve and set of estimation curves – each for specific Libor rate. The first is generally assumed to be the OIS curve, whilst the rest are ‘tenor’ curves for given Libor tenor.
The changes in the forward Libor estimation are due to the ‘loss’ of martingale property when mono-curve world is replaced by multiple curve framework. We show how multiplicative adjustment works in this new setting and how interest rate derivatives are affected. Various modelling assumptions are used to show derivatives pricing in this new setting.
![enter image description here][23]
#Introduction#
We review the setting of Interest rate derivatives in post-crisis era characterised by multi-curve environment where dedicated yield curves are defined for forward rate estimation and cashflow discounting. The multi-curve framework is a direct consequence of financial crisis of 2007-2008 when the so-called 'Libor market' - represented by single yield curve stopped being seen as risk-free, and new curves started to emerge to better reflect the counterparty risk in the financial markets.
The current interest rate framework exists in the simplest form in the dual curve setting - (i) discounting curve - usually built with OIS instruments and (ii) estimation curve - generally used to build the 'main' estimation curve in a given currency. This is 3 month Libor curve for USD or 6 months Euribor curve for EUR.
Existence of dual curve environment does change the interest rate mathematics. Martingales defined in the single curve framework do not hold and the process has to be adapted to account for curves duality. We demonstrate how this process work and show how interest rate derivatives - both linear and optional work when we move from the singe to dual framework.
#Interest rate derivatives in a single curve framework#
We firs look at the single-curve homework in the pre-2007 era. When only one yield curve exists, the derivatives pricing is simple and tidy. Forward rate defined on the singe curve using two deposits coincides the forward rate agreement rate = FRA rate
Subscript[F, S] = 1/(Subscript[T, 2] - Subscript[T, 1]) * P[0, Subscript[T, 1]]/P[0, Subscript[T, 2]] - 1;
where Subscript[F, S] is the forward rate in a single-curve setting, Subscript[T, 1], Subscript[T, 2] and tow maturity dates with Subscript[T, 2]>Subscript[T, 1] and P[0, Subscript[T, 1]] , P[0,Subscript[T, 2]] are two discount factors at time 0 with maturities Subscript[T, 1] and Subscript[T, 2].
The FRA rate is then defined as Subscript[F, FRA] = K such that the payoff of the contract at time 0 has value = 0 L[Subscript[T, 1], Subscript[T, 2]] - K = 0 with L[Subscript[T, 1], Subscript[T, 2]] defined as forward term-rate.
## Interest rate swaps in single-curve setting ##
Interest rate swap together with FRA are one the simplest linear interest rate derivatives. It usually involves exchange of fixed rate for a series of floating forward rates up to final maturity:
fixedLeg = S Sum[\[Delta][i] P[0, i], {i, 1, m}]
floatLeg = Sum[\[Delta][i] P[0, i] Subscript[L, S][i], {i, 1, n}]
![enter image description here][2]
where $L_S$ is the forward Libor rate in a single curve framework. This is identical to the FRA rate defined above:
Subscript[L, S][i] = 1/\[Delta][i]*(P[i - 1]/P[i]-1)
floatLeg =
Sum[\[Delta][i]*
P[0, i]*(1/\[Delta][i])*(P[0, i - 1]/P[0, i] - 1), {i, 1, n}]
> P[0, 0] - P[0, n]
Then swap rate *S* is simply a solution to the equation:
Solve[fixedLeg == floatLeg, S]
![enter image description here][3]
This shows that in a single-curve framework the swap rate is simply a difference in two discount factors normalised by $annuity= \sum_{i = 1}^n\delta[i]\ P[0, i]$. The same curve is used to produce discount factors that are used for (i) discounting and (ii) forward Libor estimation.
#Multi-curve framework for Interest rate derivatives#
When we move to multi-curve setting, we assume:
- Separate discounting curve - generally OIS curve
- Separate estimation curve for 'main index - 3M or 6M
- Separate estimation curves for 'minor indices - say 1M, 12M or 6M (in 3M setting)
When the discounting curve is set to the OIS curve, we define the OIS forward rate with tenor h similarly to the forward in the mono-currency setting:
![enter image description here][4]
for i = 1...n where $\delta[i]$ is a year fraction for interval $T_{i-1} -T_i$ and $P_{OIS}[t,T_i]$ is a discount factor from the OIS curve at time t maturing at time $T_i$
In the multi-curve framework, the Libor definition in the single curve environment does not hold L[Subscript[T, 1],Subscript[T, 2]]] != Subscript[F, S][t;Subscript[T, 1],Subscript[T, 2]] != Subscript[F, OIS][t,Subscript[T, 1],Subscript[T, 2]] since the discount factors in definition of Libor when only one curve is used is not the same as in dual curve case. Libor is dual curve setting is calculated from the estimation curve with unique set of discount factors.
The expectation of forward Libor in the dual curve setting can be expressed as
\!\(
\*SubsuperscriptBox[\(E\), \(t\),
SubsuperscriptBox[\(Q\), \(OIS\), \(T2\)]]\([\)\)Subscript[F, D][Subscript[T, 1];Subscript[T, 1],Subscript[T, 2]]] = Subsuperscript[E, t, Subsuperscript[Q, OIS, T2]][E^Subsuperscript[Q, OIS, T2][L[Subscript[T, 1],Subscript[T, 2]|Subscript[\[ScriptCapitalF], t]]. The valuation of forward rate agreement with Libor forward rate is therefore defined as: FRA[t,Subscript[T, 1],Subscript[T, 2]] =Subscript[P, OIS][t,Subscript[T, 2]] \[Delta][Subscript[T, 1],Subscript[T, 2]] \!\(
\*SubsuperscriptBox[\(E\), \(t\),
SubscriptBox[\(Q\), \(OIS\)]]\([\)\)L[t,Subscript[T, 1],Subscript[T, 2]]-K].
Current market practice takes a shortcut and simply values the FRA as FRA[t,Subscript[T, 1],Subscript[T, 2]] =Subscript[P, OIS][t,Subscript[T, 2]] \[Delta][Subscript[T, 1],Subscript[T, 2]] (L[t,Subscript[T, 1],Subscript[T, 2]]-K]) where discount factor Subscript[P, OIS][t,Subscript[T, 2]] comes from the OIS curve and the forward Libor L[t,Subscript[T, 1],Subscript[T, 2]] is taken from the estimation curve. This is clearly inconsistent since forward Libor is NOT martingale under the OIS forward measure.
##Libor adjustment in multi-curve framework##
To restore the non-arbitrage relationship, forward Libor rate has to be adjusted. We refer to this as Forward basis that restores the equilibrium between Subscript[F, OIS] and Subscript[F, E]. Assuming multiplicative basis Aj, we get:
Fd = (1/\[Delta]) (Pd[T1]/Pd[T2] - 1);
Fe = (1/\[Gamma]) (Pe[T1]/Pe[T2] - 1);
Solve[Fe \[Gamma] == Fd \[Delta] Aj, Aj]
![enter image description here][5]
where Subscript[F, d] represents forward rate from the OIS curve, Subscript[F, e] is the forward Libor from the estimation curve, Subscript[P, d] is a discount factor f from the OIS curve and Subscript[P, e] is a discount factor from the estimation curve.
The forward basis is therefore a ratio of discount factors from both curves and can be recovered ex-post once both curve have been calibrated to the market data.
From modelling perspective, however it is desirable to express the forward rate in terms of single curve. We introduce new discount factor adjustment Subscript[B, j] and re-calculate the forward adjustment spread:
Fd = (1/\[Delta]) (PdT1/PdT2 - 1);
Fe = (1/\[Gamma]) (PeT1/PeT2 - 1);
PeT1 = BjT1 PdT1;
PeT2 = BjT2 PdT2;
Solve[Fd == Fe Aj, Aj] // Simplify
![enter image description here][6]
and get the forward Libor $F_e$
Fe
![enter image description here][7]
This shows that the Libor is a function of (i) OIS curve and (ii) discount factor adjuster. To proceed, we assume that the forward rate follows LogNormal martingale dynamics under forward measure Subscript[Q, e]
Fe = GeometricBrownianMotionProcess[0, \[Sigma], x0];
Fe[t]
![enter image description here][8]
We apply to similar process to the forward adjuster defined under forward measure $Q_d$
Bj = GeometricBrownianMotionProcess[0, \[Eta], y0];
Bj[t]
![enter image description here][9]
To change the measure from Subscript[Q, e]==> Subscript[Q, d], we use the change-of-measure technique that says:
Subscript[E, OIS][Fe] = Subscript[E, e][Fd Bj]. To change the measure, we need joint expectation of OIS forward and the forward adjuster. We apply the **Binormal Copula** with LogNormal marginals
cDist = CopulaDistribution[{"Binormal", ρ}, {Fe[t], Bj[t]}];
cdrift = Expectation[x*y, {x, y} \[Distributed] cDist,
Assumptions ->
t > 0 && η > 0 && σ > 0 && -1 <= ρ <= 1]
![enter image description here][10]
The joint expectation of forward OIS and forward adjuster on relative basis provides the adjustment for the process where the change of measure occurs. Since the martingale process for forward Libor has to be drift less, we adjust the forward rate by its negative quantity;
Aj = cdrift/(x0 y0) /. t -> -t
![enter image description here][11]
Returning back to our original Libor adjustment formula, we observe:
![enter image description here][12]
Fe_Adj = Expectation[x, x \[Distributed] Fe[t],
Assumptions -> t > 0 && σ > 0 && x0 > 0]*Aj /. x0 -> L[0]
![enter image description here][13]
This is the forward Libor rate under the OIS forward discounting measure. The adjustment is a function (i) time, (ii) volatility of Libor and (iii) volatility of OIS rate. A reader familiar with the exposition above, an recognise here the parallelism to process drift adjustment in the foreign currency market know as **'quanto adjustment'**. The similarity is obvious - we work with two curves, two sources and randomness and switch the measure similarly to what we do in foreign currency markets.
##Forward rate agreement - FRA##
This is the simple contract that pays the difference between forward Libor and fixed rate
![enter image description here][14]
where \[DoubleStruckCapitalC] is nominal and $\delta[\tau]$ is a year fraction on day count convention between the Libor tenor $T_1$ and $T_2$.
Ho much does the adjustment affects the FRA valuation? We look first at **market volatilities** - (i) for the Libor rate and (ii) Adjuster:
Assume: $\delta=0.25$, C=1 mil, $P_{OIS}[t,T_2] = 0.98$, t=1, L=0.0125,K=0.0125
fra = C*Pois*δ*(L*E^(-t*ρ*σ*η) - K) /. {C ->
1000000, L -> 0.0125, K -> 0.0125, t -> 1, δ -> 0.25,
Pois -> 0.98, ρ -> 0.75}
Plot3D[fra, {σ, 0.1, 0.3}, {η, 0.1, 0.3},
AxesLabel -> Automatic, PlotTheme -> "Marketing",
PlotLabel ->
Style["FRA valuation impact by market volatilities", Blue, 15]]
![enter image description here][15]
![enter image description here][16]
As we can see from the graph above, higher volatilities will push the value of forward rate lower and therefore making the value of long forward contract more negative. The opposite applies to a short FRA contract.
We can now look at correlation impact:
fra2 = C*Pois*δ*(L*E^(-t*ρ*σ*η) - K) /. {C ->
1000000, L -> 0.0125, K -> 0.0125, t -> 1, δ -> 0.25,
Pois -> 0.98, σ -> 0.2, η -> 0.2};
Plot[fra2, {ρ, -0.75, 0.75}, PlotStyle -> Red,
PlotLabel -> Style["Correlation impact on FRA valuation", Blue, 15]]
![enter image description here][17]
Negative correlation will increase the long FRA value since the adjusted Libor will be higher. Positive correlation will drive the valuation i into negative territory.
##Interest rate swap - IRS##
The payer IRS formula is determined from the same equation: fixed leg = float leg
fixedLeg = K Sum[δ[i] Subscript[P, OIS][i], {i, 1, m}];
floatLeg =
Sum[δ[i] Subscript[P, OIS][i] L[
i] Exp[-Subscript[t, i] ρ σ η], {i, 1, n}];
swapR = Solve[fixedLeg == floatLeg, K] // Simplify
![enter image description here][18]
This is the equilibrium swap rate that will make present value at inception zero. The new formula differs from the swap rate formula in the single curve framework in two instances:
- Discount factor P comes from a special discounting curve - the OIS
curve and becomes Subscript[P, OIS][t,Subscript[T, i]]
- Numerator does not reduce to a simple difference of two discount
factors since adjusted Libor rate L[t, Subscript[T, 1],Subscript[T,
2]] E^(-t \[Rho] \[Eta] \[Sigma]) is now estimated on a different
curve, the so-called estimation curve
##Caps and Floors##
Consider first a Caplet paying out at time Subscript[T, k]. Caplet is essentially a call option on forward Libor rate L[t;Subscript[T, k-1],Subscript[T, k]]: \[Delta][\[Tau]] *(L[t;Subscript[T, k-1],Subscript[T, k]]-K)^+ where \[Delta][\[Tau]] is a year fraction between Subscript[T, 1] and Subscript[T, 2] and K is a fixed strike rate. The pricing formula is simply a discounted conditioned expectation of the payoff positivity under certain distributional assumptions. So, to price a Caplet in multi-curve framework, we proceed as in mono-currency case, with replacement: Libor mono-curve -> Libor multi-curve:
![enter image description here][19]
Pricing formula will differ depending on the choice distributional assumptions for the forward Libor rate. For calculation purposes, we set the adjusted Libor rate -Subscript[L, e][t;Subscript[T, 1],Subscript[T, 2]] E^(-t \[Rho] \[Eta] \[Sigma]) = x0. We choose the three processes that become the most common in the market - i.e. (i) Normal process, (ii) LogNormal process and (iii) Mean-reverting Normal process.
- **Normal process:**
nProc = OrnsteinUhlenbeckProcess[0, σ, 0, x0];
nCplt = Subscript[P, OIS][t, i] δ[i] Expectation[Max[x - k, 0],
x \[Distributed] nProc[t],
Assumptions -> σ > 0 && t > 0] // FullSimplify
![enter image description here][20]
We can now investigate the behaviour of the Caplet w..r.t Libor volatility and strike
Plot3D[nCplt /. {Subscript[P, OIS][t, i] -> 0.98, δ[i] -> 0.25,
x0 -> 0.0125, t -> 1}, {σ, 0.005, 0.015}, {k, 0.01,
0.0135}, PlotLabel ->
Style["Caplet Normal premium", Blue, {15, Bold}],
PlotLegends -> Automatic, AxesLabel -> Automatic,
ColorFunction -> "Rainbow"]
![enter image description here][21]
Premium increases as volatility goes up and strike declines. However, volatility is more dominant factor.
- **Lognormal process**
lProc = GeometricBrownianMotionProcess[0, σ, x0];
lCplt = Subscript[P, OIS][t, i] δ[i] Expectation[Max[x - k, 0],
x \[Distributed] lProc[t],
Assumptions -> σ > 0 && t > 0 && k > 0 && x0 > 0] //
FullSimplify
![enter image description here][22]
A similar pattern is observed for other processes, such as LogNormal
Plot3D[lCplt /. {Subscript[P, OIS][t, i] -> 0.98, δ[i] -> 0.25,
x0 -> 0.0125, t -> 1}, {σ, 0.15, 0.5}, {k, 0.01, 0.0135},
PlotLabel -> Style["Caplet LogNormal premium", Blue, {15, Bold}],
PlotLegends -> Automatic, AxesLabel -> Automatic,
ColorFunction -> "TemperatureMap"]
![enter image description here][23]
- **Mean-reverting normal process**
mProc = OrnsteinUhlenbeckProcess[μ, σ, θ, x0];
mCplt = Subscript[P, OIS][t, i] δ[i] Expectation[Max[x - k, 0],
x \[Distributed] NormalDistribution[a, b],
Assumptions -> b > 0 && t > 0];
mCplt = % /. {a -> mProc[t][[1]], b -> mProc[t][[2]]} // FullSimplify
![enter image description here][24]
###Floors###
Interest rate floors are are essentially put options on forward Libor rate with payoff function:
![enter image description here][25]
- **Normal process**
nProc = OrnsteinUhlenbeckProcess[0, σ, 0, x0];
nFlrt = Subscript[P, OIS][t, i] δ[i] Expectation[Max[k - x, 0],
x \[Distributed] nProc[t],
Assumptions -> σ > 0 && t > 0] // FullSimplify
![enter image description here][26]
- **LogNormal process**
lFlrt = Subscript[P, OIS][t, i] δ[i] Expectation[Max[k - x, 0],
x \[Distributed] lProc[t],
Assumptions -> σ > 0 && t > 0 && k > 0 && x0 > 0] //
FullSimplify
![enter image description here][27]
Plot3D[lFlrt /. {Subscript[P, OIS][t, i] -> 0.98, δ[i] -> 0.25,
x0 -> 0.0125, t -> 1}, {σ, 0.15, 0.5}, {k, 0.01, 0.0135},
PlotLabel -> Style["Floorlet LogNormal premium", Blue, {15, Bold}],
PlotLegends -> Automatic, AxesLabel -> Automatic,
ColorFunction -> "Pastel"]
![enter image description here][28]
##Swaptions##
Swaptions are options on the swap rate defined above. They exist in tow formats: (i) Payer swaption = put option on the swap rate and (ii) Receiver swaption = call option on the swap rate. When we operate in the multi-curve framework, we deal with the same problem as in Libor case - i.e. swap rate adjustment.
We develop the swap adjustment in the same way as Libor. When LogNormal dynamics for the swap rate is envisaged, we arrive at the adjustment quantity though a joint expectation process:
![enter image description here][29]
The volatilities in the exponent are now swaption volatilities and correlation coefficient $\rho$ is the correlation between the swap rate and the adjuster.
###Receiver swaption###
This is the call option on the swap rate with the payoff ; Rec_OSWP = Subscript[AF, OIS] (Subscript[S, ADJ][t; Subscript[T, 0],Subscript[T, n]] -K)^+ where:
Subscript[AF, OIS] = Sum[γ[i] Subscript[P, OIS][i], {i, 1, n}]
![enter image description here][30]
The option premium will depend on the modelling choice for the underlying swap rate. We look again at (i) Normal process, (ii) LogNormal process and (iii) Mean-reverting Normal process:
- **Normal process**
nSwpn = Subscript[AF, OIS]
Expectation[Max[x - k, 0], x \[Distributed] nProc[t],
Assumptions -> σ > 0 && t > 0] // FullSimplify
![enter image description here][31]
- **LogNormal process**
lSwpn = Subscript[AF, OIS]
Expectation[Max[x - k, 0], x \[Distributed] lProc[t],
Assumptions -> σ > 0 && t > 0 && k > 0 && x0 > 0] //
FullSimplify
![enter image description here][32]
- **Normal mean-reverting process**
mCplt = Subscript[AF, OIS]
Expectation[Max[x - k, 0],
x \[Distributed] NormalDistribution[a, b],
Assumptions -> b > 0 && t > 0];
mCplt = % /. {a -> mProc[t][[1]], b -> mProc[t][[2]]} // FullSimplify
![enter image description here][33]
###Payer swaption###
These are *put opinions* on the swap rate which in case of multi-curve environment is drift-adjusted. For example, if we assume normal distribution for the swap rate, we get
- **Normal process**
nSwpn2 = Subscript[AF, OIS]
Expectation[Max[k - x, 0], x \[Distributed] nProc[t],
Assumptions -> σ > 0 && t > 0] // FullSimplify
![enter image description here][34]
#Conclusion#
Multi-curve framework in case of interest rate derivatives brings new paradigm that requires certain adjustment to the underlying rates. This is due to a measure change when the expectation of the rates stops being martingale. Introduction of separate discounting curve - OIS requires adjustment to the forward rate drift in order to preserve non-arbitrage condition. Quarto-style adjustment known in foreign currency market is being used to derive neat formula.
Pricing and valuation adjustment with Mathematica, as the above demonstration shows, is easy. Availability of stochastic routines and probabilistic functions leads to quick and elegant solution.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Caplet.jpg&userId=387433
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-29at11.02.28.png&userId=20103
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-29at11.18.04.png&userId=20103
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-29at11.23.08.png&userId=20103
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-29at11.27.49.png&userId=20103
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-29at11.29.20.png&userId=20103
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-29at11.30.27.png&userId=20103
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-29at11.31.55.png&userId=20103
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=15141.png&userId=20103
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=36372.png&userId=20103
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=57483.png&userId=20103
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-29at11.38.59.png&userId=20103
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=10334.png&userId=20103
[14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=52615.png&userId=20103
[15]: http://community.wolfram.com//c/portal/getImageAttachment?filename=64676.png&userId=20103
[16]: http://community.wolfram.com//c/portal/getImageAttachment?filename=71507.png&userId=20103
[17]: http://community.wolfram.com//c/portal/getImageAttachment?filename=103448.png&userId=20103
[18]: http://community.wolfram.com//c/portal/getImageAttachment?filename=31589.png&userId=20103
[19]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-29at12.05.36.png&userId=20103
[20]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1092710.png&userId=20103
[21]: http://community.wolfram.com//c/portal/getImageAttachment?filename=291011.png&userId=20103
[22]: http://community.wolfram.com//c/portal/getImageAttachment?filename=446612.png&userId=20103
[23]: http://community.wolfram.com//c/portal/getImageAttachment?filename=732913.png&userId=20103
[24]: http://community.wolfram.com//c/portal/getImageAttachment?filename=570614.png&userId=20103
[25]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-29at12.14.26.png&userId=20103
[26]: http://community.wolfram.com//c/portal/getImageAttachment?filename=329415.png&userId=20103
[27]: http://community.wolfram.com//c/portal/getImageAttachment?filename=259916.png&userId=20103
[28]: http://community.wolfram.com//c/portal/getImageAttachment?filename=810317.png&userId=20103
[29]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-29at12.19.37.png&userId=20103
[30]: http://community.wolfram.com//c/portal/getImageAttachment?filename=240818.png&userId=20103
[31]: http://community.wolfram.com//c/portal/getImageAttachment?filename=934319.png&userId=20103
[32]: http://community.wolfram.com//c/portal/getImageAttachment?filename=797420.png&userId=20103
[33]: http://community.wolfram.com//c/portal/getImageAttachment?filename=881621.png&userId=20103
[34]: http://community.wolfram.com//c/portal/getImageAttachment?filename=498322.png&userId=20103Igor Hlivka2018-01-29T12:58:41ZSet up SendMail from Mathematica?
http://community.wolfram.com/groups/-/m/t/1286756
I just worked through the online version of "An Elementary Introduction to the Wolfram Language" with Mathematica running on a Pi Zero W. Amazed to find most things worked on that tiny platform.
There were a few examples of using SendMail in the book that I wasn't able to make work. Yahoo didn't like the mail being relayed through the Wolfram Cloud so I was attempting to configure the SMTP server settings, but can't find the "Preferences > Internet & Mail > Mail Settings" menu suggested by the SendMail::cloudrelay message that appeared in my notebook.
Since it may be important, I am using
pi@raspberrypi:~ $ mathematica --version
11.2
Any help getting this set up would be appreciated.
-- ToddTodd Kroeger2018-02-17T07:40:08ZSet Image acquisition ($ImagingDevice) on Unix?
http://community.wolfram.com/groups/-/m/t/1288310
When I do<br>
$ImagingDevice
I get the following message
Message[$ImagingDevice::notsupported, "Unix"]
What can I do to fix it?Santiago Hincapie2018-02-19T23:04:51ZUpload file to Wolfram Cloud?
http://community.wolfram.com/groups/-/m/t/1288289
I'm logged into my cloud account but I can't seem to save/open anything from MathematicaOnline's folders... Any suggestions?
![enter image description here][2]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-02-19at4.42.44PM.png&userId=900170
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Untitled.jpeg&userId=900170Mike Sollami2018-02-19T22:01:28ZRendering of RegionIntersection in 3D?
http://community.wolfram.com/groups/-/m/t/1283669
I am trying to visualize some region intersections in 3D.
## Example 1:
ra = 10;
ri = 5;
R1 = RegionDifference[Ball[{0, 0, 0}, ra], Ball[{0, 0, ri - 1/2}, ri]];
Show[R1 // Region, Axes -> True]
![rendered result][1]
The resulting rendered region has a hole, while it should not have one. Does anyone know a way to improve on this.
Another example.
## Example 2:
ra = 10;
ri = 5;
R1 = RegionDifference[Ball[{0, 0, 0}, ra], Ball[{0, 0, 0}, ri]];
R2 = Cylinder[{{-100, 0, 0}, {100, 0, 0}}, 5];
R = RegionIntersection[R1, R2] // Region
The resulting region is rendered with jagged edges.
![The rendered result of Example2][2]
How can this rendering be improved? I know that the rendered edges can not be infinitely sharp like in the mathematical world, but I think some improvement should be possible. Does anyone know how to achieve this? I am using Mathematica 11.1 on Windows.
Thanks for your help.
Maarten
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2018-02-1310_05_39-RegionIntersectionrenderingnotgood.nb_-WolframMathematica11.1.png&userId=307930
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2018-02-1310_06_27-RegionIntersectionrenderingnotgood.nb_-WolframMathematica11.1.png&userId=307930Maarten van der Burgt2018-02-13T09:17:38ZFunctions or packages to implement Belief propagation?
http://community.wolfram.com/groups/-/m/t/1288141
I look for an efficient way to implement a [Belief Propagation][1] (more specific, parallel implementation). Does anyone know about any useful functions or packages?
[1]: https://en.wikipedia.org/wiki/Belief_propagationKiril Dan2018-02-19T17:50:59Z[✓] Get a TransitiveClosureGraph[] with loops?
http://community.wolfram.com/groups/-/m/t/1287985
Here is a simple example:
In[1]:= TransitiveClosureGraph[{1->2, 2->3, 3->1}]//AdjacencyMatrix//MatrixForm
Out[1]//MatrixForm= 0 1 1
1 0 1
1 1 0
This produces the graph with the adjacency matrix of {{0,1,1},{1,0,1},{1,1,0}}, but I expected the diagonal elements to be 1 as well, i.e. a loop for each vertex. At least for a binary relation that would be the case, so I don't understand why the transitive closure for a graph is ignoring the loops. By the definition of transitive closure on [MathWorld definition][1] it is a graph which contains an edge {u,v} whenever there is a directed path from u to v. Well, in our case there is a directed path from 1 to 1, namely: 1->2, 2->3, 3->1. And likewise for the nodes 2 and 3. What am I missing here? Thank you.
[1]: http://mathworld.wolfram.com/TransitiveClosure.htmlTigran Aivazian2018-02-19T12:06:21ZAvoid homotopy error: "No Jacobian for continuous block"
http://community.wolfram.com/groups/-/m/t/1286024
I'm trying to use homotopy to make the initialization of my pipeline model. It's very similar to example 3 in the Modelica reference [here][1]. But instead of
`m_flow = f(dP)` I'm doing `dP=f(m_flow)`, which shouldn't matter, right?
Anyway, my homotopy code is
dp_fric = homotopy(actual = dPfriction(m_flow,density,eta,pipe),
simplified = someConstants * m_flow);
And then I have defined the derivative function of dPfriction with `noDerivative={density, eta, pipe}`. When I run this, I get the error
> Fatal failure: File: Backend/SimCodegen.ml, Function: generateHomotopyJacobian, Line: 4174, Msg: No Jacobian for continuous block which is main homotopy block
Can someone tell me what I'm doing wrong? Thanks.
[1]: https://build.openmodelica.org/Documentation/ModelicaReference.Operators.%27homotopy%28%29%27.htmlEric Smith2018-02-15T20:22:43ZWorking with SEGY file format for storing geophysical data
http://community.wolfram.com/groups/-/m/t/1283198
## Preamble
Several days ago I found this [question][1] in the Community. I think it interesting theme for discussion.
Because I want to show how you can using the package [CustomImportExport][2]. Something of this article will repeat comments on the previous question, but I want save this post to be a stand-alone tutorial for the package and SEGY in Wolfram Language.
## Downloading
Clone or download this repository **[CustomImportExport][3]** using git (in the terminal or cmd-window):
`git clone https://guthub.com/KirillBelovTest/CustomImportExport.git`
Also you can download repository using green button on GitHub
![download button on GitHub][4]
## Installing
After you can install the package in your system. You may open the file *Installer.nb* and execute this code:
```
SetDirectory[NotebookDirectory[]];
Get["Installer.m"];
```
*Installer.m* - script that will create a new folder in **$UserBaseDirectory**. After this you can call the context *"CustomImportExport`"* from any notebooks.
## Reading SEGY data
Now let try read the .segy-file. For demonstration in the repository exist the file [*"/CustomImportExport/Resources/MarmousiModel.segy"*][5]
If you was installed the package, you may execute following in any notebook:
```
$HistoryLength = 0;
<<CustomImportExport`
SetDirectory[$CustomImportExportDirectory];
marmousiPath = FileNameJoin[{"CustomImportExport", "Resources", "MarmousiModel.segy"}];
marmousiData = CustomImport[marmousiPath, "SEGY"]
(*
Out[..] := SEGYData[{SEGYElement["TextHeader"], SEGYElement[..], ..}]
*)
```
This output contains all data from .segy-file. equivalents of the last line of code:
```
marmousiData = CustomImport[File[marmousiPath], "SGY"];
```
## Working with loaded data
Now we have the variable **marmousiData**. This is a object with type **SEGYData**. For this type
in the package defined special operations. For example you can get same of elements:
```
marmousiData["TextHeader"]
(* Out[..] := SEGYElement["TextHeader", <3200 whitespaces>] *)
```
Similarly, you can get other elements:
1. TextHeader
2. BinaryHeader
3. TraceHeaders
4. Traces
```
marmousiData["BinaryHeader"]
(* Out[..] := SEGYElement["BinaryHeader", {"JobID" -> 0, "LineNumber" -> 0, ..}] *)
marmousiData["TraceHeaders"]
(* Out[..] := SEGYElement["TraceHeaders", {"tracl", ..} -> {{0, 1, ..}, ..}] *)
marmousiData["Traces"]
(* Out[..] := SEGYElement["Traces", {{0.0, 1.0, ..}, ..}] *)
```
I created an additional type for convenience. **SEGYElement** also has additional functionality:
```
marmousiTraceHeaders = marmousiData["TraceHeaders"];
marmousiTraceHeaders[]
(* Out[..] := {"tracl", ..} -> {{0, 1}, ..}
returns list of rules - second element in the marmousiTraceHeaders*)
```
And this will work for all SEGYElement-items `SEGYElement["Name", data][]` - returns internal data of the object.
In addition, the elements have other ways of getting data. For example - getting one of the key from the BinaryHeader (several ways):
```
marmousiBinaryHeader = marmousiData["BinaryHeader"];
marmousiData["BinaryHeader"]["JobID"]
marmousiData["BinaryHeader", "NumberDataTraces"]
marmousiBinaryHeader["NumberOfSamplesForReel"]
marmousiBinaryHeader[{"NumberDataTraces", "NumberOfSamplesForReel"}]
(*
Out[..] := 0
Out[..] := 298
Out[..] := 300
Out[..] := {298, 300}
*)
```
Getting information from the TraceHeaders-element:
```
marmousiTraceHeaders = marmousiData["TraceHeaders"];
marmousiData["TraceHeaders"][All]
marmousiData["TraceHeaders", 1, "gx"]
marmousiTraceHeaders[1 ;; 10, {"gx", "gy"}]
marmousiData["TraceHeaders"][{1, 3}]
(*
Out[..] := {{1, 1, 1, ..}, ..} - returns all data without keys.
Out[..] := 0 - only one value
Out[..] := {{0, 0}, {0, 0}, ..} - mixed span - list of keys and only part of the indexes
Out[..] := {{"tracl" -> 1, ..}, ..} - only 1 and 3 elements
*)
```
And the last data element:
```
marmousiTraces = marmousiData["Traces"];
marmousiData["Traces"][6]
marmousiData["Traces", {1, -1}]
marmousiTraces[1 ;; 10 ;; 2]
(*
Out[..] := {1500., 1500., ..} - first trace
Out[..] := {{1500., 1500., ..}, {..}} - first and last traces
Out[..] := {{1500., 1500., ..}, {..}, ..} - span
*)
```
## Helper Functions
In the package there are several auxiliary functions:
```
?SEGYDescription
(* SEGYDescription[segyData]. represent the text header of the .segy file in a convenient format *)
SEGYDescription[marmousiData]
(* Out[..] := <3200 white spaces. If in the file exist description - function will show it>*)
```
Redefined function **ArrayPlot**:
```
ArrayPlot[marmousiData]
(* equivalent:
ArrayPlot[marmousiData["Traces"]]
ArrayPlot[Transpose[marmousiData["Traces"][]]]
*)
```
![enter image description here][7]
And you can set a new value to key of the TraceHeaders (in the future is will be working for other elements):
```
marmousiData["TraceHeaders", 1, "gx"]
SEGYSetValue[marmousiData["TraceHeaders", 1, "gx"], 1];
marmousiData["TraceHeaders", 1, "gx"]
(* Out[..] := 0 *)
(* Out[..] := 1 *)
```
## Optimization
To convert IBM 32 Float numbers, the compiled function is used. By default, it is compiled into bytecode, but if you have a C-compiler, you can use it. On average, this gives a 2-fold gain in the speed of data import:
```
CustomImport[marmousiPath, "SEGY", "ConvertOptions" -> {"CompilationTarget" -> "C"}]
```
## Delayed Loading SEGY Data
This is a very interesting thing that I realized specifically for working with large files (more RAM available). You can not store such a file in the repository.Therefore, the demonstration will be conducted on the same Marmousi model. The function **CustomImport** has an additional option for calling:
```
(* by default loading has value "Memory" *)
unloadedMarmousiData = CustomImport[marmousiPath, "SGY", "Loading" -> "Delayed"]
(*
Out[..] := SEGYData[{
SEGYElement["TextHeader", ..],
SEGYElement["BinaryHeader", ..],
SEGYElement["TraceHeadersUnloaded", {keys..} ->
{"File" -> <filepath>, "Convert" -> convertfunc, "Bytes" -> 240, "Positions" -> {poslist}}],
SEGYElement["TracesUnloaded", {keys..} ->
{"File" -> <filepath>, "Convert" -> convertfunc, "Bytes" -> tracelength, "Positions" -> {poslist}}]
}]
*)
```
Unloaded elements contain only references to sections of the indexed file,
which allows not storing large amounts of data entirely in memory.
You can get the data with a special loader:
```
CustomDataLoad[unloadedMarmousiData["TracesUnloaded", 1], "SEGY"]
CustomDataLoad[unloadedMarmousiData["TracesUnloaded", {1, 3}], "SEGY"]
CustomDataLoad[unloadedMarmousiData["TracesUnloaded", 1 ;; 3], "SEGY"]
(*
Out[..] := {1500., 1500., ..} - only first trace
Out[..] := {{1500., 1500., ..}, {..}} - traces 1, 3
Out[..] := {{1500., 1500., ..}, {..}, {..}} - traces 1, 2 and 3
*)
```
## Exporting SEGY Data
This was much more difficult than import, but in this package, data export to SEGY is also available. Only exported data must fully correspond to the internal structure of SEGYData. For example you can create the copy of the MarmousiModel:
```
CustomExport[StringReplace[marmousiPath, ".segy" -> "Copy.segy"], marmousiData, "SEGY"]
(* Out[..] := <path to copy> *)
```
P.S. Sorry for my English. I'm ready to answer questions and add features to this article and expand the functionality of the package. Offer your use cases.
[1]: http://community.wolfram.com/groups/-/m/t/1272436
[2]: https://github.com/KirillBelovTest/CustomImportExport
[3]: https://github.com/KirillBelovTest/CustomImportExport
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=working-with-segy-1.jpg&userId=937303
[5]: https://github.com/KirillBelovTest/CustomImportExport/tree/master/CustomImportExport/Resources
[6]: http://community.wolfram.com/groups/-/m/t/1272436
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=working-with-segy-2.jpg&userId=937303Kirill Belov2018-02-12T11:56:31ZNarayana Cow Triangle Fractal
http://community.wolfram.com/groups/-/m/t/1286708
In 1356, Narayana posed a question in his book *Gaṇita Kaumudi*: "A cow gives birth to a calf every year. In turn, the calf gives birth to another calf when it is three years old. What is the number of progeny produced during twenty years by one cow?" This is now known as Narayana's cows sequence. The Narayana's cows sequence constant, **cow**=1.4655712318767680266567312252199391080255775684723, is the limit ratio between neighboring terms.
LinearRecurrence[{1, 0, 1}, {2, 3, 4}, 21]
NestList[Round[# Root[-1 - #1^2 + #1^3 &, 1]] &, 2, 20]
Either gives {2, 3, 4, 6, 9, 13, 19, 28, 41, 60, 88, 129, 189, 277, 406, 595, 872, 1278, 1873, 2745, 4023}. This turns out to be a good constant to use for a Rauzy fractal. The outer fractal triangle can be divided into copies of itself
r = Root[-1 - #1^2 + #1^3 &, 3]; iterations = 6;
cowed[comp_] := First /@ Split[Flatten[RootReduce[#[[1]] + (#[[2]] - #[[1]]) {0, -r^5, r^5 + 1, 1}] & /@ Partition[comp, 2, 1, 1], 1]];
poly = ReIm[Nest[cowed[#] &, #, iterations]] & /@ Table[N[RootReduce[r^({4, 1, 3, 5} + n) {1, 1, -1, 1}], 50], {n, 1,14}];
Graphics[{EdgeForm[{Black}], Gray, Disk[{0, 0}, .1], MapIndexed[{Hue[#2[[1]]/12], Polygon[#1]} &, poly]}]
![fractal Narayana Cow spiral ][1]
The ratio of areas for the triangles turns out to be **cow**. Try Area[Polygon[poly[[1]]]]/Area[Polygon[poly[[2]]]] and you'll see.
If you want to laser cut that, it's handy to get a single path.
cowpath[comp_] := First /@ Split[Flatten[RootReduce[#[[1]] + (#[[2]] - #[[1]]) {0, -r^5, r^5 + 1, 1}] & /@ Partition[comp, 2, 1], 1]];
path = ReIm[Nest[cowpath[#] &, N[Drop[Flatten[Table[r^({4, 1, 3} + n) {1, 1, -1}, {n, 1, 16}]], -1], 50], iterations]]; Graphics[{Line[path]}]
What else can be done with **cow**? With some trickier code I put together the pieces this way. Notice how order 5 spokes appear.
![Narayana cow fractal egg][2]
The opening gave an order 3 infinite spiral. Is there an order 5 infinite spiral? It turns out there is. Behold the **cow-nautilus**!
![cow-nautilus][3]
It can be made with the following code:
r=Root[-1-#1^2+#1^3&,3]; iterate=3;
cowed[comp_]:= First/@Split[Flatten[RootReduce[#[[1]]+(#[[2]]-#[[1]]){0,-r^5,r^5+1,1}]&/@Partition[comp,2,1,1],1]];
base={{r^10,r^7,-r^9,r^11},{-r^12,-r^9,r^11,-r^13},{r^8,r^5,-r^7,r^9},{-r^7,-r^4,r^6,-r^8}}+{-r^10,r^11,-r^6,r^4+r^8};
naut=RootReduce[Join[Table[base[[1]] (-r)^n,{n,0,-4,-1}],Flatten[Table[Drop[base,1](-r)^n,{n,-8,0}],1]]];
poly=ReIm[Nest[cowed[#]&,#,iterate]]&/@N[naut,50];
Graphics[{EdgeForm[{Black}],MapIndexed[{ColorData["BrightBands"][N[Norm[Mean[#1]]/2]],Polygon[#1]}&,poly]},ImageSize-> 800]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=fractalcowspiral.jpg&userId=21530
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=cowegg.jpg&userId=21530
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=cownautilus.jpg&userId=21530Ed Pegg2018-02-16T22:52:01ZRead SEGY data in Mathematica?
http://community.wolfram.com/groups/-/m/t/1272436
Please I need code/software to read SEGY data in order to input to MathematicaJohn Smith Jr.2018-01-25T17:35:21ZImprove this relatively simple FindRoot code?
http://community.wolfram.com/groups/-/m/t/1286896
I suspect the answer to this question is likely to be embarrassingly simple, but right now I'm at a loss as to why the following two examples behave so differently:
Trying to replicate the FindRoot function behavior in Mathematica for solving a system of two transcendental equations. I've setup two sample problems and I'm using the FindRoot function to check the output of my code.
This is the first example and it works as expected, matching exactly FindRoot for every iteration cycle:
U[x_, y_] := x^3 - 3 x y^2 + 1;
V[x_, y_] := 3 x^2 y - y^3;
Ux[x_, y_] = D[U[x, y], x];
Uy[x_, y_] = D[U[x, y], y];
Vx[x_, y_] = D[V[x, y], x];
Vy[x_, y_] = D[V[x, y], y];
J[x_, y_] = Ux[x, y] Vy[x, y] - Uy[x, y] Vx[x, y] // Simplify;
Iterate[x_, y_] := {x - (U[x, y] Vy[x, y] - V[x, y] Uy[x, y])/J[x, y],y - (Ux[x, y] V[x, y] - U[x, y] Vx[x, y])/J[x, y]}
NestList[Iterate[#[[1]], #[[2]]] &, {10., 10.}, 10] // TableForm
FindRoot[{U[x, y] == 0, V[x, y] == 0}, {{x, 10.}, {y, 10.}},StepMonitor :> Print[x, " ", y],Method -> {"Newton", "UpdateJacobian" -> 1}]
This produces the following output:
10. 10.
6.66667 6.66833
4.44445 4.4493
2.96297 2.97463
1.97539 2.002
1.31749 1.3768
0.882366 1.00957
0.613064 0.85679
0.505639 0.855438
0.499855 0.866033
0.5 0.866025
6.66667 6.66833
4.44445 4.4493
2.96297 2.97463
1.97539 2.002
1.31749 1.3768
0.882366 1.00957
0.613064 0.85679
0.505639 0.855438
0.499855 0.866033
0.5 0.866025
0.5 0.866025
Now testing the same code with a different set of equations:
SampleParams = {x1 -> 2., y1 -> 5., x2 -> 4., y2 -> 2, x3 -> 8, y3 -> 7};
U[x_, y_] := y1 - y3 - x Cosh[(-y + x1)/x] + x Cosh[(-y + x3)/x] /. SampleParams
V[x_, y_] := y2 - y3 - x Cosh[(-y + x2)/x] + x Cosh[(-y + x3)/x] /. SampleParams
Ux[x_, y_] = D[U[x, y], x];
Uy[x_, y_] = D[U[x, y], y];
Vx[x_, y_] = D[V[x, y], x];
Vy[x_, y_] = D[V[x, y], y];
J[x_, y_] = Ux[x, y] Vy[x, y] - Uy[x, y] Vx[x, y] // Simplify;
Iterate[x_, y_] := {x - (U[x, y] Vy[x, y] - V[x, y] Uy[x, y])/J[x, y],y - (Ux[x, y] V[x, y] - U[x, y] Vx[x, y])/J[x, y]}
NestList[Iterate[#[[1]], #[[2]]] &, {10., 10.}, 3] // TableForm
FindRoot[{U[x, y] == 0, V[x, y] == 0}, {{x, 10.}, {y, 10.}},StepMonitor :> Print[x, " ", y], Method -> {"Newton", "UpdateJacobian" -> 1}]
This time I'm not getting the desired results:
10. 10.
-61.2969 -34.1643
-2953.96 -1832.23
-6.67248*10^6 -4.14752*10^6
7.00846 8.14691
5.76637 7.37079
5.04881 6.91975
4.58046 6.62407
1.31254 4.55446
1.46434 4.67168
1.51128 4.71681
1.51456 4.72029
1.51457 4.72031
1.51457 4.72031
{x->1.51457,y->4.72031}
As you can see my code simply does not work in this case, even though a root clearly exists @ {x->1.51457,y->4.72031}
Any thoughts?Todor Latev2018-02-18T02:28:03ZUnderstand algorithm for AudioLocalMeasurements, & ModifiedKullbackLeibler?
http://community.wolfram.com/groups/-/m/t/1287765
I recently was doing some experiments with AudioLocalMeasurements for some music analysis tasks, and in the process of trying to explain what I did to someone I realized that I didn't know what the ModifiedKullbackLeibler measurement is computing. Specifically, what is modified versus regular KL divergence, and what is done to the frequency spectra of the windows being compared? Without understanding what the algorithm is actually reporting, it's hard to make any interpretation of the results that it computes.Matthew Sottile2018-02-19T07:23:15ZSolving Puzzle : 4 Pics 1 Word
http://community.wolfram.com/groups/-/m/t/1283422
4 Pics 1 Word is the Android and IOS puzzle that you guess what is the word based on four pictures that have something in common.
For example, the answer of the next screenshot is "TOOL".
![enter image description here][1]
**Goal**
-----------------------
Solve this puzzle by using Mathematica.
![enter image description here][2]
**Recognize Characters**
-----------------------
TextRecognize[] cannot recognize characters from full screenshot.
TextRecognize[screenshot, Language -> "English", RecognitionPrior -> "Character"]
Output is Null.
Find 12 box characters areas.
img2 = ImageTrim[screenshot, {{0, 150}, {900, 450}}];
img2b = Binarize[img2];
mask = MorphologicalTransform[img2b, "BoundingBoxes", Infinity];
mask = Thinning[mask, 4];
corners = Sort[ImageCorners[mask]];
HighlightImage[img2b, corners]
![enter image description here][3]
Trim 12 box characters and assemble them.
c2 = Partition[corners, 8];
rectanglerule = {a_, b_, c_, d_, e_, f_, g_, h_} -> {{a, b, e, f}, {c, d, g, h}};
c3 = Flatten[c2 /. rectanglerule, 1];
asm = ImageTrim[img2b, #] & /@ c3 // ImageAssemble
![enter image description here][4]
TextRecognize[] can recognize 12 characters.
TextRecognize[asm, RecognitionPrior -> "Word", Language -> "English"] // Characters
Output is {"L", "T", "K", "W", "J", "M", "H", "D", "U", "O", "O", "I"}.
**Recognize Word Length of the Answer**
-----------------------
In this screenshot, the word length of the answer is four.
![enter image description here][5]
Trim one line within the input area of the answer(above red line).
img3 = ImageTrim[screenshot, {{0, 555}, {1080, 555}}];
img3b = Binarize[img3]
Output is
![enter image description here][6]
The word length of the answer is the number of white area -1 (In this case, 4 = 5-1).
The elements of black line are 0 and the elements of white line are 1.
getWordLength[screenshot_] := Module[{img3, img3b},
img3 = ImageTrim[screenshot, {{0, 555}, {1080, 555}}];
img3b = Binarize[img3];
(ImageData[img3b] //. {x___, a_, a_, y___} -> {x, a, y} // Flatten //
Total) - 1
];
getWordLength[screenshot]
Output is 4.
**Find Candidates**
-----------------------
Find candidates using DictionaryLookup[].
getCandidates[string_String, n_] :=
Module[{list},
list = StringJoin /@ Permutations[Sort[Characters[string]], {n}];
Select[list,
Length[DictionaryLookup[#, IgnoreCase -> True]] != 0 &] //
ToUpperCase
];
getCandidates[StringJoin[{"L", "T", "K", "W", "J", "M", "H", "D", "U", "O", "O", "I"}], 4]
Output is {"DHOW", "DOLT", "DOOM", "DOTH", "HILT", "HOLD", "HOLT", "HOOD", "HOOK", "HOOT", "HOWL", "HTML", "HULK", "IDOL", "JILT", "JODI", "JOLT", "JOWL", "JUDO", "KILO", "KILT", "KITH", "KOHL", "LIDO", "LIMO", "LOKI", "LOOK", "LOOM", "LOOT", "LOUD", "LOUT", "LUDO", "MILD", "MILK", "MILO", "MILT", "MOHO", "MOIL", "MOLD", "MOLT", "MOOD", "MOOT", "MOTH", "ODOM", "OHIO", "OMIT", "THOU", "THUD", "TOIL", "TOJO", "TOLD", "TOOK", "**TOOL**", "WHIM", "WHIT", "WHOM", "WILD", "WILT", "WITH", "WOLD", "WOOD", "WOOL"}.
Include the answer "TOOL".
**Identify Pictures**
-----------------------
Identify one of pictures.
ImageTrim[screenshot, {{575, 1215}, {950, 1660}}]
ImageIdentify[%, All, 10]
![enter image description here][7]
Trim 4 pictures areas and identify them.
getCommonNames[screenshot_, n_: 10] :=
Module[{img41, img42, img43, img44, entities, cn},
img41 = ImageTrim[screenshot, {{55, 700}, {505, 1145}}];
img42 = ImageTrim[screenshot, {{575, 700}, {950, 1145}}];
img43 = ImageTrim[screenshot, {{55, 1215}, {505, 1660}}];
img44 = ImageTrim[screenshot, {{575, 1215}, {950, 1660}}];
entities = ImageIdentify[#, All, n] & /@ {img41, img42, img43, img44} // Flatten;
cn = CommonName /@ entities;
StringSplit /@ cn // Flatten // Union // Sort // ToUpperCase
];
cns = getCommonNames[screenshot]
Output is {"AIRPLANE", "ALLIGATOR", "ASTRONOMICAL", "BIT", "BOTTLE", "BUFFER", "CARPENTER'S", "CASSEGRAINIAN", "CHUCK", "CHURCHKEY", "CLIP", "COLLET", "COMPOUND", "CUTLERY", "CUTTER", "DRILL", "DRYER", "EDGE", "ELECTRIC", "FASTENING", "HAIR", "HAMMER", "KHUKURI", "KNIFE", "LEVER", "MALLET", "OF", "OPENER", "OPTICAL", "PAIR", "PIPE", "PLIERS", "POCKET", "POWER", "PROPELLER", "REFLECTING", "REGULATOR", "SCISSORS", "SLEDGEHAMMER", "SPIGOT", "TAILPIPE", "TELESCOPE", "**TOOL**", "TWIST", "VIAL", "WIRE"}.
Include the answer "TOOL".
**Get Answer**
-----------------------
The answer is the element common to both candidate words and what pictures are.
Intersection[
{"DHOW", "DOLT", "DOOM", "DOTH", "HILT", "HOLD", "HOLT", "HOOD",
"HOOK", "HOOT", "HOWL", "HTML", "HULK", "IDOL", "JILT", "JODI",
"JOLT", "JOWL", "JUDO", "KILO", "KILT", "KITH", "KOHL", "LIDO",
"LIMO", "LOKI", "LOOK", "LOOM", "LOOT", "LOUD", "LOUT", "LUDO",
"MILD", "MILK", "MILO", "MILT", "MOHO", "MOIL", "MOLD", "MOLT",
"MOOD", "MOOT", "MOTH", "ODOM", "OHIO", "OMIT", "THOU", "THUD",
"TOIL", "TOJO", "TOLD", "TOOK", "TOOL", "WHIM", "WHIT", "WHOM",
"WILD", "WILT", "WITH", "WOLD", "WOOD", "WOOL"},
{"AIRPLANE", "ALLIGATOR", "ASTRONOMICAL", "BIT", "BOTTLE", "BUFFER",
"CARPENTER'S", "CASSEGRAINIAN", "CHUCK", "CHURCHKEY", "CLIP",
"COLLET", "COMPOUND", "CUTLERY", "CUTTER", "DRILL", "DRYER", "EDGE",
"ELECTRIC", "FASTENING", "HAIR", "HAMMER", "KHUKURI", "KNIFE",
"LEVER", "MALLET", "OF", "OPENER", "OPTICAL", "PAIR", "PIPE",
"PLIERS", "POCKET", "POWER", "PROPELLER", "REFLECTING", "REGULATOR",
"SCISSORS", "SLEDGEHAMMER", "SPIGOT", "TAILPIPE", "TELESCOPE",
"TOOL", "TWIST", "VIAL", "WIRE"}]
Output is {"TOOL"}.
**Integrate**
-----------------------
Get 12 box characters from a screenshot.
getCharacters[screenshot_] :=
Module[{img2, img2b, mask, rectanglerule, corners, c2, c3, asm},
img2 = ImageTrim[screenshot, {{0, 150}, {900, 450}}];
img2b = Binarize[img2];
mask = MorphologicalTransform[img2b, "BoundingBoxes", Infinity];
mask = Thinning[mask, 4];
corners = Sort[ImageCorners[mask]];
c2 = Partition[corners, 8];
rectanglerule = {a_, b_, c_, d_, e_, f_, g_, h_} -> {{a, b, e, f}, {c, d, g, h}};
c3 = Flatten[c2 /. rectanglerule, 1];
asm = ImageTrim[img2b, #] & /@ c3 // ImageAssemble;
TextRecognize[asm, RecognitionPrior -> "Word", Language -> "English"] // Characters // ToUpperCase
];
Integrate all functions.
Pics41[screenshot_] := Module[{answer, chars, n, cadidates, cns},
answer = {};
chars = getCharacters[screenshot];
n = getWordLength[screenshot];
Print["Word Length: ", n];
Print["characters: ", chars[[{2, 4, 6, 8, 10, 12, 1, 3, 5, 7, 9, 11}]]];
Print["searching..."];
cadidates = getCandidates[StringJoin[chars], n];
cns = getCommonNames[screenshot];
answer = Intersection[cadidates, cns];
If[answer != {}, Print["found"]; answer, Print["not found"]; cadidates]
];
Another example is
![enter image description here][8]
![enter image description here][9]
**Finally**
-----------------------
I have some problems.
- Pics41[] cannot often get an answer. Need more information from each picture.
For example, Pics41[] cannot get the answer "COMIC".
![enter image description here][10]
![enter image description here][11]
- Some manual operations are necessary.
- launch 4 Pics 1 Word
- get screenshot
- mail it to my PC
- import it to Mathematica
I would like that Mathematica can handle 4 Pics 1 Word as directly as possible.
Any ideas very welcome.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1091501.jpg&userId=1013863
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=244402.jpg&userId=1013863
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=499903.jpg&userId=1013863
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=723404.jpg&userId=1013863
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=264405.jpg&userId=1013863
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=746806.jpg&userId=1013863
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=589007.jpg&userId=1013863
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1003308.jpg&userId=1013863
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=979209.jpg&userId=1013863
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=737810.jpg&userId=1013863
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=960111.jpg&userId=1013863Kotaro Okazaki2018-02-12T12:31:20Z[GIF] Caught (Voronoi cells of stereographically projected pattern)
http://community.wolfram.com/groups/-/m/t/1286395
![Voronoi cells of stereographically projected pattern][1]
**Caught**
Continuing with the stereographic projection theme. This time, I generated a bunch of points arranged in spirals on the sphere, like so:
![Points on the sphere][2]
Then I stereographically project the points to the plane and compute the Voronoi diagram of the resulting points. Throw in a rotation of the sphere and you get the above animation.
As for the code, first of all we need the stereographic projection map:
Stereo[p_] := p[[;; -2]]/(1 - p[[-1]])
Next, we need to define the points. It turned out that without throwing in some noise in the definition of the points, `VoronoiMesh[]` would occasionally fail, which is why I put in the `RandomVariate[]` business in both cylindrical coordinates:
pts = With[{n = 20},
Table[
CoordinateTransformData["Cylindrical" -> "Cartesian", "Mapping"]
[{Sqrt[1 - (z + #)^2], θ + RandomVariate[UniformDistribution[{-.00001, .00001}]]
+ (z + # + 2)/2 * π/2, z + #}
&[RandomVariate[UniformDistribution[{-.00001, .00001}]]]
],
{z, -.9, .9, 2/n}, {θ, 0, 2 π - 2 π/n, 2 π/n}]
];
Finally, then, here's the animation:
With[{cols = RGBColor /@ {"#F5841A", "#03002C"}},
Manipulate[
VoronoiMesh[
Stereo[RotationMatrix[θ, {1., 0, 0}].#] & /@ Flatten[pts, 1],
{{-4.1, 4.1}, {-4.1, 4.1}}, PlotTheme -> "Lines", PlotRange -> 4,
MeshCellStyle -> {{1, All} -> Directive[Thickness[.005], cols[[1]]]},
ImageSize -> 540, Background -> cols[[-1]]],
{θ, 0, π}
]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=r11Lqrc.gif&userId=610054
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5946Untitled-13.png&userId=610054Clayton Shonkwiler2018-02-16T21:10:29Z[✓] Set logarithmic and reversal scaling axes?
http://community.wolfram.com/groups/-/m/t/1287170
I'm trying to create a Hertzsprung-Russell Diagram which requires both axes to be logarithmic and the x-axis to be reversed. I've found the ScalingFunctions option for the ListPlot command, but it can only seem to do one change to each axes at a time ({"Log","Log"} or {"Reverse","Log"}).
Are there any other methods of manipulating axes or a way to get an extra change out of the ScalingFunctions option?
Thanks!Peter Driscoll2018-02-18T01:42:46ZAnalyzing Arduino Sensor Data in a STEM high school classroom
http://community.wolfram.com/groups/-/m/t/1286876
My name is Matthew Green and I team-teach at [Riverpoint Academy (RA)](http://twitter.com/riverptacademy) with Rick Biggerstaff. RA is a public [STEM high school for 9th - 12th graders](https://riverpoint.mead354.org/). This year, Rick and I are creating, and teaching, a new course that we call Computational Laboratory, or CompLab for short.
We describe our course like this:
*“In CompLab, students will develop the skills necessary to make and defend precise arguments through the use of data. Our focus will be on observable and quantifiable relationships involving movement or change. Through personal and collaborative projects, students will use Computational Thinking and technology to make informed and justifiable decisions.”*
## Putting Mathematica, Arduino, and Processing together
```
data = Import[
"/Users/matt/CircuitPlayground-master/SaveSensorData/values.csv"]
data = Select[data, Length[#] == 8 &];
data = Dataset[Map[AssociationThread[First[data], #] &, Rest[data]]]
ListLinePlot[Normal[data[All, "x"]]]
ListLinePlot[Normal[data[All, "y"]]]
ListLinePlot[Normal[data[All, "z"]]]
```
It’s day fourteen of CompLab and we’ve just released [an activity](https://docs.google.com/document/d/1drsSyPQq9YwPwmbJpVNX0cIDQY42WEAI1_TWV36Ubzc/edit) to our students that brings Arduino data into Mathematica so they can begin to analyze it in their first attempt to make and defend a claim with data. Up until now students have spent no less than one hour in Mathematica, [just poking around.](https://docs.google.com/document/d/1CvkZGASSInMbWGjpR1frf8H5lUDaVaGN0v0_v8xFK6c/edit) This will be their first attempt at connecting our CompLab tech stack (Mathematica, [Arduino](https://www.arduino.cc/) and [Processing](https://processing.org/)) to their study of rhetoric. As you can see from this [first activity](https://docs.google.com/document/d/1drsSyPQq9YwPwmbJpVNX0cIDQY42WEAI1_TWV36Ubzc/edit), our expectations of **claim** and **justification** are small, but that’s intentional. At Riverpoint Academy we’re all about giving students the chance to incubate skills needed as they move forward. We noticed last semester that many students struggled with even making a claim, so we thought it made sense to isolate that skill from the rest of the details of rhetoric at this time. This was especially important because managing the tech stack is a big challenge for many of our students this early in the course.
Mathematica is [perfectly capable](http://reference.wolfram.com/language/ref/device/Arduino.html) of communicating directly with **microcontrollers** like Arduino, so why not do that? Well, we will, just not yet. (Skip to the final section to read more) Our reasons for **not** starting there are pedagogical. Many of our students are apprehensive about reading and writing code, and we have found that Processing is a fantastic way to get started. Processing then gives purpose to Arduino and together they create the need for deeper analysis of Arduino data. We’ve seen that once students see what’s possible with the Wolfram Language, they are hooked.
## How we got started
![!\[\](Wolfram%20Community%20Arduino%20&%20Mathematica/3000-07.jpg)][1]
Many of our students are new to programming and we need to bring them up to speed quickly so we can engage in some deep [Computational Rhetoric](https://docs.google.com/document/d/1MGkbNDlLvoZ42vL-LKUjZEEu43AEysxxz6uJgvUcS3k/edit?usp=sharing) work.
In our first [activity](https://drive.google.com/open?id=1IVqpE-Hi3d4tDNAQXW7VAVSBKpOee0r4Y8ok1adNtrI), we asked students to create a [Piet Mondrian](https://www.google.com/search?safe=strict&biw=1680&bih=892&tbm=isch&sa=1&ei=sBSGWpzUOs3IjwPR_pKgAg&q=piet+mondrian+art&oq=piet+mondrian+art&gs_l=psy-ab.3..0l10.5662.5964.0.6111.4.4.0.0.0.0.90.276.4.4.0....0...1c.1.64.psy-ab..0.4.274...0i67k1.0.jVsAmxitC6Q) inspired piece using Processing (Java). We then introduced them to [Rhetoric](https://docs.google.com/document/d/1sZMUcfbUNZYs4dVTLHc8JYLB0rukdVjO4MvBOUEM-Iw/edit) and then some [Logical Fallacies](https://docs.google.com/document/d/1Vap0S-rInLrn4YIDQwrN_s7_9lXWGt92wRd4m4L9D1k/edit). Next we asked them to create a Drawing Program in Processing ([Chapter 8](https://www.sparkfun.com/products/13313)), which created the opportunity to introduce a special little Arduino, the [Adafruit Circuit Playground.](https://www.adafruit.com/product/3000?gclid=CjwKCAiAn5rUBRA3EiwAUCWb2xoaD_7VmxvPp5avAEURTuiQRF8ibjtvCaHnmLNRhvhFUPGlbLzyAhoCfEYQAvD_BwE) We are using the Circuit Playground and its many sensors so that students have the opportunity to use data they have collected from their environment to control output on screen. If our only goal were [Physical Computing](https://en.wikipedia.org/wiki/Physical_computing), we would be quite content with what’s possible when you put Arduino and Processing together… but we're interested in [exploring data more deeply](https://docs.google.com/document/d/1YK_Be_yFGThWfCDNDNgy-m1mdOejub4Q85-wcrw6iwA/edit)
## How Mathematica will take center stage
```
(* connect to the device as serial *)
playground =
DeviceOpen["Serial", {"/dev/cu.usbmodem14511", "BaudRate" -> 9600}]
(* make list to hold data *)
Dynamic[dataList];
ReadPlayground[deviceName_] :=
StringSplit[
FromCharacterCode[
DeviceReadBuffer[deviceName, "ReadTerminator" -> "\n"]],
{"\t", "\r"}]
(* getter functions *)
GetXVals[list_] := ToExpression /@ Downsample[Flatten[dataList], 8]
GetYVals[list_] :=
ToExpression /@ Downsample[Drop[Flatten[dataList], 1], 8]
GetZVals[list_] :=
ToExpression /@ Downsample[Drop[Flatten[dataList], 2], 8]
GetLeftButton[list_] :=
ToExpression /@ Downsample[Drop[Flatten[dataList], 3], 8]
GetRightButton[list_] :=
ToExpression /@ Downsample[Drop[Flatten[dataList], 4], 8]
GetLightSensor[list_] :=
ToExpression /@ Downsample[Drop[Flatten[dataList], 5], 8]
GetSoundSensor[list_] :=
ToExpression /@ Downsample[Drop[Flatten[dataList], 6], 8]
GetTempSensor[list_] :=
ToExpression /@ Downsample[Drop[Flatten[dataList], 7], 8]
```
We’ve done a bit of work to [create our own](https://www.wolframcloud.com/objects/bfdcf93b-1e74-49c7-8dc9-0a32338ca563) Wolfram Language interface to the Circuit Playground. As long as [this sketch](https://github.com/matthewalangreen/CircuitPlayground/blob/master/Arduino-allSensors/Arduino-allSensors.ino) is running on the attached Circuit Playground, you can collect live data from it, via the [WL Serial](http://reference.wolfram.com/language/ref/device/Serial.html) interface. We chose to make our own serial connection to take advantage of the awesome Circuit Playground sensor functions [defined here](https://github.com/adafruit/Adafruit_CircuitPlayground/blob/master/Adafruit_Circuit_Playground.h). We traded low-level control for easy access to lots of sensor data.
Our CompLab work culminates in a Computational Essay, inspired by Stephen’s [post](http://blog.stephenwolfram.com/2017/11/what-is-a-computational-essay/), but more directed at the traditional Argumentative Claim standards for our [lower](http://www.corestandards.org/ELA-Literacy/W/9-10/1/b/) and [upper](http://www.corestandards.org/ELA-Literacy/W/11-12/1/b/) students. We’ve co-opted the name Computational Rhetoric, by which we intend **“Rhetoric”** to be **“X”** in [Stephen’s belief](http://blog.stephenwolfram.com/2016/09/how-to-teach-computational-thinking/) that there should be a “Computational X.” That is, we are exploring Rhetoric in a computational way, using uniquely powerful tools like Mathematica to get and make sense of data to write, present and speak convincingly. We’ve told our students that we will define Computational Rhetoric thusly, “using data, and data visualizations to write, speak, and present in a convincing way.”
Though we plan to significantly edit [this activity](https://docs.google.com/document/d/1MGkbNDlLvoZ42vL-LKUjZEEu43AEysxxz6uJgvUcS3k/edit), we share it as an example of where we are headed with our CompLab students. The Wolfram Language makes it possible for our students to pull together subjects that are often kept separate in the traditional high school. CompLab students study Physics, Rhetoric and Computer Science in a coherent and interconnected way because it gives purpose and context for each skill and concept.
## If you’ve made it this far…
Thanks for reading! I’d love to hear your thoughts and ideas for improvement.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=3.jpg&userId=1285786Matthew Green2018-02-17T23:00:34ZMathematica 11.0.1 now available for the Raspberry Pi
http://community.wolfram.com/groups/-/m/t/1028536
Hi all,
Mathematica 11.0.1 is now available for the Raspberry Pi on Raspbian. If you already have Mathematica installed on your Raspberry Pi, you can update with the following:
sudo apt-get update && sudo apt-get upgrade wolfram-engine
If you don't already have Mathematica installed you can run the following commands to install it:
sudo apt-get update && sudo apt-get install wolfram-engine
New features for the Raspberry Pi include :
- Neural Network features including constructing custom nets : http://reference.wolfram.com/language/guide/NeuralNetworks.html
- Audio processing features including out of core streaming of large sounds as well as advanced audio processing : http://reference.wolfram.com/language/guide/AudioProcessing.html
- Travel based path plan functions including path finding from one city to another : http://reference.wolfram.com/language/guide/LocationsPathsAndRouting.html
- Channel based communication for sending and receiving messages : http://reference.wolfram.com/language/guide/Channel-BasedCommunication.html
- Powerful and easy scripting through WolframScript : http://reference.wolfram.com/language/ref/program/wolframscript.html
- And many more : http://reference.wolfram.com/language/guide/SummaryOfNewFeaturesIn11.html
Additionally, with the new release of WolframScript on the Raspberry Pi, you can install WolframScript standalone and run it without a local kernel against the cloud using the `-cloud` option. This means you can use the Wolfram Language through WolframScript on the Raspberry Pi without having wolfram-engine installed by running it against the cloud. See the documentation page for WolframScript for more details.Ian Johnson2017-03-09T21:02:49Z3D Design in Mathematica: Generative Jewelry
http://community.wolfram.com/groups/-/m/t/1270499
*This article [originally appeared][1] The Mathematical Zorro blog*.
----------
![enter image description here][2]
I'll share a bit of Mathematica code that has helped me to add some ordered randomness to my art and jewelry. And we'll design a new piece of generative jewelry!
Before that, let me share something else I've been working on. In June of 2017 I gave myself a goal to share with the public each day one piece of jewelry I designed. Designing, refining, and posting took some effort, and I have completed my goal! In the process I designed some new jewelry that I really like, and I will be working over the coming months to develop them into coherent jewelry collections. I have been sharing on various social media accounts: @hanusadesign on [instagram][3], [facebook][4], [twitter][5], and [pinterest][6]. Be sure to follow me to see my latest work!
Now on to the Mathematica tutorial. What do I mean by ordered randomness? Compare the following sets of 100 random points:
![enter image description here][7]
While the points seem rather "random" in both sets, you can see that the points on the left often land rather close to each other while the points on the right are pretty regularly spaced. This last observation should tell you that the points on the right are not actually "random"! Indeed, the points on the left are chosen randomly using Mathematica's [RandomReal][8] command. (Even though the numbers are generated by a deterministic process in a computer program and thus inherently not completely random, we will say that pseudorandom is close enough for our purposes.) The command
ptlist = RandomReal[{-1, 1}, {100, 2}];
generates 100 pairs of real numbers that all fall between −1 and 1. On the other hand, the points on the right are chosen by a selection process in which we grow a list of points, starting with any point in the square. Then when we want to add a new point to the list, we generate a random point in the square and see if it is greater than a specified distance to any of the points already in our list. If so, it is added to our list; otherwise it is thrown out! Here is the code:
ptlist = {RandomReal[{-1, 1}, 2]};
While[Length[ptlist] < 100,
newpt = RandomReal[{-1, 1}, 2];
If[Min[Map[Norm[newpt - #] &, ptlist]] > .1,
ptlist = Append[ptlist, newpt]]]
Running the same code multiple times gives different sets of points.
## Generative jewelry
Let's take this idea and turn it into a nice piece of [generative jewelry][9], in that we don't actually know what it is going to look like before our program completes!
My goal is to create a piece of jewelry that is a collection of overlapping rings. We'll first generate a set of points and then construct rings centered at those points. We will work to complete three tasks to improve the aesthetic appeal of the final product:
1. The points should be lie in a circle instead of a square.
2. The points should be generously spaced.
3. The rings should be different sizes
For Task 1, we will specify a shape and ensure that each point that we consider is a member of that region. (Here we choose a circle, but you can easily modify it to be ANY region.) For Task 2, we will modify our selection process from above to add more distance between the points (radius .21 instead of .1) and have fewer points (50 instead of 100). By using our selection process, the rings won't overlap too awkwardly and it will be pleasing to the eye. The values I have chosen are purely by trial and error with a view toward making the proportions of the final product look good.
shape = Disk[{0, 0}, 1];
ptlist = {RandomReal[{-1, 1}, 2]};
While[! RegionMember[shape, ptlist[[1]]],
ptlist = {RandomReal[{-1, 1}, 2]}]
While[Length[ptlist] < 50, newpt = RandomReal[{-1, 1}, 2];
If[Min[Map[Norm[newpt - #] &, ptlist]] > .21
&& RegionMember[shape, newpt],
ptlist = Append[ptlist, newpt]]]
Graphics[{
{Lighter[Blue, .8], Rectangle[{-1, -1}, {1, 1}]},
{EdgeForm[{Black, Thick}], White, shape},
{Purple, Point[ptlist]}
}]
Notice that we have also ensured that the first point is also in the circular region. The result of this code looks like this:
![enter image description here][10]
Now we want to build a ring centered at each point. A basic torus that has an outer radius of .14 and tube radius of .03 looks like this:
torus[coords_] := Module[{thickness = .14, innerradius = .03},
ParametricPlot3D[{
( thickness + innerradius Cos[v]) Cos[u],
( thickness + innerradius Cos[v]) Sin[u],
innerradius Sin[v]} + Append[coords, 0],
{u, 0, 2 Pi}, {v, 0, 2 Pi}, Mesh -> None, PlotPoints -> 50]];
Mapping this function to the points in `ptlist` gives the following:
![enter image description here][11]
Now we need to attack Task 3, making the rings have different sizes. To do this we modify our torus function:
torus[coords_, thickness_] := Module[{innerradius = .03},
ParametricPlot3D[{
( thickness + innerradius Cos[v]) Cos[u],
( thickness + innerradius Cos[v]) Sin[u],
innerradius Sin[v]} + Append[coords, 0],
{u, 0, 2 Pi}, {v, 0, 2 Pi}, Mesh -> None, PlotPoints -> 50]];
and generate a set of random outer radii. I first chose the outer radii to be between .1 and .15, but when I displayed the rings, they were disconnected, which is not what we wanted
thicknesses = RandomReal[{.1, .15}, 50]
Show[MapThread[torus, {ptlist, thicknesses}], PlotRange -> All]
![enter image description here][12]
So I modified the the outer radii to be between .09 and .17. I definitely re-ran the code multiple times until I was happy with the final product. Here you go:
thicknesses = RandomReal[{.09, .17}, 50]
Show[MapThread[torus, {ptlist, thicknesses}], PlotRange -> All]
**Pro Tip**: Re-running the code always gives you a new arrangement. When you get a random arrangement that you like, you need to **save the data** that created it, so you can recreate it next time!
In essence, when working to create a piece of generative art, you impose randomness until you find something that you like, at which time you need to save this input so that this data will not change again — which seems to be the opposite of random! It was a revelation when I realized that adding randomness to my art involved saving the random data I generated.
## The Final Result
After exporting our final work to an STL, here is a rendering of our new piece of generative jewelry on Sketchfab:
[![enter image description here][13]][14]
And Shapeways gives the following beautiful rendering of [our pendant in Raw Bronze][15]:
[![enter image description here][18]][17]
The final 3D Printed pendant is the image at the top of the post.
And now you have the tools to make your own! If you have suggestions for how to modify this in an interesting way or for something else I should tackle, let me know. Happy New Year everyone!
[1]: http://blog.mathzorro.com/2017/07/generative.html
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-22at11.07.46AM.jpg&userId=20103
[3]: http://instagram.com/hanusadesign/
[4]: https://www.facebook.com/hanusadesign/
[5]: https://www.twitter.com/hanusadesign/
[6]: https://www.pinterest.com/hanusadesign/
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Mathematica_2017-06-26_21-45-59.png&userId=20103
[8]: https://reference.wolfram.com/language/ref/RandomReal.html
[9]: https://en.wikipedia.org/wiki/Generative_art
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=points.png&userId=20103
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=rings.png&userId=20103
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=disconnected.png&userId=20103
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-22at10.59.26AM.png&userId=20103
[14]: https://sketchfab.com/models/affe8a0915e14f55b8723ec3cd339092
[15]: http://shpws.me/OIrD
[16]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-22at11.02.37AM.png&userId=20103
[17]: http://shpws.me/OIrD
[18]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Shapeways.jpg&userId=1270503Christopher Hanusa2018-01-22T17:05:53ZMake Mathematica's interface less blurry?
http://community.wolfram.com/groups/-/m/t/1202244
I run Mathematica 11.2 in Windows 10. I have a 4k monitor (resolution 3840x2160) at work and another at home running at recommended 150% scale. The Mathematica interface looks really blurry and it is painful to read (see attached image, the window behind Mathematica is the browser window where this message was being composed. Browser text is very sharp, as is the rest of Windows. Mathematica text is blurry).
My laptop (Surface book) runs at a resolution of 3000x2000 and 200% scale and Mathematica there looks even blurrier.
High dpi monitors have been out for many years and Mathematica has always been blurry for me on them. Is there a way of making it give good text? Am I missing some non-obvious setting that improves this?
Luis.Luis Rademacher2017-10-13T02:23:21Z[GIF] Small Changes (Hamiltonian cycle on the great rhombicosidodecahedron)
http://community.wolfram.com/groups/-/m/t/1282077
![Hamiltonian cycle on the great rhombicosidodecahedron][1]
**Small Changes**
This is the same idea as what I've been doing recently with [_Touch ’Em All_][2], [_All Day_][3], [_How Does That Work?_][4], and [_Throw_][5], but one dimension down: find a Hamiltonian cycle on the 1-skeleton of the [great rhombicosidodecahedron][6], normalize to get everything happening on the unit sphere, then stereographically project down to the plane.
First of all, we can extract the vertex coordinates from `PolyhedronData[]`, find a Hamiltonian cycle using `FindHamiltonianCycle[]`, and then re-order the vertices to be in the order they appear in the cycle:
sortedGRVertices =
Module[
{v = N[PolyhedronData["GreatRhombicosidodecahedron", "VertexCoordinates"]],
M, Γ, cycle},
Γ = PolyhedronData["GreatRhombicosidodecahedron", "SkeletonGraph"];
cycle = FindHamiltonianCycle[Γ];
v[[#[[1]] & /@ (cycle[[1]] /. UndirectedEdge -> List)]]
];
Now, I'm going to form spherical circles of radius $1/4$ the spherical distance between adjacent vertices and then stereographically project them down to the plane. Stereographic projection takes circles to circles, but unfortunately the stereographic image of the center is not the center of the stereographic image of the circle, which makes things complicated. Nonetheless, the function `ProjectedSphericalCircle[]` (defined below) inputs the center and radius of the circle up in the sphere and outputs a `Disk[]` object with the correct center and radius.
With that in hand, then, here's the code for an interactive version of the above animation:
DynamicModule[{r, θ, n, pts = Normalize /@ sortedGRVertices,
cols = RGBColor /@ {"#1DCED8", "#FAF9F0", "#F6490D", "#000249"}},
r = Min[DeleteCases[Flatten@Outer[VectorAngle, pts, pts, 1], 0.]];
n = Length[pts];
Manipulate[
θ = r unsmoothstep[t];
Graphics[
Table[
{Blend[cols[[;; -2]], Mod[i + 27 + t, n, 1]/(n - 1)],
ProjectedSphericalCircle[
RotationMatrix[-π/2, {0, 0, 1}].
RotationMatrix[θ, {pts[[i]], pts[[Mod[i + 1, Length[pts], 1]]]}].
pts[[i]],
r/4]},
{i, 1, Length[pts]}],
PlotRange -> 5, ImageSize -> 540, Background -> cols[[-1]]],
{t, 0, 1}]
]
Finally, then, is the definition of `ProjectedSphericalCircle[]`, which is quite ugly. I don't want to say too much about where it came from, other than that it was essentially the same procedure is described in the [post on _Inside_][7]: stereographically project an arbitrary circle on the sphere down to the plane and solve for the point where the normals to two distinct points intersect to find the center, and then of course the distance from either of those points to the center is the radius. Here's the definition:
ProjectedSphericalCircle[{x_, y_, z_}, r_] :=
If[Chop[x] == Chop[y] == 0. && Chop[z + 1] == 0,
Disk[{0, 0}, Tan[r/2]],
Disk[{(x Cos[r] + (x z Sin[r])/Sqrt[1 - z^2])/(
1 - z Cos[r] - ((-x^2 - y^2) Sin[r])/Sqrt[
1 - z^2]) + (Sqrt[2]
Sin[r] (x Sqrt[1 - z^2] (-1 + z Cos[r]) +
x (-1 + z^2) Sin[r]) ((
x Cos[r] - (y Sin[r])/Sqrt[1 - z^2])/(1 - z Cos[r]) - (
x Cos[r] + (x z Sin[r])/Sqrt[1 - z^2])/(
1 - z Cos[r] - ((-x^2 - y^2) Sin[r])/Sqrt[
1 - z^2])))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r] + (-1 + z^2) Sin[
r])^2 √(((-1 + z^2)^2 Sin[
r]^2 (3 - 4 z Cos[r] - Cos[2 r] + 2 z^2 Cos[2 r] +
4 Sqrt[1 - z^2] Sin[r] -
2 z Sqrt[1 - z^2] Sin[2 r]))/(-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r] + (-1 + z^2) Sin[r])^4) (-((2 Sqrt[2]
Sin[r] (y Sqrt[1 - z^2] (z - Cos[r]) +
x (-1 + z^2) Sin[r]))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r])^2 √(1/(-1 + z Cos[r])^4 (8 + 4 z^2 -
16 z Cos[r] - Cos[2 r] + 5 z^2 Cos[2 r] -
Cos[2 (π/2 + r)] +
z^2 Cos[2 (π/2 + r)]) Sin[r]^2))) + (Sqrt[2]
Sin[r] (x Sqrt[1 - z^2] (-1 + z Cos[r]) +
x (-1 + z^2) Sin[r]))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r] + (-1 + z^2) Sin[
r])^2 √(((-1 + z^2)^2 Sin[
r]^2 (3 - 4 z Cos[r] - Cos[2 r] + 2 z^2 Cos[2 r] +
4 Sqrt[1 - z^2] Sin[r] -
2 z Sqrt[1 - z^2] Sin[2 r]))/(-Sqrt[1 - z^2] +
z Sqrt[1 - z^2] Cos[r] + (-1 + z^2) Sin[r])^4)))), (
y Cos[r] + (y z Sin[r])/Sqrt[1 - z^2])/(
1 - z Cos[r] - ((-x^2 - y^2) Sin[r])/Sqrt[
1 - z^2]) + (2 Sqrt[2]
Sin[r] (y Sqrt[1 - z^2] (-1 + z Cos[r]) +
y (-1 + z^2) Sin[r]) ((
x Cos[r] - (y Sin[r])/Sqrt[1 - z^2])/(1 - z Cos[r]) - (
x Cos[r] + (x z Sin[r])/Sqrt[1 - z^2])/(
1 - z Cos[r] - ((-x^2 - y^2) Sin[r])/Sqrt[
1 - z^2])))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r] + (-1 + z^2) Sin[
r])^2 √(((-1 + z^2)^2 Sin[
r]^2 (12 - 16 z Cos[r] - 2 Cos[2 r] +
2 z^2 Cos[2 r] + (-2 + 6 z^2) Cos[2 r] +
16 Sqrt[1 - z^2] Sin[r] -
8 z Sqrt[1 - z^2] Sin[2 r]))/(-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r] + (-1 + z^2) Sin[r])^4) (-((2 Sqrt[2]
Sin[r] (y Sqrt[1 - z^2] (z - Cos[r]) +
x (-1 + z^2) Sin[r]))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r])^2 √(((-1 + z^2)^2 (8 - 16 z Cos[r] +
Cos[2 r] + (-2 + 6 z^2) Cos[2 r] -
Cos[2 (π/2 + r)] +
z^2 (4 - Cos[2 r] + Cos[2 (π/2 + r)])) Sin[
r]^2)/(-Sqrt[1 - z^2] +
z Sqrt[1 - z^2] Cos[r])^4))) + (2 Sqrt[2]
Sin[r] (x Sqrt[1 - z^2] (-1 + z Cos[r]) +
x (-1 + z^2) Sin[r]))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r] + (-1 + z^2) Sin[
r])^2 √(((-1 + z^2)^2 Sin[
r]^2 (12 - 16 z Cos[r] - 2 Cos[2 r] +
2 z^2 Cos[2 r] + (-2 + 6 z^2) Cos[2 r] +
16 Sqrt[1 - z^2] Sin[r] -
8 z Sqrt[1 - z^2] Sin[2 r]))/(-Sqrt[1 - z^2] +
z Sqrt[1 - z^2] Cos[r] + (-1 + z^2) Sin[r])^4))))},
Abs[((x Cos[r] - (y Sin[r])/Sqrt[1 - z^2])/(1 - z Cos[r]) - (
x Cos[r] + (x z Sin[r])/Sqrt[1 - z^2])/(
1 - z Cos[r] - ((-x^2 - y^2) Sin[r])/Sqrt[
1 - z^2]))/(-((2 Sqrt[2]
Sin[r] (y Sqrt[1 - z^2] (z - Cos[r]) +
x (-1 + z^2) Sin[r]))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r])^2 √(((-1 + z^2)^2 (8 - 16 z Cos[r] +
Cos[2 r] + (-2 + 6 z^2) Cos[2 r] -
Cos[2 (π/2 + r)] +
z^2 (4 - Cos[2 r] + Cos[2 (π/2 + r)])) Sin[
r]^2)/(-Sqrt[1 - z^2] +
z Sqrt[1 - z^2] Cos[r])^4))) + (2 Sqrt[2]
Sin[r] (x Sqrt[1 - z^2] (-1 + z Cos[r]) +
x (-1 + z^2) Sin[r]))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r] + (-1 + z^2) Sin[
r])^2 √(((-1 + z^2)^2 Sin[
r]^2 (12 - 16 z Cos[r] - 2 Cos[2 r] +
2 z^2 Cos[2 r] + (-2 + 6 z^2) Cos[2 r] +
16 Sqrt[1 - z^2] Sin[r] -
8 z Sqrt[1 - z^2] Sin[2 r]))/(-Sqrt[1 - z^2] +
z Sqrt[1 - z^2] Cos[r] + (-1 + z^2) Sin[r])^4)))]]]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=GRproj10Lr.gif&userId=610054
[2]: http://community.wolfram.com/groups/-/m/t/1263478
[3]: http://community.wolfram.com/groups/-/m/t/1265322
[4]: http://community.wolfram.com/groups/-/m/t/1269759
[5]: http://community.wolfram.com/groups/-/m/t/1273027
[6]: http://mathworld.wolfram.com/GreatRhombicosidodecahedron.html
[7]: http://community.wolfram.com/groups/-/m/t/1260753Clayton Shonkwiler2018-02-09T23:27:22ZVisualizing Euler's Number
http://community.wolfram.com/groups/-/m/t/1280901
Happy *e* day! As with pi, *e* is an irrational number (as well as [transcendental][1]), and repeats forever in a seemingly bizarre pattern of digits. It shows up in tons of places inside and outside of mathematics.
I've always been a sucker for strange patterns, and love investigating them. The Wolfram Language has some of the best pattern matching capabilities available, so I wanted to make use of them to visualize the digits of *e*. I'm no number theorist or visualization expert by any means—just an enthusiastic user who likes puzzles—but was still able to come across some cool observations.
## Partitioning Digits of *e* ##
The first thing that needed to be done to visualize how the digits of *e* behave is to essentially pick out those digits up to a certain placement. I chose the first 200 digits because, well, why not? First, I generated the digits:
e = N[E,200]
(*2.71828182845904523536028747135266249775724709369995957496696762772407663035354759457138217852516642742746639193200309921817413596629043572 9003342952605956307381323286279434907632338298807531952510190*)
Next, I figured the easiest way to split the digits into single elements of a list was to turn the whole thing into a string, then split it, then turn it back into an expression:
ToString[e] //
StringSplit[#, ""] & //
Drop[#, 2] & (*drops both the 2 and the decimal point so I just get digits after the decimal*)//
ToExpression[#] & //
(eList = #) &
Finally, I decided to do a `ListLinePlot` just to see what I was working with:
ListLinePlot[eList]
![enter image description here][2]
So first thing I thought was, "huh, that looks like a time series", which informed the rest of what I did; I decided to do a Fourier transform as well, just to check out what the power spectrum would look like:
fourierList = Rest[Abs@Fourier[eList]];
ListLinePlot[fourierList]
![enter image description here][3]
## Filtering and Comparison ##
This thing definitely required some smoothing, so I used a basic `LowpassFilter` and varied the parameters a bit until my eyeballs thought it looked roughly ok. I did this both for the original sequence of digits:
fit = LowpassFilter[eList, 0.1];
ListPlot[{eList, fit}, Joined -> True]
![enter image description here][4]
As well as the transformed sequence of digits:
fourierFit = LowpassFilter[fourierList, 0.1];
ListPlot[{fourierList, fourierFit}, Joined -> True]
![enter image description here][5]
Finally, I wanted to get a sense of how well their relative "smoothness" compared, and if there was something more to investigate:
ListLinePlot[{fit, fourierFit}, Filling -> Axis,
PlotLegends -> {"Original", "Transformed"}]
![enter image description here][6]
So to me, it looks like there's a pretty clear and consistent gap between digits of *e* before and after transformation. Could this distance be visualized? I wanted to try it; if nothing special came out of it, then, well, might at least look pretty.
## Distance Visualization ##
First, I wanted to get a idea of the distance between consecutive digits of *e*—both the original sequence:
MatrixPlot[DistanceMatrix[eList],
PlotLabel -> "Distance matrix for first 200 digits of e",
FrameTicks -> {Automatic, Automatic}]
![enter image description here][7]
and the transformed sequence:
MatrixPlot[DistanceMatrix[fourierList],
PlotLabel -> "Distance matrix for first 200 transformed digits of e",
FrameTicks -> {Automatic, Automatic}]
![enter image description here][8]
Ok, those are pretty neat looking, and compared to the `MatrixPlot` of the first 200 digits in the `PrimePi` function, it is way less smooth (I'll leave it to y'all to explore that reference visual).
Going back to my earlier desire of wanting to investigate the distance between the original sequence of digits and its corresponding transformed sequence, I was able to do that just as easily as these other two plots:
DistanceMatrix[eList, fourierList] //
MatrixPlot[#, PlotLabel -> "Distance matrix between sequences",
FrameTicks -> {Automatic, Automatic}] &
![enter image description here][9]
Interpreting this `MatrixPlot` is not something I know how to do, but as a visualization within the digit space of *e*, it's pretty cool to examine. Some other cool visuals for distance metrics I'd like to investigate for these sequences are force-directed graphs or a Voronoi diagram; maybe y'all can discuss those visualization techniques in this thread; would definitely be interested to see what gets produced! Enjoy this transcendental occasion!
[1]: http://mathworld.wolfram.com/TranscendentalNumber.html
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=eList_plot.png&userId=515558
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=fourierList_plot.png&userId=515558
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=eList_approx.png&userId=515558
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=fourierList_approx.png&userId=515558
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-02-07at12.20.52PM.png&userId=515558
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=eList_distance.png&userId=515558
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=fourierList_distance.png&userId=515558
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=distance_different.png&userId=515558Jesse Dohmann2018-02-07T18:43:33ZPixel Editor for Images
http://community.wolfram.com/groups/-/m/t/1286303
Often I would edit bitmaps in programs like MS Paint and then import them back into my notebook. To save time I developed a tool to edit the pixels of an image within a notebook: Wolfram Paint.
![enter image description here][1]
----------
Features include:
- Three tools: pen (single pixel change), bucket (change all identical pixel groups), and eye drop (get pixel color)
- Mouse down uses primary color, `Control` + mouse uses secondary color
- Editable "favorite" colors panel
- [`DominantColors`][2] automatically loaded as "favorites"
- Uses RGBA color space
- Resizable image, inset, and zoom
- "Undo" to a state that you first manually bookmark
- click-and-drag moves the zoomed region (left panel) or edits pixels (right panel)
I'm sure I could mimic other tools like drawing lines, circles, or other primitives, but as a proof-of-concept I'm pleased that it was only 300 lines of code.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=WLPaint.PNG&userId=829295
[2]: http://reference.wolfram.com/language/ref/DominantColors.htmlKevin Daily2018-02-16T04:29:47Z[✓] Define an algebra via generators?
http://community.wolfram.com/groups/-/m/t/1285840
Hi all,
I want to define an algebra $A$ over the field of complex numbers via generators. After that I want to calculate (multiply and sum) some tensors in $A\otimes A$. How could I define my algebra?
More details: Let $n$ be a natural number $\ge 1$. My algebra should be given by generators $g^{\pm}_i$ for $i=1,...,n$ (so I have $2n$ generators). One relation should for example be $g^+_ig^+_j=-g^+_jg^+_i$ and $g^-_ig^-_j=-g_j^-g^-_i$.
It would be quite nice if someone can tell me how to do that.
Thank you very much.
BGV. Dupoy2018-02-15T14:16:48ZFactor out known multipliers in algebraic expressions?
http://community.wolfram.com/groups/-/m/t/1285533
Hi there,
I have this function of a[t], and it's a long function of other variables in time and some constant parameter (Ixx, Iyy, Izz), which I really want to explicit in a somatory of any combination of those constant parameters.
I've tried to Simplify and then Apart, but Mathematica doesn't group similar coefficients. I wonder if I could get this result applying some kind of mapping (...)?
Well, below is the function a[t]:
a[t_] := -((Cos[ϕ[t]]*
Izz[t]*(Ty[t] -
Cos[ϕ[t]]*Iyy[t]*Derivative[1][ϕ][t]*
Derivative[1][ψ][t] +
Cos[ϕ[t]]*(-Ixx[t] + Izz[t])*
(Sin[ψ[t]]*Derivative[1][θ][t] +
Derivative[1][ϕ][t])*((-Cos[ψ[t]])*
Tan[ϕ[t]]*Derivative[1][θ][t] +
Derivative[1][ψ][t]) +
Iyy[t]*Derivative[1][θ][
t]*(Cos[ψ[t]]*Sin[ϕ[t]]*
Derivative[1][ϕ][t] +
Cos[ϕ[t]]*Sin[ψ[t]]*
Derivative[1][ψ][t])) -
Iyy[t]*Sin[ϕ[t]]*(Tz[t] +
Izz[t]*Sin[ϕ[t]]*Derivative[1][ϕ][t]*
Derivative[1][ψ][
t] + (Ixx[t] -
Iyy[t])*(Sin[ψ[t]]*Derivative[1][θ][t] +
Derivative[1][ϕ][t])*
(Cos[ϕ[t]]*Cos[ψ[t]]*
Derivative[1][θ][t] +
Sin[ϕ[t]]*Derivative[1][ψ][t]) +
Izz[t]*Derivative[1][θ][
t]*(Cos[ϕ[t]]*Cos[ψ[t]]*
Derivative[1][ϕ][t] -
Sin[ϕ[t]]*Sin[ψ[t]]*
Derivative[1][ψ][t])))/((-Cos[ϕ[t]]^2)*
Cos[ψ[t]]*Iyy[t]*Izz[t] -
Cos[ψ[t]]*Iyy[t]*Izz[t]*Sin[ϕ[t]]^2));
Summarizing, what I want is a way to say : **rewrite a[t] factorizing in a sum by these terms (Ixx, Iyy, Izz) on any combination between them.**
( In other way, I could ask the same by *rewriting a[t] factorizing in terms that don't vary in time?* Would this be possible/easier? )
Can anybody suggest a good thing to try?
Thanks.André Barbosa2018-02-15T10:31:20ZIncremental Machine Learning with feeding data every hour?
http://community.wolfram.com/groups/-/m/t/1283797
I ran couple of simple ML examples available from the Documentation.
A small data set with less than 100 records would take a whole 10 sec to be trained in my laptop.
If I have a new set of sample data of 100 records available every hour, do I need to add those records to the population and train the entire Classifier all over again every hour? Is Classifier capable of retaining of its previous trained knowledge, while we keep feeding in newly available set of data to the Classifier every now & then?Peter Lim2018-02-13T09:48:59ZFind minimum of two function in a given range?
http://community.wolfram.com/groups/-/m/t/1285125
Dear Sir / Ma'am,
I want to verify this result. How can I, is there any syntax for it, please give details!
X<=min{(p/6)+(q/2),p}
Y<=((1-p)/2)+1-q
for some0<=p,q<=1
Answer is (X,Y) = (1/2, 5/12)
I am using the syntax of these type. Please don't write any program, give syntax of the same type of above problem. {i.e. optimization of two functions in a given range.}
For Example:
Minimize[{5 x^2 + x + 2, -(26/5) <= x <= 5}, x]
Thanking you.dauood saleem2018-02-14T18:34:27ZsendPhoto using TelegramBot (exporting to multy-part form data format)
http://community.wolfram.com/groups/-/m/t/1285299
I created a telegram-bot and I execute requests to the telegram bot API from Mathematica. You can find full API documentation [here][1].
I have a problem with sending image from computer or RAM. I try send photo using this code:
```
$token = <token> (* string - bot token from @BotFather *)
$chat = <chat_id> (* string - allowed chat id *)
$api = StringTemplate["https://api.telegram.org/bot`token`"][<|"token" -> $token|>]
$url = URLBuild[{$api, "sendPhoto"}]
dataString = ExportString[Plot[Sin[x], {x, 1, 4}, ImageSize->Tiny], "JPEG"];
body = StringTemplate[
"
--WMAsrf456BGe4h
Content-Disposition: form-data; name=\"chat_id\"
`chat_id`
--WMAsrf456BGe4h
Content-Disposition: form-data; name=\"photo\";filename=\"photo.jpg\"
Content-Type: image/jpeg
`data`
--WMAsrf456BGe4h"
]; (* https://en.wikipedia.org/wiki/MIME#Multipart_messages *)
request[] :=
HTTPRequest[$url,
<|
Method -> "POST",
"ContentType" -> "multipart/form-data; boundary=WMAsrf456BGe4h",
"Headers" -> {
"Connection" -> "keep-alive"
},
"Body" -> body[<|"chat_id" -> $chat, "data" -> dataString|>]
|>
]
response = URLRead[request[]]
(* Out[..] := HTTPResponse[<<504>>] *)
response["Body"]
(* Out[..] := "<html>
<head><title>504 Gateway Time-out</title></head>
<body bgcolor=\"white\">
<center><h1>504 Gateway Time-out</h1></center>
<hr><center>nginx/1.12.2</center>
</body>
</html>" *)
```
how to send an image?
[1]: https://core.telegram.org/bots/apiKirill Belov2018-02-15T07:47:13Z[✓] Plot a function with two variables?
http://community.wolfram.com/groups/-/m/t/1279789
Hi,
Is there any command I can use to plot a function (minDiff) in two variables z, x . I don't want 3D plots and I tried contour plots, but it doesn't give me a result.
this is my syntax:
z = {0.336`, 0.3365`, 0.337`, 0.3375`, 0.338`, 0.3385`, 0.339`,
0.3395`, 0.34`, 0.3405`, 0.341`, 0.3415`, 0.342`, 0.3425`, 0.343`,
0.3435`, 0.34400000000000003`, 0.34450000000000003`,
0.34500000000000003`, 0.34550000000000003`, 0.34600000000000003`,
0.34650000000000003`, 0.34700000000000003`, 0.34750000000000003`,
0.34800000000000003`, 0.34850000000000003`, 0.34900000000000003`,
0.34950000000000003`, 0.35000000000000003`, 0.35050000000000003`,
0.35100000000000003`, 0.35150000000000003`, 0.35200000000000004`};
x = {0.439`, 0.4395`, 0.44`, 0.4405`, 0.441`, 0.4415`, 0.442`,
0.4425`, 0.443`, 0.4435`, 0.444`, 0.4445`, 0.445`, 0.4455`, 0.446`,
0.4465, 0.447`, 0.4475, 0.448`, 0.4485, 0.449`, 0.4495, 0.45`,
0.4505, 0.451`, 0.4515, 0.452`, 0.4525, 0.453`, 0.4535, 0.454`,
0.4545, 0.455`};
minDiff = {0.00003801029774402991`, 0.00003166395441034695`,
0.00002824280188019947`, 0.000024959958712714654,
0.000022787269822019383`, 0.000019436483137210108`,
0.00001693371175948988, 0.000015088165217656512`,
0.000012260361064817496`, 0.000010559861086240865`,
8.76936167283543`*^-6, 6.751339890899566`*^-6,
5.873151744268928`*^-6, 4.1299202056503785`*^-6,
2.9436141706752585`*^-6, 2.6963256370489514`*^-6,
1.204783793086779`*^-6, 8.73309714394511`*^-7,
6.580914927107429`*^-7, 2.9797119948788726`*^-8,
5.763762151984972`*^-7, 3.834617172196265`*^-7,
6.411511518542553`*^-7, 1.9380608650917353`*^-6,
1.908754472834736`*^-6, 3.074073348904814`*^-6,
4.3815787238334555`*^-6, 5.26905301873764`*^-6,
7.3638110225485615`*^-6, 8.673162659005944`*^-6,
0.000015202058022669781, 0.000013293830765242055};
tab11 = Table[{z[[i]], x[[i]], minDiff[[i]]}, {i, 1, Length[z]}];
ListContourPlot[tab11, FrameLabel -> {"\!\(\*
StyleBox[SubscriptBox[\"\[Kappa]\", \"z\"],\nFontSize->24]\)",
"\!\(\*
StyleBox[SubscriptBox[\"\[Kappa]\", \"x\"],\nFontSize->24]\)"},
ContourStyle ->
Directive[AbsoluteThickness[3], Dashing[{.05, .05}], Black],
BaseStyle -> {FontWeight -> Bold, FontSize -> 14},
ContourShading -> False, Contours -> 2]
Thanks.Ghady Almufleh2018-02-06T14:52:13ZIFS Generators for a Hinsley Irreptile and its Boundary
http://community.wolfram.com/groups/-/m/t/1285401
# Background
In 2002, Stewart Hinsley posted a [page][1] illustrating several fractal irreptiles inspired by the [Hokkaido][2][[?]] tiling of Shigeki Akiyama.
In Feb 2018, Ed Pegg posted the StackExchange Mathematics query "[Curve of a Fractal Triangle][3]" asking if there were a good generator for the *boundary* of a certain Hinsley irreptile (as opposed to its interior).
This post shows the derivation of the IFS generators for both the irreptile of interest and its boundary.
[1]: https://web.archive.org/web/20111212001755/http://www.meden.demon.co.uk/Fractals/dimerIRR.html
[2]: https://web.archive.org/web/20111212001755/http://mathalg.ge.niigata-u.ac.jp/~akiyama/
[3]: https://math.stackexchange.com/questions/2647782/curve-of-fractal-triangle
# The Irreptile of Interest
Here is an illustration of the subject irreptile
showing its decomposition into two smaller copies of itself
as well as labeling several notable points on its perimeter:
![Fig 1: The Irreptile of Interest][4]
Although this has been referred to as a fractal "triangle", it will be simpler to treat it as a quadrilateral []ABCD, due to the alignment requirements of the component copies at points C and F.
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=FracTri_Fig1.png&userId=1285141
# Component Transformations
The irreptile []ABCD is composed of two copies of itself, []BCFA and []CDEF, generated from the original by the transformations T1 and T2, respectively. As these are similarity transformations (translation, rotation, uniform scaling only), it will be convenient to use complex numbers to represent points in the plane.
Z[{x_, y_}] := x + I y ;
XY[z_] := {Re[z], Im[z]} ;
With this representation, the transformations become simple linear functions parameterized by a scaling/rotation value and a translation value.
T1[z_] := s1 z + t1 ;
T2[z_] := s2 z + t2 ;
We can then express the required mappings of the tile onto its component copies by the transformations T1 and T2 as the constraint equations E1 and E2.
E1 = T1 /@ {a,b,c,d} == {b,c,f,a} ;
E2 = T2 /@ {a,b,c,d} == {c,d,e,f} ;
To pin down the overall translation, rotation and scale, we place B at the origin and D at (1,0) via constraint equation E0.
E0 = b == Z[{0, 0}] && d == Z[{1, 0}] ;
We can now solve these constraint equations to give us the parameters of the transformations and the coordinates of the labeled vertices. (The symbolic results are rather lengthy, so will be suppressed here.)
Solns = Solve[{E0, E1, E2}] ;
This gives us three solutions. The first is a purely real solution which corresponds to a degenerate tile with all points lying on the x-axis. The second and third are complex conjugates of each other corresponding to a mirror images pair of tiles. We'll select the first of this pair, and evaluate it numerically.
Soln = Solns[[2]] // N
(* { s1 -> -0.232786 + 0.792552 I, s2 -> -0.42605 + 0.368989 I,
t1 -> 0.602245 - 0.141188 I, t2 -> 1., a -> 0.369459 + 0.651364 I, b -> 0.,
c -> 0.602245 - 0.141188 I, d -> 1., e -> 0.79551 + 0.282375 I, f -> 0.57395 + 0.368989 I } *)
# Plotting the Resulting IFS's
***To Be Continued...***William R. Somsky2018-02-14T23:43:53Z[✓] Extract raw data (list of points for each line) from ListContourPlot?
http://community.wolfram.com/groups/-/m/t/1284362
I was wondering if it is possible to extract the raw data (the x and y coordinates of the points used to draw the contour lines) from **ListContourPlot**. I would like to do further analysis on the shapes of certain contour lines, and having the raw data would be extremely useful. Any suggestions?Matty Mookerjee2018-02-13T21:26:56ZWhy a code that works locally does not work when deployed to the cloud?
http://community.wolfram.com/groups/-/m/t/1284759
When I run this code locally it does what I expect.
When CloudDeploy-ed, it fails. What I am I doing wrong? ( I am a totally new user of WL)
Thanks.
Conversor1 = FormPage[
{{"Amount", "Amount in Euros"} -> "Number",
"Currency" -> {"US dollars", "British Pounds"}, {"Date",
"Invoice Date"} -> "Date"},
DatedRate[moneda_, fecha_] := UnitConvert[
Quantity[1, DatedUnit["Euros", fecha]],
DatedUnit[moneda, fecha]];
Conversion[cantidad_, moneda_, fecha_] :=
Return[Times[cantidad, DatedRate[moneda, fecha]]];
Conversion[#Amount, #Currency, #Date] &]jose rubio2018-02-14T12:05:49Z[✓] Space data points evenly on LogLog Plot?
http://community.wolfram.com/groups/-/m/t/1283952
Hello,
I'm relatively new to mathematica and have what is probably a very basic question.
I'm making a List Log Log plot, from a list created with the Table function. The table function iterates in integer values so when I plot my list log log plot all of the data points are bunched up at the end, as opposed to spaced logarithmically. I realize I probably need to just take the log of some value but I'm drawing a blank. Code below:
time = Table[(1/H)*NIntegrate[(((8.4*10^(-5))/a^2) + (.3/a) + (.7*a^2))^(-1/2), {a,0, i/1000}], {i, 10^-5, 10000}] ;
listA = Table[i/1000, {i, 1, 10000}];
data = Transpose[{time, listA}];
bench1 = ListLogLogPlot[data]
![Log Plot][1]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-02-13at1.31.29PM.png&userId=1283938
Any help would be greatly appreciated.
Thanks!ian gullett2018-02-13T18:33:06Z[✓] Turn the terms of an expression into a list?
http://community.wolfram.com/groups/-/m/t/1284126
I want to turn expression a+b+c+d into list {a,b,c,d}. I always thought there was a command to do this. Any thoughts on a simple way to do this?Jesse Sheinwald2018-02-13T13:50:25ZStatus, 4th edition, "Modern Differential Geometry of Curves and Surfaces..
http://community.wolfram.com/groups/-/m/t/1281781
What is the status of the 4th (FOURTH) edition of the book "Modern Differential Geometry of Curves and Surfaces", by Elsa Abbena, Alfred Gray, and Simon Salamon?
For the second time recently, Amazon.com indicated its availability, only later to say that it is not available.Murray Eisenberg2018-02-09T23:37:47Z[✓] Avoid the disappearance of a Callout?
http://community.wolfram.com/groups/-/m/t/1283395
Hi,
Let's say I have the following `ListLinePlot`:
ListLinePlot[
Callout[Table[i, {i, 1, 20}], "list", Appearance -> "Frame"],
PlotRange -> All, ImageSize -> Medium]
It shows up as:
![enter image description here][1]
So long so nice. However, when I enlarge it by stretching then the `Callou`t starts to disappear, like:
![enter image description here][2]
I looked the options for `Callout`, but saw no remedy there. If I specify `ImageSize->Full`, then only the stick is showing up.
Thanks ahead,
János
P.S. Unrelated but needed: How do I search the list? If I search anything using the provided search box, then I get info from the Wolfram sites but nothing relevant from the list.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Calloutproblem.jpg&userId=277053
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Calloutproblem2.jpg&userId=277053Janos Lobb2018-02-13T00:01:43ZAvoid trouble while using two if Statements?
http://community.wolfram.com/groups/-/m/t/1284257
Hi ! How are you guys!
So I am using the following code to randomly to choose x or y first, then another if statement to choose to add or minus.
However, some error pop out and I don't know how to solve.
It would be so appreciated if you guys can help with this silly problem!
Thanks so much!!!
Code:
x = 0;
y = 0;
lstx = {};
lsty = {};
For[i = 0, i < 1000, i++,
a = RandomReal[];
b = RandomReal[];
c = RandomReal[];
If[ c < 0.5,
(If[a > 0.5, x = x + 1, x = x - 1];
AppendTo[lstx, x]),
(If[b > 0.5, y = y + 1, y = y - 1];
AppendTo[lsty, y])
]]
error:$RecursionLimitJack benjamin2018-02-13T15:40:07ZGet two dimensional Newton-Raphson in inverse kinematics of a plane robot?
http://community.wolfram.com/groups/-/m/t/1278327
Hello,
I just started with Mathematica a week ago and tried to implement inverse kinematics of a plane robot.
Dependent of the length x1 and x2 the position (f1,f2) is described. The idea is to calculate (x1,x2) which will reach given point Xps. The vector X12l saves the initial and later on the iterating lengths of beams x1 and x2.
The trouble I have is that the loop is not working at all, and I am only getting weird therms.
Xps = {4, 3};
X12l = {3, 3};
a := 4;
i = 0;
f1[x1_, x2_] = x1 (a^2 + x1^2 - x2^2)/(2 a x1) ;
f2[x1_, x2_] = x1* Sqrt[1 - (((a^2 + x1^2 - x2^2)/(2 a x1))^2) ];
J[x1_, x2_] = ( {{D[f1[x1, x2], x1], D[f1[x1, x2], x2]},{D[f2[x1, x2], x1], D[f2[x1, x2], x2]} } ) // MatrixForm;
dx = N[Norm[Xps - {f1[X12l[[1]], X12l[[2]]], f2[X12l[[1]], X12l[[2]]]}], 5];
While[dx > 0.1,
X12l = Inverse[J[X12l[[1]], X12l[[2]]]].(Xps - {f1[X12l[[1]], X12l[[2]]], f2[X12l[[1]], X12l[[2]]]});
dx = Norm[Xps - {f1[X12l[[1]], X12l[[2]]], f2[X12l[[1]], X12l[[2]]]}];
i++;
]
i
N[{f1[X12l[[1]], X12l[[2]]], f2[X12l[[1]], X12l[[2]]]}, 3] (*Position of the TCP after dx<0.1*)
N[X12l, 3] (*the lengths needed to reach Xps*)
![Hope this hepls][1]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=948120180203_035328.jpg&userId=1278312Ivan L.2018-02-03T03:12:25ZTransfer code from Mac to Raspberry Pi via Wolfram Cloud?
http://community.wolfram.com/groups/-/m/t/1283686
I was looking to transfer code from my Mac to a Pi via Wolfram Cloud, but I see the menus on the Pi do not allow access to the cloud. The Pi does seem to have cloud functionality built in, since CloudDirectory is defined etc. How can I add the missing menu items to give me access to the cloud? Or do I have to script it? If so how?
TIANicholas Walton2018-02-13T11:27:59ZUndocumented front-end autocompletions functionality
http://community.wolfram.com/groups/-/m/t/1282909
The front-end is great. I enjoy being able to play with it directly from my code. It's richly customizable and reasonably intuitive to work with. On the other hand, the subset of front-end functionality that is explicitly documented only covers like 60% of my desired use cases (and if I were to use it exactly as suggested it'd be slow)
In particular, one thing I've wanted to do recently is add in more autocompletions directly from my code.
To do basic function autocompletions, I'm using a method that I first heard about from [Szabolcs](http://community.wolfram.com/web/szhorvat) which he posted [here](https://mathematica.stackexchange.com/a/129910/38205).
## Functionality 1: Building .trie files
On the other hand, I would also like to be able to use a .trie file for these. This is clearly how these are handled internally. An example of what is contained in these tries can be found like so:
FrontEndExecute@CA`CADumpTriePacket@
FileNames["*.trie",
CurrentValue[$FrontEndSession, {PrivatePaths,
"AutoCompletionDataBase"}], 2][[1]]
{"Entities", "EntityCount", "Classes", "EntityClassCount", \
"SampleEntities", "SampleEntityClasses", "EntityCanonicalNames", \
"PropertyCanonicalNames", "EntityClassCanonicalNames", \
"RandomEntities", "RandomEntityClasses"}
Unfortunately I don't know how to build them. If someone could enlighten me I would appreciate it.
## Functionality 2: Adding in custom function templates
The next part that I wanted to be able to control was the function templates. When one sets a usage message, a function template interface comes into being with it. For instance, we set a usage:
funcThatNoise::usage = "funcThatNoise[a, b, c] is a func";
And now typing `funcThatNoise` and pressing Command-Shift-K will pop up a template for using the function:
![bbbb][1]
I was hoping I could use ``FrontEnd`AddFunctionTemplateInformationToFunctions`` to add these without defining a `"usage"` message, but trying the obvious things (in the context of what I found about ``FrontEnd`AddUsedToGenerateSideEffectGraphicsFunctions`` [here](https://mathematica.stackexchange.com/a/133523/38205)), e.g. any of the following:
FrontEndExecute@
FrontEnd`AddFunctionTemplateInformationToFunctions[
{"Global`",
{
{
"myFunc",
FE`GetTemplateAndUsage["Plot"] /.
s_String :> StringReplace[s, "Plot" -> "myFunc"]
}
}
}
];
FrontEndExecute@
FrontEnd`AddFunctionTemplateInformationToFunctions[
{"Global`",
{
{
"myFunc",
FE`GetTemplateAndUsage["Plot"][[1]] /.
s_String :> StringReplace[s, "Plot" -> "myFunc"]
}
}
}
];
FrontEndExecute@
FrontEnd`AddFunctionTemplateInformationToFunctions[
FE`GetTemplateAndUsage["Plot"] /.
s_String :> StringReplace[s, "Plot" -> "myFunc"]
];
FrontEndExecute@
FrontEnd`AddFunctionTemplateInformationToFunctions[
FE`GetTemplateAndUsage["Plot"][[1]] /.
s_String :> StringReplace[s, "Plot" -> "myFunc"]
]
fails to provide me with any type of template. So how can I do this?
## Functionality 3: Adding Option autocompletions
The final thing I want to know how to use is the `OptionValue` autocompletions. I know [there's a file I could tweak](https://mathematica.stackexchange.com/a/82697/38205) but that's a bit heavy. It's much nicer to be able to just do this on the fly. Again, I thought I had a possible option with ``FrontEnd`AddOptionInformationToFunctions`` but it seems to only handle the option names. Even worse there's no way to remove the coloring it adds (it's clearly how the ``"OptionNames"`` parameter to `SyntaxInformation` works).
## Obligatory note about undocumented functionality
Yes, I understand undocumented things aren't robust, tend to crash the FE, and are subject to change at any moment. Despite this, I think there are too many parts of Mathematica to just ignore the undocumented ones. Many of the best pieces of functionality in Mathematica are undocumented or minimally documented.
I'd appreciate anything anyone can tell me about how these work.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=export.png&userId=1186441b3m2a1 2018-02-11T08:04:24ZImplement a ChannelFramework-based chat system in Mathematica
http://community.wolfram.com/groups/-/m/t/1283830
This was reasonably popular on the StackExchange and people here sometimes like framework development things, so I'm copying it over from [here](https://mathematica.stackexchange.com/a/165668/38205) for those who don't spend time on StackExchange.
---
#Building a chat framework in Mathematica
The basic question is: "how can I use the [`ChannelFramework`](https://www.wolfram.com/language/11/channel-framework/) to build a chat system?"
This is place where OOP comes in very useful, so I'll use [my latest OOP framework](https://mathematica.stackexchange.com/a/165486/38205) to implement this. I've cooked this into an entire package [here](https://github.com/b3m2a1/mathematica-tools/blob/master/ChatSystem.wl)
## Basic System
But before we get into the OOP, we should establish how this should work. My thought is that we should be as unrestrictive as possible, and the best way to do that is by simply passing `Cell` objects through our channel.
### Recieved Cell action
So if we think about what we expect to receive, we'll want to `Compress` our `Cell`, send it through, and then decompress at the other end.
Each message is passed with a few metadata parameters, including `"Timestamp"` and `"RequesterWolframID"`. We'll use these to build a `CellFrameLabel` to attach to each `Cell`.
In the linked package this can be seen [here](https://github.com/b3m2a1/mathematica-tools/blob/1fc38685d8e8c6e7b6d20d8efa9815d63245c8d9/ChatSystem.wl#L139)
### Notebook Setup
The heart of this system is just a plain notebook that will act as our interface. The way I built this out was just having something that would `NotebookPut` a `"ChatLog"` into a notebook to start and then write new `Cells` after the final chat cell in the notebook.
These functions are implemented [here](https://github.com/b3m2a1/mathematica-tools/blob/c048e0e6255c63bb23e4569798ffdde7ce160d62/ChatSystem.wl#L324) and [here](https://github.com/b3m2a1/mathematica-tools/blob/c048e0e6255c63bb23e4569798ffdde7ce160d62/ChatSystem.wl#L421)
We'll also stick on a `DockedCell` which will check for updates to our baseline object and call our `"Write"` function and `NotebookEventActions` to catch `"HandleShiftReturn"` when it's called outside of a cell.
###Channel Setup
With our `Notebook` out of the way we can move to handling our `ChannelObject`. The `ChannelObject` we'll build based on config options we cook into our underlying object. The `ChannelListener` we make will simply dump new messages to our object's `"ChatLog"`.
The set up functions to these are [here](https://github.com/b3m2a1/mathematica-tools/blob/c048e0e6255c63bb23e4569798ffdde7ce160d62/ChatSystem.wl#L698)
## Chat Object
Everything before this has been really standard, but this part will be new for pretty much everyone (but not hard in anyway). So I'll go over it in a bit more detail.
Basically we're going to build a class for instantiating chat objects. In my newest OOP framework this is handled by creating a basic object with a `"New"` member function that calls `SObjInstantiate`.
`SObjInstantiate` then takes the attributes cooked into `"ObjectInstanceProperties"` and just wraps them in.
You can see the entire class declaration [here]() but there are a few things to note. First off, most of the object properties are basically just wrappers on the package functions we defined, e.g. in our `"ObjectInstanceProperties"` we'll have:
"StartChat" ->
SObjMethod@
Function[chatObjectCreateChannel[#];
chatObjectChannelListen[#];
#["OpenChat"][]
]
The `SObjMethod` just declares that when accessed this should be bound to the instance it's called from.
We do the same for our other parameters and implementation functions.
Finally, we add a single method to the class itself, which is simply a convenience function so that we can create and start a chat in one call:
"StartChat" ->
SObjMethod[
With[{n = #["New"][##]},
n["StartChat"][];
n
] &
]
This is a classic thing to do in python, adding a `classmethod` that both instantiates and does something--and python is what this OOP system is inspired by.
##Example
Finally, the fun part, we can see how we can use this package.
First we'll make a new chat instance:
(* Just a Check to see if you have the ChatSystem installed already *)
Quiet[
Check[
<<ChatSystem`,
Get["https://github.com/b3m2a1/mathematica-tools/raw/master/ChatSystem.wl"]
],
Get::noopen
];
(* Makes a new ChatObject instance and opens the chat notebook *)
ChatObject["StartChat"][]
<a href="https://i.stack.imgur.com/EZLyR.png">
<img src="https://i.stack.imgur.com/EZLyR.png" width="300"/>
</a>
And we can use it like a normal `NotebookObject`:
<a href="https://i.stack.imgur.com/PksiD.png">
<img src="https://i.stack.imgur.com/PksiD.png" width="300"/>
</a>
And press Shift-Enter at the bottom of the NB to send the data to the `ChannelObject`:
<a href="https://i.stack.imgur.com/4NmAb.png">
<img src="https://i.stack.imgur.com/4NmAb.png" width="300"/>
</a>
`Cells` that have been sent through or received from the `ChannelObject` get a timestamp attached to them and lose their [`Editability`](http://reference.wolfram.com/language/ref/Editable.html).
As a test we can send ourselves a message from a cloud notebook. First we'll add the other users as allowed contributors to our channel via the ``"AddChannelMember"`` method of our chat object, then I can log into my cloud account and send myself a message:
[![enter image description here][4]][4]
And the chat system supports relatively few features at the moment (it's only been alive for about a day), but it has the big ones I see, like changing the usernames and messages display.
You do this with the ``"ChatCellSettings"`` option, which can take any basic `Cell` options and two for the timestamp, `"NameMapping"`, and `"NameStyling"`.
<a href="https://i.stack.imgur.com/noWyr.png">
<img src="https://i.stack.imgur.com/noWyr.png" width="300"/>
</a>
Hope this is a decent example of how OOP and the `ChannelFramework` can play nicely together.
If you have questions or want clarification on how things work let me know.
[1]: https://i.stack.imgur.com/EZLyR.png
[2]: https://i.stack.imgur.com/PksiD.png
[3]: https://i.stack.imgur.com/4NmAb.png
[4]: https://i.stack.imgur.com/hZ6Q5.png
[5]: https://i.stack.imgur.com/noWyr.pngb3m2a1 2018-02-13T07:58:13ZWhat algorithm does NSolve use for real solutions of underdetermined system
http://community.wolfram.com/groups/-/m/t/1281741
Hi,
I am trying to write up a paper with some results form Mathematica (11.2) among other things. I need to know what algorithm does it use when I solve a system of polynomial equations which is underdetermined (infinitely many solutions). In particular, sometimes Mathematica also find real solutions that are embedded into the complex positive-dimensional components. I couldn't find a mentioned of the specific algorithm that Mathematica is using. I believe this code is written by @DanielLichtblau ? I know this discussion: https://mathematica.stackexchange.com/questions/47112/what-algorithms-does-nsolve-use? Also, I have looked into NSolve's documentation, but it does not mention the specific algorithm for underdetermined polynomial systems and in particular for finding real solutions embedded in complex curves (though Mathematica certainly find these!). e.g.
In= NSolve[{x^2 + y^2 - 1} == 0, {x, y}, Reals]
Out= {{x -> -0.997714, y -> 0.0675708}, {x -> -0.335987, y -> -0.941867}}
While this example may be easy enough, Mathematica also finds real solutions for larger systems.
I also wonder if Mathematica finds ALL the real solutions from all the complex curves? Again, to know this, one needs to know what algorithm/method does Mathematica uses.
Thanks.dbm3682018-02-09T18:59:30Z