WOLFRAM NOTEBOOK

Is Textual Similarity of Events Related to Event Chart Similarity?

In[]:=
eventlist=Entity["HistoricalEvent"]//EntityList;
In[]:=
Length[eventlist]
Out[]=
7818
In[]:=
startdates=Table[eventlist[[i]]["StartDate"],{i,1,Length[eventlist]}];
In[]:=
bertembedding=NetAppend[NetModel["BERT Trained on BookCorpus and English Wikipedia Data"],"pooling"SequenceLastLayer[]];
In[]:=
descriptions=CommonName[eventlist];
In[]:=
WordCloud[StringRiffle[descriptions," "]]
Out[]=
In[]:=
positions=Position[startdates,n_/;n[[1]]>=1600&&DateObjectQ[DateObject[n,"Day"]]];
In[]:=
Length[positions]
Out[]=
7153
In[]:=
pos2=positions[[All,1]];
In[]:=
goodeventdates=Extract[startdates,ArrayReshape[pos2,{Length[pos2],1}]];
In[]:=
relevantdescriptions=Extract[descriptions,ArrayReshape[pos2,{Length[pos2],1}]];
In[]:=
relevantdescriptionswithoutnumbers=Table[StringReplace[relevantdescriptions[[i]],{"0"->"","1"->"","2"->"","3"->"","4"->"","5"->"","6"->"","7"->"","8"->"","9"->"","("->"",")"->""," "->" "," "->" "}],{i,Length[relevantdescriptions]}];
In[]:=
Export["1600relevantdescriptionswithoutnumbers.m",relevantdescriptionswithoutnumbers]
Out[]=
1600relevantdescriptionswithoutnumbers.m
In[]:=
relevantdescriptionswithoutnumbers=Import["1600relevantdescriptionswithoutnumbers.m"];
In[]:=
relevantdescriptions[[1;;10]]
Out[]=
{thousands protest Vietnam War at White House,SI units are defined,United States Constitution's Thirteenth Amendment abolishes slavery,Fourteenth Amendment guaranties equal protection,Battle of Narva,Treaty of Pressburg,first of the 1811 and 1812 New Madrid Earthquakes,1812 Fire of Moscow begins,1812 Fire of Moscow ends,Tchaikovsky's "1812 Overture" debuts}
In[]:=
relevantdescriptionswithoutnumbers[[1;;10]]
Out[]=
{thousands protest Vietnam War at White House,SI units are defined,United States Constitution's Thirteenth Amendment abolishes slavery,Fourteenth Amendment guaranties equal protection,Battle of Narva,Treaty of Pressburg,first of the and New Madrid Earthquakes, Fire of Moscow begins, Fire of Moscow ends,Tchaikovsky's " Overture" debuts}
In[]:=
Length[relevantdescriptionswithoutnumbers]
Out[]=
7153
In[]:=
WordCloud[StringRiffle[relevantdescriptionswithoutnumbers]]
Out[]=
In[]:=
goodevents=Import["1600 plus dates.m"];
Import
:File 1600 plus dates.m not found during Import.
In[]:=
goodevents=Import["/home/rko/Documents/Wolfram Desktop/Event Similarities/1600 plus dates.m"];
In[]:=
goodevents//Short
Out[]//Short=
Sat 9 May 1970
,
Fri 1 Oct 1954
,
Wed 6 Dec 1865
,
Thu 9 Jul 1868
,
Tue 30 Nov 1700
,
Thu 26 Dec 1805
,7141,
Tue 29 Apr 1913
,
Sun 15 Sep 1968
,
Mon 21 Mar 1859
,
Tue 5 Jul 1977
,
Mon 28 Mar 1994
,
Wed 22 Jan 1879
In[]:=
TimelinePlot[goodevents]
Out[]=
Contents cannot be rendered at this time; please try again later or download this notebook for full functionality »
In[]:=
sentenceembedding=NetAppend[NetModel["BERT Trained on BookCorpus and English Wikipedia Data"],"pooling"SequenceLastLayer[]];
In[]:=
relevantembeddings1600=Table[sentenceembedding[relevantdescriptionswithoutnumbers[[i]]],{i,1,Length[relevantdescriptionswithoutnumbers]}];
In[]:=
Export["7153 relevantembeddings1600nonumbers.m",relevantembeddings1600]
Out[]=
7153 relevantembeddings1600nonumbers.m
In[]:=
ClearAll[relevantdescriptionswithoutnumbers]
In[]:=
relevantembeddings1600=Import["7153 relevantembeddings1600nonumbers.m"];
In[]:=
Dimensions[relevantembeddings1600]
Out[]=
{7153,768}
In[]:=
Length[goodevents]
Out[]=
7153
In[]:=
goodevents[[1;;3]]
Out[]=
Sat 9 May 1970
,
Fri 1 Oct 1954
,
Wed 6 Dec 1865
In[]:=
JT2000=DateObject{2000,1,1},TimeObject{0,0,0},TimeZoneLocalTimeZoneGeoPosition
London
CITY
,TimeZoneLocalTimeZoneGeoPosition
London
CITY
Out[]=
Sat 1 Jan 2000 00:00:00GMT
01 h 46 m 37.3761 s–03 h 29 m 42.4003 is the RA of Aries according to Aries article in Wikipedia
In[]:=
aries=N[UnitConvert[Quantity[MixedMagnitude[{1,46,37.3761}],MixedUnit[{"HoursOfRightAscension","MinutesOfRightAscension","SecondsOfRightAscension"}]],"Degrees"]]
Out[]=
26.6557
°
In[]:=
precessionrate(*(inradiansperday)*)=(-3/2)*(Quantity[6.378137*10^3,"km"])^2*(1.08262668*10^(-3))*Quantity[2*Pi,"radians"]
27.3220000000000000191`5.
days
(**Quantity[24*60*60,"Seconds"]/Quantity[1,"days"]*)*Cos[
5.16`3.
°
](
384399.9999999999977895347`4.
km
*(1-(0.0554`3.)^2))^2
Out[]=
-1.0303×
-7
10
rad/day
In[]:=
RAHUJT2000=Quantity[100.085,"Degrees"](*+aries*)
Out[]=
100.085
°
Monte Carlo Simulation Based on PDFs
Battle
Note order not the same as period length
Wolfram Cloud

You are using a browser not supported by the Wolfram Cloud

Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.


I understand and wish to continue anyway »

You are using a browser not supported by the Wolfram Cloud. Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.