BenjaminLind

Reading GDELT, Feb 2014

Feb 13th, 2014
270
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
R 24.17 KB | None | 0 0
  1. #This code will provide functions that will read all of the GDELT data into R
  2. #It will do so without leaving large files on your disk
  3. #Its subsampling motives are, for now, limited to year and ActionGeo_CountryCode
  4. #The code below is written by Benjamin Lind under CC: BY-NC-SA 3.0
  5.   #If you use or develop this code, please provide proper attribution.
  6.   #You may contact me at lind.benjamin//at//gmail//d0t//com
  7.   #You may also find me @benjaminlind on Twitter
  8.  
  9. #For information on the GDELT project, see:
  10.   #http://gdeltproject.org/
  11. #If you use data from this project, please cite it as:
  12.   #Leetaru, Kalev and Schrodt, Philip. (2013). GDELT: Global Data on Events, Language, and Tone, 1979-2012. International Studies Association Annual Conference, April 2013. San Diego, CA.
  13.  
  14. #To load these functions into R, uncomment the following four lines and enter them into R:
  15.   #library(utils)
  16.   #download.file("http://pastebin.com/raw.php?i=LrQhuVEZ", "Reading.GDELT.R")
  17.   #source("Reading.GDELT.R")
  18.   #file.remove("Reading.GDELT.R")
  19.  
  20. library(utils)
  21. library(compiler)
  22.  
  23. #All the files available for downloading, as of 1 September, 2013
  24. names.zips<-c("201303.zip", "201302.zip", "201301.zip", "201212.zip", "201211.zip", "201210.zip", "201209.zip", "201208.zip", "201207.zip", "201206.zip", "201205.zip", "201204.zip", "201203.zip", "201202.zip", "201201.zip", "201112.zip", "201111.zip", "201110.zip", "201109.zip", "201108.zip", "201107.zip", "201106.zip", "201105.zip", "201104.zip", "201103.zip", "201102.zip", "201101.zip", "201012.zip", "201011.zip", "201010.zip", "201009.zip", "201008.zip", "201007.zip", "201006.zip", "201005.zip", "201004.zip", "201003.zip", "201002.zip", "201001.zip", "200912.zip", "200911.zip", "200910.zip", "200909.zip", "200908.zip", "200907.zip", "200906.zip", "200905.zip", "200904.zip", "200903.zip", "200902.zip", "200901.zip", "200812.zip", "200811.zip", "200810.zip", "200809.zip", "200808.zip", "200807.zip", "200806.zip", "200805.zip", "200804.zip", "200803.zip", "200802.zip", "200801.zip", "200712.zip", "200711.zip", "200710.zip", "200709.zip", "200708.zip", "200707.zip", "200706.zip", "200705.zip", "200704.zip", "200703.zip", "200702.zip", "200701.zip", "200612.zip", "200611.zip", "200610.zip", "200609.zip", "200608.zip", "200607.zip", "200606.zip", "200605.zip", "200604.zip", "200603.zip", "200602.zip", "200601.zip", "2005.zip", "2004.zip", "2003.zip", "2002.zip", "2001.zip", "2000.zip", "1999.zip", "1998.zip", "1997.zip", "1996.zip", "1995.zip", "1994.zip", "1993.zip", "1992.zip", "1991.zip", "1990.zip", "1989.zip", "1988.zip", "1987.zip", "1986.zip", "1985.zip", "1984.zip", "1983.zip", "1982.zip", "1981.zip", "1980.zip", "1979.zip")
  25. url.root.dir<-"http://gdeltproject.org/data/backfiles/" #Parent directory
  26. names.zips.url<-paste(url.root.dir, names.zips, sep="") #Full file address
  27. names.year<-as.numeric(strtrim(names.zips, 4)) #Year of each file
  28. gdelt.full.files<-data.frame(file=names.zips, url=names.zips.url, year=names.year, stringsAsFactors=FALSE) #Pull together into a data frame
  29. rm(names.zips, names.zips.url, names.year, url.root.dir) #Clean-up
  30.  
  31. #Do the same for the Daily Updates
  32. daily.names<-seq.Date(from=as.Date("20130401", "%Y%m%d"), to=as.Date(date(), "%a %b %d %H:%M:%S %Y")-1, by=1) #From 1 April, 2013 to yesterday
  33. daily.names.date<-as.character(format.Date(daily.names, "%Y%m%d"))
  34. daily.names.files<-paste(gsub("-", "", daily.names), ".export.CSV.zip", sep="")
  35. url.root.dir<-"http://gdeltproject.org/data/dailyupdates/" #Parent directory
  36. daily.names.zips.url<-paste(url.root.dir, daily.names.files, sep="") #Full file address
  37. gdelt.daily.files<-data.frame(file=daily.names.files, url=daily.names.zips.url, date=daily.names.date, stringsAsFactors=FALSE)
  38. rm(daily.names, daily.names.files, daily.names.zips.url, daily.names.date, url.root.dir)
  39.  
  40. #These next lines are to download the information on the CAMEO codes.
  41. #See: http://gdeltproject.org/data/documentation/CAMEO.Manual.1.1b3.pdf
  42.  
  43. read.sstab<-function(theurl, ...){ #Function to read in a data table from online
  44.   #_theurl_ refers to the location of the data
  45.   #_..._ are parameters passed onto read.table
  46.   Sys.sleep(2) #Two second delay.
  47.   file.name<-unlist(strsplit(theurl, "/")) #Splits the URL
  48.   file.name<-file.name[length(file.name)] #The file name as presented in the URL
  49.   download.file(theurl, file.name)
  50.   outtab<-read.table(file.name, sep="\t", ...)
  51.   file.remove(file.name)
  52.   return(outtab)
  53.   }
  54. read.sstab<-cmpfun(read.sstab)
  55.  
  56. CAMEO.codes<-c(country="CAMEO.country.txt", group="CAMEO.knowngroup.txt", ethnic="CAMEO.ethnic.txt", religion="CAMEO.religion.txt", type="CAMEO.type.txt", event="CAMEO.eventcodes.txt", goldstein="CAMEO.goldsteinscale.txt") #These are the file names
  57. CAMEO.codes<-data.frame(file.name=CAMEO.codes, file.url=paste("http://gdeltproject.org/data/lookups/", CAMEO.codes, sep=""), stringsAsFactors=FALSE) #Join with URL
  58. CAMEO.codebooks<-lapply(CAMEO.codes$file.url, read.sstab, quote="", header=TRUE, as.is=TRUE, stringsAsFactors=FALSE, colClasses=c("character", "character")) #Download the tables
  59. names(CAMEO.codebooks)<-rownames(CAMEO.codes) #Name the list
  60. #Aside from the Goldstein Scale, all items should be characters.
  61. CAMEO.codebooks$goldstein$GOLDSTEINSCALE<-as.numeric(CAMEO.codebooks$goldstein$GOLDSTEINSCALE)
  62. CAMEO.codes<-list(codebooks=CAMEO.codebooks, source=CAMEO.codes) #Combine
  63. rm(CAMEO.codebooks, read.sstab) #Clean-up
  64.  
  65. read.gdelt<-function(file.name, daily=FALSE, ActionGeo_CountryCode=NULL){
  66.   #_file.name_ is the name of the .csv file extracted from the corresponding .zip
  67.   #_daily_, if set to TRUE, indicates that file.name comes from the Daily Updates data source
  68.   #Filters to subsample
  69.     #_ActionGeo_CountryCode_: Character vector.
  70.       #Codebook advises to use this variable for location filtering
  71.       #Description: "This is the 2-character FIPS10-4 country code for the location."
  72.       #For the codes, see the PDF/XLS here: http://earth-info.nga.mil/gns/html/gazetteers2.html
  73.     #Other filtering variables can be added. For now, I'm only interested in _ActionGeo_CountryCode_
  74.  
  75.   #Column names come from "http://gdeltproject.org/data/lookups/CSV.header.dailyupdates.txt"
  76.     #I suppose names below could be automatically downloaded from that site, but whatevs
  77.     #Disadvantages: 1) The code looks less clean and 2) constants are introduced
  78.     #Advantages: 1) The column names are listed before us, making subsampling easier, and 2) these constants will be introduced anyways due to the colClasses argument.
  79.   out.dat.colnames<-c("GLOBALEVENTID", "SQLDATE", "MonthYear", "Year", "FractionDate", "Actor1Code", "Actor1Name", "Actor1CountryCode", "Actor1KnownGroupCode", "Actor1EthnicCode", "Actor1Religion1Code", "Actor1Religion2Code", "Actor1Type1Code", "Actor1Type2Code", "Actor1Type3Code", "Actor2Code", "Actor2Name", "Actor2CountryCode", "Actor2KnownGroupCode", "Actor2EthnicCode", "Actor2Religion1Code", "Actor2Religion2Code", "Actor2Type1Code", "Actor2Type2Code", "Actor2Type3Code", "IsRootEvent", "EventCode", "EventBaseCode", "EventRootCode", "QuadClass", "GoldsteinScale", "NumMentions", "NumSources", "NumArticles", "AvgTone", "Actor1Geo_Type", "Actor1Geo_FullName", "Actor1Geo_CountryCode", "Actor1Geo_ADM1Code", "Actor1Geo_Lat", "Actor1Geo_Long", "Actor1Geo_FeatureID", "Actor2Geo_Type", "Actor2Geo_FullName", "Actor2Geo_CountryCode", "Actor2Geo_ADM1Code", "Actor2Geo_Lat", "Actor2Geo_Long", "Actor2Geo_FeatureID", "ActionGeo_Type", "ActionGeo_FullName", "ActionGeo_CountryCode", "ActionGeo_ADM1Code", "ActionGeo_Lat", "ActionGeo_Long", "ActionGeo_FeatureID", "DATEADDED", "SOURCEURL")
  80.   #Setting the column classes is important here.  R would otherwise autodetect many of the character fields as integer/numerics (because they're expressed as numbers).  Setting these columns as a character class is important when it comes to matching their verbal descriptions.
  81.   out.dat.colClasses<-c(GLOBALEVENTID="integer", SQLDATE="integer", MonthYear="integer", Year="integer", FractionDate="numeric", Actor1Code="character", Actor1Name="character", Actor1CountryCode="character", Actor1KnownGroupCode="character", Actor1EthnicCode="character", Actor1Religion1Code="character", Actor1Religion2Code="character", Actor1Type1Code="character", Actor1Type2Code="character", Actor1Type3Code="character", Actor2Code="character", Actor2Name="character", Actor2CountryCode="character", Actor2KnownGroupCode="character", Actor2EthnicCode="character", Actor2Religion1Code="character", Actor2Religion2Code="character", Actor2Type1Code="character", Actor2Type2Code="character", Actor2Type3Code="character", IsRootEvent="integer", EventCode="character", EventBaseCode="character", EventRootCode="character", QuadClass="integer", GoldsteinScale="numeric", NumMentions="integer", NumSources="integer", NumArticles="integer", AvgTone="numeric", Actor1Geo_Type="integer", Actor1Geo_FullName="character", Actor1Geo_CountryCode="character", Actor1Geo_ADM1Code="character", Actor1Geo_Lat="numeric", Actor1Geo_Long="numeric", Actor1Geo_FeatureID="integer", Actor2Geo_Type="integer", Actor2Geo_FullName="character", Actor2Geo_CountryCode="character", Actor2Geo_ADM1Code="character", Actor2Geo_Lat="numeric", Actor2Geo_Long="numeric", Actor2Geo_FeatureID="integer", ActionGeo_Type="integer", ActionGeo_FullName="character", ActionGeo_CountryCode="character", ActionGeo_ADM1Code="character", ActionGeo_Lat="numeric", ActionGeo_Long="numeric", ActionGeo_FeatureID="integer", DATEADDED="integer", SOURCEURL="character")
  82.  
  83.   if (daily){
  84.     #Some of the FeatureIDs in the daily updates are characters. Same for IsRootEvent, among others.
  85.     #If other problems arise with an error that reads something like, "Expecting an integer, got <a character>", identify the offending column, add its name below, then add another "suppressWarnings" line.
  86.     out.dat.colClasses[c("Actor1Geo_FeatureID", "Actor2Geo_FeatureID", "ActionGeo_FeatureID", "IsRootEvent", "GoldsteinScale", "NumMentions", "AvgTone", "NumSources", "NumArticles", "Actor1Geo_Lat", "Actor1Geo_Long", "Actor2Geo_Lat", "Actor2Geo_Long", "ActionGeo_Lat", "ActionGeo_Long")]<-"character"
  87.     out.dat<-read.table(file.name, header=FALSE, sep="\t", quote="\"", col.names=out.dat.colnames, colClasses=out.dat.colClasses, na.strings=c("NA", ""), as.is=TRUE, stringsAsFactors=FALSE, comment.char="")
  88.     #Reset the FeatureIDs to integers, etc.
  89.     #Will issue a warning as some of the characters do not correspond to integers.
  90.       #Those will receive NA values.
  91.     suppressWarnings(out.dat$Actor1Geo_FeatureID<-as.integer(out.dat$Actor1Geo_FeatureID))
  92.     suppressWarnings(out.dat$Actor2Geo_FeatureID<-as.integer(out.dat$Actor2Geo_FeatureID))
  93.     suppressWarnings(out.dat$ActionGeo_FeatureID<-as.integer(out.dat$ActionGeo_FeatureID))
  94.     suppressWarnings(out.dat$IsRootEvent<-as.integer(out.dat$IsRootEvent))
  95.     suppressWarnings(out.dat$GoldsteinScale<-as.numeric(out.dat$GoldsteinScale))
  96.     suppressWarnings(out.dat$NumMentions<-as.integer(out.dat$NumMentions))
  97.     suppressWarnings(out.dat$AvgTone<-as.numeric(out.dat$AvgTone))
  98.     suppressWarnings(out.dat$NumSources<-as.integer(out.dat$NumSources))
  99.     suppressWarnings(out.dat$NumArticles<-as.integer(out.dat$NumArticles))
  100.     suppressWarnings(out.dat$Actor1Geo_Lat<-as.numeric(out.dat$Actor1Geo_Lat))
  101.     suppressWarnings(out.dat$Actor1Geo_Long<-as.numeric(out.dat$Actor1Geo_Long))
  102.     suppressWarnings(out.dat$Actor2Geo_Lat<-as.numeric(out.dat$Actor2Geo_Lat))
  103.     suppressWarnings(out.dat$Actor2Geo_Long<-as.numeric(out.dat$Actor2Geo_Long))
  104.     suppressWarnings(out.dat$ActionGeo_Lat<-as.numeric(out.dat$ActionGeo_Lat))
  105.     suppressWarnings(out.dat$ActionGeo_Long<-as.numeric(out.dat$ActionGeo_Long))
  106.     }
  107.   else #SOURCEURL is only available for the daily updates
  108.     out.dat<-read.table(file.name, header=FALSE, sep="\t", quote="\"", col.names=out.dat.colnames[1:(length(out.dat.colnames)-1)], colClasses=out.dat.colClasses[1:(length(out.dat.colnames)-1)], na.strings=c("NA", ""), as.is=TRUE, stringsAsFactors=FALSE, comment.char="")
  109.   rownames(out.dat)<-out.dat$GLOBALEVENTID
  110.   out.dat$IsRootEvent<-as.logical(out.dat$IsRootEvent) #Original data in 0s and 1s
  111.  
  112.   #Some cleaning. Values that don't belong get NA
  113.   #Country codes
  114.   if (any(out.dat$Actor1CountryCode%in%CAMEO.codes$codebooks$country$CODE==FALSE)){
  115.     bad.cases<-which(out.dat$Actor1CountryCode%in%CAMEO.codes$codebooks$country$CODE==FALSE)
  116.     out.dat$Actor1CountryCode[bad.cases]<-NA
  117.     }
  118.   if (any(out.dat$Actor2CountryCode%in%CAMEO.codes$codebooks$country$CODE==FALSE)){
  119.     bad.cases<-which(out.dat$Actor2CountryCode%in%CAMEO.codes$codebooks$country$CODE==FALSE)
  120.     out.dat$Actor2CountryCode[bad.cases]<-NA
  121.     }
  122.   #Known group codes
  123.   if (any(out.dat$Actor1KnownGroupCode%in%CAMEO.codes$codebooks$group$CODE==FALSE)){
  124.     bad.cases<-which(out.dat$Actor1KnownGroupCode%in%CAMEO.codes$codebooks$group$CODE==FALSE)
  125.     out.dat$Actor1KnownGroupCode[bad.cases]<-NA
  126.     }
  127.   if (any(out.dat$Actor2KnownGroupCode%in%CAMEO.codes$codebooks$group$CODE==FALSE)){
  128.     bad.cases<-which(out.dat$Actor2KnownGroupCode%in%CAMEO.codes$codebooks$group$CODE==FALSE)
  129.     out.dat$Actor2KnownGroupCode[bad.cases]<-NA
  130.     }
  131.   #Ethnic codes
  132.   if (any(out.dat$Actor1EthnicCode%in%CAMEO.codes$codebooks$ethnic$CODE==FALSE)){
  133.     bad.cases<-which(out.dat$Actor1EthnicCode%in%CAMEO.codes$codebooks$ethnic$CODE==FALSE)
  134.     out.dat$Actor1EthnicCode[bad.cases]<-NA
  135.     }
  136.   if (any(out.dat$Actor2EthnicCode%in%CAMEO.codes$codebooks$ethnic$CODE==FALSE)){
  137.     bad.cases<-which(out.dat$Actor2EthnicCode%in%CAMEO.codes$codebooks$ethnic$CODE==FALSE)
  138.     out.dat$Actor2EthnicCode[bad.cases]<-NA
  139.     }
  140.   #Religion codes
  141.   if (any(out.dat$Actor1Religion1Code%in%CAMEO.codes$codebooks$religion$CODE==FALSE)){
  142.     bad.cases<-which(out.dat$Actor1Religion1Code%in%CAMEO.codes$codebooks$religion$CODE==FALSE)
  143.     out.dat$Actor1Religion1Code[bad.cases]<-NA
  144.     }
  145.   if (any(out.dat$Actor1Religion2Code%in%CAMEO.codes$codebooks$religion$CODE==FALSE)){
  146.     bad.cases<-which(out.dat$Actor1Religion2Code%in%CAMEO.codes$codebooks$religion$CODE==FALSE)
  147.     out.dat$Actor1Religion2Code[bad.cases]<-NA
  148.     }
  149.   if (any(out.dat$Actor2Religion1Code%in%CAMEO.codes$codebooks$religion$CODE==FALSE)){
  150.     bad.cases<-which(out.dat$Actor2Religion1Code%in%CAMEO.codes$codebooks$religion$CODE==FALSE)
  151.     out.dat$Actor2Religion1Code[bad.cases]<-NA
  152.     }
  153.   if (any(out.dat$Actor2Religion2Code%in%CAMEO.codes$codebooks$religion$CODE==FALSE)){
  154.     bad.cases<-which(out.dat$Actor2Religion2Code%in%CAMEO.codes$codebooks$religion$CODE==FALSE)
  155.     out.dat$Actor2Religion2Code[bad.cases]<-NA
  156.     }
  157.   #Type codes
  158.   if (any(out.dat$Actor1Type1Code%in%CAMEO.codes$codebooks$type$CODE==FALSE)){
  159.     bad.cases<-which(out.dat$Actor1Type1Code%in%CAMEO.codes$codebooks$type$CODE==FALSE)
  160.     out.dat$Actor1Type1Code[bad.cases]<-NA
  161.     }
  162.   if (any(out.dat$Actor1Type2Code%in%CAMEO.codes$codebooks$type$CODE==FALSE)){
  163.     bad.cases<-which(out.dat$Actor1Type2Code%in%CAMEO.codes$codebooks$type$CODE==FALSE)
  164.     out.dat$Actor1Type2Code[bad.cases]<-NA
  165.     }
  166.   if (any(out.dat$Actor1Type3Code%in%CAMEO.codes$codebooks$type$CODE==FALSE)){
  167.     bad.cases<-which(out.dat$Actor1Type3Code%in%CAMEO.codes$codebooks$type$CODE==FALSE)
  168.     out.dat$Actor1Type3Code[bad.cases]<-NA
  169.     }
  170.   if (any(out.dat$Actor2Type1Code%in%CAMEO.codes$codebooks$type$CODE==FALSE)){
  171.     bad.cases<-which(out.dat$Actor2Type1Code%in%CAMEO.codes$codebooks$type$CODE==FALSE)
  172.     out.dat$Actor2Type1Code[bad.cases]<-NA
  173.     }
  174.   if (any(out.dat$Actor2Type2Code%in%CAMEO.codes$codebooks$type$CODE==FALSE)){
  175.     bad.cases<-which(out.dat$Actor2Type2Code%in%CAMEO.codes$codebooks$type$CODE==FALSE)
  176.     out.dat$Actor2Type2Code[bad.cases]<-NA
  177.     }
  178.   if (any(out.dat$Actor2Type3Code%in%CAMEO.codes$codebooks$type$CODE==FALSE)){
  179.     bad.cases<-which(out.dat$Actor2Type3Code%in%CAMEO.codes$codebooks$type$CODE==FALSE)
  180.     out.dat$Actor2Type3Code[bad.cases]<-NA
  181.     }
  182.   #Event codes
  183.   if (any(out.dat$EventCode%in%CAMEO.codes$codebooks$event$CAMEOEVENTCODE==FALSE)){
  184.     bad.cases<-which(out.dat$EventCode%in%CAMEO.codes$codebooks$event$CAMEOEVENTCODE==FALSE)
  185.     out.dat$EventCode[bad.cases]<-NA
  186.     }
  187.   if (any(out.dat$EventBaseCode%in%CAMEO.codes$codebooks$event$CAMEOEVENTCODE==FALSE)){
  188.     bad.cases<-which(out.dat$EventBaseCode%in%CAMEO.codes$codebooks$event$CAMEOEVENTCODE==FALSE)
  189.     out.dat$EventBaseCode[bad.cases]<-NA
  190.     }
  191.   if (any(out.dat$EventRootCode%in%CAMEO.codes$codebooks$event$CAMEOEVENTCODE==FALSE)){
  192.     bad.cases<-which(out.dat$EventRootCode%in%CAMEO.codes$codebooks$event$CAMEOEVENTCODE==FALSE)
  193.     out.dat$EventRootCode[bad.cases]<-NA
  194.     }
  195.  
  196.   #Here's where the data should be subsampled
  197.   if (is.null(ActionGeo_CountryCode)==FALSE){
  198.     country.filter<-which(out.dat$ActionGeo_CountryCode%in%ActionGeo_CountryCode)
  199.     if (length(country.filter)==0){ #In case none of the events satisfy the filter
  200.       out.dat<-out.dat[1,] #Preserve the format
  201.       out.dat[,]<-NA #Assign all NA
  202.       cat("\n  None of the cases in '", file.name, "' passed through the filter. Returning NA.\n", sep="")
  203.       }
  204.     else
  205.       out.dat<-out.dat[country.filter,]
  206.     }
  207.   #Add other filters, if needed, here
  208.  
  209.   return(out.dat)
  210.   }
  211. #read.gdelt() will be greedy on the resources. Hopefully better performance if compiled.
  212. read.gdelt<-cmpfun(read.gdelt)
  213.  
  214. dluzrd<-function(file.url, ...){
  215.   #DownLoad UnZip Read Delete
  216.   #_file.url_ should correspond to gdelt.full.files$url[x]
  217.   #_..._ are parameters to pass on to the read command
  218.   file.name<-unlist(strsplit(file.url, "/")) #Splits the URL
  219.   file.name<-file.name[length(file.name)] #The file name as presented in the URL
  220.   download.file(file.url, file.name) #The files are big, so this could take a few minutes
  221.   unzip(file.name) #Extract the contents
  222.   #Hopefully all of the .zip files will always and forever contain only one file, and that file is the .csv
  223.   file.csv<-unzip(file.name, list=TRUE)[1,"Name"] #Create .csv file name
  224.   file.csv<-toString(file.csv)
  225.   out.dat<-read.gdelt(file.csv, ...)
  226.   file.remove(file.name, file.csv)
  227.   return(out.dat)
  228.   }
  229. #To avoid running a for loop in R
  230. dluzrd<-Vectorize(dluzrd, vectorize.args="file.url", SIMPLIFY=FALSE)
  231. dluzrd<-cmpfun(dluzrd)
  232.  
  233. #All of the above functions could be nested within this next one, but the code reads cleaner this way.  That, and some of them could be individually useful.
  234.  
  235. acquire.gdelt<-function(years.interest=c(1979:2013), country.code=NULL){
  236.   #_years.interest_ are the years you want to sample
  237.   #_country.code_ is a vector of FIPS10-4 country codes for the location
  238.   #By default, this program select all years and all countries
  239.   #If you value your RAM and download time, I would not recommend using the defaults on most computers
  240.   years.interest<-which(gdelt.full.files$year%in%years.interest) #Return an index
  241.   gdelt.interest<-dluzrd(gdelt.full.files$url[years.interest], daily=FALSE, ActionGeo_CountryCode=country.code) #This function will return a list
  242.   gdelt.interest<-do.call(rbind, gdelt.interest) #Turn this list into a single dataframe
  243.   rownames(gdelt.interest)<-1:nrow(gdelt.interest)
  244.   return(gdelt.interest)  
  245.   }
  246. acquire.gdelt<-cmpfun(acquire.gdelt) #Compiling might help
  247.  
  248. acquire.gdelt.daily<-function(start.date=20130401, end.date=as.character(format.Date(as.Date(date(), "%a %b %d %H:%M:%S %Y")-1, "%Y%m%d")), country.code=NULL){
  249.   #_start.date_ is the date, expressed as the number YYYYMMDD, of when to start retrieving data
  250.   #_end.date_ is the date, expressed as the number YYYYMMDD, of when to end retrieving data
  251.     #By default, _end.date_ is yesterday.
  252.   #_country.code_ is a vector of FIPS10-4 country codes for the location
  253.   #By default, this program select all years and all countries
  254.   #If you value your RAM and download time, I would not recommend using the defaults on most computers
  255.   dates.to.retrieve<-seq.Date(from=as.Date(as.character(start.date), "%Y%m%d"), to=as.Date(as.character(end.date), "%Y%m%d"), by=1)
  256.   dates.to.retrieve<-as.character(format.Date(dates.to.retrieve, "%Y%m%d"))
  257.   dates.to.retrieve<-which(gdelt.daily.files$date%in%dates.to.retrieve) #Return an index
  258.   gdelt.interest<-dluzrd(gdelt.daily.files$url[dates.to.retrieve], daily=TRUE, ActionGeo_CountryCode=country.code) #This function will return a list
  259.   gdelt.interest<-do.call(rbind, gdelt.interest) #Turn this list into a single dataframe
  260.   rownames(gdelt.interest)<-1:nrow(gdelt.interest)
  261.   return(gdelt.interest)  
  262.   }
  263. acquire.gdelt.daily<-cmpfun(acquire.gdelt.daily) #Compiling might help
  264.  
  265. assign.CAMEO<-function(your.gdelt){
  266.   #_your.gdelt_ should be dataset produced by acquire.gdelt()
  267.   #This function will create verbal descriptions for the CAMEO codes in _your.gdelt_
  268.   #These tables will likely be resource needy.
  269.   Actor1CountryCode.verbal<-CAMEO.codes$codebooks$country$LABEL[match(your.gdelt$Actor1CountryCode, CAMEO.codes$codebooks$country$CODE)]
  270.   Actor2CountryCode.verbal<-CAMEO.codes$codebooks$country$LABEL[match(your.gdelt$Actor2CountryCode, CAMEO.codes$codebooks$country$CODE)]
  271.   Actor1KnownGroupCode.verbal<-CAMEO.codes$codebooks$group$LABEL[match(your.gdelt$Actor1KnownGroupCode, CAMEO.codes$codebooks$group$CODE)]
  272.   Actor2KnownGroupCode.verbal<-CAMEO.codes$codebooks$group$LABEL[match(your.gdelt$Actor2KnownGroupCode, CAMEO.codes$codebooks$group$CODE)]
  273.   Actor1EthnicCode.verbal<-CAMEO.codes$codebooks$ethnic$LABEL[match(your.gdelt$Actor1EthnicCode, CAMEO.codes$codebooks$ethnic$CODE)]
  274.   Actor2EthnicCode.verbal<-CAMEO.codes$codebooks$ethnic$LABEL[match(your.gdelt$Actor2EthnicCode, CAMEO.codes$codebooks$ethnic$CODE)]
  275.   Actor1Religion1Code.verbal<-CAMEO.codes$codebooks$religion$LABEL[match(your.gdelt$Actor1Religion1Code, CAMEO.codes$codebooks$religion$CODE)]
  276.   Actor1Religion2Code.verbal<-CAMEO.codes$codebooks$religion$LABEL[match(your.gdelt$Actor1Religion2Code, CAMEO.codes$codebooks$religion$CODE)]
  277.   Actor2Religion1Code.verbal<-CAMEO.codes$codebooks$religion$LABEL[match(your.gdelt$Actor2Religion1Code, CAMEO.codes$codebooks$religion$CODE)]
  278.   Actor2Religion2Code.verbal<-CAMEO.codes$codebooks$religion$LABEL[match(your.gdelt$Actor2Religion2Code, CAMEO.codes$codebooks$religion$CODE)]
  279.   Actor1Type1Code.verbal<-CAMEO.codes$codebooks$type$LABEL[match(your.gdelt$Actor1Type1Code, CAMEO.codes$codebooks$type$CODE)]
  280.   Actor1Type2Code.verbal<-CAMEO.codes$codebooks$type$LABEL[match(your.gdelt$Actor1Type2Code, CAMEO.codes$codebooks$type$CODE)]
  281.   Actor1Type3Code.verbal<-CAMEO.codes$codebooks$type$LABEL[match(your.gdelt$Actor1Type3Code, CAMEO.codes$codebooks$type$CODE)]
  282.   Actor2Type1Code.verbal<-CAMEO.codes$codebooks$type$LABEL[match(your.gdelt$Actor2Type1Code, CAMEO.codes$codebooks$type$CODE)]
  283.   Actor2Type2Code.verbal<-CAMEO.codes$codebooks$type$LABEL[match(your.gdelt$Actor2Type2Code, CAMEO.codes$codebooks$type$CODE)]
  284.   Actor2Type3Code.verbal<-CAMEO.codes$codebooks$type$LABEL[match(your.gdelt$Actor2Type3Code, CAMEO.codes$codebooks$type$CODE)]
  285.   EventCode.verbal<-CAMEO.codes$codebooks$event$EVENTDESCRIPTION[match(your.gdelt$EventCode, CAMEO.codes$codebooks$event$CAMEOEVENTCODE)]
  286.   EventBaseCode.verbal<-CAMEO.codes$codebooks$event$EVENTDESCRIPTION[match(your.gdelt$EventBaseCode, CAMEO.codes$codebooks$event$CAMEOEVENTCODE)]
  287.   EventRootCode.verbal<-CAMEO.codes$codebooks$event$EVENTDESCRIPTION[match(your.gdelt$EventRootCode, CAMEO.codes$codebooks$event$CAMEOEVENTCODE)]
  288.   QuadClass.vec<-c("Verbal Cooperation", "Material Cooperation", "Verbal Conflict", "Material Conflict")
  289.   QuadClass.verbal<-QuadClass.vec[your.gdelt$QuadClass]
  290.   Geo_Type.vec<-c(NA, "COUNTRY", "USSTATE", "USCITY", "WORLDCITY", "WORLDSTATE")
  291.   Actor1Geo_Type.verbal<-Geo_Type.vec[your.gdelt$Actor1Geo_Type+1]
  292.   Actor2Geo_Type.verbal<-Geo_Type.vec[your.gdelt$Actor2Geo_Type+1]
  293.   ActionGeo_Type.verbal<-Geo_Type.vec[your.gdelt$ActionGeo_Type+1]
  294.   #Goldstein Scale already assigned in the data
  295.   out.df<-data.frame(Actor1CountryCode.verbal, Actor2CountryCode.verbal, Actor1KnownGroupCode.verbal, Actor2KnownGroupCode.verbal, Actor1EthnicCode.verbal, Actor2EthnicCode.verbal, Actor1Religion1Code.verbal, Actor1Religion2Code.verbal, Actor2Religion1Code.verbal, Actor2Religion2Code.verbal, Actor1Type1Code.verbal, Actor1Type2Code.verbal, Actor1Type3Code.verbal, Actor2Type1Code.verbal, Actor2Type2Code.verbal, Actor2Type3Code.verbal, EventCode.verbal, EventBaseCode.verbal, EventRootCode.verbal, QuadClass.verbal, Actor1Geo_Type.verbal, Actor2Geo_Type.verbal, ActionGeo_Type.verbal, stringsAsFactors=FALSE)
  296.   return(out.df)
  297.   }; assign.CAMEO<-cmpfun(assign.CAMEO)
Advertisement
Add Comment
Please, Sign In to add comment