COMPUTATIONAL PUBLIC RELATIONS
What happens when we apply computation everywhere?

Swede White, Wolfram Research

Join the Conversation #WolframTechConf

Motivation

Public relations has lagged behind marketing in terms of using data and analytics for strategy.

Simultaneously, public relations and marketing are becoming more intertwined as advertising becomes less distinguishable from media outreach.

The democratization of access to data and computational tools allows for easier use of data science tools to formulate strategies.

Outline of Talk

What is public relations anyway?

Example 1: ServiceConnect[] with Reddit

Example 2: ServiceConnect[] with Twitter

Example 3: Trade Show Influencer Networks and Information Diffusion

What is public relations?

WordData["public relations","Definitions"]

Information provided to the public

Persuasion directed at the public to modify attitudes and actions

Efforts to integrate attitudes and actions of an institution with its publics and of publics with that institution

Traditional media and advertising are becoming less important with the advent of social and new media

Research shows us face-to-face and word-of-mouth influence are still crucial to spreading information

Though public relations has its origins politics, statecraft, and governance, it has emerged as a key invisible force of ensuring social cohesion, consumer behavior, and the crystallization of societal norms.

Edward Bernays wrote an influential book in 1928 aptly titled Propaganda that was one of the first general exposition on the art of persuading large groups of people with messaging strategy.

PersonData[(Entity["Edward Bernays", Entity["Person","EdwardBernays::d2ff9"], "Entity[\"Person\", \"EdwardBernays::d2ff9\"]", "person"]),"Image"]

How long has public relations existed?

DateListPlot[WordFrequencyData[{"marketing","propaganda","advertising",
"TimeSeries",{1800,2010},IgnoreCase->True],
Filling->Axis, FrameTicks->{{None,None},{All,None}}]

Example 1: ServiceConnect[“Reddit”]

Stephen Wolfram Idea Makers r/IAmA

Grab comments and build a text network using Nearest[]

reddit=ServiceConnect["Reddit"];
amaComments=reddit["PostCommentsData",
"Post"->"https://www.reddit.com/r/IAmA/comments/4tspts/im_stephen_wolframask_me_anything/"
, MaxItems-> 500];
comments=amaComments["Comments"];
data= comments[All,{"Author","Body","Score","CreationDate","Edited","GlobalID"}];
similarities=Flatten[Outer[Rule,{#},
Nearest[DeleteCases[Normal[data[All,"Body"]],#],#]]&/@Normal[data[All,"Body"]]];
With[{g=Graph[similarities,VertexSize->Normal[data[All,#["Body"]->{"Scaled",#["Score"]/500}&]],
VertexLabels->Placed["Name",Tooltip],DirectedEdges->False,ImageSize->Large]},
CommunityGraphPlot[#,FindGraphCommunities[#],CommunityRegionStyle->Directive[Opacity[.2],Gray],
CommunityBoundaryStyle->Directive[Orange,Dotted],ImageSize->Large,
DirectedEdges->False,PlotLegends->Automatic]&@g]

(Legended)

Use Classify[] for sentiment and topic analysis

cSent=Classify["Sentiment",data];
tallied=Transpose@Tally@cSent;
BarChart[tallied[[2]],ChartLabels->Placed[tallied[[1]],Above],
ColorFunction->"SolarColors"]

categories =Tally@Classify["FacebookTopic",data[All,"Body"]];
BarChart[Apply[Callout,Reverse[categories,2],{1}],
Axes->False,ChartStyle->"SolarColors"]

Example 2: ServiceConnect[“Twitter”]

Examine Wolfram Research Twitter Feed

twitter=ServiceConnect["Twitter"];
twitter["UserData","Username"->"wolframresearch"]

getTweetStrings[username_,number_: 4000]:=Block[{text,tweetsWRI},tweetsWRI=twitter["TweetList","Username"->username,MaxItems->number];
text=Flatten[StringSplit[Normal[tweetsWRI[All,"Text"]]],1];
StringDelete[DeleteStopwords[text],{"&amp",";",".",",","-","_","\"","(",")","RT"}]]
WordCloud[getTweetStrings["wolframresearch"],ColorFunction->ColorData["SolarColors"]]

Examine recent hashtags

wriHash=twitter["UserHashtags","Username"->"wolframresearch",MaxItems->35];
talliedHash=Tally[wriHash];
BarChart[Apply[Callout,Reverse[talliedHash,2],{1}],ChartStyle->"SolarColors",Axes->False]

Use Classify[] for sentiment analysis

wriTweetsStrings=getTweetStrings["wolframresearch"];

cSent=Classify["Sentiment",wriTweetsStrings];
tallied=Transpose@Tally@cSent;

BarChart[tallied[[2]],ChartLabels->Placed[tallied[[1]],Above],ColorFunction->"SolarColors"]

Examine Wolfram Research Follower Mentions

With[{mentionGraph=twitter["FriendMentionNetwork","Username"->"wolframresearch"]},CommunityGraphPlot[#,FindGraphCommunities[#],CommunityRegionStyle->Directive[Opacity[.2],Gray],CommunityBoundaryStyle->Directive[Orange,Dotted],ImageSize->Large]&@SimpleGraph[mentionGraph]]

When does Wolfram Research tweet?

wriEventseries=twitter["TweetEventSeries","Username"->"wolframresearch",MaxItems->5000];
datediff=DateDifference[DateObject[{2016,10,25}],DateObject[{2017,10,25}]];

N[Quantity[Length@wriEventseries["Times"],"tweets"]/datediff]

hourlypercents=DateHistogram[wriEventseries["Dates"],"Hour","Probability",DateReduction->"Day",ColorFunction->"SolarColors"]

weekcounts=DateHistogram[wriEventseries["Dates"],"Day",DateReduction->"Week",ColorFunction->"SolarColors",LabelingFunction->Above]

alltimecounts=DateHistogram[wriEventseries["Dates"],"Month",ColorFunction->"SolarColors",BarOrigin->Left]

Exploring #MachineLearning on Twitter

mltweets = twitter["TweetSearch","Query"-> "#machinelearning",MaxItems-> 100];

similarMLTweets=Flatten[Outer[Rule,{#},Nearest[DeleteCases[Normal[mltweets[All,"Text"]],#],#]]&/@Normal[mltweets[All,"Text"]]];

gMLT=Graph[similarMLTweets,VertexLabels->Placed["Name",Tooltip],VertexSize->Normal[mltweets[All,#["Text"]->{"Scaled",#["RetweetCount"]/10000}&]], DirectedEdges->False,ImageSize->Large];

sgMLT=SimpleGraph[gMLT];

CommunityGraphPlot[#,FindGraphCommunities[#],CommunityRegionStyle->Directive[Opacity[.2],Gray],CommunityBoundaryStyle->Directive[Orange,Dotted],ImageSize->Large,DirectedEdges->False,Method->"Hierarchical", VertexLabels->Placed["Name",Tooltip]]&@gMLT

mlCats=Tally@Classify["FacebookTopic",mltweets[All,"Text"]];

BarChart[Apply[Callout,Reverse[mlCats,2],{1}],
Axes->False,ChartStyle->"SolarColors"]

CEO analysis on Twitter

search=twitter["TweetSearch","Query"->"stephen_wolfram",MaxItems->1000,"Language"->Entity["Language","English"]];

FilterTweets[tweets_]:=StringReplace[ToLowerCase@tweets,{RegularExpression["[http]*[s]*[:][\\/\\/][a-z0-9.\\/]+[ ]*"]->" ",RegularExpression["[rt: ]*[rt ]*[\\@][a-z0-9]*[:]*"]->" ",RegularExpression["[^a-z\\s:]"]|":"->" "}];tweets=FilterTweets[#["Text"]]&/@(Normal@search);processedTweets=DeleteCases[#,""]&/@(Function[{wordList},(If[Classify["Profanity",wordList],"",wordList]),Listable][DeleteCases[DeleteDuplicates@(DeleteStopwords@ToLowerCase@TextWords[#]),"h"|"ht"|"htt"|"http"|"https"|"stephen"|"wolfram"|"s"]&/@tweets]);significantWords=Take[(Reverse@(SortBy[Tally@(#&/@(Flatten[(Tally@#&/@processedTweets),1]))/.{{w_,_},c_}->{w,c},Last])),10];topWordsQuantities=N[#[[2]]/1000]&/@significantWords;topWordsNames=First@#&/@significantWords;pieChart=PieChart[#&/@topWordsQuantities,ChartLabels->Placed[topWordsNames,"RadialCallout"],ChartStyle->"SolarColors",LabelingFunction->(Row[{NumberForm[100 N[#/Total[topWordsQuantities]],{3,2}],"%"}]&)]

similarTweets=Flatten[Outer[Rule,{#},Nearest[DeleteCases[Normal[search[All,"Text"]],#],#]]&/@Normal[search[All,"Text"]]];

gT=Graph[similarTweets,VertexLabels->Placed["Name",Tooltip],DirectedEdges->False,ImageSize->Large];

sgT=SimpleGraph[gT];

CommunityGraphPlot[#,FindGraphCommunities[#],CommunityRegionStyle->Directive[Opacity[.2],Gray],CommunityBoundaryStyle->Directive[Orange,Dotted],ImageSize->Large,DirectedEdges->False,VertexLabels->Placed["Name",Tooltip]]&@gT

Tally@Classify["Sentiment",search[All,"Text"]]

BarChart[Apply[Callout,Reverse[{{"Neutral",720},{"Positive",144},
{"Negative",28}},2],{1}],
ChartStyle->"SolarColors",Axes->False]

categories =Tally@Classify["FacebookTopic",search[All,"Text"]];
BarChart[Apply[Callout,Reverse[categories,2],{1}],
Axes->False,ChartStyle->"SolarColors"]

Example 3: Conference Attendees, Social Networks, and Information Diffusion

Wrangle the data

Import data

csv=Import["/Users/swedew/Dropbox (Wolfram)/WTC/Talk/ConferenceData.csv"];

Check dimensions

Dimensions@%

Check data structure

csv[[;;4]]

Change to Boolean true/false values

csv1=csv/.{0->False,1->True};

Give column 1 a header

assoc0=With[{header = (csv1[[1]]/."" -> "Name")},
AssociationThread[header-> #]&/@Rest@csv1];

assoc0[[;;3]]

Create association

assoc1= Module[{rec=#},
rec["Name"] = StringRiffle[Reverse[StringSplit[rec["Name"],"."]]];
rec]&/@assoc0;

ds = Dataset[assoc1];

Check an association

names=Normal@ds[All,"Name"];

ds@SelectFirst[#["Name"]=="Sean Applegate"&]

A look at the conference level

Examine a graph of all attendees by conference

conferences=Normal@Rest[Keys[First[ds]]];

cg=HighlightGraph[Flatten[Normal[With[{row = #,name = #Name},
If[row[#],name \[UndirectedEdge]#,Nothing]&/@conferences]&/@ds]],conferences,VertexLabels->Placed["Name",Tooltip],ImageSize->Large, VertexLabelStyle->Background->White, VertexSize->5,GraphLayout->"RadialDrawing"]

Create a graph with conferences highlighted by vertex count (N of attendees)

HighlighVertexDegree[g_,vd_]:=HighlightGraph[g,Table[Style[VertexList[g][[i]],ColorData["SolarColors"][vd[[i]]/Max[vd]]],{i,VertexCount[g]}]];

vd=VertexDegree[cg];

HighlighVertexDegree[cg,vd]

A look at the person level

Create a bipartite graph

bipartiteAdjacencyMatrix=Boole@Normal[ds[Values,Rest]];
edges=ReplacePart[bipartiteAdjacencyMatrix.Transpose[bipartiteAdjacencyMatrix],{i_,i_}->0];
personLevelGraph=AdjacencyGraph[names,edges,
EdgeStyle->{Opacity[.02]},ImageSize->Large,VertexSize->Automatic,VertexLabels->Placed["Name",Tooltip],PlotLabel->"Conference Attendees"]

Create a function for various measures of centrality

HighlightCentrality[g_,cc_]:=HighlightGraph[g,Table[Style[VertexList[g][[i]],ColorData["SolarColors"][cc[[i]]/Max[cc]]],{i,VertexCount[g]}]]

Examine Betweenness Centrality

HighlightCentrality[personLevelGraph,BetweennessCentrality[personLevelGraph]]

TopFive[measure_,heading_]:=TableForm[TakeLargestBy[Transpose[{names,measure}],#[[2]]&,5],TableHeadings->{None,{"Conference Attendee",heading}}]

betweenness=BetweennessCentrality[personLevelGraph];
TopFive[betweenness,"Betweenness Centrality"]

Examine Closeness Centrality

HighlightCentrality[personLevelGraph,ClosenessCentrality[personLevelGraph]]

closeness=ClosenessCentrality[personLevelGraph];
TopFive[closeness,"ClosenessCentrality"]

Examine Eigenvector Centrality

HighlightCentrality[personLevelGraph,EigenvectorCentrality[personLevelGraph]]

eigenvectorCentrality=EigenvectorCentrality[personLevelGraph];
TopFive[eigenvectorCentrality,"Eigenvector Centrality"]

With[{g =Flatten[Normal[With[{row = #,name = #Name},
If[row[#],name \[UndirectedEdge]#,Nothing]&/@conferences]&/@ds]]},
 HighlightGraph[g,
NeighborhoodGraph[g,"John Whitney",1,VertexLabels->Automatic], GraphLayout->"RadialDrawing",VertexLabels->Automatic, VertexLabelStyle->Background->White,ImageSize->Large]]

A look at information diffusion

infect[neighbors_List,p_]:=
Pick[neighbors,RandomChoice[{p,1-p}->{1,0},Length[neighbors]],1];

infect[{1,2,3},.5]

step[graph_,{recentlyInfected_,infectedLongAgo_},p_]:=
{Complement[
infect[AdjacencyList[graph,recentlyInfected],p],recentlyInfected,infectedLongAgo],Join[infectedLongAgo,recentlyInfected]};

Example

network=RandomGraph[WattsStrogatzGraphDistribution[264,0.1,3],ImageSize->Large];

step[network,{{1},{}},.5]

HighlightGraph[Graph[network,VertexSize->2],{Style[1,Red]}~Join~(Style[#,Yellow]&/@{2,4,39})]

infected[g_,i_,p_]:=Last[FixedPoint[step[g,#,p]&,{i,{}}]]

infectedList=infected[network,{1} ,0.4] ;

HighlightGraph[Graph[network,VertexSize->1.5],
{Style[1,Red]}~Join~(Style[#,Yellow]
&/@Complement[infectedList,{1}])]

epidemicHistory=FixedPointList[step[network,#,.3]&,{{1},{}}];

Manipulate[
Column[{HighlightGraph[
Graph[network,VertexSize->3],Join[Style[#,Red]&/@#[[1]],
Style[#,Yellow]&/@#[[2]],
Style[#,{Red,Thick}]&/@EdgeList@Subgraph[network,x_\[UndirectedEdge]y_/;
MemberQ[#[[1]],x]&&MemberQ[#[[2]],y]]]]
&@epidemicHistory[[index]],
ListPlot[Length[Join@@#]&/@Take[epidemicHistory,index],
AspectRatio->1/3,Filling->Axis,AxesLabel->{"Time","Spread"},AxesOrigin->{0,0},Ticks->{Range[index],Range[0,Length[Join@@epidemicHistory[[-1,-1]]],Max[1,IntegerPart[Length[Join@@epidemicHistory[[-1,-1]]]/5]]]},
ImageSize->Large]}],{{index,1,"Iteration Number"},1,Length[epidemicHistory],1}]

Questions, comments, suggestions?

PersonConnect[] ...

LinkedIn: /in/swedewhite

Twitter: /swedewhite

Email: swedew@wolfram.com