Random Mathematica examples

Basic Mathematica functionality

Mathematica comes with an enormeous range of functionality. Below follow a few very simple examples.

See https://reference.wolfram.com/language/ for exhaustive documentation.

In [32]:
Factor[x^2 + 1, GaussianIntegers -> True]
Out[32]:
Output
In [27]:
sol[x_]= Integrate[1/(1 + x^3), x]
Out[27]:
Output
In [28]:
TeXForm[sol[x]]
Out[28]:
$$-\frac{1}{6} \log \left(x^2-x+1\right)+\frac{1}{3} \log (x+1)+\frac{\tan ^{-1}\left(\frac{2 x-1}{\sqrt{3}}\right)}{\sqrt{3}}$$
In [29]:
Plot[sol[x],{x,0,100}]
Out[29]:
Output
In [30]:
wave3d[x_]= Sin[Sqrt[x^2 + y^2]]/Sqrt[x^2 + y^2]
Out[30]:
Output
In [31]:
Plot3D[wave3d[x], {x, -5*Pi, 5*Pi}, {y, -5*Pi, 5*Pi},
    PlotPoints -> 100, BoxRatios -> {1, 1, 0.2},
    PlotRange -> All]
Out[31]:
Output

Working with data

Mathematica comes with built-in example data. Moreover, Wolfram runs a site with curated datasets, https://datarepository.wolframcloud.com/, from where data can be loaded directly into Mathematica.

This allows for some simple illustrations of using Mathematica. Much more can be found at the above site.

Another good resource is Wolfram U.

In [18]:
resourceData = ResourceObject["A Connecticut Yankee in King Arthur's Court"]
Out[18]:
Output
In [22]:
resourceData//InputForm
Out[22]:
ResourceObject[<|"Name" -> "A Connecticut Yankee in King Arthur's Court", 

 
>     "UUID" -> "7f8f706c-89fd-4f85-b7d1-3370795a015f", "ResourceType" ->\
 
>    "DataResource", 
  "Version" -> "1.0.0", "Description" -> 

 
>      "Plaintext for Mark Twain's \"A Connecticut Yankee in King Arthur's Court\"", 

 
>     "RepositoryLocation" -> 

 
>      URL["https://www.wolframcloud.com/objects/resourcesystem/api/1.0"], 

 
>     "ContentSize" -> Quantity[643.6800000000001, "Kilobytes"], 

 
>     "ContentElements" -> {"Plaintext"}|>, ResourceSystemBase -> Automatic]
In [23]:
WordCloud[
 DeleteStopwords[
  ResourceData["A Connecticut Yankee in King Arthur's Court"]]]
Out[23]:
Output
In [81]:
Entity["Species", "Species:AmanitaMuscaria"]["Image"]
Out[81]:
Output
In [24]:
TextSentences[WikipediaData["Moon"]][[;; 5]]
Out[24]:
{The Moon is Earth's only natural satellite., 
 
>   At about one-quarter the diameter of Earth (comparable to the width of Australia),\
 
>    it is the largest natural satellite in the Solar System relative to the size of a\
 
>    major planet, the fifth largest satellite in the Solar System overall, and larger\
 
>    than any known dwarf planet., The Moon is a planetary-mass object that formed a\
 
>    differentiated rocky body, making it a satellite planet under the geophysical\
 
>    definitions of the term., It lacks any significant atmosphere, hydrosphere, or\
 
>    magnetic field., Its surface gravity is about one-sixth of Earth's (0.1654 g);\
 
>    Jupiter's moon Io is the only satellite in the Solar System known to have a higher\
 
>    surface gravity and density.}
In [25]:
links = WikipediaData["Graph theory", "BacklinksRules", 
   "MaxLevelItems" -> 20, "MaxLevel" -> 2];
In [26]:
Graph[links, VertexLabels -> Placed["Name", Tooltip], 
 VertexStyle -> {"Graph theory" -> Red}]
Out[26]:
Output
In [33]:
data = ExampleData[{"Geometry3D", "StanfordBunny"}, "VertexData"];
In [34]:
ListSurfacePlot3D[data, MaxPlotPoints -> 50]
Out[34]:
Output
In [40]:
data = Entity["Country", #] /. {"United States" -> "UnitedStates"} & /@
    WolframAlpha[
     "nations with highest population", {{"OrdinalRankings", 1}, 
      "ComputableData"}][[All, 2]];
In [42]:
GeoListPlot[data, GeoLabels -> True]
Out[42]:
Output
In [43]:
countries = 
 EntityValue[EntityClass["Country", "SouthAmerica"], "Entities"]
Out[43]:
Output
In [44]:
order = Last[FindShortestTour[GeoPosition[countries]]]
Out[44]:
{1, 7, 13, 10, 3, 8, 12, 9, 14, 5, 6, 11, 2, 4, 1}
In [45]:
GeoListPlot[countries[[order]], Joined -> True]
Out[45]:
Output
In [103]:
ListPlot3D[Reverse[GeoElevationData[Entity["City", {"Pasadena", "California", 
      "UnitedStates"}]]], ColorFunction -> "Topographic", 
  PlotLabel -> "Pasadena topographic map", ImageSize -> Large, Ticks -> None]
Out[103]:
Output
In [7]:
Entity["Country", "UnitedStates"][Dated["AdultPopulation",All]]
Out[7]:
Output
In [8]:
%//DateListPlot
Out[8]:
Output
In [10]:
GeoGraphics[{EdgeForm[{Thick, Black}], Entity["Country", "VaticanCity"][
    "Polygon"]}, ImageSize -> Large, 
  GeoRange -> Entity["City", {"Rome", "Lazio", "Italy"}]]
Out[10]:
Output
In [97]:
GeoGraphics[{Blue, PointSize[.03], 
  Tooltip[Point[#1], #2] & @@@ 
   BridgeData[
    GeoNearest["Bridge", 
     Entity["City", {"Copenhagen", "Copenhagen", "Denmark"}], {All, 
      Quantity[5, "Kilometer"]}], {"Position", "Image"}]}]
Out[97]:
Output
In [12]:
Histogram[DeleteMissing@EntityValue["Dinosaur","Length"],AxesLabel->{"Length (ft)","Count"},PlotLabel->"Dinosaur heights",ImageSize->Large]
Out[12]:
Output
In [23]:
countries = {Entity["Country", "UnitedStates"], Entity["Country", "Japan"], 
    Entity["Country", "UnitedKingdom"], Entity["Country", "India"], Entity["Country", "Denmark"]}; 

TimelinePlot[Table[DayRange[{2020, 1, 1}, {2020, 12, 31}, "Holiday", 
    HolidayCalendar -> c], {c, countries}], PlotLegends -> countries, 
  PlotLabel -> "Holidays"]
Out[23]:
Output
In [33]:
usCPI = Entity["Country", "UnitedStates"][EntityProperty["Country", 
    "ConsumerPriceIndex", 
    {"Date" -> Interval[{DateObject[{1913}], DateObject[{2019}]}], 
     "Frequency" -> "Monthly", "SeasonalAdjustment" -> 
      "NotSeasonallyAdjusted"}]]
Out[33]:
Output
In [34]:
DateListPlot[usCPI, PlotTheme -> "Business", AspectRatio -> 1/2, 
  ImageSize -> Large, FrameLabel -> {"Date", "CPI"}, 
  PlotLabel -> "US CPI 1913-2019"]
Out[34]:
Output
In [35]:
inflationMonthly=100.Differences[Log@usCPI,1,12]
Out[35]:
Output
In [36]:
DateListPlot[{inflationMonthly, TimeSeriesAggregate[inflationMonthly, 
    Quantity[1, "Years"]]}, PlotTheme -> "Business", AspectRatio -> 1/2, 
  ImageSize -> Large, PlotStyle -> {Opacity[0.3], Black}, PlotRange -> All, 
  FrameLabel -> {"Date", "Inflation"}, PlotLabel -> "US Inflation 1914-2019"]
Out[36]:
Output
In [37]:
WolframAlpha["US CPI inflation", IncludePods -> "History", 
  AppearanceElements -> {"Pods"}, TimeConstraint -> 
   {20, Automatic, Automatic, Automatic}]
Out[37]:
Output

Real research

Wolfram hosts an archive of scientific and educational notebooks: The Notebook Archive.

The code can in general simply be copied and pasted into a Jupyter notebook with a Wolfram Language kernel of your own. If you have Mathematica, you can download whole notebooks, export them as packages and paste them into Jupyter notebooks.

From https://notebookarchive.org/poincare-map-for-a-four-dimensional-model-of-the-visual-cortex--2021-10-1uutypp/

In [38]:
Hamsys = {Derivative[1][a][t] -> u3[t], 
  Derivative[1][u3][t] -> u4[t] Cos[a[t]], 
  Derivative[1][u4][t] -> -k[t] Cos[a[t]] (k[t] u3[t] + Cos[a[t]]), 
  Derivative[1][k][t] -> Sin[a[t]]}
Out[38]:
Output
In [39]:
Clear[sol]
sol[{a0_, u30_, u40_, k0_}] := 
 With[{T = Abs[2*4 Pi/(2 u30)]}, 
   NDSolve[Join[
     Map[#[[1]] == #[[2]] &, Hamsys] /. {t -> tt}, {a[0] == a0, 
      u3[0] == u30, u4[0] == u40, k[0] == k0}], {a, u3, u4, k}, {tt, 
     0, T}]][[1]]
solau3u4[{a_, u3_, u4_}] := sol[{a, u3, u4, 0}]
In [42]:
Clear[a0, u30, u40, k0, \[Epsilon]a, \[Epsilon]u3, \[Epsilon]u4, aa, 
  uu3, uu4, TT, curpoints1, curpoints2, curpoints3, solcur, NPt];
(* Equilibrium point *)
a0 = N@Pi/2; u30 = 1.; u40 = 0.; k0 = 0.;
(* Varying in a, u3 and u4 directions *) 
\[Epsilon]a = 0.01; \[Epsilon]u3 = 0.02; \[Epsilon]u4 = 0.01;
(* Number of points (loops of Poincare map *)
NPt = 200;
(*------------------------------------*)
(*----------Compute points \
-----------*)
(*------------------------------------*)
(* 0) Periodic \
trajectory *)
Clear[aa, uu3, uu4, curpoints2];
aa = a0; uu3 = u30; uu4 = u40; 
curpoints0 = {N@{aa, uu3, uu4}};
NPt0 = 200;
For[i = 0, i < NPt0, i++,
 solcur = solau3u4[{aa, uu3, uu4}];
 TT = (*t/.FindRoot[(u4/.solcur)[t]\[Equal]0, {t,N@Abs[4 Pi/(2uu)]}]*)
  2. Pi*i/(1. NPt0);
 {aa, uu3, uu4} = {Mod[#[[1]], 2 Pi, 0], #[[2]], #[[3]]} &@
   Through[({a, u3, u4} /. solcur)[TT]];
 curpoints0 = Prepend[curpoints0, {aa, uu3, uu4}];
 ]
(*------------------------------------*)
(* 1) First trajectiry: \
Computation of points, when trajectory intersects the hyperspace k=0 *)

Clear[aa, uu3, uu4, curpoints1];
aa = a0 + 3*\[Epsilon]a; uu3 = u30 + 7*\[Epsilon]u3; uu4 = 
 u40 + 2*\[Epsilon]u4; 
NPt1 = 1000;
Print["Black: ", "a=", aa, "u3=", uu3, "u4=", uu4, "NP=", NPt1];
curpoints1 = {N@{aa, uu3, uu4}};
For[i = 0, i < NPt1, i++,
 (*kk= kk+\[Epsilon]k;*)
 (*Print[curpoints];
 Print[{aa,uu,kk}];*)
 solcur = solau3u4[{aa, uu3, uu4}];
 (*Print[solcur];
 Print[N@Abs[4 Pi/(2uu)]];*)
 
 TT = t /. FindRoot[(k /. solcur)[t] == 0, {t, N@Abs[4 Pi/(2 uu3)]}];
 (*Print[TT];*)
 {aa, uu3, 
   uu4} = {Mod[#[[1]], 2 Pi, 0], #[[2]], #[[3]]} &@
   Through[({a, u3, u4} /. solcur)[TT]];
 curpoints1 = Prepend[curpoints1, {aa, uu3, uu4}];
 ]
(* 2) Second trajectiry: Computation of points, when trajectory \
intersects the hyperspace k=0 *)
Clear[aa, uu3, uu4, curpoints2];
NPt2 = 1000;
aa = a0 + 1*\[Epsilon]a; uu3 = u30 + 12*\[Epsilon]u3; uu4 = 
 u40 + 1*\[Epsilon]u4; 
Print["Blue: ", "a=", aa, "u3=", uu3, "k=", uu4, "NP=", NPt2];
curpoints2 = {N@{aa, uu3, uu4}};
For[i = 0, i < NPt2, i++,
 solcur = solau3u4[{aa, uu3, uu4}];
 TT = t /. FindRoot[(k /. solcur)[t] == 0, {t, N@Abs[4 Pi/(2 uu3)]}];
 {aa, uu3, uu4} = {Mod[#[[1]], 2 Pi, 0], #[[2]], #[[3]]} &@
   Through[({a, u3, u4} /. solcur)[TT]];
 curpoints2 = Prepend[curpoints2, {aa, uu3, uu4}];
 ]
(* 3) Third trajectiry: Computation of points, when trajectory \
intersects the hyperspace k=0 *)
Clear[aa, uu3, uu4, curpoints3];
NPt3 = 1000;
aa = a0 - 1.*\[Epsilon]a; uu3 = u30 - 3*\[Epsilon]u3; uu4 = 
 u40 + 2.*\[Epsilon]u4; 
Print["Orange: ", "a=", aa, "u3=", uu3, "u4=", uu4, "NP=", NPt3];
curpoints3 = {N@{aa, uu3, uu4}};
For[i = 0, i < NPt3, i++,
 solcur = solau3u4[{aa, uu3, uu4}];
 TT = t /. FindRoot[(k /. solcur)[t] == 0, {t, N@Abs[4 Pi/(2 uu3)]}];
 {aa, uu3, uu4} = {Mod[#[[1]], 2 Pi, 0], #[[2]], #[[3]]} &@
   Through[({a, u3, u4} /. solcur)[TT]];
 curpoints3 = Prepend[curpoints3, {aa, uu3, uu4}];
 ]
(* 4) Fourth trajectiry: Computation of points, when trajectory \
intersects the hyperspace k=0 *)
Clear[aa, uu3, uu4, curpoints4];
NPt4 = 1000;
aa = a0 - 2.*\[Epsilon]a; uu3 = u30 + 3*\[Epsilon]u3; uu4 = 
 u40 + 5.*\[Epsilon]u4; 
Print["Green: ", "a=", aa, "u3=", uu3, "u4=", uu4, "NP=", NPt4];
curpoints4 = {N@{aa, uu3, uu4}};
For[i = 0, i < NPt4, i++,
 solcur = solau3u4[{aa, uu3, uu4}];
 TT = t /. FindRoot[(k /. solcur)[t] == 0, {t, N@Abs[4 Pi/(2 uu3)]}];
 {aa, uu3, uu4} = {Mod[#[[1]], 2 Pi, 0], #[[2]], #[[3]]} &@
   Through[({a, u3, u4} /. solcur)[TT]];
 curpoints4 = Prepend[curpoints4, {aa, uu3, uu4}];
 ]
(* 5) Fifth trajectiry: Computation of points, when trajectory \
intersects the hyperspace k=0 *)
Clear[aa, uu3, uu4, curpoints5];
NPt5 = 1000;
aa = a0 - 3.*\[Epsilon]a; uu3 = u30 + 10*\[Epsilon]u3; uu4 = 
 u40 + 12.*\[Epsilon]u4; 
Print["Purple: ", "a=", aa, "u3=", uu3, "u4=", uu4, "NP=", NPt4];
curpoints5 = {N@{aa, uu3, uu4}};
For[i = 0, i < NPt5, i++,
 solcur = solau3u4[{aa, uu3, uu4}];
 TT = t /. FindRoot[(k /. solcur)[t] == 0, {t, N@Abs[4 Pi/(2 uu3)]}];
 {aa, uu3, uu4} = {Mod[#[[1]], 2 Pi, 0], #[[2]], #[[3]]} &@
   Through[({a, u3, u4} /. solcur)[TT]];
 curpoints5 = Prepend[curpoints5, {aa, uu3, uu4}];
 ]

(* 3D Plot of the oints in (a,u3,k) space *)
With[{a0 = Pi/2, u30 = 1,
   u40 = 0},
 Show[
  Graphics3D[
   Join[{{PointSize[Large], Red, Point[N@{a0, u30, u40}]}},
    {{PointSize[Large], Black, Point[N@curpoints1[[1]]]}},
    Map[{Black, Point[{Mod[#[[1]], 2 Pi, -Pi/2], #[[2]], #[[3]]}]} &, 
     curpoints1],
    {{PointSize[Large], Blue, Point[N@curpoints2[[1]]]}},
    Map[{Blue, Point[{Mod[#[[1]], 2 Pi, -Pi/2], #[[2]], #[[3]]}]} &, 
     curpoints2],
    {{PointSize[Large], Orange, Point[N@curpoints3[[1]]]}},
    Map[{Orange, 
       Point[{Mod[#[[1]], 2 Pi, -Pi/2], #[[2]], #[[3]]}]} &, 
     curpoints3],
    {{PointSize[Large], Green, Point[N@curpoints4[[1]]]}},
    Map[{Green, Point[{Mod[#[[1]], 2 Pi, -Pi/2], #[[2]], #[[3]]}]} &, 
     curpoints4],
    {{PointSize[Large], Purple, Point[N@curpoints5[[1]]]}},
    Map[{Purple, 
       Point[{Mod[#[[1]], 2 Pi, -Pi/2], #[[2]], #[[3]]}]} &, 
     curpoints5]]
   ]
  , PlotRange -> All, PlotPoints -> All, BoxRatios -> {1, 1, 1}(*, 
  Axes\[Rule] True,AxesLabel\[Rule] {"\[Alpha]","Subscript[u, 3]",
  "Subscript[u, 4]"},LabelStyle\[Rule]Directive[Black,Bold, Large], 
  Ticks\[Rule] None*)]]

Black: a=1.6008u3=1.14u4=0.02NP=1000
Blue: a=1.5808u3=1.24k=0.01NP=1000
Orange: a=1.5608u3=0.94u4=0.02NP=1000
Green: a=1.5508u3=1.06u4=0.05NP=1000
Purple: a=1.5408u3=1.2u4=0.12NP=1000
Out[42]:
Output
In [ ]: