Complex System Modelling 
with Wolfram Mathematica

Tutorial on YRNCS'14 Workshop
September 2014 Lucca

Gregory Siudem, Warsaw University of Technology

What is Mathematica?

Mathematica is just a notebook...

... a very usefull notebook.

Notebook is your workspace,

Cell is the simplest unit of the code,

You can evaluate cell with the combination [Shift]+[Enter],

(*This is empty cell*)

Functions have easy for guess names,

Solve[x+1==2,x]

Interactive Manipulations!

(3.2+5.8)/5

∫Exp[x]\[DifferentialD]x

Plot[Sin[x],{x,0,2π}]

Solve[x^2+a x+1==0,x]

ListPlot[RandomReal[{0,1},100],Joined->True,Mesh->All]

Why Mathematica?

Simplicity - functions have natural names.

Symbolic computations

Integrate[(Sqrt[1-(x^2)]),{x,-1,1}]

Build - in functions

Plot[Re@Zeta[(1/2)+I x],{x,-20,20},PlotRange->{-3,3}]

Speed programming

Fast generating a code

Fast calculations

source: http://julialang.org/

Visualisation of data!

Plot3D[y^2-x^2,{x,-4,4},{y,-4,4},MeshFunctions->{#3&},Mesh->{{0}},BoxRatios->{1,1,1}]

Instead of bibliography

Documentation center [F1] or http://reference.wolfram.com/language/

http://mathematica.stackexchange.com/

Hints!

Wolfram online resources

http://www.wolfram.com/broadcast/

WolframAlpha

Lots of tutorials

http://blog.wolfram.com/

Example 1.

Logistic family

(Subscript[x, n+1])=(Subscript[H, α])((Subscript[x, n]))=α (Subscript[x, n])(1-(Subscript[x, n]))

Manipulate[GraphicsGrid[{{
ListPlot[NestList[H[#,α]&,z,80],PlotRange->{0,1},Frame->True,FrameStyle->Directive[18,Bold,FontFamily->"Courier",Background->White],Background->White,Joined->True,Mesh->All,PlotStyle->PointSize[0.02],FrameLabel->{"n","(Subscript[x, n])"}],ListPlot[{diag,Table[{α,zz},{zz,0.,1,.01}]},PlotRange->{0,1},Frame->True,FrameStyle->Directive[18,Bold,FontFamily->"Courier",Background->White],Background->White,Mesh->All,PlotStyle->PointSize[0.01],FrameLabel->{"α","(Subscript[x, n])"}]},{Plot[{H[x,α],x},{x,0,1},PlotStyle->Thick,PlotRange->{0,1},Frame->True,FrameStyle->Directive[18,Bold,FontFamily->"Courier",Background->White],FrameLabel->{"x","(Subscript[H, α])[x]"},AspectRatio->1]}}],{α,1,3.999,0.001},{{z,0.5},0,1},Initialization:>{H[x_,α_]:=α x(1-x);
diag=DeleteDuplicates@(Round[#,0.01]&/@Flatten[Table[Thread[{r,Nest[r # (1-#)&,Range[0,1,0.01],1000]}],{r,1.02,3.98,0.02}],1]);}]

Example 2.

Prayer vs. Predator

Lotka-Volterra Model

({{(d/(dt))x=x(k-a y)}, {(d/(dt))y=y(-l+b x)}})

Manipulate[s=NDSolve[{x'[t]==x[t](k-a y[t]),y'[t]==y[t](-l+b x[t]),y[0]==1,x[0]==0.4},{x,y},{t,0,30}];Show[Plot[Evaluate[{x[t],y[t]}/.s],{t,0,20},PlotRange->All,PlotStyle->Thick],ListPlot[Flatten[Evaluate[{Table[{t,x[t]},{t,0,20,3}],Table[{t,y[t]},{t,0,20,3}]}/.s],1],PlotMarkers->{{Graphics@ghost[Red],0.1},{Graphics@pacman,0.1}},Joined->False]],{{k,1},0.1,4,0.1},{{l,1},0.1,4,0.1},{{a,0.5},0.1,4,0.1},{{b,2},0.1,4,0.1},Initialization:>{ghost[color_]:={color,Disk[{0,0},{3,5},{0,π}],White,Disk[{1,3.5},{0.8,1}],Disk[{-0.7,3.5},{0.8,1}],Polygon[{{-3,-0.1},{-2,(Sqrt[2])/2},{-1,-0.1}}],Polygon[{{3,-0.1},{2,(Sqrt[2])/2},{1,-0.1}}],Polygon[{{-1,-0.1},{0,(Sqrt[2])/2},{1,-0.1}}],Blue,Disk[{1.36,3.3},0.4],Disk[{-0.4,3.3},0.4]};
pacman={EdgeForm[Thick],Yellow,Disk[{0,0},0.001,{-π/6,-3π/2-π/3}]};}]

Example 3.

Graphs and networks

Examples from Wolfram Documentation Center

Simple Graphs

Graph[{1\[UndirectedEdge]2,2\[UndirectedEdge]3,3\[UndirectedEdge]1}]
AdjacencyMatrix@%//MatrixForm

Graph Properties

Manipulate[Column[{GraphData[g],GraphData[g,p]}],{g,GraphData[All]},{p,Complement@@GraphData/@{"Properties","Classes"}}]

Social Media Data

Analyzing Road Networks

img=WolframAlpha["Champaign IL",{{"Map:CityData",1},"Image"}];
g=MorphologicalGraph[Binarize[ColorNegate[img]],EdgeStyle->LightGray,VertexStyle->LightGray];
Column[{img,HighlightGraph[g,NeighborhoodGraph[g,125,20],ImageSize->500]}]

Example 4.

Cellular automata

Examples from Wolfram Documentation Center

CellularAutomaton[30,{0,0,0,1,0,0,0},4]
ArrayPlot[CellularAutomaton[30,{{1},0},50]]

ArrayPlot[CellularAutomaton[30, RandomInteger[1, 250], 100]]

ArrayPlot[#, ImageSize -> 40, Mesh -> True] & /@ CellularAutomaton[{224, {2, {{2, 2, 2}, {2, 1, 2}, {2, 2, 2}}}, {1, 1}}, {{{0, 1, 0}, {0, 0, 1}, {1, 1, 1}}, 0}, 8]

Example 5.

Image processing

Examples from Wolfram Documentation Center

lena=ExampleData[{"TestImage","Lena"}]
ImageEffect[lena, #] & /@ {"OilPainting", 
    "Charcoal", "Solarization", {"SaltPepperNoise", 0.2}, 
    "Embossing", {"GaussianNoise", .5}} // Partition[#, 3] & // Grid

i = ;
cells=SelectComponents[DeleteBorderComponents[Binarize[i,{0,.7}]],{"Area","Holes"},100<#1<1000&&#2>0&];
circles=ComponentMeasurements[ImageMultiply[i,cells],{"Centroid","EquivalentDiskRadius"}][[All,2]];
Show[i,Graphics[{Red,Thick,Circle@@#&/@circles}]]

im=
m = MorphologicalComponents[BottomHatTransform[im,8],.1];
SelectComponents[m,"Width",#>5&]//Colorize

Example 6.

π of many flavours

N@π

Integrate[Exp[-((x^2)/2)],{x,-∞,∞}]
(∫_(-∞)^∞)(E^((-(x^2))/2))\[DifferentialD]x

Sum[((((-1))^(k+1))/(2k-1)),{k,1,∞}]
(∑_(k=1)^∞)((((-1))^(k+1))/(2k-1))

n=2000;
points=Partition[Riffle[RandomReal[{-1,1},n],RandomReal[{0,1},n]],2];
out=Select[points,1-((#[[1]])^2)≤ ((#[[2]])^2)&];
in=Select[points,1-((#[[1]])^2)> ((#[[2]])^2)&];
Show[Plot[(Sqrt[1-(x^2)]),{x,-1,1},AspectRatio->0.5,PlotStyle->Thick],ListPlot[{in,out}]]
(Length@in)/n
4%//N

Example 7.

Examples from Wolfram Documentation Center

Mathematical Data

KnotData["Trefoil"]

GraphicsGrid[Partition[GraphData /@ SortBy[GraphData["Cayley", ;; 10], GraphData[#, "V"] &], 7]]

Geographic Data

CountryData["World", {"Shape", "Mollweide"}]

Show[CountryData[#,"Flag"],ImageSize->50]&/@CountryData["Europe"]

CountryData["Italy", "Languages"]
CountryData["Italy","LanguagesFractions"]

DateListPlot[CountryData["Italy",{"GDP",All}]]

ListLogLogPlot[Tooltip[{CountryData[#, "Area"], CountryData[#, "Population"]}, CountryData[#, "Name"]] & /@ CountryData["Europe"],PlotMarkers->{Automatic,Medium}]

Graphics[{Gray, CountryData["Italy", "Polygon"], Thick, Green, Line[#[[Last[FindShortestTour[#]]]] &[Reverse[CityData[#, "Coordinates"]] & /@ CityData[{Large, "Italy"}]]]}]

DateListPlot[WeatherData["Lucca", "MeanTemperature", {{2009, 9,31}, {2014, 9, 31}, "Day"}], Joined->True]

Scientific Data

ListPlot[Flatten[Table[Thread[{z,ElementData[z,"StableIsotopes"]}],{z,100}],1]]

Graphics[Table[If[Head[ElementData[z,"Group"]]=!=Missing,Inset[Style[Pane[ElementData[z,"Abbreviation"],{20,20}],Background->(ElementData[z,"Phase"]/.{"Solid"->LightBrown,"Liquid"->LightBlue,"Gas"->Yellow,_->Gray})],{ElementData[z,"Group"],-ElementData[z,"Period"]}],{}],{z,108}]]

ChemicalData["Caffeine"]

ChemicalData["Ethanol", "MoleculePlot"]

GenomeData[{"ChromosomeX", {108771220, 108771260}}]

DateListPlot[FinancialData["IBM", "Jan. 1, 1950"]]

Example 8.

Statistics and probability

Examples from Wolfram Documentation Center

Probability[x≤3,x\[Distributed]PoissonDistribution[μ]]

sample=RandomFunction[WienerProcess[],{0,1,.001},2]["States"];
ListLinePlot[Transpose@sample,ColorFunction->"Rainbow",ImageSize->300]

FindClusters[
  Join[RandomVariate[NormalDistribution[0, 1], {1000, 2}], 
   RandomVariate[NormalDistribution[1, .1], {1000, 2}]]] // ListPlot

data = {87, 91, 97 , 80, 71, 86, 72, 93, 83, 73, 76}
ℋ=DistributionFitTest[data,𝒹=NormalDistribution[82,9],"HypothesisTestData"]
ℋ["TestDataTable"]
Plot[Evaluate@{CDF[ℋ["FittedDistribution"],x],CDF[EmpiricalDistribution[data],x]},{x,50,110},PlotStyle->{Red,Blue},Exclusions->None,Filling->{1->{2}},Frame->True]

Outline

Mathematica may be usefull tool in the Research in th Complex Systems Science

Manipulate is awesome!

There are a lot of bulid-in data.

What next? Mathematica at RaspberryPi or Wolfram Cloud? ;-)

i=;
b=FindFaces[i];
Show[i,Graphics[{EdgeForm[{Red,Thick}],Opacity[0],Rectangle@@@b}]]

Example from Wolfram Documentation Center

Thank you for your attention!