All in one platform

Specialized software and add-on toolboxes discourage the creative exploration of new ideas and areas—an even greater cost than their purchase price. Mathematica requires no add-ons. It has built-in specialized functionality for many technical areas, from computational biology to wavelet analysis, all tightly integrated with the rest of the system.

Why “All in one platform” Part I

Almost everything can be done in Mathematica. Here is a small example for a Digitizer.

findMarkers[img_,pt_,thres_,minArea_]:=ComponentMeasurements[MorphologicalComponents[ColorNegate[Binarize[ImageCorrelate[img,ImageTrim[img,pt],NormalizedSquaredEuclideanDistance],thres]]],{"Centroid","Area"},#2>minArea&][[All,2,1]];

SetAttributes[getMarkers,HoldRest];
getMarkers[img_,resMarkers_]:=DynamicModule[{pt={ImageDimensions[img]/4,ImageDimensions[img]/2},axisDefinePane,defineMarkerPane,findMarkerPane,editMarkersPane,finalResultPane,xAxisBegin,xAxisEnd,yAxisBegin,yAxisEnd,myMarkers,myTransform,xoy={{1/2,1/8} ImageDimensions[img],{1/8,1/8} ImageDimensions[img],{1/8,1/2} ImageDimensions[img]}},axisDefinePane=Grid[{{LocatorPane[Dynamic[xoy],Dynamic[Show[img,Graphics[{Line[xoy]}]]],Appearance->{Graphics[{Red,AbsolutePointSize[5],Point[{0,0}]}],Graphics[{Green,AbsolutePointSize[5],Point[{0,0}]}],Graphics[{Blue,AbsolutePointSize[5],Point[{0,0}]}]}]},{Row[{"x(1): ",InputField[Dynamic[xAxisBegin],Number,FieldSize->Tiny]," x(2): ",InputField[Dynamic[xAxisEnd],Number,FieldSize->Tiny]}]},{Row[{"y(1): ",InputField[Dynamic[yAxisBegin],Number,FieldSize->Tiny]," y(2): ",InputField[Dynamic[yAxisEnd],Number,FieldSize->Tiny]}]}}];
defineMarkerPane=LocatorPane[Dynamic[pt],Dynamic[Show[img,Graphics[{EdgeForm[Black],FaceForm[],Rectangle@@pt}]]],Appearance->Graphics[{Red,AbsolutePointSize[5],Point[{0,0}]}]];
findMarkerPane=Manipulate[Show[img,Graphics[{Red,Circle[#,5]&/@(myMarkers=findMarkers[img,pt,t,1.05])}]],{{t,0.2,"Threshold"},0,1},TrackedSymbols->{t},ControlPlacement->Bottom];
editMarkersPane=LocatorPane[Dynamic[myMarkers],img,Appearance->Graphics[{Red,Circle[{0,0},1]},ImageSize->10],LocatorAutoCreate->True];
finalResultPane=Dynamic[myTransform=FindGeometricTransform[{{xAxisEnd,yAxisBegin},{xAxisBegin,yAxisBegin},{xAxisBegin,yAxisEnd}},xoy][[2]]//Quiet;
ListLinePlot[resMarkers=myTransform/@Sort[myMarkers],Frame->True,Mesh->All],TrackedSymbols->{myMarkers,xoy,xAxisEnd,yAxisBegin,xAxisBegin,yAxisBegin,xAxisBegin,yAxisEnd}];
TabView[{"Define axes"->axisDefinePane,"Define marker"->defineMarkerPane,"Find Markers"->findMarkerPane,"Edit Markers"->editMarkersPane,"Results"->finalResultPane}]]

img=;

getMarkers[img, test]

Why “All in one platform” Part II

Almost everything can be done in Mathematica. Here is a small example for an image restorer.

lincoln = ;

edges = EdgeDetect[lincoln]

dims = ImageDimensions[lincoln]

Manipulate[LCPP=ListCurvePathPlot[pts,PlotStyle->Directive[Thickness[th]]];Row[{Show[lincoln,LCPP, ImageSize->dims, PlotRange->{{0, dims[[1]]}, {0, dims[[2]]}}],Inpaint[lincoln, Dilation[ImageMultiply[edges,ColorNegate[Binarize[Show[LCPP, ImageSize->dims,PlotRange->{{0,dims[[1]]},{0,dims[[2]]}},Axes->False]]]],1],Method->method]}], {{pts,RandomReal[Min[ImageDimensions[lincoln]],{3,2}]},{0,0},ImageDimensions[lincoln],Locator,Appearance->Graphics[{Red,Disk[{0,0}]}, ImageSize->7],LocatorAutoCreate->{2,10}},{{th,.004,"thickness"},0,.1},{{method,"Diffusion"},{"Diffusion","TotalVariation","FastMarching","NavierStokes","TextureSynthesis"},Setter}]

Help systems

Websites

SystemOpen["http://demonstrations.wolfram.com/"]

SystemOpen["http://mathematica.stackexchange.com/"]

Wellknown “F1”

Manipulate[Plot[Sin[x(1+a x)],{x,0,6}],{a,0,2}]

Getting options from a function

Options[Manipulate]

UNIX ??

?Manipulate

FreeForm Input

Wolfram Alpha

Numerical precision // Mathematica vs. Excel

(4/5)*5* (1-(4/5))

NestList[Function[x,5 x (1-x)],(4/5),30]

SystemOpen[FileNameJoin[{NotebookDirectory[],"SupplementalFiles","Genauigkeit.xlsx"}]];

New in Mathematica9 // Units

Quantity

A unit can be a string or a product of strings:

Quantity[1,"Feet"]

Quantity[1.84,("Meters"*"Pascals")/"Farads"]

Quantity[1,"SpeedOfLight"]

Unit Convert

Convert from miles to kilometers :

UnitConvert[Quantity[8.2,"Miles"],"Kilometers"]

Convert a Quantity to the appropriate SI base unit :

UnitConvert[Quantity[3.8,"Pounds"]]

UnitConvert[Quantity[3,"Pascals"]]

CompatibleUnitQ

Test whether a sequence of quantities is compatible:

CompatibleUnitQ[Quantity[3,"Feet"],Quantity[8,"Meters"]]

CompatibleUnitQ[Quantity[1,"Feet"],Quantity[1,"Pounds"]]

New in Mathematica9 // WWW Access

Utilizing Google Maps

Manipulate[
ImportString[
ExportString[
URLFetch["http://maps.googleapis.com/maps/api/staticmap","ContentData","Parameters"->{"center"->c,"zoom"->ToString[z],"size"->"1024x768","maptype"->ToLowerCase[t],"sensor"->"false","style"->"inverse_lightness:true","format"->"png"}],"Byte","DataFormat"->{"Bytes"}
],
"PNG","DataFormat"->{"Byte"}
],
{{c,"Friedrichsdorf, Max-Planck-Straße 22b","location"},"",InputField[#1,String,FieldSize->35]&},
Delimiter,
{{t,"terrain","map type"},{"roadmap","terrain","satellite","hybrid"},ControlType->RadioButton},
{{z,9,"zoom"},1,20,1},
ContinuousAction->False
]

Graph Theory

Die Deutsche Bahn

Utility function to sparse the URL source  zugmonitor.sueddeutsche.de.

UTF8Fix[string_String]:= StringReplace[string, "\\u00"~~hex:(HexadecimalCharacter~~HexadecimalCharacter):> FromCharacterCode@FromDigits[hex,16]]

MinutesToTime[ms_Integer]:= {Quotient[ms,1440],Mod[Quotient[ms,60],24],Mod[ms,60]}

ScrapeStatus[status_String]:=Switch[status,"E","Error","F","Finished","S","Sleeping","X","Running","N","New"]

StringToTrainProperties[props_String]:=
Replace[
Replace[
ToExpression@StringReplace[props,{":"-> "->","["->"{","]"->"}","\\u00"~~hex:(HexadecimalCharacter~~HexadecimalCharacter):> FromCharacterCode@FromDigits[hex,16]}],
{("arrival"-> time_Integer):> "Arrival"->MinutesToTime[time],
("departure"-> time_Integer):> "Departure"->MinutesToTime[time],
("station_id"-> id_Integer):> "StationID"->id,
("scraped"-> status_Integer):> "Scraped"->(status===1),
("delay"-> duration_Integer):> "Delay"->duration,
("delay_cause"-> cause_String):> "DelayCause"->UTF8Fix[cause]},
{4}
],
{("status"->status_String):> ("Status" -> ScrapeStatus[status]),
("stations"->stations_List):> ("Stations" -> stations),
("started"->null):> ("Started" -> 0),("started"-> time_String):> ("Started"-> DateList[{time, {"Year","-","Month","-","Day","T","Hour","->","Minute","->","Second",".","Millisecond"}}]),
("finished"-> null):> ("Finished" -> 0),
("finished"-> time_String):> ("Finished"-> DateList[{time, {"Year","-","Month","-","Day","T","Hour","->","Minute","->","Second",".","Millisecond"}}]),
("nextrun"-> time_String):> ("NextRun"-> DateList[{time, {"Year","-","Month","-","Day","T","Hour","->","Minute","->","Second"}}]),
("train_nr"-> train_String):> ("TrainNumber"-> train),
("date"-> date_List):> ("Date"-> date + {0,1,0})},
{1}
]

TravelTimes[train_List]:=Map[
Map[{24 60,60,1}.(-Subtract@@#)&,Partition[Take[Flatten[#,1],{2,-2}],2]]&,
Replace[{"Arrival","Departure"}/.Replace["Stations",trains[[All,2]]],{{"Arrival",time:{_,_,_}}:> {time-{0,0,2},time},{time:{_,_,_},"Departure"}:> {time,time+{0,0,2}}},{2}]
]

TrainConnectivity[train_List]:=
Map[Apply[DirectedEdge,Partition[#,2,1],{1}]&,"StationID"/.Replace["Stations",trains[[All,2]]]]

Stations

stationString=URLFetch["zugmonitor.sueddeutsche.de/api/stations"];

stations=StringCases[stationString,"\""~~(DigitCharacter ..)~~"\":{\"lat\":"~~lat:NumberString~~",\"lon\":"~~lon:NumberString~~",\"name\":\""~~Shortest[station__]~~"\",\"id\":"~~id:(DigitCharacter ..)~~"}":> (ToExpression@id->{ UTF8Fix@station,{ToExpression@lat,ToExpression@lon}})];

stations=DeleteCases[stations,_->{__String,{0.,0.}}];

stationNames = stations[[All,2,1]];

Trains

trainString= URLFetch["zugmonitor.sz.de/api/trains/"<>DateString[{"Year", "-","Month","-","Day"}]];

trains=Apply[
(ToExpression[#1]->StringToTrainProperties[#2])&,
Partition[StringReplace[StringSplit[StringTake[trainString,{2,-2}],"\""~~id:DigitCharacter..~~"\":":>id],props:(StartOfString~~"{"~~__~~"},"~~EndOfString):>StringDrop[props,-1]],2],
{1}
];

Graph

db=Graph[
Thread@Labeled[stations[[All,1]],Thread@Placed[stations[[All,2,1]],Tooltip]],
Union@Flatten[Map[Apply[(UndirectedEdge@@Sort[{##}])&,Partition[#,2,1],{1}]&,"StationID"/.("Stations"/.trains[[All,2]])],1],
VertexCoordinates-> Apply[(#1-> Reverse@Last[#2])&,stations,{1}]
];

map=Graphics@MapThread[
{FaceForm[#1],CountryData[#2,"Polygon"]}&,
{Map[ColorData["SouthwestColors"],RandomReal[{0,1},{13}]],
Prepend[Join[CountryData["Germany","BorderingCountries"],{"Italy","Hungary","Slovakia"}],"Germany"]}
];

The network of the German railroad:

Show[
{map,db}, 
ImageSize-> {1024,768}
]

Betweenness Centrality of Stations:

Take[Part[Thread[stationNames->BetweennessCentrality[db]],Ordering[BetweennessCentrality[db],All,Greater]],25]//TableForm

Find Shortest Path from x to y

Dynamic[Row[route=Riffle[FindShortestPath[db,origin , destination]/. Thread[stations[[All,1]]-> stations[[All,2,1]]]," -> "]]];

routecoord=Map[
Reverse[stations[[First[First[Position[stations,#,Infinity]]],2,2]]]&,
DeleteCases[route," -> "]];

DynamicModule[
{validstations=DeleteCases[route," -> "]},
Grid[{
{PopupMenu[Dynamic[origin],Reverse/@Sort@Thread[stations[[All,2,1]]-> stations[[All,1]]]]," -> "
PopupMenu[Dynamic[destination],Reverse/@Sort@Thread[stations[[All,2,1]]-> stations[[All,1]]]],
Button["Prüfe Verbindung",
route=Riffle[FindShortestPath[db,origin , destination]/. Thread[stations[[All,1]]-> stations[[All,2,1]]]," -> "];validstations=DeleteCases[route," -> "];
routecoord=Map[
Reverse[stations[[First[First[Position[stations,#,Infinity]]],2,2]]]&,
validstations]],""},
{Dynamic[Row[Riffle[Map[stations[[First[First[Position[stations,#,Infinity]]],2,1]]&,validstations]," -> "]]],SpanFromLeft},
{Dynamic[Show[
{map,db,Graphics[{ Thick, Dashed,Red,Line[routecoord],Green,PointSize[.01],Point[First[routecoord]],Blue,Point[Last[routecoord]]}]}, 
ImageSize-> {1024,768}
]],SpanFromLeft}
},Alignment->Left]
]

New in Mathematica9 // Reliability Analysis

A vehicle needs steering and at least one of two brake systems to be working to be safe...

ℛ=ReliabilityDistribution[

steering∧(brake1∨brake2),

{{steering,ExponentialDistribution[3]},
{brake1,ExponentialDistribution[1]},
{brake2,ExponentialDistribution[2]}}];

Distribution functions:

Table[Plot[df[ℛ,t],{t,0,2},PlotLabel->df,PlotRange->All],{df,{SurvivalFunction,HazardFunction,PDF,CDF}}]

Mean and median time to failure:

{Mean[ℛ],Median[ℛ]}

N[%]

The probability that the system fails before time t==1/2:

Probability[time<0.5,time\[Distributed]ℛ]

New in Mathematica9 // Random Processes

Customers arrive at a store according to a Poisson rate of four per hour. Given that the store opens at 9am, find the probability that fewer than five customer has arrived by 9:30am:

arrivalProcess=PoissonProcess[4];

NProbability[x[1.5]<5,x\[Distributed]arrivalProcess]

How long can you stay open to be at least 10% certain of receiving fewer than 5 customers?

Probability[x[t]<5,x\[Distributed]arrivalProcess]

FindRoot[%==0.10,{t,1}]

New in Mathematica9 // Markov Chains and Queues

𝒬=QueueingProcess[5(*Arrival rate*),3 (*Service rate*),2 (*Number of service queues*)]

QueueProperties[𝒬]//FullSimplify

data=RandomFunction[𝒬,{0,300}];
ListLinePlot[data]

New in Mathematica9 // When events

Simulate a bouncing ball that retains 95% of its velocity in each bounce:

Manipulate[
sol=NDSolve[{y''[t]==-9.8,y[0]==13.5,y'[0]==5,a[0]==13,WhenEvent[y[t]-a[t]==0,y'[t]->-c y'[t]],WhenEvent[Mod[t,n],a[t]->a[t]-1]},{y,a},{t,0,8},DiscreteVariables->{a}] ;
Plot[Evaluate[{y[t],a[t]}/.sol],{t,0,8},Filling->{2->0}],
{c,0.6,1},
{n,0.6,1.75}]

New in Mathematica9 // Time Series and Stochastic Differential Equations

Stochastic differential equations (SDEs) occur where a system described by differential equations is influenced by random noise. Stochastic differential equations are used in finance (interest rate, stock prices, …), biology (population, epidemics, …), physics (particles in fluids, thermal noise, …), and control and signal processing (controller, filtering, …).

TimeSeries application is now almost completely obsolete

Example

proc=ItoProcess[\[DifferentialD]x[t]==-x[t]\[DifferentialD]t+(Sqrt[1+x[t]^2])\[DifferentialD]w[t],x[t],{x,1},t,w\[Distributed]WienerProcess[]]

Simulate the process:

RandomFunction[proc,{0.,5.,0.01}]

ListLinePlot[%,Filling->Axis]

Compute mean function:

Mean[proc[t]]

Compute covariance function:

CovarianceFunction[proc,s,t]

Plot3D[%,{s,0,5},{t,0,5},ColorFunction->"NeonColors"]

New in Mathematica9 // Graphics & Dynamics

ListPicker

DynamicModule[{tt={}},Row[{ListPicker[Dynamic[tt],{Labeled[1.502198148431174*^12, "Canada"] -> "Canada", 
  Labeled[2.8565288385419565*^12, "France"] -> "France", 
  Labeled[3.649468713254549*^12, "Germany"] -> "Germany", 
  Labeled[2.3030587981565913*^12, "Italy"] -> "Italy", 
  Labeled[4.910691611511709*^12, "Japan"] -> "Japan", 
  Labeled[1.6765878003431465*^12, "Russia"] -> "Russia", 
  Labeled[2.666266099178948*^12, "UnitedKingdom"] -> "UnitedKingdom", 
  Labeled[1.4096716929022*^13, "UnitedStates"] -> "UnitedStates"}]," ",Dynamic[PieChart[Append[tt,3.366151693844008`*^13-Total[tt[[All,1]]]],ImageSize->200,PlotLabel->"G8 GDP"]]}]]

Legends

LogPlot[{Sin[x^2+1],Cos[x^2+1]},{x,0,π},PlotLegends->"Expressions"]

Plot[{Sin[x],Cos[x]},{x,0,2π},PlotStyle->{Directive[Thick,Red],Directive[Dashed,Gray,Thick]},PlotLegends->LineLegend[{"sin(x)","second curve"}]]

ListLinePlot[Table[f,{f,{Log[x],x^(1/2)}},{x,0,10,0.1}],DataRange->{0,10},PlotLegends->Placed[{"log(x)","(x^(1/2))"},Above]]

Plot[{Sin[x],Cos[x]},{x,0,2π},PlotLegends->SwatchLegend["Expressions"]]

ContourPlot[Sin[x y],{x,0,3},{y,0,3},PlotLegends->Automatic]

Gauges

Manipulate[Row[{ContourPlot[q1/Norm[{x,y}-p[[1]]]+q2/Norm[{x,y}-p[[2]]],{x,-2,2},{y,-2,2},ColorFunction->"GrayYellowTones",ImageSize->220],AngularGauge[q1/Norm[p[[3]]-p[[1]]]+q2/Norm[p[[3]]-p[[2]]],{-5,5},PlotTheme->"Volts",ScaleRanges->{{-5,-3},{3,5}}]},Spacer[10],Alignment->{Center,Center}],{{q1,-1},-3,3},{{q2,1},-3,3},{{p,{{-1,0},{1,0},{0,0}}},{-2,-2},{2,2},Locator},Deployed->True]

New in Mathematica9 // Image processing

Mathematica 8 is already the most powerful high - level image processing algorithm development platform.

Dominant color detection

Row[Tooltip[Image[ImageResize[#,400],Magnification->1],Image[{List@@@DominantColors[#,8]},ImageSize->200]]&/@{,}]

Denoising filters

FourierDCTFilter[,.6]

Feature detection

images={,};
pts=ImageFeatureTrack[images,MaxFeatures->15];
Row@MapThread[Show[#1,Graphics[{PointSize[Medium],Yellow,Point[#2]}]]&,{images,DeleteCases[pts,_Missing,Infinity]}]

Face detection

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

dynamic face detection

3D volumetric image processing

Image processing engine now supports 3D volumetric processing—and adds new capabilities.

i=Image3D[Import["ExampleData/CTengine.tiff","Data"],"Byte",BoxRatios->1,Graphics3DMethod->{"ColorFormatExperiment"->"HighBits"}]

Manipulate[
If[d==1&&slice>110,slice=110];
Image3DSlices[i,{slice},d][[1]],{slice,1,Dynamic[If[d==1,110,256]],1},{d,{1,2,3}}]

New in Mathematica9 // Social Network Analysis

Connection tools for Facebook, Twitter, GooglePlus and LinkedIn

SocialMediaData["Facebook","FriendNetwork"]

SocialMediaData[{"Facebook","2038288"},"BimodalLikeCommentNetwork" ]

Show the recent history of a user's activities:

SocialMediaData["Facebook", "ActivityRecentHistory"]

Formatted data:

SocialMediaData["Facebook", "ActivityRecentHistory","FormattedData"]

SocialMediaData[{"Twitter","yanzhang20"}, "Friends"]

Follower network of a specified user:

SocialMediaData[{"Twitter","16003913"},"FollowerNetwork"]

New in Mathematica9 // RLink

This example compares beta sites on the StackExchange Q & A portal.

Needs["RLink`"]
InstallR[]

Start with some data, which was originally also obtained by running a Mathematica script to query the sites of StackExchange.

data={{"personal-finance-and-money",4,98,429,2.6`,1341},{"startup-business",5.5`,97,601,3.4`,3040},{"board-and-card-games",2.9`,97,285,2.5`,1680},{"homebrewing-beer-wine-etc",1.4`,100,181,2.7`,1577},{"writers",1.4`,100,207,3.4`,1146},{"audio-video-production",3.2`,87,107,2.`,1231},{"graphic-design",4.6`,96,153,2.2`,4773},{"code-review",11.7`,90,436,2.`,3173},{"code-golf-programming-puzzles",1.6`,97,236,7.8`,464},{"quantitative-finance",2.7`,92,179,2.2`,1034},{"project-management",1.8`,99,166,4.1`,1025},{"physical-fitness",4.1`,97,227,2.3`,4177},{"motor-vehicle-maintenance-and-repair",1.9`,94,101,1.9`,1448},{"parenting",2.1`,100,243,3.8`,1368},{"musical-practice-and-performance",2,99,211,2.8`,1421},{"software-quality-assurance-testing",1.4`,88,91,3.4`,1332},{"german-language-usage",1.4`,100,201,2.7`,663},{"japanese-language-usage",3.2`,99,159,2.`,599},{"philosophy",2.5`,97,128,2.7`,289},{"gardening-and-landscaping",3.2`,96,188,1.8`,1960},{"travel",7.2`,99,320,2.2`,1781},{"personal-productivity",2.1`,98,170,4.`,447},{"cryptography",3.3`,96,97,1.9`,574},{"signal-processing",3.9`,90,119,1.9`,709},{"french-language-usage",1.6`,100,121,2.6`,541},{"christianity",4.1`,100,246,2.6`,813},{"bitcoin",2.1`,96,112,2.1`,1033},{"linguistics",1.1`,92,114,2.2`,236},{"biblical-hermeneutics",2.1`,99,60,1.8`,245},{"history",1.9`,95,126,1.9`,215},{"lego",0.5`,98,76,2.1`,391},{"spanish-language-usage",1,100,104,2.2`,378},{"computational-science",2.6`,91,107,2.3`,417},{"movies-tv",5.1`,90,177,1.6`,1738},{"chinese-language-usage",0.9`,99,66,2.6`,143},{"biology",3.1`,89,126,1.6`,510},{"poker",0.6`,99,28,2.6`,74},{"mathematica",12.9`,96,227,2.2`,1538},{"cognitive-sciences",2.9`,86,67,1.7`,203},{"the-great-outdoors",1.1`,98,96,2.3`,401},{"smugmug",0.6`,93,18,1.6`,227},{"martial-arts",0.4`,97,56,3.6`,165},{"sports",1.4`,99,64,1.8`,439},{"academia",4.5`,98,104,2.5`,446},{"computer-science",5.4`,88,138,1.9`,362},{"the-workplace",4.2`,100,157,3.6`,529},{"windows-phone",1.6`,97,30,1.6`,617},{"chemistry",2.1`,87,36,1.5`,98},{"chess",1.5`,98,46,2.1`,98},{"libraries-information-science",1.1`,99,43,2.9`,142},{"raspberry-pi",6.3`,95,50,1.8`,1122},{"russian-language-usage",3.7`,98,30,2.5`,153},{"islam",15.5`,93,36,2.4`,292}};

Each row contains the name of the site, average number of questions per day, percentage of answered questions, number of avid users, average ratio of answers to questions, and average number of daily visits.
Export this data to a file.

file=Export[FileNameJoin[{$TemporaryDirectory,"testdata.dat"}],data,"Table"];

Send the file name to R.

RSet["testfile",file]

Read the data.

REvaluate["testdata <- read.table(testfile);"]

Add names to columns.

REvaluate["names(testdata) <- c(\"Site\",\"Q_day\",\"answered\",\"Av_users\",\"Ans_ratio\",\"Visits\")"]

Display the first few rows.

TableForm@REvaluate["head(testdata)"]

This shows how the convenience of Mathematica' s interactivity can be combined with R' s processing of tabular data.Construct a filtering function that allows filtering of data according to thresholds on values of various columns, and sort the data with respect to any single column.

sortAndFilter=RFunction["function(nq,users,aratio,visits, orderby) {		
   		filtered <- testdata[
   			testdata$Q>nq & testdata$Av > users & 
   			testdata$An > aratio & testdata$Vis > visits,
   		];
   		filtered[rev(order(filtered[,orderby])),]
   	}"];

Define the Mathematica dynamic interface.

getSEStats[]:=Manipulate[TableForm@sortAndFilter[nq,users,aratio,visits,orderby],Column[{Row[{Control[{{orderby,"Q_day","Order by"},{"Q_day","answered","Av_users","Ans_ratio","Visits"}}]}],Grid[{{Row[{Control[{{nq,5,"Questions per day"},1,15,1}],Framed@Dynamic[nq]}," "]},{Row[{Control[{{users,100,"Avid users"},5,800,5}],Framed@Dynamic[users]}," "]},{Row[{Control[{{aratio,1.5,"Answer ratio"},0.5,5.,0.1}],Framed@Dynamic[aratio]}," "]},{Row[{Control[{{visits,500,"Visits per day"},0,5000,50}],Framed@Dynamic[visits]}," "]}},Alignment->{{Left,Right},{Left,Right}}]},Alignment->Center]]

Now start exploring the data.The sliders control thresholds for each of the column values, and the buttons allow you to order the results according to the specific column values.

getSEStats[]

Freeform Input and Wolfram Alpha: Differences

Manipulate

Manipulate[Show[img2/.{Sphere[l_,_]->Sphere[l,r]},img1,ImageSize->500],{r,0,170}]

Some examples

Parallelizing

Timing[Table[{Cos[ϕ]Sin[θ],Sin[θ]Sin[ϕ],Cos[θ]},{ϕ,-1000π,1000π,.2},{θ,0,π,.1}];]

Timing[ParallelTable[{Cos[ϕ]Sin[θ],Sin[θ]Sin[ϕ],Cos[θ]},{ϕ,-1000π,1000π,.2},{θ,0,π,.1}];]

Table[ParallelSubmit[{i},FactorInteger[2^i+1]],{i,213,220}]

WaitAll[%]

Compilation & Parallelization

In Mathematica the Compile function can automatically generate C code, compile it, link dynamically to Mathematica at run-time, and run in parallel when possible.

testx=N[Range[12^3]];
n=12^3;

cf=Compile[{{x,_Real},{n,_Integer}},Module[{y=1.},Do[y=(y+x/y)/2,{n}];y],RuntimeAttributes->Listable,Parallelization->False];

cfp=Compile[{{x,_Real},{n,_Integer}},Module[{y=1.},Do[y=(y+x/y)/2,{n}];y],RuntimeAttributes->Listable, Parallelization->True];

dllf=Compile[{{x,_Real},{n,_Integer}},Module[{y=1.},Do[y=(y+x/y)/2,{n}];y],RuntimeAttributes->Listable,CompilationTarget->"C",Parallelization->False];

dllfp=Compile[{{x,_Real},{n,_Integer}},Module[{y=1.},Do[y=(y+x/y)/2,{n}];y],RuntimeAttributes->Listable, Parallelization->True ,CompilationTarget->"C"];

AbsoluteTiming[Length[cf[testx,n]]]

AbsoluteTiming[Length[cfp[testx,n]]]

AbsoluteTiming[Length[dllf[testx,n]]]

AbsoluteTiming[Length[dllfp[testx,n]]]

CDF // Creating a jigsaw

How to create a jigsaw with predefined pictures and distribute them

iml={,,,,,};

I enjoy Mathematica’s ability’s to make images part of the code. You can replace them with your own photographs. Please note that the lock and extract functions and variable iml need to be evaluated first for the code below to work. You can always add them explicitly in the body of Manipulate or via its option Initialization.

lock[p1_,p2_]:=
With[{rc=RandomChoice[{-1,1}],d=EuclideanDistance[p1,p2],pm=(p1+p2)/2,dp=(p2-p1)/5},
If[d<.1,Line[{p1,p2}],
BSplineCurve[{p1,pm,pm-dp+rc {1,-1} Reverse[dp],pm+dp+rc {1,-1} Reverse[dp],pm,p2},SplineWeights->{1,15,25,25,15,1}]]]

extract[gr_]:=Union[Sort/@Flatten[Partition[#,2,1]&/@Map[gr[[1,1,#]]&,Flatten[Cases[gr,Polygon[_],Infinity][[All,1]],1]],1]]

Manipulate[
SeedRandom[rn];
jig=Graphics[{Thickness[thk],Opacity[op],color,lock@@@extract[ListDensityPlot[Flatten/@Transpose[{pt,RandomReal[1,Length[pt]]}],InterpolationOrder->0,Mesh->All,PlotRange->{{0,1},{0,1}}]]},PlotRange->{{0,1},{0,1}},FrameStyle->Thick,ImageSize->435,Prolog->If[swt,Inset[Image[img,ImageSize->435]],{}],Background->Gray]
,{{pt,RandomReal[1,{35,2}]},Locator,LocatorAutoCreate->True,Appearance->Style["●",Orange,Opacity[If[loc,1,0]]]},
Column[{
Row[{Control[{color,GrayLevel[.95],ImageSize->{185,40}}],
Spacer[45],Control[{{loc,False,"Locators"},{False,True}}],
Spacer[45],Control[{{swt,True,"Image"},{False,True}}]}],
Row[{Control[{{thk,.004,"Width"},0,.01,Slider,ImageSize->75}],
Spacer[10],Control[{{op,1,"Fade"},0,1,Slider,ImageSize->75}],
Spacer[10],Control[{{rn,8,"Mix"},1,1000,1,Slider,ImageSize->75}],
Spacer[10],Button["copy",CopyToClipboard[Image[jig,ImageSize->{435,435}]],Appearance->"Palette",Background->Orange],
Spacer[10],Button["new",pt=RandomReal[1,{35,2}],Appearance->"Palette",Background->Orange]}],
Control[{{img,iml[[1]],""},
iml,Setter}]},Alignment->Center],FrameMargins->0,AppearanceElements->None,SaveDefinitions->True,SynchronousUpdating->False, SaveDefinitions->True]

C - Programming: Creating a directory

First we create a directory on our HDD to store all our files

targetDir = CreateDirectory["C:/mathematica-source"]

C-Programming // Compiled function

Now we are creating a compiled function that defines the discrete low-pass filter

lopass=Compile[{{x,_Real,1},dt,RC},Module[{a=dt/(RC+dt),yprev=First[x],yi},Table[yi=a*x[[i]]+(1-a)*yprev;
yprev=yi;
yi,{i,1,Length[x]}
]
]
];

C-Programming // Saving almost all necessary files

The following function uses the Code Generator to save the necessary files in our folder

fnSource = FileNameJoin[{targetDir,"lopass.c"}];
Export[fnSource, lopass];
FileNames["*",targetDir]

C-Programming // Creating the main source code

Writing the main source of the C-Code in Mathematica isn't necessary, but for demonstration just fine

lopassmainSrc="
#include \"stdio.h\"
#include \"stdlib.h\"
#include \"lopass.h\"
#include \"WolframRTL.h\"
static WolframLibraryData libData = 0;

int main()
{
  int err = 0;
  mint i, type, rank, nelems, *dims;
  double *data;
  MTensor x, y;
  double dt;
  double RC;
  libData = WolframLibraryData_new(WolframLibraryVersion);

  /* read x */
  type = MType_Real;
  rank = 1;
  dims = (mint*)malloc(rank * sizeof(mint));
  scanf(\" %d\", &nelems);
  dims[0] = nelems;

  err = (*(libData->MTensor_new))(type, rank, dims, &x);
  if (err) return 1;

  free(dims);

  data = (*(libData->MTensor_getRealData))(x);
  for(i = 0; i < nelems; i++) {
    scanf(\" %lf\", &(data[i]));
  }

  /* read dt */
  scanf(\" %lf\", &dt);
  /* read RC */
  scanf(\" %lf\", &RC);

  err = Initialize_lopass(libData);

  y = 0;
  err = lopass(libData, x, dt, RC, &y);
  printf(\"%d\\n\", err);
  if(0 == err){
    dims = libData->MTensor_getDimensions(y);
    nelems = dims[0];
    data = (*(libData->MTensor_getRealData))(y);
    printf(\"%d\\n\", nelems);
    for(i = 0; i < nelems; i++)
      printf(\"%f\\n\", data[i]);
  }

  Uninitialize_lopass(libData);
  return 0;
}
";

C-Programming // Saving

Saving the main source into our target directory

lopassmainSrcFile=FileNameJoin[{targetDir,"lopassMain.c"}]
Export[lopassmainSrcFile,lopassmainSrc,"Text"];

C-Programming // Creating the executable file

Linking with the WolframRTL_Static _Minimal.lib, we do not have to define path variables for the library

Needs["CCompilerDriver`"];
lopassExe=CreateExecutable[{fnSource,lopassmainSrcFile},"lowpass","TargetDirectory"->targetDir,"Libraries"->"WolframRTL_Static_Minimal.lib"]

C-Programming // Creating the input

The following code defines our input

dt=0.01;
RC=0.3;
input=Table[Sin[x]+Sin[x*10]+Sin[x*50],{x,0,10,dt}];
ListPlot[input,ImageSize->Medium,Joined->True]

Our application needs the input in the following form due to our main source:
nelems
elem #1
 ...
elem # n
dt
RC

C-Programming // Saving the input

Now we create a valid input from our source and save it in our main directory as a text file

inputText=StringJoin[ToString[Length[input]],"\n",Riffle[ToString/@input,"\n"],ToString[dt],ToString[RC]];
inputFile=FileNameJoin[{targetDir,"input.txt"}]
Export[inputFile,inputText,"Text"];

C-Programming // Starting the application

The following command starts the executable, feeds it with the input and saves the data into "outputLines"

SetDirectory[targetDir];outputLines=Import["!"<>lopassExe<>" < "<>inputFile,"Lines"];//AbsoluteTiming
ResetDirectory[];

C-Programming // Converting the data

We now extract the result and cut off the last 2 values, which were dt and RC

output=ToExpression/@outputLines;
output=
If[MatchQ[output, {0,x_/;x+2===Length[output],___}],
Drop[output,2],
$Failed
];

C-Programming // Programming: Did it work?

Did our low-pass filter work?

ListPlot[{input,output},Joined->True]

Mathematica V7 vs. V8 vs. V9

Solution 1 : Using 3D Texture with Polygons -> Mathematica 7

The idea is to use Polygon with 3 D texture supported by Texture, but it requires a bit of undocumented hack to make it smooth.The original data set is from Stanford Graphics Group website.The dataset that has been used is CThead, 8 - bit tiffs (download).Before proceed, make sure that you have a plenty of memory (~500 MB would be enough).Also, if you don' t have a good graphics card, turning off 3 D antialiasing (through "Preference" menu) will be helpful.

Step 1

Download slices into Mathematica (it takes a long time ...)

filename=FileNameJoin[{NotebookDirectory[],"SupplementalFiles","cthead-8bit.tar.gz"}];

slices=Import[filename,#]&/@Import[filename];

The images should look like this :

(Image[#,ImageSize->32])&/@slices

Step 2 :

Let' s apply some colors and transparency.We apply color function using Colorize, then add alpha channel based on binarized image using ColorCombine.Don' t forget to specify the color space "RGB" (otherwise, the last channel will not be interpreted as opacity).Since it is a lot of slices, we will use ParallelMap.I am reversing the result to match the orientation.

colored = Reverse[ParallelMap[With[{img = #}, ColorCombine[{Colorize[img, ColorFunction -> "SunsetColors"], Binarize[img]}, "RGB"]] &, slices]];

The result will look like this :

(Image[#, ImageSize -> 32]) & /@ colored

We will combine them and pack them so that it will make a nice volumetric color dataset.Again, notice that option DataReversed is used to reverse the orientation.

data=Developer`ToPackedArray[Map[ImageData[#,DataReversed->True]&,colored]];

Step 3

Basically, we put a lot of polygons with textures coming from this volumetric color dataset.But to make it work rather smooth, you need to use undocumented option BaseStyle -> {RenderingOptions -> {"DepthPeelingLayers" -> n}} (n being some reasonable number).I won' t go deep into how this option works, I will just say that this sets limit on rendering of translucent polygons.Here is the main code to display it :

(*All are in 0-1 coordinates.*)(*top is z-value for x-y cutaway.*)(*right is x value for y-z cutaway.*)(*step defines how many polygon slices will be inserted.Smaller->more*)With[{top=0.4,right=0.4,rpad=-.2,step=0.01},Graphics3D[{EdgeForm[],Opacity[.4],(*Overall transparency of the textured polygons*)Texture[data],(*Set volumetric texture*)(*Bottom part up until the variable top*)With[{pts=Table[{{0,0,z},{1,0,z},{1,1,z},{0,1,z}},{z,0,top,step}]},Polygon[pts,VertexTextureCoordinates->pts]],(*Top part from top to 1,but from 0 to right in x direction*)With[{pts=Table[{{x,0,top},{x,1,top},{x,1,1},{x,0,1}},{x,0,right,step}]},Polygon[pts,VertexTextureCoordinates->pts]],(*Cutaway decoration*)EdgeForm[Directive[Opacity[.6,RGBColor[1.,.8,.1]],Thick]],FaceForm[],Polygon[{{right,0,top},{1+rpad,0,top},{1+rpad,1,top},{right,1,top},{right,1,1},{right,0,1}}]},PlotRange->{{0,1+rpad},{0,1},{0,1}},Lighting->"Neutral",Background->Black,RotationAction->"Clip",SphericalRegion->True,BoxStyle->Directive[Opacity[.2],White],ImageSize->4 {100,100},(*Rendering option for smooth volumetric rendering*)BaseStyle->{RenderingOptions->{"DepthPeelingLayers"->100}},BoxRatios->{1+rpad,1,.9}]]

Warning : Be very careful of decreasing step or increasing DepthPeelingLayers and ImageSize.It will crash the Front End ...

Solution 2 : Using CUDAVolumetricRender -> Mathematica 8

It is a limited solution for the people who has CUDA capable graphics cards.Essentially, it will call CUDAVolumetricRender function which is a part of CUDALink.

Step 0

We need to load the CUDALink package.

Needs["CUDALink`"]

Step 1

Create a volume data suitable for the CUDAVolumetricRender.First, the data should be a packed integer array with depth 3, each element should range from 0 to 255 (0 being background).Since original data is already in 0 - 255 range (8 - bit TIFF), you can use ImageData[..., Automatic] to take original values out.Otherwise, you can use ImageData[..., "Byte"] to enforce it to be in byte range.

data=Developer`ToPackedArray[Map[ImageData[#,Automatic]&,slices]];

Here is a slight problem.Apparently there is a bug.To render d*h*w voxel data, you need to
partition it again, so that the data would have h*w*d dimension.We are not talking of transposing
it, instead, literally we just need to change dimension, without touching data order.It is hard to explain and no need to understand, so I will just provide a conversion function here

Clear[prepareCUDAVolumeData];

prepareCUDAVolumeData::arg="The argument should be an integer array of depth 3.";

prepareCUDAVolumeData[array_]/;ArrayQ[array,3,IntegerQ]:=Module[{x,y,z},{x,y,z}=Dimensions[array];
Developer`ToPackedArray[Partition[#,x]&/@Partition[Flatten[array],x*z]]];

prepareCUDAVolumeData[___]/;(Message[prepareCUDAVolumeData::arg];
False):=Null;

Step 2 :

Now, we are ready.Let' s try this :

CUDAVolumetricRender[prepareCUDAVolumeData[data]]

The problem with this approach is that you don' t have much flexibility except what is given by the interface.

Note : The volume rendering support in Mathematica 8 is quite limited (without CUDALink).Technically, it is not really volumetric rendering in traditional sense.A proper volumetric rendering requires a transfer function which converts accumulation of density values into certain color per each pixel.Here, we are mimicking the effect by using false coloring and alpha blending.The CUDALink volume rendering is a real deal, but you don' t really need CUDA as long as graphics cards supports shader language (which is mostly true nowadays).

Note 2 : You can expect much improved (and proper) volumetric support in the future ...;)

Solution 3 : Using Image3D -> Mathematica 9

Manipulate[Image3D[slices,BoxRatios->{6,6,6}, ClipRange->{All,{slice,-1},All}],{slice,0,256,1}]

Common Unified Device Architecture

CPU contra GPU

Which one is faster?

GPU achitecture

Architecture difference between CPU and GPU

CUDALink // OpenCLLink

How to initialize CUDA in Mathematica?

Needs["CUDALink`"]
Needs["OpenCLLink`"]

Which commands are coming with Mathematica?

?*CUDA*

?*OpenCL*

CUDA Fluid Dynamic

A neat little example about the capabilities of CUDA

CUDAFluidDynamics[ImageSize->600,"NumberOfParticles"->10000]

Using self written OpenCL functions // Julia Set

The Julia set is a generalization of the Mandelbrot set. This implements the CUDA kernel:

code="
__global__ void julia_kernel(Real_t * set, mint width, mint height, Real_t cx, Real_t cy) {
   mint xIndex = threadIdx.x + blockIdx.x*blockDim.x;
   mint yIndex = threadIdx.y + blockIdx.y*blockDim.y;
   mint ii;

   Real_t x = ZOOM_LEVEL*(width/2 - xIndex);
   Real_t y = ZOOM_LEVEL*(height/2 - yIndex);
   Real_t tmp;
   Real_t c;

   if (xIndex < width && yIndex < height) {
       for (ii = 0; ii < MAX_ITERATIONS && x*x + y*y < BAILOUT; ii++) {
			tmp = x*x - y*y + cx;
			y = 2*x*y + cy;
			x = tmp;
		}
		c = logf(static_cast<Real_t>(0.1) + sqrtf(x*x + y*y));
		set[xIndex + yIndex*width] = c;
    }
}
";

The width and height are set. Since the set is computed, the memory need not be set—that is, only memory allocation is needed:

{width,height}={512,512};
jset=CUDAMemoryAllocate[Real,{height,width}];

This loads the CUDAFunction. Macros are used to allow the compiler to optimize the code—doing things like loop unrolling:

JuliaCalculate=CUDAFunctionLoad[code,"julia_kernel",{{_Real,_,"Output"},_Integer,_Integer, _Real, _Real},{16,16},"Defines"->{"MAX_ITERATIONS"->10,"ZOOM_LEVEL"->"0.0050","BAILOUT"->"4.0"}, ShellOutputFunction->Print];

This computes the set and views it using Reliefimage:

JuliaCalculate[jset, width, height, 0.4,0.2, {width, height}];
ReliefImage[Reverse@CUDAMemoryGet[jset], ImageSize->512]

This creates an interface using Manipulate and ReliefPlot where the user can adjust the value of c:

Manipulate[
JuliaCalculate[jset, width, height, c[[1]], c[[2]], {width, height}];
ReliefPlot[Reverse@CUDAMemoryGet[jset], ColorFunction->"Rainbow",DataRange->{{-2.0, 2.0}, {-2.0, 2.0}},ImageSize->512],
{{c, {0, 1}}, {-2, -2}, {2, 2}, Locator}]

The user can substitute ReliefPlot for Image to make the visualization even faster:

Manipulate[JuliaCalculate[jset, width, height, c, d, {width, height}]; Image[CUDAMemoryGet[jset],ImageSize->256], {{c, 0.0}, -2.0, 2.0, Slider}, {{d, 0.0}, -2.0, 2.0, Slider}]

Comparing financial derivative functions

First, we generate some random numbers.

numberOfOptions=2^14;
spotPrices=RandomReal[{25.0,35.0},numberOfOptions];
strikePrices=RandomReal[{20.0,40.0},numberOfOptions];
expiration=RandomReal[{0.1,10.0},numberOfOptions];
interest=0.08;
volatility=RandomReal[{0.10,0.50},numberOfOptions];
dividend=RandomReal[{0.2,0.06},numberOfOptions];

Now, compute the European call option price using a traditional method.

Timing[FinancialDerivative[{"European", "Call"}, {"Expiration"->expiration[[#]],"StrikePrice"->strikePrices[[#]]},{"CurrentPrice"->spotPrices[[#]],  "InterestRate"->interest, "Volatility"->volatility[[#]], "Dividend"->dividend[[#]]}]&/@Range[numberOfOptions]]

Finally, let’s look at using the CUDA-optimized function instead.

Timing[CUDAFinancialDerivative[{"European", "Call"}, {"StrikePrice"->strikePrices, "Expiration"->expiration},{"CurrentPrice"->spotPrices, "InterestRate"->interest, "Volatility"->volatility, "Dividend"->dividend}]]

We see that the results are identical but that the CUDA-optimized function performs the computation more quickly.

ADDITIVE GmbH

Geschäftsbereich Software
Max - Planck - Str.22 b
61381 Friedrichsdorf
Vertrieb : 06172 - 5905 - 30
Support : 06172 - 5905 - 20 // support@additive - net.de
Tel : 06172 - 5905 - 0 // Fax : 06172 - 77613
www.additive - mathematica.de // mathematica@additive - net.de