Computational Politics: The Wolfram Data Drop Meets Election 2016

Evan Ott, University of Texas at Austin
Wolfram Student Ambassador Program

Join the Conversation #WolframTechConf

SetDirectory[NotebookDirectory[]];
bin=Databin["66W7CW2x"];

(* Take the arbitrary number stored and convert it to a DateObject, then a string *)
times=DateObject/@Dataset[bin][All,"Timestamp"]//Normal;

(* Place all data in chronological order *)
chronologicalOrdering=Ordering[times];
latestIndex=chronologicalOrdering[[Length[times]]];
gopDebates=DateObject/@{"August 6, 2015 8pm","September 16, 2015 7pm"};
(* Use the names from the last row to be sure to have them all *)
names=Select[Keys[Dataset[bin][latestIndex]]//Normal,StringContainsQ[#,"("]&];
lastNamesWithParty=Module[{split},(split=StringSplit[#];StringJoin[split[[2]]," ",split[[3]]])&/@names];
lastNamesWithoutParty=Module[{split},(split=StringSplit[#];split[[2]])&/@names];

(* Sort names in alpha by last name *)
nameOrdering=Ordering[lastNamesWithParty];
names=names[[nameOrdering]];
lastNamesWithParty=lastNamesWithParty[[nameOrdering]];
lastNamesWithoutParty=lastNamesWithoutParty[[nameOrdering]];

Clear[data];

times=times[[chronologicalOrdering]];
data=names/.(Dataset[bin][chronologicalOrdering,names]//Normal);

(* At this point, all data is in chronological order *)
times=DateString/@times;

dayTimes=N[(AbsoluteTime[#]-AbsoluteTime[times[[Length[times]]]])/(3600*24)]&/@times;

InvalidNum=-1;

data=Module[{emptyData,missingData},
missingData=(MissingQ/@#)&/@(data);
emptyData=
Table[
Table[
If[
Or[
Length[data[[j]]]<i,
missingData[[j,i]]],
InvalidNum,ToExpression[data[[j,i]]]]

,{i,Length[names]}],
{j,Length[data]}]];

firstRecordingDates=Flatten[Position[#,_Integer?(#>0&)]][[1]]&/@Transpose[data];

(* A function that finds the indices of all elements of a list of strings that contain a particular substring. *)
GetIndicesFromList[list_List,str_String]:=Module[{vals},
vals=Select[list,StringContainsQ[#,str]&];
Flatten[Union[Position[list,#]&/@vals]
]]
(* Republican and Democrat indices. *)
all = Range[Length[names]];
reps=GetIndicesFromList[names,"(R)"];
dems=GetIndicesFromList[names,"(D)"];
(* convert a data set where each row of data was taken at the same time *)
ConvertToTimes[data_List,times_List]:=If[Length[data]≠Length[times],Message[ConvertToTimes::illegal],
Table[TimeSeries[Table[{times[[i]],data[[i,j]]},{i,Length[times]}]],{j,Length[data[[1]]]}]]
absoluteDiffData=Differences[data];

absoluteDiffData=
Table[Table[
If[absoluteDiffData[[r,c]]+InvalidNum==data[[r+1,c]],0,absoluteDiffData[[r,c]]]
,{c,Length[names]}],{r,Length[absoluteDiffData]}];

percentDiffData=absoluteDiffData/data[[1;;Length[data]-1]]//N;

titles={"Total Likes","Overnight Change (Absolute)","Overnight Change (Percentage)"};
pieTitles={"Total Likes (#)","Total Likes (%)","Overnight Change (#)","Overnight Change (%)"};
findIndex[candidate_String]:=Position[names,_String?(StringContainsQ[#,candidate]&)][[1,1]]




graphFn[option_Integer,selection_List,scale_Integer,customStyle_List:{,,,,,,,,,,,,,,,,},plotRange_:All,highlight_Integer:0]:=Module[
{labels,plotLabel,graph,graphTimes,fn,styles,ordering},
labels=If[Length[selection]==Length[names],lastNamesWithParty,lastNamesWithoutParty];
plotLabel=titles[[option]];
graph=If[option==1,data,If[option==2,absoluteDiffData,percentDiffData*100]];

(* Sort by choice of graph to make colors better *)
graph=graph[[All,selection]];
labels=labels[[selection]];
ordering=Reverse[Ordering[graph[[Length[graph]]]]];
labels=labels[[ordering]];
graph=graph[[All,ordering]];

graphTimes=If[option==1,times,times[[2;;]]];
fn=If[scale==1,DateListPlot,DateListLogPlot];
(* Only nicely do the first one, dash the rest. *)
styles=Table[
If[findIndex[labels[[i]]]==highlight,Directive[customStyle[[Mod[i,Length[customStyle],1]]],Thickness[.015]],
If[i<10,customStyle[[Mod[i,Length[customStyle],1]]],Directive[Dashed,customStyle[[Mod[i,Length[customStyle],1]]]]]],
{i,Length[selection]}];


fn[ConvertToTimes[graph,graphTimes],PlotLegends->labels,
PlotLabel->plotLabel,
PlotRange->plotRange,
PlotStyle->styles]]

graphFn[option_Integer,selection_List,OptionsPattern[{Scale->1,CustomStyle->{,,,,,,,,,,,,,,,,},PlotRange->All,Highlight->0}]]:=graphFn[option,selection,OptionValue[Scale],OptionValue[CustomStyle],OptionValue[PlotRange],OptionValue[Highlight]]

pieFn[option_Integer,timestamp_Integer,selection_List]:=Module[{labels,plotLabel,graph,graphTimes,totalLikes,labelfn,ts},
plotLabel=pieTitles[[option]];
graph=If[option≤2,data,If[option==3,absoluteDiffData,percentDiffData//N]];
graphTimes=If[option≤2,times,times[[2;;]]];
labels=If[Length[selection]==Length[names],lastNamesWithParty,lastNamesWithoutParty];
ts=Min[timestamp,Length[graphTimes]];
totalLikes=Total[graph[[ts,selection]]];
labelfn=If[option==1,(Placed[Row[{NumberForm[IntegerPart[#/1000],DigitBlock->3],"k"}],"RadialCenter"]&),

If[option==3,
(Placed[Row[{NumberForm[IntegerPart[#],DigitBlock->3],""}],"RadialCenter"]&),

If[option==2,(Placed[Row[{N[#/totalLikes,3]*100,"%"}],"RadialCenter"]&),
(Placed[Row[{N[#,3]*100,"%"}],"RadialCenter"]&)
]]];

PieChart[graph[[ts,selection]],ChartLabels->Placed[labels[[selection]],"RadialCallout"],PlotLabel->plotLabel<>"\n"<>graphTimes[[ts]],
LabelingFunction->labelfn
]]

tableFn[sort_Integer,order_Integer,timestamp_Integer,selection_List]:=Module[{labels,plotLabel,graph,tableData,ordering},
plotLabel=titles[[sort]];
graph=If[sort==1,data,If[sort==2,absoluteDiffData,percentDiffData//N]];
labels=If[Length[selection]==Length[names],lastNamesWithParty,lastNamesWithoutParty];
tableData=Table[{data[[timestamp+1,i]],absoluteDiffData[[timestamp,i]],
percentDiffData[[timestamp,i]],
ToString[percentDiffData[[timestamp,i]]*100]<>"%"},{i,selection}];
ordering=If[sort==0,
Ordering[labels[[selection]]],
Ordering[tableData,All,#1[[sort]]>#2[[sort]]&]];
ordering=If[order==1,ordering,Reverse[ordering]];

Labeled[TableForm[tableData[[ordering,{1,2,4}]],TableHeadings->{labels[[selection[[ordering]]]],{"Total Likes","Overnight Gains\n(Absolute)","Overnight Gains\n(Percentage)"}}],"Likes as of "<>times[[timestamp+1]]<>"\n",Top]]

leadFn[one_String,two_String,time_]:=Show[ListPlot[{dayTimes,data[[All,findIndex[one]]]-data[[All,findIndex[two]]]}//Transpose,
PlotLegends->{"Actual Lead"}],
Plot[{0,
Normal[LinearModelFit[{dayTimes[[time;;]],data[[time;;,findIndex[one]]]-data[[time;;,findIndex[two]]]}//Transpose,{x},x]]/.{x->t}},{t,dayTimes[[time]],0},
PlotLegends->{"No difference","Fit from "<>ToString[Abs[IntegerPart[dayTimes[[time]]]]]<> " days ago\nto Present"}],
PlotLabel->one<>"'s Lead over "<>two,
FrameLabel->{"Day Difference to Present","Difference in Likes"},
Frame->True
]

Outline

About the Speaker

MathematElection

Wolfram Data Drop in Practice

Exploratory Data Analysis in Mathematica

CloudDeploy for Live Results

Conclusion

Q&A

About the Speaker

Background

Statistics Doctoral Student | University of Texas at Austin

B.S. Computer Science & B.S. Physics | University of Texas at Austin (2015)

Undergraduate honors thesis: “Estimating rainfall with neural networks and conditional random fields”

Introduced to Mathematica as data analysis / symbolic mathematics tool in undergraduate physics

Created online textbook Introduction to Data Analysis for Physics focusing on Mathematica

Designed and taught course to undergraduate physics majors on performing data analysis in Mathematica

Software engineering internships at TripAdvisor, Applied Research Laboratories, Sandia National Laboratories

MathematElection

Predictions since 30 Jan 2014...

Real work starting 3 Jul 2015:

http://mathematelection.blogspot.com

frames=Import["blog.gif"];
Animate[frames[[i]],{i,1,Length[frames],1},AnimationRate->20,AnimationDirection->ForwardBackward]

MathematElection

Collecting “Likes” for each candidate on Facebook

Animate[
tableFn[1,1,timestamp,all],
{timestamp,1,Length[times]-1,1},AnimationRate->8]

Creating visualizations

Show[
graphFn[1,Range[Length[names]],Highlight->findIndex["Carson"],PlotRange->{{gopDebates[[1]]-(Quantity[14, "days", days, "Days"]),DateObject[times[[Length[times]]]]},Automatic}],
Graphics[
Line[{{AbsoluteTime[#],0},{AbsoluteTime[#],5*^6}}]&/@gopDebates]]

Data Drop in Practice

Online data manager

myBin=Databin["7yGu_O8T"];
l=Length[Dataset[myBin]];
For[i=0,i<l,i++,DatabinRemove[myBin,1]];

(* bin = CreateDatabin[] *)
myBin=Databin["7yGu_O8T"];
DatabinAdd[myBin,<|"Speaker"->"Stephen Wolfram","Date"->"20 October","Time"->"9 AM" |>];
DatabinAdd[myBin,<|"Speaker"->"Evan Ott","Date"->"20 October","Time"->"11:30 AM" |>];
DatabinAdd[myBin,<|"Speaker"->"Stephen Wolfram","Date"->"20 October", "Time"->"9:30 PM" |>];
Dataset[myBin]

DateObject/@Dataset[myBin][All,"Timestamp"]//Normal

API accessible via web too

https://datadrop.wolframcloud.com/api/v1.0/Add?bin=7yGu_O8T&Speaker=Evan+Ott&Date=Today&Time=Now

MathematElection

Daily Java script reads from public Facebook API, records Likes in a Databin

Dataset[Databin["66W7CW2x"]]

Exploratory Data Analysis in Mathematica

Manipulate

Manipulate[
pieFn[option,timestamp,selection],

{{option,1},(#->pieTitles[[#]]&/@Range[Length[pieTitles]])},
{timestamp,1,Length[times],1},
{{selection,Range[1,Length[names]]},{Range[1,Length[names]]-> "All",
reps->"Republicans",
dems->"Democrats"}}]

LinearModelFit, NonlinearModelFit, FindFit

dayToStart=gopDebates[[1]];
dataStart=Flatten[Position[(DateObject[#]≥DateObject[dayToStart])&/@times,True]][[1]];
Manipulate[
Labeled[
TableForm[
Sort[
{lastNamesWithParty[[#]],

(LinearModelFit[({dayTimes[[dataStart;;]],data[[dataStart;;,#]]}//Transpose),{x},x]["BestFit"]/.{x->time})}&/@all,

#1[[2]]>#2[[2]]&]],
"Estimated Total Likes from Linear Fit\n"<>DatePlus[times[[Length[times]]],time],Top],{time,1,QuantityMagnitude[DateDifference[Today,DateObject[{2016,11,8}]]],1}]

CloudDeploy for Live Results

Power to the people

Live results

f=FormFunction[
<|
"option"-><|"Interpreter"->((pieTitles[[#]]->#)&/@Range[Length[pieTitles]]), "Control" -> SetterBar|>,
"timestamp"-><|"Interpreter"->Restricted["Integer",{1,Length[times]}], "Control" -> Slider|>,
"selection"-><|"Interpreter"->{"All"->Range[Length[names]],"Republicans"->reps,"Democrats"->dems}, "Control" -> SetterBar|>
|>,
pieFn[#option,#timestamp,#selection]&,
"PNG"];

f[]

(* Do cloud deploy here *)

Conclusion

Data Drop is easily integrated as normal List

fields=Keys[Dataset[myBin][1]]//Normal

myData=fields/.#&/@Dataset[myBin][All,fields]//Normal

Manipulate lets you explore data in a systematic way

Manipulate[leadFn[one,two,t],{{one,"Carson"},lastNamesWithoutParty},{{two,"Trump"},lastNamesWithoutParty},{t,1,Length[dayTimes],1}]

Combining Data Drop and CloudDeploy enables dynamic content

CloudDeploy[Delayed[({"Speaker","Time"}/.#&/@Dataset[myBin][All,{"Speaker","Time"}]//Normal)],Permissions->"Public"]

DatabinAdd[myBin,<|"Speaker"->"Evan","Date"->"Today","Time"->"20 Minutes Ago"|>];

Q & A

Can’t stick around? Email: evan.ott@utexas.edu