Community RSS Feed
http://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Wolfram Scienceshowthread.php?s= sorted by activeHow to change speed setting for remote kernels?
http://community.wolfram.com/groups/-/m/t/1267044
If you add remote kernels via menu Edit -> Preferences -> Parallel -> Remote Kernels they are all given the default value of Speed=1 which assumes that all machines are identical, but if one of them is much slower than the others, then it will slow down the computation instead of speeding it up, because all nodes will be given the same amount of work to do. This value is shown by the "Parallel Kernel Status" dialog if one enables it via "Select Columns..."
So, my question is: is it possible to change the Speed setting so as to help Mathematica 11 decide the optimal amount of work to give to each node? If so, how?Tigran Aivazian2018-01-17T10:30:26ZProblem with PDF and discrete variates
http://community.wolfram.com/groups/-/m/t/1264375
Can you help me understand why these two plots differ? It seems like in first case variate suddenly stopped being discrete
d1 = TransformedDistribution[x + x, x\[Distributed]DiscreteUniformDistribution[{1,6}]];
DiscretePlot[PDF[d1, {a}], {a,0,15}]
d2 = TransformedDistribution[x + x, {x\[Distributed]DiscreteUniformDistribution[{1,6}], y\[Distributed]DiscreteUniformDistribution[{1,6}]}];
DiscretePlot[PDF[d2, {b}], {b,0,15}]
Thank you.Michael Kilburn2018-01-12T10:46:35ZHow to extract the boundary points of an image using wolfram mathematica?
http://community.wolfram.com/groups/-/m/t/1266525
Hi, Currently, I am dealing with problems related to images. My intention is to convert an image to binary image and extract the boundary outline of the image to get the coordinates of the boundary image. Through Wolfram Mathematica, we can use the built-in function "binarize" to convert the image to binary image. Further steps to extract the boundary points through Wolfram Mathematica built-in function is not applicable. Is there any built-in function exist to extract the boundary outline points? For my concern, there is a "corner detection" but I could not find the built-in function for binary image outline extraction? Is there any way to extract the binary outline using Wolfram Mathematica? Here is an example of what I want to extract
## Original
![enter image description here][1]
## Extracted Boundary image
![enter image description here][2]
I want to get the boundary points and image as above. Can anyone help me?
Thank you in advance for your time
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Originalimage.JPG&userId=1266510
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ExtractedBoundaryimage.JPG&userId=1266510Nur Soffiah2018-01-16T08:53:22ZHow do I convert a Mathematica Notebook into a fully interactive web page?
http://community.wolfram.com/groups/-/m/t/1266033
I have a Mathematica notebook that contains some animations based on numerical solutions to differential equations, with a few input parameters (either directly typed in or using sliders). I can't find a tutorial (either online or within the Help system) on how to convert this into an online web file that my students can explore for themselves. Ideally, it should show all the same content as the nb, but also be able to actually run the animation, with students being able to change the input. I tried simpleminded commands like "Export", but although a bunch of html files were created, they don't seem to do anything in my browser (Safari). Any hints would be appreciated!Sebastian Kuhn2018-01-15T17:08:09ZImprove paclet formatting?
http://community.wolfram.com/groups/-/m/t/1266698
Cross posted on StackExchange: [Improving paclet formatting](https://mathematica.stackexchange.com/questions/163854/improving-paclet-formatting)
---
For such an increasingly relevant data type the `Paclet` has a particularly useless formatted form.
Can we do better?
In particular we'll want the `Paclet` [`Format`](http://reference.wolfram.com/language/ref/Format.html) to be attractive, show particularly relevant paclet info, and be customizable.
Here's my version, to get people started:
pacletKeyOrdering =
{
"Name", "Version", "Creator",
"Description", "Root", "WolframVersion",
"MathematicaVersion", "Internal", "Loading",
"Qualifier", "SystemID", "BuildNumber",
"Tags", "Icon", "Categories",
"Authors", "Extensions"
};
With[{keyOrdering = pacletKeyOrdering},
pacletInfoAssociation[PacletManager`Paclet[k__]] :=
KeySortBy[First@FirstPosition[keyOrdering, #] &]@
With[
{
base =
KeyMap[Replace[s_Symbol :> SymbolName[s]], <|k|>]
},
ReplacePart[base,
"Extensions" ->
AssociationThread[
First /@ Lookup[base, "Extensions", {}],
Association@*Rest /@ Lookup[base, "Extensions", {}]
]
]
]
];
If[! AssociationQ@$pacletIconCache, $pacletIconCache = <||>];
pacletGetIcon[a_Association] :=
Replace[
FileNames[
Lookup[
a,
"Icon",
"PacletIcon.m" | "PacletIcon.png"
],
a["Location"]
],
{
{f_, ___} :>
Lookup[$pacletIconCache, f, $pacletIconCache[f] = Import[f]],
{} :>
With[{f =
"https://github.com/b3m2a1/mathematica-BTools/raw/master/\
Resources/Icons/PacletIcon.png"
},
Image[
Lookup[$pacletIconCache, f, $pacletIconCache[f] = Import[f]],
ImageSize -> 28
]
]
}
];
$formatPaclets = True;
Format[p_PacletManager`Paclet /;
($formatPaclets && AssociationQ@
pacletInfoAssociation[p])] :=
With[{a = pacletInfoAssociation[p]},
RawBoxes@
BoxForm`ArrangeSummaryBox[
"Paclet",
p,
pacletGetIcon[a],
KeyValueMap[
BoxForm`MakeSummaryItem[
{Row[{#, ": "}], #2},
StandardForm
] &,
a[[{"Name", "Version"}]]
],
Join[
{
If[KeyMemberQ[a, "Location"],
BoxForm`MakeSummaryItem[
{Row[{"Location", ": "}],
With[{l = a["Location"]},
Button[
Hyperlink[l],
SystemOpen[l],
Appearance -> None,
BaseStyle -> "Hyperlink"
]
]},
StandardForm
],
Nothing
]
},
KeyValueMap[
BoxForm`MakeSummaryItem[
{Row[{#, ": "}], #2},
StandardForm
] &,
KeyDrop[a, {"Name", "Version", "Location"}]
]
],
StandardForm
]
];
FormatValues[PacletManager`Paclet] =
SortBy[
FormatValues[PacletManager`Paclet],
FreeQ[HoldPattern[$formatPaclets]]
];
This is what I use in my own packages. It makes paclets that look like this:
PacletFind /@ {"BTools", "ChemTools"} // Flatten
[![img][1]][1]
(*sorry about bad raster quality*)
Of course where this is actually useful is that it shows you what's inside the paclet:
PacletFind["MQTTLink"][[1]]
[![asdasd][2]][2]
[1]: https://i.stack.imgur.com/yeIuE.png
[2]: https://i.stack.imgur.com/WCeVf.pngb3m2a1 2018-01-17T05:10:59ZOutput a Table as Column
http://community.wolfram.com/groups/-/m/t/1266354
Hallo!
I have a problem.
The code
Clear@"Global`*" (*Speicher löschen*)
test1[k_] = k;
test2[n_] = n;
text = "abc";
myrow[y_] = y;
mycolumn[x_] = x;
mycell[k_, n_] :=
ToString@myrow[n] <> " " <> ToString@mycolumn[k] <> " " <>
ToString@test1[k] <> " " <> ToString@test2[n] <> " " <>
ToString@text
list2 = Table[mycell[k, n], {k, 1, 2}, {n, 1, 3}]
Export["Test.txt", list2, "Table"]
gives me a txt-file with
1 1 1 1 abc 2 1 1 2 abc 3 1 1 3 abc
1 2 2 1 abc 2 2 2 2 abc 3 2 2 3 abc
How can I export a textfile which contains the same stuff rowwise?
That means:
1 1 1 1 abc
2 1 1 2 abc
3 1 1 3 abc
1 2 2 1 abc
2 2 2 2 abc
3 2 2 3 abc
Do you have any idea?
Thanks a lot!cis cis2018-01-16T23:39:23ZCalling WL users in Charleston, ATL, DC, Raleigh-Durham, Baltimore, Chicago
http://community.wolfram.com/groups/-/m/t/1266493
Hi all --
I'm looking to connect with some Wolfram language power-users located near the following areas:
- Charleston, SC
- Atlanta, GA
- Washington, DC
- Raleigh, NC
- Baltimore, MD
- Chicago, IL
I work with our Commercial team to establish and support licensing in these major cities, and I think it'd be really beneficial to work with some of our more passionate users there. Obviously, being located in Champaign, I have some limitations to my knowledge of as well as my access to these areas, so I think collaborating with you all to either get a better idea of the tech landscape or even working to raise awareness could be a worthwhile effort.
Curious in connecting to some of you. Any level of interest from "I can help you learn more about this city's tech landscape and its networking opportunites" to "here's some connections I have in the area" to "let ME be your Wolfram Language evangelist for my city" is appreciated. Feel free to comment on here or shoot me a quick email at samt@wolfram.com if you're interested. Excited to connect!Sam Tone2018-01-16T23:31:20ZCustom Activation Function in Neural Network?
http://community.wolfram.com/groups/-/m/t/1263274
Hello! Is it possible to set user defined activation function for a layer in neural network?
If this feature is not yet part of WL, are there any plans for such an addition as it would be very helpful.narendra2018-01-10T20:39:53ZHome Blood Pressure Monitoring
http://community.wolfram.com/groups/-/m/t/1265408
Home Blood Pressure Monitoring
On November 13th, 2017 the American College of Cardiology and American Heart Association released a massive document centered on the prevention, detection, evaluation and management of high blood pressure in adults. (http://hyper.ahajournals.org/content/early/2017/11/10/HYP.0000000000000065)
New blood pressure categories were established:
![enter image description here][1]
While the decision about when to modify lifestyle habits and/or introduce or change medications is best left to discussions between each person and their family physician / cardiologist, there is no reason we can't rely on our favorite computing platform - Mathematica - to help us organize data typically collected through home blood pressure monitoring.
I currently use a blood pressure application called "Blood Pressure Log - My Diary" (via GooglePlay) written by Dr. Tomasz Jan Zlamaniec to record my sphygmomanometer readings - specially my systolic & diastolic blood pressure values, as well as heart rate. The application automatically records the date and time of the data entered. It is a simple matter of exporting the data (csv, xlsx format) to be organized and summarized by Mathematica. The application exports 5 columns of data, including date, time (in 24 hour format), systolic bp, diastolic bp, heart rate (in beats per minute).
Importing the data from the application into Mathematica looks as follows:
mydata = Drop[
Flatten[Import["C:\\Users\\Todd's PC\\Desktop\\Todd BP scrubbed.xlsx",
"Data"], 1], None, {2}]
![enter image description here][2]
You'll note that Mathematica automatically collapses the date and time into a single DateObject[], which is why we are left with 4 columns of data instead of the initial 5 exported from the blood pressure application. (Mathematica does preserve the 5 column data structure by inserting data that is not useful to me, so I Drop it after the import.)
I've created some code (notebook attached) that will produce graphical and statistical output simply by sending <mydata> to a function called <bpdashboard>.
bpdashboard[mydata]
Tab 1 (Blood Pressure): A ListPlot of your personal systolic (x-axis) and diastolic (y-axis) values. Data points are wrapped in tooltip and will report their values when you place your cursor over them. The data is color coded according to the time of day the value was recorded. Morning is defined as 0100 to 1159 hours. Afternoon 1200 to 1759 hours and evening from 1800 to 2459 hours.
![enter image description here][3]
Tab 2 (Pulse Pressure): A DateListPlot of your pulse pressure. Pulse pressure is the difference between systolic and diastolic values. Normal pulse pressure is considered 40mmHg. Note that data is displayed in a stacked format to make it easier to see morning, afternoon, and evening data on the same plot.
![enter image description here][4]
Tab 3: A DateListPlot of your mean arterial pressure. Mean arterial pressure is defined as the average blood pressure in a patient's arteries during one cardiac cycle. MAP is generally considered normal in the 60 - 110 mmHg range. As in Tab 2, the data is plotted in a stacked format.
![enter image description here][5]
Tab 4: A statistical summary reporting many self explanatory vital statistics. SD = standard deviation; bpm = beats per minute; MAP = mean arterial pressure
![enter image description here][6]
My goal in creating such a program is to be able to produce monthly status reports on my cardiovascular health, print the data as desired, and take the information along to office visits as necessary. Feel free to use and modify for your own purposes.
Wishing everyone good cardiovascular health in 2018!
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=categorysnip.JPG&userId=99116
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=importsnip.JPG&userId=99116
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=bpsnip.JPG&userId=99116
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=pulsepressuresnip.JPG&userId=99116
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=mapsnip.JPG&userId=99116
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=statsnip.JPG&userId=99116Todd Allen2018-01-13T21:09:06ZI have problems with code execution of a button
http://community.wolfram.com/groups/-/m/t/1266463
I want to execute the function moverIntXx within the button and nothing happen. If I execute the function outside the button, the function runs fine. What is that I don' t understand? Thanks.
SetAttributes[moverIntXx,HoldFirst];
moverIntXx[var_,n_]:=Module[{t},
t=Flatten[Table[{1,2,3},{i,1,n}]];
Map[(Pause[0.05];FinishDynamic[];var=#)&,t];
];
Dynamic[var]
Button[
Style[Tooltip["Clic"], Red,FontFamily->"Palatino",18],
moverIntXx[var,6],Appearance->"Frameless"]Ernesto Espinosa2018-01-16T17:22:48ZPlotting and printing out values of a function in NestList
http://community.wolfram.com/groups/-/m/t/1264365
Hi,
I'm new to Mathematica and I'm having troubles in understanding how to evaluate a custom function that I applied NestList to. Here's my function:
f[x_, m_] := m*x /; 0 <= x < 1/2
f[x_, m_] := m*(1 - x) /; 1/2 <= x <= 1
x = 0.2
m = 2
Next I got NestList like this:
NestList[f, {0.2, 2}, 4]
which have given me following output:
{{0.2, 2}, f[{0.2, 2}], f[f[{0.2, 2}]], f[f[f[{0.2, 2}]]],
f[f[f[f[{0.2, 2}]]]]}
Now instead of printing f f f .... f f I'd like to see actual values of the function f after evaluation such as {value 1, value 2, value 3, ..., value n}. Moreover I'd like to plot such a NestList where values in NestList would be coordinates of n points on axis.
Any help, advice or example would be greatly appreciated.
EDIT: I'm studying Dynamic systems and trying to compute and plot so called ["tent map"] (https://en.wikipedia.org/wiki/Tent_map)Nikol Skorupova2018-01-12T10:03:28ZHow to change TimeConstraint option in Mathematica
http://community.wolfram.com/groups/-/m/t/1266551
Hello ,
I would like to solve a Limit Question in Mathematica but when i click on Step by step solution then i get this error.
"WolframAlpha::timeout: The call to WolframAlpha[lim ((ln(1+sinx)\[Sqrt]sinx)/\[Sqrt](3x^3(1+x+2x^2-5x^3)) as x->0] has exceeded 20.` seconds. Increasing the value of the TimeConstraint option may improve the result."
Can anyone help me to change TimeConstraint?
Thank you in AdvanceSalahuddin Sediqi2018-01-16T11:14:48ZHandling discontinuities at the boundary in DSolve and NDSolve
http://community.wolfram.com/groups/-/m/t/1266614
I feel like there's an easy answer to this. Laminar flow in a cylinder:
DSolveValue[mu/r D[r u'[r], r] == dp, u[r], r]
c1 log(r)+c2+(dp r^2)/4/mu
(*log[0] is -infinity, but apply boundary conditions sets c1=0:*)
DSolveValue[{mu/r D[r u'[r], r] == dp,u'[0]==0,u[1]==0}, u[r], r]
dp/4/mu (r^2-1)
In DSolve it evaluates fine but with the error "For some branches of the general solution, unable to compute the limit at the given points. Some of the solutions may be lost"
NDSolve fails with a 1/0 error. What's the best way of handling this? I have a more difficult problem I need to resolve where one of the dependent variable goes to zero at the boundary and is in the denominator (the numerator goes to zero faster).Eric Smith2018-01-16T15:40:54ZUsing NDSolve to solve three dimensional (t,x,y,) pde, codes not work
http://community.wolfram.com/groups/-/m/t/1266574
Clear[x, t, xMin, xMax, TMax, yMin, yMax];
TMax = 3.73; xMin = -Sqrt[2] Pi; xMax = -xMin; yMin = -Sqrt[
2] Pi; yMax = -yMin;
eqn = D[h[t, x, y],
t] == -Div[Grad[h[t, x, y], {x, y}]/h[t, x, y], {x, y}] -
Div[Grad[Laplacian[h[t, x, y], {x, y}], {x, y}]*h[t, x, y]^3, {x,
y}];
bcs = {h[0, x, y] == 1 - 0.1 Cos[Sqrt[2]/2*Sqrt[x^2 + y^2]],
h[t, x, yMin] == h[t, x, yMax], h[t, xMin, y] == h[t, xMax, y]};
hsol = NDSolveValue[{eqn, bcs},
h[t, x, y], {t, 0, TMax}, {x, xMin, xMax}, {y, yMin, yMax}]
******************************************************
The above code can be run but show no results when I try to plot it using Plot3D,like: Plot3D[hsol[0, x, y], {x, xMin, xMax}, {y, yMin, yMax},
PlotRange -> All]. Does anyone can help me with this? Thanks a lot.Yixin Zhang2018-01-16T11:27:46ZFactoring out matrices in expressions
http://community.wolfram.com/groups/-/m/t/1265715
Hi Community,
I am working on a tutorial for matrix algebra, I cannot figure out how to make Mathematica identify and replace previously defined symbols in calculations. For example. I have defined
rules = {IdentityMatrix[2] -> Subscript[\[Sigma], 0],
PauliMatrix[1] -> Subscript[\[Sigma], 1],
PauliMatrix[2] -> Subscript[\[Sigma], 2],
PauliMatrix[3] -> Subscript[\[Sigma], 3]}
So when I make
Grid[Join[{Table[PauliMatrix[i] // MatrixForm, {i, 3}]},
Table[MatrixForm[PauliMatrix[i].PauliMatrix[j] /. rules], {i,
3}, {j, 3}]]]
I get `Subscript[\[Sigma], 0]` in the diagonal, but cannot figure out how I make Mathematica to identify the other elements as simply products of `+/- I` and the other Pauli matrices.
Or simpler put: how do I make Mathematica answer `I PauliMatrix[3]` to the input
PauliMatrix[1].PauliMatrix[2]
Kind regards
Mogens
Ps. Is it true that Solve etc. does not work on matrices, or is it just me? (I have tried to specify `Matrices[{2,2},Complexes]` as the domain but I get errors or nothing back)jallberg2018-01-14T20:51:08Z[CALL] Reddit DataViz Battle JAN2018: Visualize the Growth Rates of Algae
http://community.wolfram.com/groups/-/m/t/1257547
# Intro
One of the most popular Reddit's channels **Data Is Beautiful** (with multi-million membership of subscribers) has just started **Battle Competitions** for data visualizations that will run monthly. This is a call to Wolfram Community members to collaborate on **JAN 2018 Battle**.
***Direct reference to the JAN 2018 Battle***: https://redd.it/7nm6ed
## Solutions
- **Heatmap of inter- and intra- species comparison** *by Vitaliy Kaurov*:
- http://community.wolfram.com/groups/-/m/t/1257577
- **Bubble chart for 4D data** *by Sander Huisman*:
- http://community.wolfram.com/groups/-/m/t/1257885
- **Population - pyramid like visualization**: *by George Varnavides*
- http://community.wolfram.com/groups/-/m/t/1258056
- **Growth Rate in "Intensity Space"** *by Henrik Schachner*
- http://community.wolfram.com/groups/-/m/t/1258281
- **Intraspecies comparison using RadarChart** *by Diego Zviovich*
- http://community.wolfram.com/groups/-/m/t/1260507
- **Interspecies comparison using HeatmapPlot** by *Anton Antonov*
- http://community.wolfram.com/groups/-/m/t/1261444
- **Scatter plot slices of temperature dynamics** *by Vitaliy Kaurov*
- http://community.wolfram.com/groups/-/m/t/1261948
- **RadarChart for each pecies** by *Anton Antonov*
- http://community.wolfram.com/groups/-/m/t/1261438
## Rules of this thread
Reddi requires direct links to the images. Hence a separate post is necessary. Here are the steps:
- Make a separate post solving the challenge with detailed title describing your specific method of visualization and starting with tag [Reddit-DiBB0118] (Data is Beautiful Battle 01/2018)
- Make a comment in this thread simply stating the title and copying your post URL.
See my example in the comments. I will collect the solutions in the "solutions" section above. This method enables you to post your own posts on Reddit if you want to keeping your authorship.
## Goal
I simply suggest that Wolfram Community members brainstorm in the comments below about how the best to visualize the dataset. Feel free to submit **your own** solutions to Reddit if you want to as they require the original authors. The main goal though is simply to have fun here on Community. **Don't forget to vote up the posts you like**.
## Important
Battles have simple rules explained clearly in the Reddit battle thread linked above. To not get disqualified it is advised to read rules carefully. You can ask Reddit admins any additional questions directly in the thread comments. I recommend reading other people comments as they clarify the nature of the dataset.
## Getting the data w/ Wolfram Language (WL)
The dataset is located at a web page: http://aquatext.com/tables/algaegrwth.htm
The nature of the data is clear from the website description. It is easy to get the raw data with the following WL command:
raw = Import["http://aquatext.com/tables/algaegrwth.htm", "Data"] /."0..06" -> .06;
You need `/."0..06" -> .06` because the data has a clerical error resulting in the import of a string instead of a number. One way of obtaining a simple rectangular array / table of data is:
data=Cases[raw,{_String,__?NumberQ},Infinity]/.
x_List/;First[x]=="Temperature":>{"Temperature",5,5,10,10,25,25,30,30};
which can be viewed as
TableForm[data]
![enter image description here][3]
[1]: https://www.reddit.com/r/dataisbeautiful/
[2]: http://community.wolfram.com/groups/-/m/t/1257577
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-02at6.20.30PM.png&userId=11733Vitaliy Kaurov2018-01-03T00:33:35ZUsing Basic JSON REST Services in Mathematica
http://community.wolfram.com/groups/-/m/t/1262929
I recently had a job interview where I was given the following problem and I decided to tackle it with Mathematica vs. Groovy; it seemed very simple to accomplish using Mathematica: *(Hopefully they take kindly to it)*
- There’s a “fake” REST service available for testing at:
http://jsonplaceholder.typicode.com/
- Write some code in the Groovy programming language that uses the
“posts” API published at http://jsonplaceholder.typicode.com/posts,
which reports back some fake blog posts including a userid, post id,
title, and body.
- Retrieve the records from the API and generate a report that lists only the users who wrote posts where the post title starts with the
letter “s” along with the number of such posts for each of those
users.
- Use the user's name in the report, not the numerical user ID.
- Return to us the report that's generated, along with the (working)
code that generated it.
First, let's import our posts from the website as RawJSON format and generate a Dataset from it which is much more convenient to work with:
posts = Import["http://jsonplaceholder.typicode.com/posts", "RawJSON"];
postsDataSet = Dataset[posts]
![enter image description here][1]
Next, let us filter out all of the posts whose bodies of text start with the string character "s":
filterPostsDataSet = postsDataSet[Select[StringTake[#title, 1] == "s" &]]
![enter image description here][2]
We are left with 9 entries and all we need to do is keep the userId values associated with these:
userIDs = filterPostsDataSet[All, "userId"]
![enter image description here][3]
Now we need to retrieve the user's information attached to these Id values; although not specifically stated I assumed these could be found at http://jsonplaceholder.typicode.com/users. Thus, we simply import these values and, like before, wrap them in a Dataset.
users = Import["http://jsonplaceholder.typicode.com/users", "RawJSON"];
usersDataSet = Dataset[users]
![enter image description here][4]
Although I feel there is a more elegant way - I am going to make a list of just the users names from this Dataset to work with using the following:
userResults =
Table[usersDataSet[Select[#id == userIDs[[i]] &]][[1]]["name"], {i, 1, Length[userIDs]}]
Additionally, I want to keep a list of the *unique* user names since some might be duplicated in the previous list:
uniqueUsers = DeleteDuplicates[userResults]
Finally, I will create a final list which is essentially my required report, which will be a list of pairs. Each pair will contain the unique user name as well as the count of how many times that unique user name appeared in the original list. I put this in TableForm just for aesthetic value. This can then be exported to the desired format later on if necessary.
uniqueUserPosts = Table[{uniqueUsers[[i]], Count[userResults, uniqueUsers[[i]]]}, {i, 1, Length[uniqueUsers]}] // TableForm
![enter image description here][5]
In conclusion, I think that in the future using Mathematica in working with REST API's could and should be allowed if not encouraged as a proper scripting languages in many commercial and industrial settings. So - what do you guys think?? Is this better or worse than what could be done in Groovy or other scripting languages? Also, I feel that I could condense and optimize my code in areas and would love to hear feedback on that.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Result1.png&userId=856782
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=7292Result2.png&userId=856782
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1220Result3.png&userId=856782
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Result4.png&userId=856782
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5573Result5.png&userId=856782William Duhe2018-01-10T05:24:46ZSolving a non-linear system of equations
http://community.wolfram.com/groups/-/m/t/1265768
I have a set of non-linear equations that I want to solve numerically. The "Solver" of Excel is sometimes able to solve it, but often fails (ends up with not-a-number values and gives up).
I am thinking of switching to Mathematica or Matlab. Would appreciate if someone gave me any guidance about the pros and cons of these two.Jay Cal2018-01-15T09:34:20ZSolved: Linux Interface Toolbar and Font Size
http://community.wolfram.com/groups/-/m/t/1266184
Thought I'd post something I was struggling with in order to get Mathematica (and any sub-menus it might launch) to display correctly on high resolution monitors in Linux.
The default ScreenResolution is 72dpi in a newly installed Mathematica. My monitor (and almost all modern monitors) use a higher resolution. In my case 96dpi. This means that everything rendered is tiny (it renders to 72/96 of what it was intended to run at). Controlling some fonts fails to control sizes in menus, icons, and tool bars in general. Bits and pieces of Mathematica can be enlarged through font or ScreenResolution changes, but it is difficult at best to get even part of what is too small back to a normal size. So here is how to fix this with a single step...
Setting environment variables like this will fix the issue...note that 96/72, the dpi of actual monitor versus what seems to sometimes be hard coded into Mathematica, is about 1.33. This will correct the issue if starting on command line:
QT_AUTO_SCREEN_SCALE_FACTOR=1 QT_SCALE_FACTOR=1.33 Mathematica &
Starting Mathematica like this will allow the palettes, icons, buttons, and window frames to enlarge uniformly.Dan Stimits2018-01-16T02:04:25ZCalculate Confidence Interval for an expected value in linear model
http://community.wolfram.com/groups/-/m/t/1265869
Hi everyone
I'm sure there is a really simple solution for my problem but I just can't figure it out.
After using LinearModelFit to estimate a mode (lm)l, I calculated an expected point estimate using some fixed values (lm[1,2,3]). I'd now like to calculate a confidence interval for my point estimate. What would be the way to do it?
ThanksLuka Vucicevic2018-01-15T19:41:21ZUse of Gradient in FindMinimum
http://community.wolfram.com/groups/-/m/t/1261346
I use FindMinimum using objective and gradient functions that take a matrix and vector as inputs, as in
FindMinimum[f[mat, vec], {{mat, matstart}, {vec, vecstart}}, Gradient :> g[mat, vec}], Method -> "QuasiNewton"]
The arguments to f[mat,vec] and g[mat,vec] are a matrix (mat) and a vector (vec). FindMinimum wants the Gradient function g to return a vector, which makes sense. Question is in which order should the derivatives be specified? The most logical option appears to be that corresponding to Flatten[{mat,vec}]... but I'm not having much luck with that.
Thanks for any help.
-EricEric Michielssen2018-01-07T16:29:02ZCalculate minimum common differences?
http://community.wolfram.com/groups/-/m/t/1159745
![sketch][1] Can someone program something todo this? Calculate the least or greatest most different numbers between a series of numbers?
So far I came out with these lines, but nothing comes out...
Unprotect [Element]Unprotect [NotElement]Unprotect[NestWhile]Unprotect[a,a1,a2]Unprotect[Slot]
f[a1_]:= a&;&["|<a 1] ,[|>"a 1"\[Rule]a 1],|<=>"a1 "\[Rule] a1 "];
Block
Thread[f[{a},{a1,a2},List AllTrue]]
e=Intersection [a,a1,a2]
Last[%]
Block[{$RecursionLimit=1000},f= a]
RandomChoice[a,27]
Thread[a=NestWhileList[a!= a1>a!=a2[Element[a,aa]& Element[a1,aa]& Element[aa,a],Element[a,aa]!=Element[a1,aa]!=Element[a2,aa]&],a,27]]
a=Flatten[List[%]]
Thread[a1=NestWhileList[a1!= a1>b!=a2[Element[a1,aa]& Element[a1,aa]& Element[aa,a1],Element[a1,aa]!=Element[a1,aa]!=Element[a1,aa]&],a1,27]]
a1=Flatten[%]
Block[{$RecursionLimit=1000},c1 ]
c1={#&,a+b1-c1}
b1={a,a1+a}
Map[MatchQ[#,_Integer]&,b]
Pick[c1,b1]
Do[If[a1 a1 And Or >=a1,Print["a1 = ",a1],Throw[a]],{a1,d}]
Catch[Do[If[a2!= a And Or #3&,Print["a1 = ",a1],Throw[a1]],{a,d}]]
Directory[]
Export["aa.txt","aa"]
Import["aa.txt"]
a=Flatten[a]
b=Flatten[a1]
c=Flatten[a2]
d=Union[a,b,c]
s=Subtract[a1,a2]
Take[a1,"-s"]
Solve[aa->aa!= aa!= #& ,aa]
a={3,4,5,7,10,15,23,27}
a1={4,6,7,8,9,10,12,15,25}
a2={2,6,7,10,11,12,23,13,14,15,25}
While a<=a1!=a2 Take[Last[a]]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=minimadiferen%C3%A7acomum0007.jpg&userId=1147177Luis Felipe Massena Misiec2017-08-06T20:48:16ZMin and Max value (range) of a variate
http://community.wolfram.com/groups/-/m/t/1265736
Hi,
If I have a distribution, e.g.:
p := DiscreteUniformDistribution[{1,6}]
is there any way to find out range of values of related variate? (e.g. [1,6] in my example)
Thank youMichael Kilburn2018-01-15T08:41:47ZSize Step is effectively zero?
http://community.wolfram.com/groups/-/m/t/1265562
Hello, I am trying to plot a double pendulum. But when I try to plot the results, this error occurs:
"NDSolve::ndsz: At t == 0.5517583468854775`, step size is effectively zero; singularity or stiff system suspected."
Any idea what I've got wrong?
Lagrangian = (m1 + m2)/2*l1^2*\[Theta]1'[t]^2 +
m2/2*l2^2*\[Theta]2[t]^2 +
m2*l1*l2*\[Theta]1'[t]*\[Theta]2'[t]*
Cos[\[Theta]1[t] + \[Theta]2[t]] + (m1 + m2)*g*l1*
Cos[\[Theta]1[t]] + m2*l2*g*Cos[\[Theta]2[t]];
g = 9.81;
l1 = 1;
l2 = 1;
m1 = 1;
m2 = 1;
eq1 = D[D[Lagrangian, \[Theta]1'[t]], t] - D[Lagrangian, \[Theta]1[t]];
eq2 = D[D[Lagrangian, \[Theta]2'[t]], t] - D[Lagrangian, \[Theta]2[t]];
sol = NDSolve[{eq1 == 0,
eq2 == 0, \[Theta]1[0] == Pi/10, \[Theta]1'[0] ==
0, \[Theta]2[0] == 0, \[Theta]2'[0] ==
0}, {\[Theta]1, \[Theta]2}, {t, 0, 10}];
Plot[{Evaluate[\[Theta]1[t] /. sol],
Evaluate[\[Theta]2[t] /. sol]}, {t, 0, 10}, PlotRange -> A]Jonas Hamp2018-01-14T17:11:29ZCitation for a table “Large Tasks - Line count ratio” // Mathematica vs ...
http://community.wolfram.com/groups/-/m/t/1265482
I would like to include this table in a publication and need attribution. It's a screenshot I took, but I don't remember the source.
Anyone recognize it and can provide a citation?
![enter image description here][1]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=line-count-ratio_JPG.jpg&userId=389628Alan Calvitti2018-01-14T17:17:16ZHow do I define a range of values for this recurrent equation?
http://community.wolfram.com/groups/-/m/t/1265237
Hello,
I want to plot the values for n from 0 to 100 for this recurrent equation: g(0)=0.6 | g(n+1)=g(n)^3 * 4- 3 * g(n) .
How do I do it?
Thank you.Roald Baudoux2018-01-13T23:58:43ZIntroduction to Computer Programming
http://community.wolfram.com/groups/-/m/t/1265276
For several decades, computer technology made dramatic advancements that a introductory book for computer programming quickly became obsolete. We are preparing for a up-to-date comprehensive introductory course for computer programming using Wolfram Language and Visual Studio with minimal requirements. Syllabus is provided via the following link:
https://drive.google.com/open?id=1YnEOp0jhv-Rv4o4BWTzs4twOECiNcNty
We would like to ask for suggestion for materials and recommendation for collaborators that the book may be produced with great quality with real-world code examples for reference.
Thank you for the time and consideration.AQUARIM NEVATHIR2018-01-14T10:40:24Z[GIF] All Day (Hamiltonian cycle on the 24-cell)
http://community.wolfram.com/groups/-/m/t/1265322
![Stereographic projection of a Hamiltonian cycle on the 24-cell][1]
**All Day**
Same idea as [_Touch ’Em All_][2]: this is the stereographic image of a Hamiltonian cycle on the 24-cell. The idea behind the code is the same, so look back at that post for an explanation (as before, the definition of `ProjectedSphere[]` is not reproduced here; see [_Inside_][3]).
Stereo[{x1_, y1_, x2_, y2_}] := {x1/(1 - y2), y1/(1 - y2), x2/(1 - y2)}
smootherstep[t_] := 6 t^5 - 15 t^4 + 10 t^3;
twenty4cellvertices = Normalize /@
DeleteDuplicates[
Flatten[
Permutations /@ ({-1, -1, 0, 0}^Join[#, {1, 1}] & /@ Tuples[{0, 1}, 2]), 1]
];
sorted24CellVertices =
Module[{v = twenty4cellvertices, M, Γ, cycle},
M = Table[
If[v[[i]] != -v[[j]] && HammingDistance[v[[i]], v[[j]]] == 2, 1,
0], {i, 1, Length[v]}, {j, 1, Length[v]}];
Γ = AdjacencyGraph[M];
cycle = FindHamiltonianCycle[Γ];
v[[#[[1]] & /@ (cycle[[1]] /. UndirectedEdge -> List)]]
];
DynamicModule[{θ, viewpoint = 1/2 {-1, 1, 1},
pts = N[sorted24CellVertices],
cols = RGBColor /@ {"#04E762", "#00A1E4", "#DC0073", "#011627"}},
Manipulate[
θ = π/3 smootherstep[t];
Graphics3D[{Specularity[.4, 10],
Table[
ProjectedSphere[RotationMatrix[θ, {pts[[i]], pts[[Mod[i + 1, Length[pts], 1]]]}].pts[[i]], .2],
{i, 1, Length[pts]}]},
PlotRange -> 4.5, ViewAngle -> π/3, ViewPoint -> viewpoint,
Boxed -> False, Background -> cols[[-1]], ImageSize -> 540,
Lighting -> {{"Directional", cols[[1]],
50 {1, -1, 2}}, {"Directional", cols[[2]],
50 {1, 2, -1}}, {"Directional", cols[[3]],
50 {-2, -1, -1}}, {"Ambient", cols[[-1]]}}],
{t, 0, 1}]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=proj14q.gif&userId=610054
[2]: http://community.wolfram.com/groups/-/m/t/1263478
[3]: http://community.wolfram.com/groups/-/m/t/1260753Clayton Shonkwiler2018-01-13T19:57:21ZHow to TranslationTransform a VectorPlot3D or a DensityPlot3D object?
http://community.wolfram.com/groups/-/m/t/1265002
Hi,
The question said it all. `Graphics` primitives can be `GeometricTransformed` as the heart desire, and display them with `Graphics` or `Graphics3D`. On the other hand the different available `YourfavoritePlots` are also graphic objects but I see now easy way to move them around. `Translate` and `TranslationTransform` for example does not work on the scalar or vector fields as they are working on graphics primitives. I am wondering if any manipulations of the different fields like translation and rotation is possible for them without doing a `CoordinateTransform`.
In particular I have a vector field fixed to the origo. I would like it to be fixed to the `{x0,y0,z0} != {0,0,0}` point. Simply by adding `{x0,y0,z0}` to the vector field does not give the desired result.
Thanks ahead,
JánosJanos Lobb2018-01-13T01:26:57ZHow to build a function? (as it is understood by a programmer)
http://community.wolfram.com/groups/-/m/t/1264310
I am a beginner. I keep running into the same problem over and over. Please, consider this code:
P[N_Integer, p_] = BinomialDistribution[N,p];
Y[D_] = Expectation[x, x\[Distributed]P[D,0.5]];
DiscretePlot[Y[x], {x, 0, 20}, ExtentSize -> 0.8]
All I need is to plot expected value of BinomialDistribution[x,0.5] where x is in [0,20] range. But because the way symbolic substitution works -- this code fails (because I used `x` as parameter in both `DiscretePlot` invocation and `Y` definition).
How should I rewrite this code in such way that in `DiscretePlot` I don't need to care about parameter names used by `Y` (or any other symbols/definitions it may depends on)? Should I use CompileFunction?
Thank you.Michael Kilburn2018-01-12T08:45:43ZFrom Mathcad to Wolfram Language?
http://community.wolfram.com/groups/-/m/t/1253294
I am having trouble staying in one screen while working in Wolfram. Generally I prepare a CAS document (called workbooks) in Mathcad with a rough draft, formulas, variable definitions, code and a graph. Then of course we want to pretty the thing up like it all appears on the page of a Calculus book.. Colorful, little text regions, moving things around and resizing. In Mathcad this is so simple and much like photo shop and image cropping and PowerPoint slides. It is mostly just point, drag, clip, fill, stretch and what not. You do have to be careful of hierarchy and order. You can actual drag a small definition just a little to far up in a worksheet and get a syntax error because it will not be calculated in the order of left to right and down. In Wolfram I see the cell formats and text formats . . .****all the way across the screen**** with apparently no way to drag a graph or picture into this block of only code. Everything in wolfram seems to just propagates another line of code that keeps going down and to the left margin. This leaves a lot of blank document / screen space to the upper right. ESPECIALLY when working with graphs. There are many cool options available and I find it somewhat easy to learn (so far) but with every click of the mouse at each option chosen ANOTHER graph appears . . .in another line . . .again down to the left. By the time I get to he graph that I want I have to go back and erase about fifteen others up the page . . .again trying to make use of the whole screen. Why can I not make changes, choose options, and keep operating in the same graph?
.rogerwells2017 Wells2017-12-24T13:26:21ZWhy does the code not work?
http://community.wolfram.com/groups/-/m/t/1264549
I am trying to derive the equations of motion for the double pendulum and then solve and plot it. Unfortunately, it does not work. Any suggestions?
Remove[l1, l2, m1, m2, g]
x1 = l1*Sin[\[Theta]1[t]];
x1' = D[x1, t];
y1 = -l1*Cos[\[Theta]1[t]];
y1' = D[y1, t];
x2 = l2*Sin[\[Theta]2[t]] + x1;
x2' = D[x2, t];
y2 = -l2*Cos[\[Theta]2[t]] + y1;
y2' = D[y2, t];
V = m1*g*y1 + m2*g*y2;
T = m1/2*(x1' + y1')^2 + m2*(x2' + y2')^2;
Lagrange = T - V;
eqs = D[D[Lagrange, \[Theta]'], t] - D[Lagrange, \[Theta]];
sol = NDSolve[{eqs == 0, \[Theta]1[0] = Pi, \[Theta]2[0] =
Pi, \[Theta]1'[0] = 0, \[Theta]2'[0] =
0}, {\[Theta]1, \[Theta]2}, {t, 0, 10}];
l1 = 1;
l2 = 1;
g = 9.81;
m1 = 1;
m2 = 1;
Plot[{\[Theta]1, \[Theta]2}, {t, 0, 10}]Jonas Hamp2018-01-12T18:00:07ZHow can I compile incomplete gamma function with C code?
http://community.wolfram.com/groups/-/m/t/1264577
Can I compile the Mathmatica incomplete gamma function Gamma(a,z), which accepts complex number with C code?Zhe Shen2018-01-12T18:18:46Z[Numberphile] - The Square-Sum Problem
http://community.wolfram.com/groups/-/m/t/1264240
As part of my Numberphile series of posts:
- [\[Numberphile\] - Frog Jumping - Solving the puzzle][1]
- [\[Numberphile\] - The Illumination Problem][2]
- [\[Numberphile\] - Sandpiles - Done in the Wolfram Language][3]
here is another one about a recent video called [The Square-Sum Problem][4]
[![enter image description here][5]][6]
The question is: if you have the integers 1 through n, can you arrange that list in such a way that every two adjacent ones sum to a square number. As seen in the video and the [extra footage][7].
We can easily check this in the Wolfram Language:
Let's see which number can pair up to a pair:
SquareEdges[n_Integer?Positive]:=Reap[Do[If[IntegerQ[Sqrt[i+j]],Sow[{i,j}]],{i,n-1},{j,i+1,n}]][[2,1]]
Now let's try for 15, as in the main video:
n = 15;
poss = SquareEdges[n];
gr = Graph[TwoWayRule @@@ poss, VertexLabels -> Automatic];
path = FindHamiltonianPath[gr, PerformanceGoal :> "Speed"]
HighlightGraph[gr, BlockMap[Rule @@ # &, path, 2, 1]]
giving:
{9, 7, 2, 14, 11, 5, 4, 12, 13, 3, 6, 10, 15, 1, 8}
![enter image description here][8]
In the extra footage, it is revealed that they found the solution for up to n=299. Can we do better? Yes we can! Changing n to 300 in the above code and rerunning gives us the solution in 0.28 sec on my laptop.
{289,35,65,259,30,294,67,257,32,292,69,100,44,125,71,154,135,189,211,113,248,8,281,119,205,195,166,158,283,6,250,191,133,156,285,4,252,277,12,244,117,207,193,168,273,16,240,160,164,236,20,269,131,94,230,59,197,92,232,57,199,90,234,22,267,217,224,137,152,73,123,46,150,75,121,48,148,77,179,110,214,270,19,237,163,161,239,17,272,128,41,103,297,27,262,62,227,97,99,190,210,114,175,50,146,79,177,112,212,188,253,3,286,155,134,266,23,233,91,198,58,231,93,196,60,229,95,130,159,165,276,13,243,118,206,194,167,274,15,241,288,1,255,186,138,223,218,143,181,108,88,201,55,170,86,203,53,172,84,37,107,182,142,299,25,264,220,221,140,184,216,225,64,36,85,171,54,202,87,169,56,200,89,235,21,268,132,157,284,5,251,278,11,245,116,208,192,249,7,282,247,9,280,204,120,136,153,72,124,45,151,74,122,47,149,76,180,109,215,185,139,222,219,265,24,300,141,183,106,38,83,173,52,144,81,40,104,296,28,261,63,226,98,127,42,102,298,26,263,61,228,96,129,271,18,238,162,279,10,246,115,209,275,14,242,287,2,254,187,213,111,178,78,147,49,176,80,145,51,174,82,39,105,295,29,260,101,43,126,70,291,33,256,68,293,31,258,66,34,290}
and a completely mess of a graph:
![enter image description here][9]
Can we go beyond? Let's optimize a code a bit, and let's find the solution for larger n:
Let's store our intermediate results in the association **db**:
SetDirectory[NotebookDirectory[]];
$HistoryLength=1;
db=If[FileExistsQ["squaresumdb.mx"],
Import["squaresumdb.mx"]
,
<||>
];
And now our main code:
ClearAll[SquareEdges,SquareEdges2,CheckSol,TryToFind]
SquareEdges[n_Integer?Positive]:=Reap[Do[If[IntegerQ[Sqrt[i+j]],Sow[{i,j}]],{i,n-1},{j,i+1,n}]][[2,1]]
SquareEdges2[n_Integer]:=Module[{tmp},
tmp=Table[
{i,#}&/@(Range[Ceiling[Sqrt[2 i]],Floor[Sqrt[i+n]]]^2-i)
,
{i,1,n-1}
];
tmp=Join@@tmp;
Select[tmp,Less@@#&]
]
CheckSol[l_List]:=Sort[l]===Range[Length[l]]\[And](And@@BlockMap[IntegerQ@*Sqrt@*Total,l,2,1])
TryToFind[n_Integer?Positive]:=Module[{edges,out},
If[!KeyExistsQ[db,n],
edges=SquareEdges2[n];
If[Union[Flatten[edges]]===Range[n],
edges=TwoWayRule@@@edges;
edges=RandomSample[edges];
Do[
out=TimeConstrained[FindHamiltonianPath[Graph[edges],PerformanceGoal:>"Speed"],5+i,$Failed];
If[out=!=$Failed,
If[Length[out]==0,
Print[Style["No solution for ",Red],n];
,
status=Row[{"Found solution for ",n,":",i}];
];
AssociateTo[db,n->out];
Break[]
];
Print["Failed ",n,":",i];
edges=RandomSample[edges];
,
{i,5}
]
,
Print["Edges are not connected for ",n];
AssociateTo[db,n->{}]
]
]
]
Let's scan the first 1000:
Dynamic[status]
status = "";
Do[TryToFind[k], {k, 3, 1000}]
Export["squaresumdb.mx", db];
Note that if finding the Hamiltonian path takes too long I mix the edges and try again, sometimes, seemingly random, it then finds the solution quickly.
I can tell you now that all of them have a solution. In fact I went up to larger numbers and found that all up to 2667 have a solution, and possibly beyond. I attached the notebook and the solutions in form of a mx file.
[1]: http://community.wolfram.com/groups/-/m/t/1055504
[2]: http://community.wolfram.com/groups/-/m/t/1048489
[3]: http://community.wolfram.com/groups/-/m/t/1058615
[4]: https://www.youtube.com/watch?v=G1m7goLCJDY
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-11at23.36.51.png&userId=73716
[6]: https://www.youtube.com/watch?v=G1m7goLCJDY
[7]: https://www.youtube.com/watch?v=7_ph5djCCnM
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-11at23.43.52.png&userId=73716
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-11at23.46.51.png&userId=73716Sander Huisman2018-01-11T23:29:05Z[GIF] Fall Out (Rotating circle on the projective plane)
http://community.wolfram.com/groups/-/m/t/1239487
![Rotating circle on the projective plane][1]
_Fall Out_
This was a result of various experiments mapping from the sphere to the plane.
In this case, I'm taking a circle of disks on the sphere, then mapping to the plane by the following map: each point on the sphere (except those on the equator) is sent to the point on the $z=1$ plane lying on the same line through the origin (this map arises as a way of identifying [most of] the projective plane with an actual plane). Then, apply the inversion in the unit circle $z \mapsto \frac{z}{|z|^2}$.
The circle on the sphere is the orbit of the point $p = (0,1/2,\sqrt{3}/2)$ under rotations around $(\cos s, 0 \sin s)$. Here $s$ is treated as the time parameter and varies from $0$ to $\pi$.
Here's the code:
inversion[p_] := p/Norm[p]^2;
With[{n = 141, d = .01, p = {0, 1/2, Sqrt[3]/2},
b = NullSpace[{N[{0, 1/2, Sqrt[3]/2}]}],
cols = {Black, GrayLevel[.95]}},
Manipulate[
Graphics[
{PointSize[.01], cols[[1]],
Polygon /@
Table[inversion[#1[[1 ;; 2]]/#1[[3]]]
&[RotationMatrix[t, {Cos[s], 0, Sin[s]}].(Cos[d] p + Sin[d] (Cos[θ] b[[1]] + Sin[θ] b[[2]]))],
{t, 0., 2 π, 2 π/n}, {θ, 0., 2 π - 2 π/20, 2 π/20}]},
PlotRange -> 4, ImageSize -> 540, Background -> cols[[-1]]],
{s, 0., π}]]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=dots4.gif&userId=610054Clayton Shonkwiler2017-12-05T05:25:23ZCorrect format for NetChain
http://community.wolfram.com/groups/-/m/t/1262168
I am trying to create a simple neural network with one hidden layer to recognise hand written characters from the MNIST training set. I would like my hidden layer to be an ElementwiseLayer[LogisticSigmoid] with 30 neurons. I would have expected the syntax for a linear layer to be
NetChain[{LinearLayer[30]},
"Input" -> NetEncoder[{"Image", {28, 28}, "Grayscale"}],
"Output" -> NetDecoder[{"Class", Range[0, 9]}]]
But this generates the error
"Specification NetDecoder[Class, ...]) is not compatible with port "Output", which must be a length-30 vector"
Does anyone have an idea what the correct syntax is to achieve what I want?
ThanksLenny Johnson2018-01-09T14:06:02Z[GIF] Microcosm (Stereographic projection of cube grid)
http://community.wolfram.com/groups/-/m/t/1225032
![Stereographic projection of cube grid][1]
**Microcosm**
This is conceptually very simple: take a $7 \times 7$ grid of unit cubes in space, normalize to the unit sphere, stereographically project to the plane, then apply a rotation to the original grid of cubes. Here's the code:
Stereo[p_] := 1/(1 - p[[-1]]) p[[;; 2]];
With[{n = 3, cols = RGBColor /@ {"#4EEAF6", "#291F71"}},
Manipulate[
Graphics[
{Opacity[.5], CapForm[None], cols[[1]], Thickness[.006],
Line[
Flatten[
Transpose[
Table[
Stereo[Normalize[#]] & /@
{{t,
y Cos[θ] - z Sin[θ],
z Cos[θ] + y Sin[θ]},
{y, t Cos[θ] - z Sin[θ],
z Cos[θ] + t Sin[θ]},
{y, z Cos[θ] - t Sin[θ],
t Cos[θ] + z Sin[θ]}},
{z, -n - 1/2, n + 1/2}, {y, -n - 1/2, n + 1/2}, {t, -n - 1/2.,
n + 1/2, 1/20}],
{2, 3, 4, 1, 5}],
2]
]
},
PlotRange -> 1, Axes -> False, ImageSize -> 540, Background -> cols[[-1]]],
{θ, 0, π/2}]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=rotateStereo12c.gif&userId=610054Clayton Shonkwiler2017-11-20T05:51:30ZThe Great conversation in USA presidential speeches
http://community.wolfram.com/groups/-/m/t/1253836
# Introduction
This document shows a way to chart in Mathematica / WL the evolution of topics in collections of texts.
The making of this document (and related code) is primarily motivated by the fascinating concept of the [Great Conversation](https://en.wikipedia.org/wiki/Great_Conversation), [[Wk1](https://en.wikipedia.org/wiki/Great_Conversation), MA1].
In brief, all western civilization books are based on $103$ great ideas; if we find the great ideas each significant book is based on we can construct a time-line (spanning centuries) of the great conversation between the authors; see [MA1, MA2, MA3].
Instead of finding the great ideas in a text collection we extract topics statistically, using dimension reduction with [Non-Negative Matrix Factorization (NNMF)](https://en.wikipedia.org/wiki/Non-negative_matrix_factorization), [[AAp3](https://github.com/antononcube/MathematicaForPrediction/blob/master/NonNegativeMatrixFactorization.m), [AA1](https://github.com/antononcube/MathematicaForPrediction/blob/master/Documentation/Topic%20and%20thesaurus%20extraction%20from%20a%20document%20collection.pdf), [AA2](https://mathematicaforprediction.wordpress.com/2013/10/15/statistical-thesaurus-from-npr-podcasts/)].
The presented computational results are based on the text collections of State of the Union speeches of USA presidents \[D2\].
The code in this document can be easily configured to use the much smaller text collection [[D1](https://resources.wolframcloud.com/DataRepository/resources/Presidential%2BNomination%2BAcceptance%2BSpeeches)] available online and in Mathematica/WL.
(The collection [[D1](https://resources.wolframcloud.com/DataRepository/resources/Presidential%2BNomination%2BAcceptance%2BSpeeches)] is fairly small, $51$ documents; the collection [D2] is much larger, $2453$ documents.)
The procedures (and code) described in this document, of course, work on other types of text collections.
For example: movie reviews, podcasts, editorial articles of a magazine, etc.
A secondary objective of this document is to illustrate the use of the monadic programming pipeline as a [Software design pattern](https://en.wikipedia.org/wiki/Software_design_pattern), [[AA3](https://github.com/antononcube/MathematicaForPrediction/blob/master/MarkdownDocuments/Monad-code-generation-and-extension.md)].
In order to make the code concise in this document I wrote the package [MonadicLatentSemanticAnalysis.m](https://github.com/antononcube/MathematicaForPrediction/blob/master/MonadicProgramming/MonadicLatentSemanticAnalysis.m), [[AAp5](https://github.com/antononcube/MathematicaForPrediction/blob/master/MonadicProgramming/MonadicLatentSemanticAnalysis.m)].
Compare with the code given in [[AA1](https://github.com/antononcube/MathematicaForPrediction/blob/master/Documentation/Topic%20and%20thesaurus%20extraction%20from%20a%20document%20collection.pdf)].
The very first version of this document was written for the 2017 summer course ["Data Science for the Humanities"](http://www.dhoxss.net/datascienceforhumanities) at the University of Oxford, UK.
# Outline of the procedure applied
The procedure described in this document has the following steps.
1. Get a collection of documents with known dates of publishing.
- Or other types of tags associated with the documents.
2. Do preliminary analysis of the document collection.
- Number of documents; number of unique words.
- Number of words per document; number of documents per word.
- (Some of the statistics of this step are done easier after the Linear vector space representation step.)
3. Optionally perform Natural Language Processing (NLP) tasks.
1. Obtain or derive [stop words](https://en.wikipedia.org/wiki/Stop_words).
2. Remove stop words from the texts.
3. Apply [stemming](https://en.wikipedia.org/wiki/Stemming) to the words in the texts.
4. Linear vector space representation.
- This means that we represent the collection with a document-word matrix.
- Each unique word is a basis vector in that space.
- For each document the corresponding point in that space is derived from the number of appearances of document's words.
5. Extract topics.
- In this document [NNMF](https://en.wikipedia.org/wiki/Non-negative_matrix_factorization) is used.
- In order to obtain better results with NNMF some experimentation and refinements of the topics search have to be done.
6. Map the documents over the extracted topics.
- The original matrix of the vector space representation is replaced with a matrix with columns representing topics (instead of words.)
7. Order the topics according to their presence across the years (or other related tags).
- This can be done with hierarchical clustering.
- Alternatively,
1. for a given topic find the weighted mean of the years of the documents that have that topic, and
2. order the topics according to those mean values.
8. Visualize the evolution of the documents according to their topics.
1. This can be done by simply finding the contingency matrix year vs topic.
2. For the president speeches we can use the president names for time-line temporal axis instead of years.
+ Because the corresponding time intervals of president office occupation do not overlap.
**Remark:** Some of the functions used in this document combine several steps into one function call (with corresponding parameters.)
# Packages
This loads the packages [AAp1-AAp8]:
Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/MonadicProgramming/MonadicLatentSemanticAnalysis.m"];
Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/MonadicProgramming/MonadicTracing.m"]
Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/Misc/HeatmapPlot.m"];
Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/Misc/RSparseMatrix.m"];
(Note that some of the packages that are imported automatically by [[AAp5](https://github.com/antononcube/MathematicaForPrediction/blob/master/MonadicProgramming/MonadicLatentSemanticAnalysis.m)].)
The functions of the central package in this document, [[AAp5](https://github.com/antononcube/MathematicaForPrediction/blob/master/MonadicProgramming/MonadicLatentSemanticAnalysis.m)], have the prefix "LSAMon". Here is a sample of those names:
Short@Names["LSAMon*"]
(* {"LSAMon", "LSAMonAddToContext", "LSAMonApplyTermWeightFunctions", <<27>>, "LSAMonUnit", "LSAMonUnitQ", "LSAMonWhen"} *)
# Data load
In this section we load a text collection from a specified source.
The text collection from ["Presidential Nomination Acceptance Speeches"](https://resources.wolframcloud.com/DataRepository/resources/Presidential%2BNomination%2BAcceptance%2BSpeeches), [D1], is small and can be used for multiple code verifications and re-runnings. The "State of Union addresses of USA presidents" text collection from [D2] was converted to a Mathematica/WL object by Christopher Wolfram (and sent to me in a private communication.) The text collection [D2] provides far more interesting results (and they are shown below.)
If[True,
speeches = ResourceData[ResourceObject["Presidential Nomination Acceptance Speeches"]];
names = StringSplit[Normal[speeches[[All, "Person"]]][[All, 2]], "::"][[All, 1]],
(*ELSE*)
(*State of the union addresses provided by Christopher Wolfram. *)
Get["~/MathFiles/Digital humanities/Presidential speeches/speeches.mx"];
names = Normal[speeches[[All, "Name"]]];
];
dates = Normal[speeches[[All, "Date"]]];
texts = Normal[speeches[[All, "Text"]]];
Dimensions[speeches]
(* {2453, 4} *)
# Basic statistics for the texts
Using different [contingency matrices](https://en.wikipedia.org/wiki/Contingency_table) we can derive basic statistical information about the document collection. (The document-word matrix is a contingency matrix.)
First we convert the text data in long-form:
docWordRecords =
Join @@ MapThread[
Thread[{##}] &, {Range@Length@texts, names,
DateString[#, {"Year"}] & /@ dates,
DeleteStopwords@*TextWords /@ ToLowerCase[texts]}, 1];
Here is a sample of the rows of the long-form:
GridTableForm[RandomSample[docWordRecords, 6],
TableHeadings -> {"document index", "name", "year", "word"}]
[!["Speeches-words-long-form-rows-sample"](https://imgur.com/3a1hoLzl.png)](https://imgur.com/3a1hoLz.png)
![enter image description here][1]
Here is a summary:
Multicolumn[
RecordsSummary[docWordRecords, {"document index", "name", "year", "word"}, "MaxTallies" -> 8], 4, Dividers -> All, Alignment -> Top]
[!["summary"][2]](https://imgur.com/ASBFWQ6.png)
Using the long form we can compute the document-word matrix:
ctMat = CrossTabulate[docWordRecords[[All, {1, -1}]]];
MatrixPlot[Transpose@Sort@Map[# &, Transpose[ctMat@"XTABMatrix"]],
MaxPlotPoints -> 300, ImageSize -> 800,
AspectRatio -> 1/3]
[!["USA-presidents-speeches-doc-vs-term-contingency-matrix"](https://imgur.com/k9vTR1Ml.png)](https://imgur.com/k9vTR1M.png)
![enter image description here][3]
Here is the president-word matrix:
ctMat = CrossTabulate[docWordRecords[[All, {2, -1}]]];
MatrixPlot[Transpose@Sort@Map[# &, Transpose[ctMat@"XTABMatrix"]], MaxPlotPoints -> 300, ImageSize -> 800, AspectRatio -> 1/3]
[!["USA-presidents-speeches-president-vs-term-contingency-matrix"](https://imgur.com/2MLCq7pl.png)](https://imgur.com/2MLCq7p.png)
![enter image description here][4]
Here is an alternative way to compute text collection statistics through the document-word matrix computed within the monad `LSAMon`:
LSAMonUnit[texts]⟹LSAMonEchoTextCollectionStatistics[];
[!["USA-presidents-speeches-LSAMonEchoTextCollectionStatistics"](https://imgur.com/8c48rxtl.png)](https://imgur.com/8c48rxt)
![enter image description here][5]
# Procedure application
## Stop words
Here is one way to obtain [stop words](https://en.wikipedia.org/wiki/Stop_words):
stopWords = Complement[DictionaryLookup["*"], DeleteStopwords[DictionaryLookup["*"]]];
Length[stopWords]
RandomSample[stopWords, 12]
(* 304 *)
(* {"has", "almost", "next", "WHO", "seeming", "together", "rather", "runners-up", "there's", "across", "cannot", "me"} *)
We can complete this list with additional stop words derived from the collection itself. (Not done here.)
## Linear vector space representation and dimension reduction
**Remark:** In the rest of the document we use "term" to mean "word" or "stemmed word".
The following code makes a document-term matrix from the document collection, exaggerates the representations of the terms using ["TF-IDF"](https://en.wikipedia.org/wiki/Tfâidf), and then does topic extraction through dimension reduction. The dimension reduction is done with [NNMF](https://en.wikipedia.org/wiki/Non-negative_matrix_factorization); see [[AAp3](https://github.com/antononcube/MathematicaForPrediction/blob/master/NonNegativeMatrixFactorization.m), [AA1](https://github.com/antononcube/MathematicaForPrediction/blob/master/Documentation/Topic%20and%20thesaurus%20extraction%20from%20a%20document%20collection.pdf), [AA2](https://mathematicaforprediction.wordpress.com/2013/10/15/statistical-thesaurus-from-npr-podcasts/)].
SeedRandom[312]
mObj =
LSAMonUnit[texts]⟹
LSAMonMakeDocumentTermMatrix[{}, stopWords]⟹
LSAMonApplyTermWeightFunctions[]⟹
LSAMonTopicExtraction[Max[5, Ceiling[Length[texts]/100]], 60, 12, "MaxSteps" -> 6, "PrintProfilingInfo" -> True];
This table shows the pipeline commands above with comments:
[!["LSAMon-sample-pineline"](https://imgur.com/cX2S5EF.png)](https://imgur.com/cX2S5EF.png)
![enter image description here][6]
### Detailed description
The monad object `mObj` has a context of named values that is an Association with the following keys:
Keys[mObj⟹LSAMonTakeContext]
(* {"texts", "docTermMat", "terms", "wDocTermMat", "W", "H", "topicColumnPositions", "automaticTopicNames"} *)
Let us clarify the values by briefly describing the computational steps.
1. From texts we derive the document-term matrix $\text{docTermMat}\in \mathbb{R}^{m \times n}$, where $n$ is the number of documents and $m$ is the number of terms.
- The terms are words or stemmed words.
- This is done with `LSAMonMakeDocumentTermMatrix`.
2. From `docTermMat` is derived the (weighted) matrix wDocTermMat using ["TF-IDF"](https://en.wikipedia.org/wiki/Tfâidf).
- This is done with `LSAMonApplyTermWeightFunctions`.
3. Using `docTermMat` we find the terms that are present in sufficiently large number of documents and their column indices are assigned to topicColumnPositions.
4. Matrix factorization.
1. Assign to $\text{wDocTermMat}[[\text{All},\text{topicsColumnPositions}]]$, $\text{wDocTermMat}[[\text{All},\text{topicsColumnPositions}]]\in \mathbb{R}^{m_1 \times n}$, where $m_1 = |topicsColumnPositions|$.
2. Compute using NNMF the factorization $\text{wDocTermMat}[[\text{All},\text{topicsColumnPositions}]]\approx H W$, where $W\in \mathbb{R}^{k \times n}$, $H\in \mathbb{R}^{k \times m_1}$, and $k$ is the number of topics.
3. The values for the keys "W, "H", and "topicColumnPositions" are computed and assigned by `LSAMonTopicExtraction`.
5. From the top terms of each topic are derived automatic topic names and assigned to the key `automaticTopicNames` in the monad context.
- Also done by `LSAMonTopicExtraction`.
## Statistical thesaurus
At this point in the object `mObj` we have the factors of NNMF. Using those factors we can find a statistical thesaurus for a given set of words. The following code calculates such a thesaurus, and echoes it in a tabulated form.
queryWords = {"arms", "banking", "economy", "education", "freedom",
"tariff", "welfare", "disarmament", "health", "police"};
mObj⟹
LSAMonStatisticalThesaurus[queryWords, 12]⟹
LSAMonEchoStatisticalThesaurus[];
[!["USA-presidents-speeches-statistical-thesaurus"](https://imgur.com/bTPrbfJ.png)](https://imgur.com/bTPrbfJ.png)
![enter image description here][7]
By observing the thesaurus entries we can see that the words in each entry are semantically related.
Note, that the word "welfare" strongly associates with "[applause]". The rest of the query words do not, which can be seen by examining larger thesaurus entries:
thRes =
mObj⟹
LSAMonStatisticalThesaurus[queryWords, 100]⟹
LSAMonTakeValue;
Cases[thRes, "[applause]", Infinity]
(* {"[applause]", "[applause]"} *)
The second "[applause]" associated word is "education".
### Detailed description
The statistical thesaurus is computed by using the NNMF's right factor $H$.
For a given term, its corresponding column in $H$ is found and the nearest neighbors of that column are found in the space $\mathbb{R}^{m_1}$ using Euclidean norm.
## Extracted topics
The topics are the rows of the right factor $H$ of the factorization obtained with NNMF .
Let us tabulate the topics found above with `LSAMonTopicExtraction` :
mObj⟹ LSAMonEchoTopicsTable["NumberOfTerms" -> 6, "MagnificationFactor" -> 0.8, Appearance -> "Horizontal"];
[!["USA-presidents-speeches-topics"](https://imgur.com/SvjWjQol.png)](https://imgur.com/SvjWjQo.png)
![enter image description here][8]
## Map documents over the topics
The function `LSAMonTopicsRepresentation` finds the top outliers for each row of NNMF's left factor $W$. (The outliers are found using the package [[AAp4](https://github.com/antononcube/MathematicaForPrediction/blob/master/OutlierIdentifiers.m)].) The obtained list of indices gives the topic representation of the collection of texts.
Short@(mObj⟹LSAMonTopicsRepresentation[]⟹LSAMonTakeContext)["docTopicIndices"]
{{53}, {47, 53}, {25}, {46}, {44}, {15, 42}, {18}, <<2439>>, {30}, {33}, {7, 60}, {22, 25}, {12, 13, 25, 30, 49, 59}, {48, 57}, {14, 41}}
Further we can see that if the documents have tags associated with them -- like author names or dates -- we can make a contingency matrix of tags vs topics. (See [[AAp8](https://github.com/antononcube/MathematicaForPrediction/blob/master/CrossTabulate.m), [AA4](https://mathematicaforprediction.wordpress.com/2016/10/04/contingency-tables-creation-examples/)].)
This is also done by the function `LSAMonTopicsRepresentation` that takes tags as an argument. If the tags argument is `Automatic`, then the tags are simply the document indices.
Here is a an example:
rsmat = mObj⟹LSAMonTopicsRepresentation[Automatic]⟹LSAMonTakeValue;
MatrixPlot[rsmat]
[!["USA-presidents-speeches-document-vs-topic-contigency-matrix-plot"](https://imgur.com/y8ezXJzl.png)](https://imgur.com/y8ezXJz.png)
![enter image description here][9]
Here is an example of calling the function LSAMonTopicsRepresentation with arbitrary tags.
rsmat = mObj⟹LSAMonTopicsRepresentation[DateString[#, "MonthName"] & /@ dates]⟹LSAMonTakeValue;
MatrixPlot[rsmat]
[!["USA-presidents-speeches-dateMonth-vs-topic-contigency-matrix-plot"](https://imgur.com/0TZYBnM.png)](https://imgur.com/0TZYBnM.png)
![enter image description here][10]
Note that the matrix plots above are very close to the charting of the Great conversation that we are looking for. This can be made more obvious by observing the row names and columns names in the tabulation of the transposed matrix `rsmat`:
Magnify[#, 0.6] &@MatrixForm[Transpose[rsmat]]
[!["USA-presidents-speeches-dateMonth-vs-topic-contigency-matrix-form"](https://imgur.com/iZFngoil.png)](https://imgur.com/iZFngoi.png)
![enter image description here][11]
# Charting the great conversation
In this section we show several ways to chart the Great Conversation in the collection of speeches.
There are several possible ways to make the chart: using a time-line plot, using heat-map plot, and using appropriate tabulation (with `MatrixForm` or `Grid`).
In order to make the code in this section more concise the package [RSparseMatrix.m](https://github.com/antononcube/MathematicaForPrediction/blob/master/Misc/RSparseMatrix.m), \[[AAp7](https://github.com/antononcube/MathematicaForPrediction/blob/master/Misc/RSparseMatrix.m), [AA5](https://mathematicaforprediction.wordpress.com/2015/10/08/rsparsematrix-for-sparse-matrices-with-named-rows-and-columns/)\], is used.
## Topic name to topic words
This command makes an Association between the topic names and the top topic words.
aTopicNameToTopicTable =
AssociationThread[(mObj⟹LSAMonTakeContext)["automaticTopicNames"],
mObj⟹LSAMonTopicsTable["NumberOfTerms" -> 12]⟹LSAMonTakeValue];
Here is a sample:
Magnify[#, 0.7] &@ aTopicNameToTopicTable[[1 ;; 3]]
[!["USA-presidents-speeches-topic-name-to-topic-words-sample"](https://imgur.com/HRanSAEl.png)](https://imgur.com/HRanSAE.png)
![enter image description here][12]
## Time-line plot
This command makes a contingency matrix between the documents and the topics (as described above):
rsmat = ToRSparseMatrix[mObj⟹LSAMonTopicsRepresentation[Automatic]⟹LSAMonTakeValue]
This time-plot shows great conversation in the USA presidents state of union speeches:
TimelinePlot[
Association@
MapThread[
Tooltip[#2, aTopicNameToTopicTable[#2]] -> dates[[ToExpression@#1]] &,
Transpose[RSparseMatrixToTriplets[rsmat]]],
PlotTheme -> "Detailed", ImageSize -> 1000, AspectRatio -> 1/2, PlotLayout -> "Stacked"]
[!["USA-presidents-speeches-great-conversation-time-line-plot-large"](https://imgur.com/RNVLsVIl.png)](https://imgur.com/RNVLsVI.png)
[![enter image description here][13]](https://imgur.com/RNVLsVI.png)
The plot is too cluttered, so it is a good idea to investigate other visualizations.
## Heatmap of topic vs president
We can use the USA president names instead of years in the Great Conversation chart because the USA presidents terms do not overlap.
This makes a contingency matrix presidents vs topics:
rsmat2 = ToRSparseMatrix[
mObj⟹LSAMonTopicsRepresentation[
names]⟹LSAMonTakeValue];
Here we compute the chronological order of the presidents based on the dates of their speeches:
nameToMeanYearRules =
Map[#[[1, 1]] -> Mean[N@#[[All, 2]]] &,
GatherBy[MapThread[List, {names, ToExpression[DateString[#, "Year"]] & /@ dates}], First]];
ordRowInds = Ordering[RowNames[rsmat2] /. nameToMeanYearRules];
This heat-map plot uses the (experimental) package [HeatmapPlot.m](https://github.com/antononcube/MathematicaForPrediction/blob/master/Misc/HeatmapPlot.m), \[[AAp6](https://github.com/antononcube/MathematicaForPrediction/blob/master/Misc/HeatmapPlot.m)\]:
Block[{m = rsmat2[[ordRowInds, All]]},
HeatmapPlot[SparseArray[m], RowNames[m],
Thread[Tooltip[ColumnNames[m], aTopicNameToTopicTable /@ ColumnNames[m]]],
DistanceFunction -> {None, Sort}, ImageSize -> 1000,
AspectRatio -> 1/2]
]
[!["USA-presidents-speeches-great-conversation-heatmap"](https://imgur.com/xJvddq3l.png)](https://imgur.com/xJvddq3.png)
[![enter image description here][14]](https://imgur.com/xJvddq3.png)
Note the value of the option `DistanceFunction`: there is not re-ordering of the rows and columns are reordered by sorting. Also, the topics on the horizontal names have tool-tips.
# References
## Text data
\[D1\] Wolfram Data Repository, ["Presidential Nomination Acceptance Speeches"](https://resources.wolframcloud.com/DataRepository/resources/Presidential%2BNomination%2BAcceptance%2BSpeeches).
\[D2\] US Presidents, [State of the Union Addresses](https://books.google.com/books?id=eRRYCwAAQBAJ), Trajectory, 2016. ISBN1681240009, 9781681240008.
\[D3\] Gerhard Peters, ["Presidential Nomination Acceptance Speeches and Letters, 1880-2016"](http://www.presidency.ucsb.edu/nomination.php), [The American Presidency Project](http://www.presidency.ucsb.edu/index.php).
\[D4\] Gerhard Peters, ["State of the Union Addresses and Messages"](http://www.presidency.ucsb.edu/sou.php), [The American Presidency Project](http://www.presidency.ucsb.edu/index.php).
## Packages
\[AAp1\] Anton Antonov, [MathematicaForPrediction utilities ](https://github.com/antononcube/MathematicaForPrediction/blob/master/MathematicaForPredictionUtilities.m)*[Mathematica ](https://github.com/antononcube/MathematicaForPrediction/blob/master/MathematicaForPredictionUtilities.m)*[package](https://github.com/antononcube/MathematicaForPrediction/blob/master/MathematicaForPredictionUtilities.m), (2014), [MathematicaForPrediction at GitHub.](https://github.com/antononcube/MathematicaForPrediction)
\[AAp2\] Anton Antonov, [Implementation of document-term matrix construction and re-weighting functions in Mathematica](https://github.com/antononcube/MathematicaForPrediction/blob/master/DocumentTermMatrixConstruction.m)[, ](https://github.com/antononcube/MathematicaForPrediction/blob/master/MathematicaForPredictionUtilities.m)(2013), [MathematicaForPrediction at GitHub.](https://github.com/antononcube/MathematicaForPrediction)
\[AAp3\] Anton Antonov, [Implementation of the Non-Negative Matrix Factorization algorithm in Mathematica](https://github.com/antononcube/MathematicaForPrediction/blob/master/NonNegativeMatrixFactorization.m), (2013), [MathematicaForPrediction at GitHub.](https://github.com/antononcube/MathematicaForPrediction)
\[AAp4\] Anton Antonov, [Implementation of one dimensional outlier identifying algorithms in Mathematica](https://github.com/antononcube/MathematicaForPrediction/blob/master/OutlierIdentifiers.m), (2013), [MathematicaForPrediction at GitHub](https://github.com/antononcube/MathematicaForPrediction).
\[AAp5\] Anton Antonov, [Monadic latent semantic analysis Mathematica package](https://github.com/antononcube/MathematicaForPrediction/blob/master/MonadicProgramming/MonadicLatentSemanticAnalysis.m), (2017), [MathematicaForPrediction at GitHub](https://github.com/antononcube/MathematicaForPrediction).
\[AAp6\] Anton Antonov, [Heatmap plot Mathematica package](https://github.com/antononcube/MathematicaForPrediction/blob/master/Misc/HeatmapPlot.m), (2017), [MathematicaForPrediction at GitHub](https://github.com/antononcube/MathematicaForPrediction).
\[AAp7\] Anton Antonov, [RSparseMatrix Mathematica package](https://github.com/antononcube/MathematicaForPrediction/blob/master/Misc/RSparseMatrix.m), (2015), [MathematicaForPrediction at GitHub](https://github.com/antononcube/MathematicaForPrediction).
\[AAp8\] Anton Antonov, [Cross tabulation implementation in Mathematica](https://github.com/antononcube/MathematicaForPrediction/blob/master/CrossTabulate.m), (2017), [MathematicaForPrediction at GitHub.](https://github.com/antononcube/MathematicaForPrediction)
## Books and articles
\[AA1\] Anton Antonov, ["Topic and thesaurus extraction from a document collection"](https://github.com/antononcube/MathematicaForPrediction/blob/master/Documentation/Topic%20and%20thesaurus%20extraction%20from%20a%20document%20collection.pdf), (2013), [MathematicaForPrediction at GitHub](https://github.com/antononcube/MathematicaForPrediction).
\[AA2\] Anton Antonov, ["Statistical thesaurus from NPR podcasts"](https://mathematicaforprediction.wordpress.com/2013/10/15/statistical-thesaurus-from-npr-podcasts/), (2013), [MathematicaForPrediction at WordPress blog](https://mathematicaforprediction.wordpress.com)*.*
\[AA3\] Anton Antonov, ["Monad code generation and extension](https://github.com/antononcube/MathematicaForPrediction/blob/master/MarkdownDocuments/Monad-code-generation-and-extension.md)", (2017), [MathematicaForPrediction at GitHub](https://github.com/antononcube/MathematicaForPrediction)*.*
\[AA4\] Anton Antonov, ["Contingency tables creation examples"](https://mathematicaforprediction.wordpress.com/2016/10/04/contingency-tables-creation-examples/), (2016), [MathematicaForPrediction at WordPress blog](https://mathematicaforprediction.wordpress.com)*.*
\[AA5\] Anton Antonov, ["RSparseMatrix for sparse matrices with named rows and columns"](https://mathematicaforprediction.wordpress.com/2015/10/08/rsparsematrix-for-sparse-matrices-with-named-rows-and-columns/), (2015), [MathematicaForPrediction at WordPress blog](https://mathematicaforprediction.wordpress.com)*.*
\[Wk1\] Wikipedia entry, [Great Conversation](https://en.wikipedia.org/wiki/Great_Conversation).
\[MA1\] Mortimer Adler, "The Great Conversation Revisited," in The Great Conversation: A Peoples Guide to Great Books of the Western World, Encyclopædia Britannica, Inc., Chicago,1990, p. 28.
\[MA2\] Mortimer Adler, ["Great Ideas"](https://www.thegreatideas.org/greatideas1.html).
\[MA3\] Mortimer Adler, ["How to Think About the Great Ideas: From the Great Books of Western Civilization"](https://www.goodreads.com/book/show/136043.How_to_Think_About_the_Great_Ideas), 2000, Open Court.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=3a1hoLz.png&userId=143837
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ASBFWQ6l.png&userId=143837
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=k9vTR1Ml.png&userId=143837
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2MLCq7pl.png&userId=143837
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=8c48rxtl.png&userId=143837
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=cX2S5EF.png&userId=143837
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=bTPrbfJ.png&userId=143837
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=SvjWjQo.png&userId=143837
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=y8ezXJzl.png&userId=143837
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=0TZYBnM.png&userId=143837
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=iZFngoil.png&userId=143837
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=HRanSAEl.png&userId=143837
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=RNVLsVIl.png&userId=143837
[14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=xJvddq3l.png&userId=143837Anton Antonov2017-12-24T18:40:56ZWhy does WL not know that Log[a]-Log[b] is Log[a/b]?
http://community.wolfram.com/groups/-/m/t/1263243
Obviously I am to too stupid to understand WL's symbolic calculations.
I try to explain my question stepwise:
After a ClearAll["Global`*"] I start with some primitive examples:
In[187]:= Simplify[Log[a] - Log[b]]
Out[187]= Log[a] - Log[b]
In[188]:= Simplify[Log[a] - Log[b], Reals]
Out[188]= Log[a] - Log[b]
In[189]:= Simplify[Log[a] - Log[b], b > 0]
Out[189]= Log[a/b]
Only the last one works. But I have to know, that there is some "-Log[b]" within my expression.
Actually I have some unknown expression exp resulting from some former calculations and I have no idea what that expression will be. Say:
In[190]:= exp = Assuming[Reals, Integrate[1/(m x + c), {x, s0, s}]]
Out[190]= ConditionalExpression[(Log[1 + (m s)/c] - Log[1 + (m s0)/c])/m,
s0 > 0 && Re[s] > s0 && s == Re[s]]
BTW: I have no idea, why I get a ConditionalExpression telling something about real parts although I restricted everything to Reals. But this is another problem.
For the moment I just take the first part of exp (which is nonsense in a general case):
In[191]:= exp1 = First[exp]
Out[191]= (Log[1 + (m s)/c] - Log[1 + (m s0)/c])/m
... and Simplify it. Which doesn't change anything of course. Unlike the above primitive a,b-example I do not know the structure of my expression exp1 and hence cannot assume anything apart from being Reals:
In[192]:= Simplify[exp1, Reals]
Out[192]= (Log[1 + (m s)/c] - Log[1 + (m s0)/c])/m
If I knew the result already I could write:
In[193]:= Simplify[exp1, {m s + c > 0, m s0 + c > 0}]
Out[193]= Log[(c + m s)/(c + m s0)]/m
... and get the desired result. But I don't know anything about exp1.
Now I get to my real application. I have some arbitrary symbolic function v(s) and need the definite integral t(s) of 1/v(s) from s0 to s in a simple form. I know that v(s)>0 within the interval [s0,s]. But I do not know, what the structure of v(s) is.
Here a simple example with a straigt line for v(s)
(BTW: Without assuming Reals the Integrate takes an awfull long time):
In[194]:= v[s_] := m s + c;
t1 = Assuming[Reals, Integrate[1/v[x], {x, s0, s}]]
Out[195]= ConditionalExpression[(Log[1 + (m s)/c] - Log[1 + (m s0)/c])/m,
s0 > 0 && Re[s] > s0 && s == Re[s]]
If I assume everything I know, i.e. Reals and v(s)>0 I can write:
In[196]:= v[s_] := m s + c;
t2 = Assuming[{Reals, v[x] > 0}, Integrate[1/v[x], {x, s0, s}]]
Out[197]= ConditionalExpression[(Log[1 + (m s)/c] - Log[1 + (m s0)/c])/m,
s0 > 0 && Re[s] > s0 && s == Re[s]]
... but this doesn't change anything.
**What I need is a result like t = Log[(c+ m s)/(c+m s0)]/m. How could I get this?**Werner Geiger2018-01-10T16:19:27ZMaking a website / GitBook for a Mathematica tutorial
http://community.wolfram.com/groups/-/m/t/1254676
## Building the Tutorial
This is a successor post to [one a few days ago](http://community.wolfram.com/groups/-/m/t/1251138), where I demonstrated how to build websites in the Wolfram Cloud.
A few days ago I remembered a little [tutorial notebook](https://www.wolframcloud.com/objects/b3m2a1/tutorial/MathematicaTutorial.nb) I had written for some friends about a year back and wanted to make it more useable.
I'd also had a conversation with people on the StackExchange where halirutan had suggested linking [interactivity in the tutorial](https://chat.stackexchange.com/transcript/message/41852526#41852526). I don't have the cloud credits (or patience, given the idiosyncrasies of the cloud) to roll an entirely cloud-notebook tutorial, so I decided to use a [different thing I'd played with](https://mathematica.stackexchange.com/a/162305/38205) where I use a sandboxed cloud-notebook in an iframe to add dynamic interactivity.
I decided to chop my tutorial notebook into its different sections and make a page for each subsection. I'd then link each page to the next page via some ID (like 1.1.1 for chapter 1, section 1, page 1) and add a cloud-notebook footer to the template.
To start, though, I needed a theme, so I merged a [W3 template](https://www.w3schools.com/w3css/w3css_templates.asp) and my existing [PacletServer theme](https://github.com/b3m2a1/mathematica-BTools/tree/master/Resources/Themes/PacletServer) to make a new theme with a side-bar and stuff to hold the page index.
The actual process of building the site theme is boring, but it was certainly the most time consuming part of the whole project.
Then I just made a new notebook for each section where I basically just changed the metadata for each, e.g.:
![asddd][1]
And then used the website builder palette I developed to build and deploy my site.
## Actual Site
Now here's the fun part. The actual site lives here: https://www.wolframcloud.com/objects/b3m2a1.testing/tutorial/main.html
![asddd2][2]
This would of course be much nicer [with a better domain name](http://community.wolfram.com/groups/-/m/t/1250055)
I used that ID I mentioned (and which you can see in the notebook metadata) to build in an ordering and then the template builds that out into a proper documentation layout.
You can then click on a any of those pages to read that piece of the tutorial:
![asddd][3]
There's a little thumb that sticks to the bottom of the window which you can click on to open a cloud notebook to test the code snippets in:
![asddd][4]
And clicking on it again will minimize it:
![asddd][5]
This is I think the best feature of the entire enterprise, as it combines the convenience of cloud notebook with the responsiveness of a static site.
Finally, each page has a set of buttons to go to the next / previous topic in the tutorial:
![asddd][6]
The site map lives in the side bar (which is hidden on small screens and is opened via a menu button):
![asddd][7]
And, like all pelican-esque sites, the tutorial website has aggregation pages, e.g. by category:
![asddd][8]
![asddd][9]
I think that's all of the features, so now we'll move to how you, dear reader, can make something like this for yourself
## Making your own
I've included this [as a template in BTools](https://github.com/b3m2a1/mathematica-BTools/tree/master/Resources/Templates/tutorial) so that you can copy it. It is not mirrored in the [SiteBuilder](https://github.com/b3m2a1/mathematica-SiteBuilder) subpaclet.
You can make your own theme (or just repurpose mine), add features, etc. and deploy the whole thing with the [SiteBuilder palette](http://community.wolfram.com/groups/-/m/t/1251138#_19_message_1253177)
## Getting a better domain name
Finally, as I mentioned previously, it would be much nicer to send someone to a [different domain name](http://community.wolfram.com/groups/-/m/t/1250055) than `"wolframcloud.com/objects/actual/domain/info/here"`.
The `"wolframcloud.com/objects"` hides the meaning behind the URL and scares off visitors (or at least makes them think more before clicking).
If you agree, be sure to [send support an email](http://www.wolfram.com/support/contact/email/). WRI has in the past bowed to user pressure on things like this.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=asddd.png&userId=1186441
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5896asddd.png&userId=1186441
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=4846asddd.png&userId=1186441
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=6462asddd.png&userId=1186441
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1881asddd.png&userId=1186441
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=8193asddd.png&userId=1186441
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5261asddd.png&userId=1186441
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5920asddd.png&userId=1186441
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=7547asddd.png&userId=1186441b3m2a1 2017-12-28T07:05:16Z[GiF] Hip to be square
http://community.wolfram.com/groups/-/m/t/1256276
After being a life long Macbook Pro user, I just switched and bought a Surfacebook 2. Here's an homage to the squareness of Windows:
![enter image description here][1]
w=1920;h=1080;d=60;t=1;
f[t_] := Module[{fillStyle,q,e,o},
Reap[For[q=0,q<w,q+=d*2,
For[e=0,e<h,e+=d*2,
fillStyle=RGBColor[Sin[t+e],Cos[2-e],Cos[t+q+e],Cos[t+q+e]];
o=(d*Cos[t+q]);
Sow@{fillStyle,Rectangle[{q+o,e-o},{q+o,e-o}+{d+o,d+o}]}
]
]][[2,1]]
];
Graphics[Dynamic[f[t++0.05]], PlotRange->{{0,w},{0,h-80}}*(t), ImageSize->500, Background->Black]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=windows.gif&userId=900170Mike Sollami2018-01-01T08:24:06ZAnalysis of the Wolfram Community
http://community.wolfram.com/groups/-/m/t/1256480
The Wolfram Community is now ~4.5 years 'old'. So time to do some analysis… let's go!
Let's download all the threads-titles, their votes, their authors et cetera:
SetDirectory[NotebookDirectory[]];
$HistoryLength=1;
xml=Import["http://community.wolfram.com/dashboard/-/discussions-list/all+groups/Any+discussions/none/active/full/10000/1/filter","XMLObject"];
Export["website.mx",xml]
This will save that output to `website.mx` file next to your notebook.
Here is a small function that extract the relevant data:
ClearAll[GetThreadProperties]
GetThreadProperties[threadxml_]:=Module[{url,title,creator,creatorurl,views,replies,votes},
{url,title}=FirstCase[threadxml,XMLElement["h3",{"class"->"asset-title"},{_,XMLElement["a",{"shape"->"rect","href"->url_},{title_}],_}]:>{url,title},{Missing[],Missing[]},\[Infinity]];
{creator,creatorurl}=FirstCase[threadxml,XMLElement["span",{"class"->"metadata-entry"},{_,XMLElement["span",{"class"->"asset-meta-bold"},{"CREATED BY: "}],_,XMLElement["span",{"class"->"asset-meta-normal"},{_,XMLElement["a",{"shape"->"rect","href"->creatorprofileurl_},{creator_}],_}],_}]:>{creator,creatorprofileurl},{Missing[],Missing[]},\[Infinity]];
views=FirstCase[threadxml,XMLElement["div",{"class"->"views stats"},{_,XMLElement["div",{"class"->_},{views_}],_,XMLElement["div",{"class"->_},{"VIEWS"}],_}]:>views,Missing[],\[Infinity]];
replies=FirstCase[threadxml,XMLElement["div",{"class"->"replies stats"},{_,XMLElement["div",{"class"->_},{replies_}],_,XMLElement["div",{"class"->_},{"REPLIES"}],_}]:>replies,Missing[],\[Infinity]];
votes=FirstCase[threadxml,XMLElement["div",{"class"->"votes stats"},{_,XMLElement["div",{"class"->_},{votes_}],_,XMLElement["div",{"class"->_},{"VOTES"}],_}]:>votes,Missing[],\[Infinity]];
views=If[StringEndsQ[views,"K"],1000ToExpression[StringDrop[views,-1]],ToExpression@views];
replies=If[StringEndsQ[replies,"K"],1000ToExpression[StringDrop[replies,-1]],ToExpression@replies];
votes=If[StringEndsQ[votes,"K"],1000ToExpression[StringDrop[votes,-1]],ToExpression@votes];
<|"url"->url,"title"->title,"creator"->creator,"views"->views,"replies"->replies,"votes"->votes,"createrurl"->creatorurl|>
]
Import the data from the mx file, and then get the relevant values from it using the above function, store in a dataset:
tmp=Import["website.mx"];
tmp=Cases[tmp,XMLElement["div",{"class"->"asset-abstract default-asset-publisher","style"->_},___],\[Infinity]];
ds=Dataset[GetThreadProperties/@tmp];
Here an example:
![enter image description here][1]
Let's start simple and get the number of threads, the number of views, votes, and replies:
Length[ds]
ds[Total,{"views","votes","replies"}]
![enter image description here][2]
Nearly 8000 topics and nearing 15 mega-views!
Let's check the number of replies for each topic:
ListLogPlot[Tally[Normal[ds[All, "replies"]]], AxesLabel -> {"Number of replies", "Number of threads"}]
giving:
![enter image description here][3]
We can also plot the number of votes vs rank:
ListLogLogPlot[Flatten[Normal[Values[ds[Reverse@*SortBy[#votes&]][All,{"votes"}]]]],PlotRange->All,AxesLabel->{"Rank","Number of votes"},PlotMarkers->{Automatic,Medium}]
![enter image description here][4]
Let's look into my posts:
ds[Select[#creator=="Sander Huisman"&]/*Reverse@*SortBy[#votes&]]
![enter image description here][5]
I'm very happy to see some of my posts got ~50 votes.
Let's have a look at the authors, who is the most active in making threads:
data=SortBy[Tally[Flatten[Normal[Values[ds[[All,{"creator"}]]]]]],Minus@*Last][[;;50]];
BarChart[Association[Rule@@@Reverse@data],ChartLabels->Automatic,BarOrigin->Left,Frame->True,PerformanceGoal->"Speed",AspectRatio->GoldenRatio/2,ChartStyle->Directive[EdgeForm[{Thickness[Medium],Black,Opacity[1]}],RGBColor[0,0.5,1]],FrameStyle->Black,FrameTicks->{{Automatic,Automatic},{All,All}},ImageSize->650,PlotRange->{0,160},PlotRangePadding->{None,{None,Scaled[0.01]}},BarSpacing->None,PlotLabel->Style["Number of threads",16,Black]]
![enter image description here][6]
[@Clayton Shonkwiler][at0] is by far the author with the most posts.
We can also check by number of votes:
BarChart[Sort[GroupBy[Normal[Values[ds[[All,{"creator","votes"}]]]],First->Last,Total]][[-100;;]],ChartLabels->Automatic,BarOrigin->Left,Frame->True,PerformanceGoal->"Speed",ScalingFunctions->"Log",AspectRatio->GoldenRatio,ChartStyle->Directive[EdgeForm[{Thickness[Medium],Black,Opacity[1]}],RGBColor[0,0.5,1]],FrameStyle->Black,FrameTicks->{{Automatic,Automatic},{All,All}},ImageSize->650,PlotRange->{20,3000},PlotRangePadding->{None,{None,Scaled[0.01]}},PlotLabel->Style["Total number of votes",16,Black]]
![enter image description here][7]
I was surprised to see I end up second in this list!
Finally let's make a word cloud of the topic-titles:
WordCloud[ToLowerCase[StringRiffle[Flatten[Normal[Values[ds[[All,{"title"}]]]]]]],MaxItems->150]
![enter image description here][8]
Hope you enjoyed this little exploration, even further analysis would be to download all the threads, but that would be quite the undertaking without access to the database directly…
[at0]: http://community.wolfram.com/web/claytonshonkwiler
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-01at23.08.20.png&userId=73716
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-01at23.09.59.png&userId=73716
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-01at23.12.56.png&userId=73716
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=rank.png&userId=73716
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-01at23.16.41.png&userId=73716
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-01at23.18.32.png&userId=73716
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1517out.png&userId=73716
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-01at23.22.11.png&userId=73716Sander Huisman2018-01-01T22:27:37Z[GiF] Disks all the way down
http://community.wolfram.com/groups/-/m/t/1256817
A non-mathematica friend of mine had an idea for this endless 3D animation, where the third dimension is simulated with 2D graphics, and I just coded it up:
![enter image description here][1]
Note the use of bit-wise logic ;)
f[t_]:=Module[{g},
g[z_] := Module[{fs,w,n,m,x,y,c},
If[z>0, For[
w = (1/z*4000.); c = (Clip[#,{0,1}]&)/@({w/4/255,w/2/255,w/255,0.95}); fs = RGBColor@@c; i = z*z*2,
n = Mod[i,z]; m=IntegerPart[i/BitOr[z,0]]; i>0, i--;
If[BitXor[Mod[n,2],Mod[m,2]]!=0,
{x, y} = {(n-Mod[t,2]-1.)*w, (Sin[t]+m-1.)*w};
Sow @ {fs, Disk[{x,y}, w/2.5]};
]
];g[z-6]
]]; Check[Reap[g[36]][[2,1]], {}]
]
Manipulate[Graphics[f[t], Axes -> False, Background -> Black,
PlotRange -> {{0, 1600}, {0, 1200}}, ImageSize -> 500], {t, 0, 2 \[Pi], .2}]
But any shape will do:
![enter image description here][2]
Happy New Years!
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=anim-opt.gif&userId=900170
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2018-01-0201_21_10.gif&userId=900170Mike Sollami2018-01-02T06:12:02Z[GIF] Inside (Stereographic projection of points on the Clifford torus)
http://community.wolfram.com/groups/-/m/t/1260753
![Stereographic projection of points on the Clifford torus][1]
**Inside**
The basic idea is simple: take $39^2=1521$ small spheres centered at points on the Clifford torus inside the 3-sphere, rotate in the $zw$-plane, and then stereographically project down to 3-space.
One could theoretically accomplish this with `ParametricPlot3D[]`, but with so many spheres I strongly suspect the kernel would crash long before you could actually render it. So instead I had to figure out the following: given a 2-sphere of radius $r$ centered at a point $p$ in the 3-sphere, what is the center and radius of the resulting 2-sphere after stereographically projecting to $\mathbb{R}^3$.
To figure that out, define the stereographic projection map:
Stereo[{x1_, y1_, x2_, y2_}] := {x1/(1 - y2), y1/(1 - y2), x2/(1 - y2)}
And a function which gives an orthonormal basis for the orthogonal complement of a point in the 3-sphere:
ThreeSpherePointPerp[{x_, y_, z_, w_}] := {{-y, x, -w, z}, {-z, w, x, -y}, {-w, -z, y, x}};
(All this is doing is thinking of the point $p = (x,y,z,w)$ as a unit quaternion $q=x + i y + j z + k w$, and then multiplying on the left by $i$, $j$, and $k$, yielding $ip$, $jp$, and $kp$. Then $(p, ip, jp, kp)$ is guaranteed to be an orthonormal basis for $\mathbb{R}^4$, and in particular $(ip, jp, kp)$ is an orthonormal basis for $p^\bot$.)
Next, using spherical coordinates in $p^\bot$, we can define a sphere of radius $r$ centered at $p$:
ThreeSphereSphere[p_, r_, θ_, ϕ_] :=
With[{b = ThreeSpherePointPerp[p]},
Cos[r] p + Sin[r] (Cos[ϕ] Sin[θ] b[[1]] + Sin[ϕ] Sin[θ] b[[2]] + Cos[θ] b[[3]])
];
At this point, leaving $p$ and $r$ symbolic, I just found where the normal lines to two points on the stereographic projection of the above sphere intersected: this is the center of the projected sphere, and its distance from either of the two points is its radius. I then encoded that in the function `ProjectedSphere[{x_, y_, z_, w_}, r_]`, which outputs a `Sphere[]` object of the appropriate center and radius (the definition is very long and slightly horrifying, so I've deferred it until the end of this post).
With all of that in place, then, here's the `Manipulate` for the above animation (which undoubtedly could be optimized):
With[{a = 39, b = 39,
cols = RGBColor /@ {"#1DCED8", "#F6490D", "#000249"}},
Manipulate[
Graphics3D[
Table[
ProjectedSphere[1/Sqrt[2] {Cos[θ + 2 π i/(3 a)], Sin[θ + 2 π i/(3 a)], Cos[2 π i/b + t], Sin[2 π i/b + t]}, .05],
{θ, 0., 2 π - 2 π/a, 2 π/a}, {i, 0, b - 1}],
PlotRange -> 3, ViewPoint -> {.38, 0, 0}, ViewAngle -> π/2,
ImageSize -> 540, Boxed -> False, Background -> cols[[-1]],
SphericalRegion -> True,
Lighting -> {{"Point", cols[[1]], {0, 1, 0}}, {"Point", cols[[2]], {0, -1, 0}}}],
{t, 0., 3*2 π/b}]
]
And, finally, here's the definition of `ProjectedSphere`. I'm sure there are various simplifications one could do to make this less intimidating, but I didn't have the patience to do much more than apply `Simplify[]` with some reasonable `TimeConstraint`.
ProjectedSphere[{x_, y_, z_, w_}, r_] :=
Sphere[{(-2 x Cos[r] + Sqrt[2] (w + y) Sin[r])/(-2 + 2 w Cos[r] +
Sqrt[2] (x + z) Sin[
r]) - (Sin[
r]^2 ((-1 + y^2 + z^2 + w Cos[r])/Sqrt[
2] + (-w y - x z + y Cos[r])/Sqrt[2] +
x Sin[r]) (-((x Cos[r] - y Sin[r])/(
1 - w Cos[r] - z Sin[r])) + (-2 x Cos[r] +
Sqrt[2] (w + y) Sin[r])/(-2 + 2 w Cos[r] +
Sqrt[2] (x + z) Sin[r])))/(Sqrt[
2] (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^3 √((
Sin[r]^4 ((-1 + y^2 + z^2 + w Cos[r])/Sqrt[
2] + (-w y - x z + y Cos[r])/Sqrt[2] + x Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^6) + (
Sin[r]^4 ((w x - y z - x Cos[r])/Sqrt[2] - (
x y + w z - z Cos[r])/Sqrt[2] + y Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^6) + (
Sin[r]^4 ((-1 + x^2 + y^2 + w Cos[r])/Sqrt[
2] - (-w y + x z + y Cos[r])/Sqrt[2] + z Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^6)) (-((Sin[
r]^2 (-w y - x z + y Cos[r] + x Sin[r]))/((-1 +
w Cos[r] +
z Sin[r])^3 √((
Sin[r]^4 (-w y - x z + y Cos[r] + x Sin[r])^2)/(-1 +
w Cos[r] + z Sin[r])^6 + (
Sin[r]^4 (w x - y z - x Cos[r] + y Sin[r])^2)/(-1 +
w Cos[r] + z Sin[r])^6 + (
Sin[r]^4 (-1 + x^2 + y^2 + w Cos[r] +
z Sin[r])^2)/(-1 + w Cos[r] +
z Sin[r])^6))) + (Sin[
r]^2 ((-1 + y^2 + z^2 + w Cos[r])/Sqrt[
2] + (-w y - x z + y Cos[r])/Sqrt[2] +
x Sin[r]))/(Sqrt[
2] (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^3 √((
Sin[r]^4 ((-1 + y^2 + z^2 + w Cos[r])/Sqrt[
2] + (-w y - x z + y Cos[r])/Sqrt[2] +
x Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/
Sqrt[2])^6) + (
Sin[r]^4 ((w x - y z - x Cos[r])/Sqrt[2] - (
x y + w z - z Cos[r])/Sqrt[2] + y Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/
Sqrt[2])^6) + (
Sin[r]^4 ((-1 + x^2 + y^2 + w Cos[r])/Sqrt[
2] - (-w y + x z + y Cos[r])/Sqrt[2] +
z Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/
Sqrt[2])^6))))), (
y Cos[r] + (x/Sqrt[2] - z/Sqrt[2]) Sin[r])/(
1 - w Cos[r] - (x/Sqrt[2] + z/Sqrt[2]) Sin[
r]) - (Sin[
r]^2 ((w x - y z - x Cos[r])/Sqrt[2] - (
x y + w z - z Cos[r])/Sqrt[2] +
y Sin[r]) (-((x Cos[r] - y Sin[r])/(
1 - w Cos[r] - z Sin[r])) + (-2 x Cos[r] +
Sqrt[2] (w + y) Sin[r])/(-2 + 2 w Cos[r] +
Sqrt[2] (x + z) Sin[r])))/(Sqrt[
2] (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^3 √((
Sin[r]^4 ((-1 + y^2 + z^2 + w Cos[r])/Sqrt[
2] + (-w y - x z + y Cos[r])/Sqrt[2] + x Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^6) + (
Sin[r]^4 ((w x - y z - x Cos[r])/Sqrt[2] - (
x y + w z - z Cos[r])/Sqrt[2] + y Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^6) + (
Sin[r]^4 ((-1 + x^2 + y^2 + w Cos[r])/Sqrt[
2] - (-w y + x z + y Cos[r])/Sqrt[2] + z Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^6)) (-((Sin[
r]^2 (-w y - x z + y Cos[r] + x Sin[r]))/((-1 +
w Cos[r] +
z Sin[r])^3 √((
Sin[r]^4 (-w y - x z + y Cos[r] + x Sin[r])^2)/(-1 +
w Cos[r] + z Sin[r])^6 + (
Sin[r]^4 (w x - y z - x Cos[r] + y Sin[r])^2)/(-1 +
w Cos[r] + z Sin[r])^6 + (
Sin[r]^4 (-1 + x^2 + y^2 + w Cos[r] +
z Sin[r])^2)/(-1 + w Cos[r] +
z Sin[r])^6))) + (Sin[
r]^2 ((-1 + y^2 + z^2 + w Cos[r])/Sqrt[
2] + (-w y - x z + y Cos[r])/Sqrt[2] +
x Sin[r]))/(Sqrt[
2] (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^3 √((
Sin[r]^4 ((-1 + y^2 + z^2 + w Cos[r])/Sqrt[
2] + (-w y - x z + y Cos[r])/Sqrt[2] +
x Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/
Sqrt[2])^6) + (
Sin[r]^4 ((w x - y z - x Cos[r])/Sqrt[2] - (
x y + w z - z Cos[r])/Sqrt[2] + y Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/
Sqrt[2])^6) + (
Sin[r]^4 ((-1 + x^2 + y^2 + w Cos[r])/Sqrt[
2] - (-w y + x z + y Cos[r])/Sqrt[2] +
z Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/
Sqrt[2])^6))))), (
z Cos[r] + (-(w/Sqrt[2]) + y/Sqrt[2]) Sin[r])/(
1 - w Cos[r] - (x/Sqrt[2] + z/Sqrt[2]) Sin[
r]) - (Sin[
r]^2 ((-1 + x^2 + y^2 + w Cos[r])/Sqrt[
2] - (-w y + x z + y Cos[r])/Sqrt[2] +
z Sin[r]) (-((x Cos[r] - y Sin[r])/(
1 - w Cos[r] - z Sin[r])) + (-2 x Cos[r] +
Sqrt[2] (w + y) Sin[r])/(-2 + 2 w Cos[r] +
Sqrt[2] (x + z) Sin[r])))/(Sqrt[
2] (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^3 √((
Sin[r]^4 ((-1 + y^2 + z^2 + w Cos[r])/Sqrt[
2] + (-w y - x z + y Cos[r])/Sqrt[2] + x Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^6) + (
Sin[r]^4 ((w x - y z - x Cos[r])/Sqrt[2] - (
x y + w z - z Cos[r])/Sqrt[2] + y Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^6) + (
Sin[r]^4 ((-1 + x^2 + y^2 + w Cos[r])/Sqrt[
2] - (-w y + x z + y Cos[r])/Sqrt[2] + z Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^6)) (-((Sin[
r]^2 (-w y - x z + y Cos[r] + x Sin[r]))/((-1 +
w Cos[r] +
z Sin[r])^3 √((
Sin[r]^4 (-w y - x z + y Cos[r] + x Sin[r])^2)/(-1 +
w Cos[r] + z Sin[r])^6 + (
Sin[r]^4 (w x - y z - x Cos[r] + y Sin[r])^2)/(-1 +
w Cos[r] + z Sin[r])^6 + (
Sin[r]^4 (-1 + x^2 + y^2 + w Cos[r] +
z Sin[r])^2)/(-1 + w Cos[r] +
z Sin[r])^6))) + (Sin[
r]^2 ((-1 + y^2 + z^2 + w Cos[r])/Sqrt[
2] + (-w y - x z + y Cos[r])/Sqrt[2] +
x Sin[r]))/(Sqrt[
2] (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^3 √((
Sin[r]^4 ((-1 + y^2 + z^2 + w Cos[r])/Sqrt[
2] + (-w y - x z + y Cos[r])/Sqrt[2] +
x Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/
Sqrt[2])^6) + (
Sin[r]^4 ((w x - y z - x Cos[r])/Sqrt[2] - (
x y + w z - z Cos[r])/Sqrt[2] + y Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/
Sqrt[2])^6) + (
Sin[r]^4 ((-1 + x^2 + y^2 + w Cos[r])/Sqrt[
2] - (-w y + x z + y Cos[r])/Sqrt[2] +
z Sin[r])^2)/(
2 (-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/
Sqrt[2])^6)))))}, √(-((Csc[
r]^4 (-2 + 2 w Cos[r] +
Sqrt[2] (x + z) Sin[
r])^6 ((Sqrt[2] (-1 - w y + y^2 - x z + z^2) +
Sqrt[2] (w + y) Cos[r] +
2 x Sin[r])^2 + (Sqrt[2] (w (x - z) - y (x + z)) -
Sqrt[2] (x - z) Cos[r] + 2 y Sin[r])^2 +
4 ((-1 + x^2 + y^2 + w Cos[r])/Sqrt[
2] - (-w y + x z + y Cos[r])/Sqrt[2] + z Sin[r])^2) ((
x Cos[r] - y Sin[r])/(-1 + w Cos[r] +
z Sin[r]) + (-2 x Cos[r] + Sqrt[2] (w + y) Sin[r])/(-2 +
2 w Cos[r] + Sqrt[2] (x + z) Sin[r]))^2)/((-1 +
w Cos[r] + (x Sin[r])/Sqrt[2] + (z Sin[r])/Sqrt[
2])^6 (-4 - 2 w^2 + x^2 - 2 w^2 x^2 - 2 x^4 + 4 y^2 -
4 w^2 y^2 - 6 x^2 y^2 - 4 y^4 - 6 x z + 4 w^2 x z +
4 x^3 z + 4 x y^2 z + z^2 - 2 w^2 z^2 - 4 x^2 z^2 -
6 y^2 z^2 + 4 x z^3 - 2 z^4 +
8 w Cos[r] + (-2 w^2 + (x + z)^2) Cos[2 r] +
4 Sqrt[2] x Sin[r] + 4 Sqrt[2] z Sin[r] -
2 Sqrt[2] w x Sin[2 r] -
2 Sqrt[2]
w z Sin[
2 r]) ((Sqrt[
2] ((-1 + y^2 + z^2 + w Cos[r])/Sqrt[
2] + (-w y - x z + y Cos[r])/Sqrt[2] +
x Sin[r]))/((-1 + w Cos[r] + (x Sin[r])/Sqrt[2] + (
z Sin[r])/Sqrt[
2])^3 √((Sin[
r]^4 (2 - 2 x^2 + w^2 x^2 + x^4 - 4 y^2 +
2 w^2 y^2 + 3 x^2 y^2 + 2 y^4 + 4 x z -
2 w^2 x z - 2 x^3 z - 2 x y^2 z - 2 z^2 +
w^2 z^2 + 2 x^2 z^2 + 3 y^2 z^2 - 2 x z^3 + z^4 -
4 w Cos[r] + 2 w^2 Cos[r]^2 + x^2 Cos[r]^2 +
2 y^2 Cos[r]^2 - 2 x z Cos[r]^2 + z^2 Cos[r]^2 -
2 Sqrt[2] x Sin[r] - 2 Sqrt[2] z Sin[r] +
2 Sqrt[2] w x Cos[r] Sin[r] +
2 Sqrt[2] w z Cos[r] Sin[r] + 2 x^2 Sin[r]^2 +
2 y^2 Sin[r]^2 + 2 z^2 Sin[r]^2))/(-2 +
2 w Cos[r] + Sqrt[2] x Sin[r] +
Sqrt[2] z Sin[r])^6)) - (8 Sqrt[
2] (-w y - x z + y Cos[r] + x Sin[r]))/((-1 +
w Cos[r] +
z Sin[r])^3 √((Sin[
r]^4 (2 + w^2 - 2 x^2 + 2 w^2 x^2 + 2 x^4 -
2 y^2 + 2 w^2 y^2 + 4 x^2 y^2 + 2 y^4 + z^2 +
2 x^2 z^2 + 2 y^2 z^2 -
4 w Cos[r] + (w^2 - z^2) Cos[2 r] - 4 z Sin[r] +
2 w z Sin[2 r]))/(-1 + w Cos[r] +
z Sin[r])^6)))^2)))];
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=proj2q.gif&userId=610054Clayton Shonkwiler2018-01-06T20:58:59ZBuilding a GitBook with Mathematica
http://community.wolfram.com/groups/-/m/t/1261033
This is a [cross post from the StackExchange](https://mathematica.stackexchange.com/a/163194/38205) that I thought might appeal to some here as well
---
###Preface
This is gonna build off some stuff I've been developing off-and-on for the past few months. Everything is packaged up and most of it is in a palette, so you'll be able to do this with minimal effort.
It started with [my attempts to build websites with Mathematica](https://mathematica.stackexchange.com/q/152663/38205). That turned out to be a decent success. [This Mathematica tutorial](https://www.wolframcloud.com/app/objects/b3m2a1.testing/tutorial/main.html) is an example of a fun, non-trivial website I built with Mathematica.
Then halirutan brought [GitBook](https://www.gitbook.com) to my attention and I realized I could adapt that quickly to my needs.
First I took my tutorial website and [built a GitBook out of it](https://b3m2a1.gitbooks.io/mathematica-tutorial/content/).
But now I've done that one better and generalized that framework entirely, [packaging up my GitBook builder](https://github.com/b3m2a1/mathematica-tools/blob/master/GitBookBuilder.wl).
Here's how we do this. It's really quite easy, although there is some minimal book-keeping involved.
## Book Development
It may seem like there are many steps here, but most of them are so fast and boiler-plate that by using the palettes and templates I provide you can get a GitBook up and running in about 5 minutes (excluding the time it takes to actually write your content)
### Initializing a website
My system builds off my work making a website builder, so to start I make a website that I simply never build an deploy.
I have a site-builder palette, which can be used to make a new one and add content. Alternately, you can simply copy down the content I have [here](https://github.com/b3m2a1/mathematica-gitbook/tree/master/src/content) and just build off of it.
### Writing our content
For this sample GitBook I poached the content from the [python tutorial](https://docs.python.org/3/tutorial/introduction.html) to show that this system can do things beyond Mathematica code.
To make the content we use [a stylesheet I developed for writing Markdown](https://github.com/b3m2a1/mathematica-BTools/blob/master/FrontEnd/StyleSheets/BTools/MarkdownNotebook.nb) websites, which requires that one has installed my package [BTools](https://github.com/b3m2a1/mathematica-BTools).
These notebooks are basically the same as any notebook:
[![asd][1]][1]
`"Text"` cells get exported as plain text, `"Code"` cells get exported as code, etc.
There are also a bunch of custom cell types built-in with different export behaviors, all linked together via `StyleKeyMapping` for ease of access.
### Book-keeping and Metadata
The only thing that's really different is a metadata block that's put at the top of the notebook (the style for which is accessed via <kbd>Cmd</kbd>+<kbd>`</kbd>:
[![meta][2]][2]
This is used by pelican and my site builder, and we'll use it again here for setting up the [GitBook SUMMARY.md](https://toolchain.gitbook.com/pages.html)
The main things we need for that are the `"ID"` and `"Path"` parameters. The `"Path"` gives the section it should be nested under and the `"ID"` gives the sorting in standard versioning syntax.
As an example, here's the used metadata [for one page](https://b3m2a1.gitbooks.io/gitbook/content/2-using-the-interpreter/1-invoking-the-interpreter.html):
<|
"Title" -> "Invoking the Interpreter",
"Path" -> "Using the Python Interpreter/Invoking the Interpreter",
"ID" -> "2.1"
|>
And here is the the same for [the following page](https://b3m2a1.gitbooks.io/gitbook/content/2-using-the-interpreter/1-invoking-the-interpreter/1-argument-passing.html):
<|
"Title" -> "Argument Passing",
"Path" -> "Using the Python Interpreter/Invoking the Interpreter",
"ID" -> "2.1.1"
|>
We see that in a given section of the book all that really changes is the `"ID"` (which doesn't even have to be in a list like that) and the `"Title"`.
### Creating the Intro Page
All of my websites have an About page to them, so I just use that as the [GitBook README](https://toolchain.gitbook.com/structure.html)
So you'll have to add an About page under the pages directory of the site. Again the easiest thing is likely just to copy the sample site I have and edit that About page.
## Building the Site
With the content part of the equation handled we can now actually get the book deployed.
I've written [a package for this](https://github.com/b3m2a1/mathematica-tools/blob/master/GitBookBuilder.wl), but I'll do a quick walkthrough of the requisite steps.
### Copying content
First we simply copy over the content from the site to our build directory. I take all of the md files from the `"posts"` directories of the site we've built, stripping the metadata, and anything else in the `"content"` directory
### Creating the README.md
This is build from the `"pages/About.md"` file, stripping all of the metainfo first. I simply export that to a top-level `"README.md"` file
### Creating the SUMMARY.md
This was the only at-all-challenging part of the whole endeavor. First I extract all of metainfo, then I sort this by `"ID"`, group it by path components, build a new markdown notebook from these parts, and call `NotebookMarkdownSave` on that.
### Setting up the GitHub Repo
Finally, all one needs to do is initialize a GitHub remote, initialize git on the book directory, and push that to GitHub.
## Package-Level Flow
None of the preceding steps actually need to be done by hand, though. I have two functions in the package I linked to before, `GitBookBuild` and `GitBookPush`.
The first builds a GitBook from the site directory, and is called like so:
build = FileNameJoin@{$UserDocumentsDirectory, "GitHub",
"mathematica-gitbook"};
GitBookBuild[
FileNameJoin@{$WebSiteDirectory, "gitbook"},
build
];
The second will initialize the git repo, and can use the GitHub API to initialize a GitHub repo too. That's called like this:
remote =
"https://github.com/b3m2a1/mathematica-gitbook";
GitBookPush[build, remote]
When all of this is done we get a [GitHub repo like this](https://github.com/b3m2a1/mathematica-gitbook):
![gitbook][3]][3]
Everytime you edit the source, simply call `GitBookBuild` and `GitBookPush` again and it'll push the changes.
## Setting up the GitBook
The last step is just to go to [gitbook.com](https://www.gitbook.com), make an account, and make a new book that loads from the GitHub repo.
After the smoke clears, you get a [nice new GitBook](https://b3m2a1.gitbooks.io/gitbook/content/):
[![gitbook][4]][4]
[1]: https://i.stack.imgur.com/giSXH.png
[2]: https://i.stack.imgur.com/DWLXT.png
[3]: https://i.stack.imgur.com/Uhohr.png
[4]: https://i.stack.imgur.com/TGzSh.pngb3m2a1 2018-01-07T06:04:51Z[GIF] Touch ’Em All (Hamiltonian cycle on the hypercube)
http://community.wolfram.com/groups/-/m/t/1263478
![Hamiltonian cycle on the hypercube][1]
**Touch ’Em All**
Consider the vertices of the hypercube as points on the 3-sphere. If we center a sphere of radius 0.2 at each vertex and stereographically project to $\mathbb{R}^3$, the result is the first frame in this animation.
Of course, to accomplish that we need a stereographic projection function:
Stereo[{x1_, y1_, x2_, y2_}] := {x1/(1 - y2), y1/(1 - y2), x2/(1 - y2)}
As well as the `ProjectedSphere[]` function from [Inside][2] (which I won't reproduce here due to its length and unpleasantness, but which produces the stereographic image of a given sphere in the 3-sphere).
Now, the animation shows a Hamiltonian cycle of the 1-skeleton of the hypercube (a.k.a., the hypercube graph). Now one can extract such a Hamiltonian cycle using `FindHamiltonianCycle[HypercubeGraph[4]]`, but the coordinates of the vertices of `HypercubeGraph[4]` are only given in 2-D, so this doesn't help so much with actual visualization. So instead I construct the 1-skeleton of the hypercube, find a Hamiltonian cycle using `FindHamiltonianCycle[]`, and then sort the vertices to appear in the order from the given cycle (by semi-coincidence, this actually turns out to be exactly the same Hamiltonian cycle as one gets from evaluating `FindHamiltonianCycle[HypercubeGraph[4]]`):
sortedHypercubeVertices =
Module[{v = Tuples[{1/2, -1/2}, {4}], M, Γ, cycle},
M = Table[
If[HammingDistance[v[[i]], v[[j]]] == 1, 1, 0],
{i, 1, Length[v]}, {j, 1, Length[v]}];
Γ = AdjacencyGraph[M];
cycle = FindHamiltonianCycle[Γ];
v[[#[[1]] & /@ (cycle[[1]] /. UndirectedEdge -> List)]]
];
With that all in place, then, we just need to rotate the $i$th vertex to the $(i+1)$st vertex (mod 16) up in the 3-sphere and then stereographically project (with a little help from the [smoothstep function][3], which makes the transitions less jarring):
smoothstep[t_] := 3 t^2 - 2 t^3;
DynamicModule[{θ, pts = N[sortedHypercubeVertices],
cols = RGBColor /@ {"#41EAD4", "#B91372", "#011627"}},
Manipulate[
θ = π/3 smoothstep[t];
Graphics3D[
{Specularity[.4, 10],
Table[
ProjectedSphere[RotationMatrix[θ, {pts[[i]], pts[[Mod[i + 1, Length[pts], 1]]]}].pts[[i]], .2],
{i, 1, Length[pts]}]},
PlotRange -> 3, Boxed -> False, ViewPoint -> 1/2 {2, 1, 0}, ViewAngle -> π/4,
Lighting -> {{"Directional", cols[[1]], {0, 0, 50}},
{"Directional", cols[[2]], {0, 0, -50}},
{"Ambient", cols[[-1]]}},
Background -> cols[[-1]], ImageSize -> 540],
{t, 0, 1}
]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=proj7q.gif&userId=610054
[2]: http://community.wolfram.com/groups/-/m/t/1260753
[3]: https://en.wikipedia.org/wiki/SmoothstepClayton Shonkwiler2018-01-11T05:21:33ZHow to overcome Compiler Errors in a trial version of SystemModeler 5.5
http://community.wolfram.com/groups/-/m/t/1263960
I encountered the following error attempting to set up a trial package of SystemModeler5.5. The version of which is illustrated by the picture below:
![System Modeler Version][1]
The compiler I felt was best to use was Microsoft Visual Studio 2017. I downloaded it installed on my machine. It attempted to get SystemModeler to work with it I received the following error:
![SysModeler Compiler Error][2]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1Versionsysm.jpg&userId=131633
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2compiler.jpg&userId=131633
I used the above set up in SystemModeler5.5. I tried installing the compiler multiple times. I have attempted to use Visual C++ Build Tools 2017; Visual C++ Build Tools 2015 and Visual C++, and Visual C++ Build Tools 2013.
Thank You in advance for any assistance you can render !
Brian Buchholz
mailto:buckb1979@gmail.comBrian Buchholz2018-01-11T20:51:13ZHow to add two vector fields if they based on different mesh points?
http://community.wolfram.com/groups/-/m/t/1264139
Hi,
I have `n` number different `3D` vector fields which are partially overlaying on each-other, but not at the same mesh points. Let's say `n=2` and
vField1={{{x11,y11,z11},{vx11,vy11,vz11}},{{x12,y12,z12},{vx12,vy12,vz12}},....,{{x1m,y1m,z1m},{vx1m,vy1m,vz1m}}}
and
vField2={{{x21,y21,z21},{vx21,vy21,vz21}},{{x22,y22,z22},{vx22,vy22,vz22}},....,{{x2m,y2m,z2m},{vx2m,vy2m,vz2m}}}
where `{x1i,y1i,z1i} != {x2i,y2i,z2i}` are the coordinate points and `{vx1i,vy1i,vz1i}=={vx2i,vy2i,vz2i}` are the vector coordinates at the given space points. `{x1i,y1i,z1i}` and `{x2i,y2i,z2i}` might be very far from each-other space-wise, other `{x2j,y2j,z2j}` points surely can be much closer to `{x1i,y1i,z1i}` in the `3D` space.
My thinking is to interpolate the two fields above the union of the two `3D` coordinate sets and then discretize them over some third `{x3i,y3i,z3i}` mesh where `{i,1,m}` and finally add them over this third mesh. However it looks too complicated to me. Also there are regions in coordinate space where `vField1` or `vField2` are non-existent or very spar and any interpolation can be very wacky. I hope for a more elegant way, if there is one already in existence.
Thanks ahead,
JánosJanos Lobb2018-01-12T05:51:56ZUsing formula for the integration of the product of 3 MeijerG function
http://community.wolfram.com/groups/-/m/t/1263851
I am trying to use the formula for the integration of the product of 3 MeijerG functions in the following link:
http://functions.wolfram.com/HypergeometricFunctions/MeijerG/21/02/04/0001/
However, the following remark is mentioned in ( http://functions.wolfram.com/HypergeometricFunctions/MeijerG/21/ShowAll.html ) :
Remark: This relationship only holds true when the parameters satisfy certain
well-specified restrictions.
what is the reference for this sentence to be able to use the conversion in the formula?
Thank you in advanceBasem ElHalawany2018-01-11T13:36:09Z[✓] Plot multiple lines on ParametricPlot3D?
http://community.wolfram.com/groups/-/m/t/1263061
How does one plot multiple lines on ParametricPlot3D?
ParametricPlot3D[{{u, 0, 0}, {0, 0, p}}, {u, -1, 1}, {p, -1, 1}]
This snippet of code works and plots two lines, however when this is extended to three lines it fails.
ParametricPlot3D[{{u, 0, 0}, {0, s, 0}, {0, 0, p}}, {u, -1,1}, {p, -1, 1}, {s, -1, 1}]
This line fails.
I would like to extended this to 5+ lines.
Any help would be appreciated.Ninad Kothmire2018-01-09T23:42:36Z