├── .Rbuildignore ├── src ├── registerDynamicSymbol.c ├── temp.cpp ├── RcppExports.cpp └── rem.cpp ├── .travis.yml ├── rem.Rproj ├── inst └── CITATION ├── README.md ├── NAMESPACE ├── DESCRIPTION ├── man ├── rem-package.Rd ├── timeToEvent.Rd ├── eventSequence.Rd ├── inertiaStat.Rd ├── createRemDataset.Rd ├── reciprocityStat.Rd ├── fourCycleStat.Rd ├── triadStat.Rd ├── similarityStat.Rd └── degreeStat.Rd └── R ├── RcppExports.R └── temp.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | .travis.yml 2 | README.md 3 | -------------------------------------------------------------------------------- /src/registerDynamicSymbol.c: -------------------------------------------------------------------------------- 1 | // RegisteringDynamic Symbols 2 | 3 | #include 4 | #include 5 | #include 6 | 7 | void R_init_markovchain(DllInfo* info) { 8 | R_registerRoutines(info, NULL, NULL, NULL, NULL); 9 | R_useDynamicSymbols(info, TRUE); 10 | } 11 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: r 2 | 3 | r: 4 | - devel 5 | - release 6 | 7 | sudo: false 8 | 9 | cache: packages 10 | 11 | github_packages: 12 | - assertthat 13 | - devtools 14 | 15 | r_check_args: --as-cran 16 | 17 | notifications: 18 | email: 19 | recipients: 20 | - laurence.brandenberger@eawag.ch 21 | on_success: change 22 | on_failure: change 23 | -------------------------------------------------------------------------------- /rem.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite the 'rem' package in publications use:") 2 | 3 | year <- sub(".*(2[[:digit:]]{3})-.*", "\\1", meta$Date) 4 | vers <- paste("R package version", meta$Version) 5 | 6 | citEntry(entry="Manual", 7 | title = "rem: Relational Event Models", 8 | author = personList(as.person("Laurence Brandenberger")), 9 | year = year, 10 | note = vers, 11 | textVersion = paste("Brandenberger, Laurence (", year, "). ", 12 | "rem: Relational Event Models. ", vers, ".", sep = "") 13 | ) 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # rem 2 | R-package for relational event models (REM). 3 | 4 | Calculate endogenous network effects in event sequences and fit relational event models (REM). Using network event sequences (where each tie between a sender and a target in a network is time-stamped), REMs can measure how networks form and evolve over time. Endogenous patterns such as popularity effects, inertia, similarities, cycles or triads can be calculated and analyzed over time. 5 | 6 | 7 | [![Build Status](https://travis-ci.org/brandenberger/rem.svg?branch=master)](https://travis-ci.org/brandenberger/rem) 8 | [![cran version](http://www.r-pkg.org/badges/version/rem)](https://cran.r-project.org/package=rem) 9 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | useDynLib(rem, .registration = TRUE) 2 | import("doParallel") 3 | import("foreach") 4 | importFrom("Rcpp", evalCpp) 5 | importFrom("stats", "as.formula") 6 | importFrom("utils", "setTxtProgressBar", "txtProgressBar") 7 | # export all functions -> exportPattern("^[[:alpha:]]+") -> or: exportPattern("^[^\\.]") 8 | # since there are cpp-functions included, they would be exported as well, therefore, only the R-functions are exported 9 | export("degreeStat") 10 | export("eventSequence") 11 | export("fourCycleStat") 12 | export("triadStat") 13 | export("inertiaStat") 14 | export("reciprocityStat") 15 | export("similarityStat") 16 | export("createRemDataset") 17 | export("timeToEvent") -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: rem 2 | Type: Package 3 | Title: Relational Event Models (REM) 4 | Version: 1.3.3 5 | Date: 2020-08-14 6 | Author: Laurence Brandenberger 7 | Maintainer: Laurence Brandenberger 8 | Description: Calculate endogenous network effects in event sequences and fit relational event models (REM): Using network event sequences (where each tie between a sender and a target in a network is time-stamped), REMs can measure how networks form and evolve over time. Endogenous patterns such as popularity effects, inertia, similarities, cycles or triads can be calculated and analyzed over time. 9 | License: GPL (>= 2) 10 | Depends: R (>= 2.14.0) 11 | Imports: Rcpp, foreach, doParallel 12 | LinkingTo: Rcpp 13 | Suggests: texreg, statnet, ggplot2 -------------------------------------------------------------------------------- /src/temp.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | using namespace Rcpp; 4 | 5 | 6 | //#################################################################### 7 | // [[Rcpp::export]] 8 | NumericVector absoluteDiffAverageWeightEventAttributeCpp( 9 | std::vector sender, 10 | std::vector target, 11 | NumericVector time, 12 | NumericVector weightvar, 13 | std::vector eventattributevar, 14 | std::string eventattribute, 15 | double xlog) { 16 | 17 | NumericVector result(time.size()); 18 | int count = 0; 19 | 20 | // for-loop: for each event, do: 21 | for ( int i = 0; i < time.size(); i++){ 22 | 23 | double totaldiff = 0; 24 | count = 0; 25 | 26 | for ( int w = 0; w < i; w++ ) { 27 | if (eventattributevar[w] == eventattribute && sender[i] != sender[w] && target[i] == target[w]) { 28 | if ( time[i] != time[w] ) { 29 | count = count + 1; 30 | totaldiff = totaldiff + std::abs(weightvar[i] - weightvar[w]); 31 | } 32 | } 33 | } // closes w-loop 34 | if (count == 0) { 35 | result[i] = 0; 36 | }else{ 37 | result[i] = totaldiff/count; 38 | } 39 | } // closes i-loop 40 | return Rcpp::wrap(result); 41 | } -------------------------------------------------------------------------------- /man/rem-package.Rd: -------------------------------------------------------------------------------- 1 | \name{rem-package} 2 | \alias{rem-package} 3 | \alias{rem} 4 | \alias{relational-event-model} 5 | \alias{relational event model} 6 | \docType{package} 7 | \title{Fit Relational Event Models (REM)} 8 | \description{The \pkg{rem} package uses a combination of event history and network analysis to test network dependencies in event sequences. If events in an event sequence depend on each other, network structures and patterns can be calculated and estimated using relational event models. The \code{rem}-package includes functions to calculate endogenous network statistics in (signed) one-, two- and multi-mode network event sequences. The statistics include inertia (\link{inertiaStat}), reciprocity (\link{reciprocityStat}), in- or outdegree statistics (\link{degreeStat}), closing triads (\link{triadStat}), closing four-cycles (\link{fourCycleStat}) or endogenous similarity statistics (\link{similarityStat}). The rate of event occurrence can then be tested using standard models of event history analysis, such as a stratified Cox model (or a conditional logistic regression). \link{createRemDataset} can be used to create counting process data sets with dynamic risk sets. 9 | } 10 | \details{ 11 | \tabular{ll}{ 12 | Package: \tab rem\cr 13 | Type: \tab Package\cr 14 | Version: \tab 1.3.3\cr 15 | Date: \tab 2020-08-14\cr 16 | } 17 | } 18 | \author{ 19 | Laurence Brandenberger \email{lbrandenberger@ethz.ch} 20 | } 21 | \references{ 22 | Lerner, Jurgen, Bussmann, Margit, Snijders, Tom. A., & Brandes, Ulrik. 2013. Modeling frequency and type of interaction in event networks. Corvinus Journal of Sociology and Social Policy, (1), 3-32. 23 | 24 | Brandenberger, Laurence. 2018. Trading Favors - Examining the Temporal Dynamics of Reciprocity in Congressional Collaborations Using Relational Event Models. Social Networks, 54: 238-253. 25 | 26 | Malang, Thomas, Laurence Brandeberger and Philip Leifeld. 2018. Networks and Social Influence in European Legislative Politics. British Journal of Political Science. DOI: 10.1017/S0007123417000217. 27 | } 28 | 29 | -------------------------------------------------------------------------------- /R/RcppExports.R: -------------------------------------------------------------------------------- 1 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | fourCycleCpp <- function(sender, currentSender, target, currentTarget, typevar, currentType, time, currentTime, weightvar, xlog, attrvarAaj, attrAaj, attrvarBib, attrBib, attrvarCij, attrCij, fourCycleType, w, x, i, begin) { 5 | .Call(`_rem_fourCycleCpp`, sender, currentSender, target, currentTarget, typevar, currentType, time, currentTime, weightvar, xlog, attrvarAaj, attrAaj, attrvarBib, attrBib, attrvarCij, attrCij, fourCycleType, w, x, i, begin) 6 | } 7 | 8 | similarityTotalAverageCpp <- function(sender, currentSender, target, currentTarget, time, currentTime, eventAttributeVar, eventAttribute, eventTypeVar, currentType, totalAverageSim, matchNomatchSim, senderTargetSim, v, w, i, begin) { 9 | .Call(`_rem_similarityTotalAverageCpp`, sender, currentSender, target, currentTarget, time, currentTime, eventAttributeVar, eventAttribute, eventTypeVar, currentType, totalAverageSim, matchNomatchSim, senderTargetSim, v, w, i, begin) 10 | } 11 | 12 | similaritySimpleCpp <- function(sender, currentSender, target, currentTarget, time, currentTime, xlog, eventAttributeVar, eventAttribute, eventTypeVar, currentType, matchNomatchSim, senderTargetSim, v, w, i, begin) { 13 | .Call(`_rem_similaritySimpleCpp`, sender, currentSender, target, currentTarget, time, currentTime, xlog, eventAttributeVar, eventAttribute, eventTypeVar, currentType, matchNomatchSim, senderTargetSim, v, w, i, begin) 14 | } 15 | 16 | similarityComplexCpp <- function(sender, currentSender, target, currentTarget, time, currentTime, xlog, halflifeTimeDifference, eventAttributeVar, eventAttribute, eventTypeVar, currentType, matchNomatchSim, senderTargetSim, v, w, i, begin) { 17 | .Call(`_rem_similarityComplexCpp`, sender, currentSender, target, currentTarget, time, currentTime, xlog, halflifeTimeDifference, eventAttributeVar, eventAttribute, eventTypeVar, currentType, matchNomatchSim, senderTargetSim, v, w, i, begin) 18 | } 19 | 20 | triadCpp <- function(v, sender, target, time, weightvar, typevar, typeA, typeB, attributevarAI, attrAI, attributevarBI, attrBI, xlog, i, currentSender, currentTarget, currentTime) { 21 | .Call(`_rem_triadCpp`, v, sender, target, time, weightvar, typevar, typeA, typeB, attributevarAI, attrAI, attributevarBI, attrBI, xlog, i, currentSender, currentTarget, currentTime) 22 | } 23 | 24 | weightTimesSummationCpp <- function(pastSenderTimes, xlog, currentTime, weightvar) { 25 | .Call(`_rem_weightTimesSummationCpp`, pastSenderTimes, xlog, currentTime, weightvar) 26 | } 27 | 28 | createNullEvents <- function(eventID, sender, target, eventAttribute, time, start, end, allEventTimes, nrows) { 29 | .Call(`_rem_createNullEvents`, eventID, sender, target, eventAttribute, time, start, end, allEventTimes, nrows) 30 | } 31 | 32 | absoluteDiffAverageWeightEventAttributeCpp <- function(sender, target, time, weightvar, eventattributevar, eventattribute, xlog) { 33 | .Call(`_rem_absoluteDiffAverageWeightEventAttributeCpp`, sender, target, time, weightvar, eventattributevar, eventattribute, xlog) 34 | } 35 | 36 | -------------------------------------------------------------------------------- /man/timeToEvent.Rd: -------------------------------------------------------------------------------- 1 | \name{timeToEvent} 2 | \alias{timeToEvent} 3 | \title{Calculate the time-to-next-event or the time-since-date for a REM data set.} 4 | % 5 | \description{Calculate time-to-next-event or time-since-date for a REM data set.} 6 | \usage{ 7 | timeToEvent(time, type = 'time-to-next-event', timeEventPossible = NULL) 8 | } 9 | \arguments{ 10 | \item{time}{ A integer or Date variable reflecting the time of the event. Note: make sure to specify event time not the event sequence in a counting process data set.} 11 | \item{type}{ Either 'time-to-next-event' or 'time-since-date'. 12 | \code{type = 'time-to-next-event'} calculates the time between the current event and the event closes to the current in the past. 13 | \code{type = 'time-since-date'} uses the \code{time}-variable as well as the \code{timeEventPossible}-variable to calculate how much time has passed between the two variables, i.e., how long the event took to come true. } 14 | \item{timeEventPossible}{ An optional integer or Date variable to be used if \code{type = 'time-since-date'} is specified.} 15 | } 16 | \details{ 17 | 18 | To come. 19 | 20 | } 21 | % \value{ 22 | % 23 | % } 24 | % \references{ 25 | % 26 | % } 27 | % \note{ 28 | % 29 | % } 30 | \author{ 31 | Laurence Brandenberger \email{laurence.brandenberger@eawag.ch} 32 | } 33 | \seealso{ 34 | \link{rem-package} 35 | } 36 | \examples{ 37 | ## get some random data 38 | dt <- data.frame( 39 | sender = c('a', 'c', 'd', 'a', 'a', 'f', 'c'), 40 | target = c('b', 'd', 'd', 'b', 'b', 'a', 'd'), 41 | date = c(rep('10.01.90',2), '11.01.90', '04.01.90', 42 | '05.01.90', rep('10.01.90',2)), 43 | start = c(0, 0, 1, 1, 1, 3, 3), 44 | end = rep(6, 7), 45 | targetAvailableSince = c(rep(-10,6), -2), 46 | dateTargetAvailable = c(rep('31.12.89',6), '01.01.90') 47 | ) 48 | 49 | ## create event sequence 50 | dt <- eventSequence(dt$date, dateformat = '\%d.\%m.\%y', data = dt, 51 | type = "continuous", byTime = "daily", 52 | excludeDate = '07.01.90', 53 | returnData = TRUE, sortData = TRUE, 54 | returnDateSequenceData = FALSE) 55 | ## also return the sequenceData 56 | dt.seq <- eventSequence(dt$date, dateformat = '\%d.\%m.\%y', data = dt, 57 | type = "continuous", byTime = "daily", 58 | excludeDate = '07.01.90', 59 | returnDateSequenceData = TRUE) 60 | 61 | ## create counting process data set 62 | dts <- createRemDataset( 63 | data = dt, sender = dt$sender, target = dt$target, 64 | eventSequence = dt$event.seq.cont, 65 | eventAttribute = NULL, time = NULL, 66 | start = dt$start, startDate = NULL, 67 | end = dt$end, endDate = NULL, 68 | timeformat = NULL, atEventTimesOnly = TRUE, 69 | untilEventOccurrs = TRUE, 70 | includeAllPossibleEvents = FALSE, 71 | possibleEvents = NULL, returnInputData = TRUE) 72 | ## divide up the results: counting process data = 1, original data = 2 73 | dt.rem <- dts[[1]] 74 | dt <- dts[[2]] 75 | 76 | ## merge all necessary event attribute variables back in 77 | dt.rem$targetAvailableSince <- dt$targetAvailableSince[match(dt.rem$eventID, 78 | dt$eventID)] 79 | dt.rem$dateTargetAvailable <- dt$dateTargetAvailable[match(dt.rem$eventID, 80 | dt$eventID)] 81 | 82 | ## add dates to the eventTime 83 | dt.rem$eventDate <- dt.seq$date.sequence[match(dt.rem$eventTime, 84 | dt.seq$event.sequence)] 85 | 86 | ## sort the dataframe according to eventTime 87 | dt.rem <- dt.rem[order(dt.rem$eventTime), ] 88 | 89 | ## 1. numeric, time-to-next-event 90 | dt.rem$timeToNextEvent <- timeToEvent(as.integer(dt.rem$eventTime)) 91 | 92 | ## 2. numeric, time-since 93 | dt.rem$timeSince <- timeToEvent(dt.rem$eventTime, 94 | type = 'time-since-date', 95 | dt.rem$targetAvailableSince) 96 | 97 | ## 3. Date, time-to-next-event 98 | # since the event sequence excluded 06.01.90 => time to next event differs 99 | # for the two specification with the integr (1) and the Date-variable (2). 100 | # To be consistent, pick the eventTime instead of the Date-variable. 101 | dt.rem$timeToNextEvent2 <- timeToEvent(as.Date(dt.rem$eventDate, '\%d.\%m.\%y')) 102 | 103 | 104 | ## 4. Date, time-since 105 | dt.rem$timeSince2 <- timeToEvent( 106 | as.Date(dt.rem$eventDate, '\%d.\%m.\%y'), 107 | type = 'time-since-date', 108 | as.Date(dt.rem$dateTargetAvailable, '\%d.\%m.\%y')) 109 | 110 | } 111 | %\keyword{key} 112 | 113 | 114 | 115 | 116 | -------------------------------------------------------------------------------- /man/eventSequence.Rd: -------------------------------------------------------------------------------- 1 | \name{eventSequence} 2 | \alias{eventSequence} 3 | \alias{event.sequence} 4 | \alias{event sequence} 5 | \title{Create event sequence} 6 | % 7 | \description{ Create the event sequence for relational event models. Continuous or ordinal sequences can be created. Various dates may be excluded from the sequence (e.g. special holidays, specific weekdays or longer time spans).} 8 | \usage{ 9 | eventSequence(datevar, 10 | dateformat = NULL, data = NULL, 11 | type = "continuous", byTime = "daily", 12 | excludeDate = NULL, excludeTypeOfDay = NULL, 13 | excludeYear = NULL, excludeFrom = NULL, 14 | excludeTo = NULL, returnData = FALSE, 15 | sortData = FALSE, 16 | returnDateSequenceData = FALSE) 17 | } 18 | \arguments{ 19 | \item{datevar}{ The variable containing the information on the date and/or time of the event.} 20 | \item{dateformat}{ A character string indicating the format of the \code{datevar}. see \code{\link{as.Date}}} 21 | \item{data}{ An optional data frame containing all the variables.} 22 | \item{type}{ "`\code{continuous}"' or "`\code{ordinal}"'. Specifies whether the event sequence is to be created as a continuous sequence or an ordinal sequence.} 23 | \item{byTime}{ String value. Specifies at what interval the event sequence is created. Use "daily", "monthly" or "yearly".} 24 | \item{excludeDate}{ An optional string or string vector containing one or more dates that should be excluded from the event.sequence. The dates have to be in the same format as provided in \code{dateformat}. Only valid for continuous event sequences.} 25 | \item{excludeTypeOfDay}{ String value or vector naming the day(s) that should be excluded from the event sequence. Depending on the locale the weekdays may be named differently. Use \code{Sys.getlocale("LC_TIME")} to find which locale is installed.} 26 | \item{excludeYear}{ A string value or vector naming the year(s) that should be excluded from the event sequence.} 27 | \item{excludeFrom}{ A string value (or a vector of strings) with the start value of the date from (from-value included) which the event sequence should not be affected. The value has to be in the same format as specified in \code{dateformat}.} 28 | \item{excludeTo}{ A string value (or a vector of strings) with the end value of the date to which time the event sequence should not be affected (to-value included). The value has to be in the same format as specified in \code{dateformat}.} 29 | \item{returnData}{ \code{TRUE/FALSE}. Default set to \code{FALSE}. The data frame provided is returned in full, together with the new variable for the event sequence. } 30 | \item{sortData}{ \code{TRUE/FALSE}. Default set to \code{FALSE}. Should only be used if \code{returnData = TRUE}. The entire data.frame will be ordered according to the event sequence.} 31 | \item{returnDateSequenceData}{ \code{TRUE/FALSE}. Boolean option to return 32 | the full information on which date matches to which sequence number instead 33 | of the event sequence (and corresponding data frame).} 34 | } 35 | \details{ 36 | 37 | In order to estimate relational event models, the events have to be ordered, either according to an ordinal or a continuous event sequence. The ordinal event sequence simply orders the events and gives each event a place in the sequence. 38 | The continuous event sequence creates an artificial sequence ranging from \code{min(datevar)} to \code{max(datevar)} and matches each event with its place in the artificial event sequence. Dates, years or Weekdays can be excluded from the artificial event sequence. This is useful for excluding specific holidays, weekends etc.. 39 | 40 | Where two or more events occur at the same time, they are given the same value in the event sequence. 41 | 42 | } 43 | % \value{ 44 | % 45 | % } 46 | % \references{ 47 | % 48 | % } 49 | % \note{ 50 | % 51 | % } 52 | \author{ 53 | Laurence Brandenberger \email{laurence.brandenberger@eawag.ch} 54 | } 55 | \seealso{ 56 | \link{rem-package} 57 | } 58 | \examples{ 59 | # create some data with 'sender', 'target' and a 'time'-variable 60 | # (Note: Data used here are random events from the Correlates of War Project) 61 | sender <- c('TUN', 'NIR', 'NIR', 'TUR', 'TUR', 'USA', 'URU', 62 | 'IRQ', 'MOR', 'BEL', 'EEC', 'USA', 'IRN', 'IRN', 63 | 'USA', 'AFG', 'ETH', 'USA', 'SAU', 'IRN', 'IRN', 64 | 'ROM', 'USA', 'USA', 'PAN', 'USA', 'USA', 'YEM', 65 | 'SYR', 'AFG', 'NAT', 'NAT', 'USA') 66 | target <- c('BNG', 'ZAM', 'JAM', 'SAU', 'MOM', 'CHN', 'IRQ', 67 | 'AFG', 'AFG', 'EEC', 'BEL', 'ITA', 'RUS', 'UNK', 68 | 'IRN', 'RUS', 'AFG', 'ISR', 'ARB', 'USA', 'USA', 69 | 'USA', 'AFG', 'IRN', 'IRN', 'IRN', 'AFG', 'PAL', 70 | 'ARB', 'USA', 'EEC', 'BEL', 'PAK') 71 | time <- c('800107', '800107', '800107', '800109', '800109', 72 | '800109', '800111', '800111', '800111', '800113', 73 | '800113', '800113', '800114', '800114', '800114', 74 | '800116', '800116', '800116', '800119', '800119', 75 | '800119', '800122', '800122', '800122', '800124', 76 | '800125', '800125', '800127', '800127', '800127', 77 | '800204', '800204', '800204') 78 | 79 | # combine them into a data.frame 80 | dt <- data.frame(sender, target, time) 81 | 82 | # create continuous event sequence: return the data with the 83 | # event sequence and sort the data according to the event sequence. 84 | dt <- eventSequence(datevar = dt$time, dateformat = '\%y\%m\%d', 85 | data = dt, type = 'continuous', 86 | byTime = 'daily', returnData = TRUE, 87 | sortData = TRUE) 88 | 89 | # alternative : create variable with the continuous event 90 | # sequence, unsorted 91 | dt$eventSeq <- eventSequence(datevar = dt$time, 92 | dateformat = '\%y\%m\%d', 93 | data = dt, type = 'continuous', 94 | byTime = 'daily', 95 | returnData = FALSE, 96 | sortData = FALSE) 97 | # manually sort the data set 98 | dt <- dt[order(dt$eventSeq), ] 99 | 100 | # create the sequence by month 101 | dt$eventSeqMonthly <- eventSequence(datevar = dt$time, 102 | dateformat = '\%y\%m\%d', 103 | data = dt, 104 | type = 'continuous', 105 | byTime = 'monthly', 106 | returnData = FALSE, 107 | sortData = FALSE) 108 | 109 | # create the sequence by year 110 | dt$eventSeqYearly <- eventSequence(datevar = dt$time, 111 | dateformat = '\%y\%m\%d', 112 | data = dt, 113 | type = 'continuous', 114 | byTime = 'yearly', 115 | returnData = FALSE, 116 | sortData = FALSE) 117 | 118 | # create an ordinal event sequence 119 | dt$eventSeqOrdinal <- eventSequence(datevar = dt$time, 120 | dateformat = '\%y\%m\%d', 121 | data = dt, 122 | type = 'ordinal', 123 | byTime = 'daily', 124 | returnData = FALSE, 125 | sortData = FALSE) 126 | 127 | # exclude certain dates 128 | dt$eventSeqEx <- eventSequence(datevar = dt$time, 129 | dateformat = '\%y\%m\%d', 130 | data = dt, type = 'continuous', 131 | byTime = 'daily', 132 | excludeDate = c('800108', '800112'), 133 | returnData = FALSE, 134 | sortData = FALSE) 135 | 136 | # return the sequence data set, where all values in the event sequence 137 | # correspond to the date of the events. Useful to calculate 138 | # start-variables for the createRemDataset-command. 139 | seq.data <- eventSequence(datevar = dt$time, 140 | dateformat = "\%y\%m\%d", 141 | data = dt, type = "continuous", 142 | byTime = "daily", 143 | excludeDate = c("800108", "800112"), 144 | returnData = FALSE, 145 | sortData = FALSE, 146 | returnDateSequenceData = TRUE) 147 | } 148 | %\keyword{key} 149 | 150 | 151 | 152 | 153 | -------------------------------------------------------------------------------- /man/inertiaStat.Rd: -------------------------------------------------------------------------------- 1 | \name{inertiaStat} 2 | \alias{inertiaStat} 3 | \alias{inertia} 4 | \title{Calculate inertia statistics} 5 | % 6 | \description{Calculate the endogenous network statistic \code{inertia} for relational event models. \code{inertia} measures the tendency for events to consist of the same sender and target (i.e. repeated events).} 7 | \usage{ 8 | inertiaStat(data, time, sender, target, halflife, 9 | weight = NULL, 10 | eventtypevar = NULL, 11 | eventtypevalue = "valuematch", 12 | eventfiltervar = NULL, 13 | eventfiltervalue = NULL, 14 | eventvar = NULL, 15 | variablename = "inertia", 16 | returnData = FALSE, 17 | showprogressbar = FALSE, 18 | inParallel = FALSE, cluster = NULL) 19 | } 20 | \arguments{ 21 | \item{data}{ A data frame containing all the variables.} 22 | 23 | \item{time}{ Numeric variable that represents the event sequence. The variable has to be sorted in ascending order.} 24 | 25 | \item{sender}{ A string (or factor or numeric) variable that represents the sender of the event.} 26 | 27 | \item{target}{ A string (or factor or numeric) variable that represents the target of the event.} 28 | 29 | \item{halflife}{ A numeric value that is used in the decay function. The vector of past events is weighted by an exponential decay function using the specified halflife. The halflife parameter determins after how long a period the event weight should be halved. E.g. if \code{halflife = 5}, the weight of an event that occured 5 units in the past is halved. Smaller halflife values give more importance to more recent events, while larger halflife values should be used if time does not affect the sequence of events that much.} 30 | 31 | \item{weight}{ An optional numeric variable that represents the weight of each event. If \code{weight = NULL} each event is given an event weight of \code{1}.} 32 | 33 | \item{eventtypevar}{ An optional variable that represents the type of the event. Use \code{eventtypevalue} to specify how the \code{eventtypevar} should be used to filter past events.} 34 | 35 | \item{eventtypevalue}{ An optional value (or set of values) used to specify how paste events should be filtered depending on their type. 36 | \code{eventtypevalue = "valuematch"} indicates that only past events that have the same type as the current event should be used to calculate the inertia statistic. 37 | \code{eventtypevalue = "valuemix"} indicates that past and present events of specific types should be used for the inertia statistic. All the possible combinations of the eventtypevar-values will be used. E.g. if \code{eventtypevar} contains two unique values "a" and "b", 4 inertia statistics will be calculated. The first variable calculates the inertia effect where the present event is of type "a" and all the past events are of type "b". The next variable calculates inertia for present events of type "b" and past events of type "a". Additionally, a variable is calculated, where present events as well as past events are of type "a" and a fourth variable calculates inertia for events with type "b" (i.e. valuematch on value "b"). 38 | \code{eventtypevalue = c(.., ..)} is similar to the \code{"nodmix"}-option, all different combinations of the values specified in \code{eventtypevalue} are used to create inertia statistics.} 39 | 40 | \item{eventfiltervar}{ An optional numeric/character/or factor variable for each event. If \code{eventfiltervar} is specified, \code{eventfiltervalue} has to be provided as well.} 41 | 42 | \item{eventfiltervalue}{ An optional character string that represents the value for which past events should be filtered. To filter the current events, use \code{eventtypevar}.} 43 | 44 | \item{eventvar}{ An optional dummy variable with 0 values for null-events and 1 values for true events. If the \code{data} is in the form of counting process data, use the \code{eventvar}-option to specify which variable contains the 0/1-dummy for event occurrence. If this variable is not specified, all events in the past will be considered for the calulation of the inertia statistic, regardless if they occurred or not (= are null-events).} 45 | 46 | \item{variablename}{ An optional value (or values) with the name the inertia statistic variable should be given. To be used if \code{returnData = TRUE} or multiple inertia statistics are calculated.} 47 | 48 | \item{returnData}{ \code{TRUE/FALSE}. Set to \code{FALSE} by default. The new variable(s) are bound directly to the \code{data.frame} provided and the data frame is returned in full.} 49 | 50 | \item{showprogressbar}{ \code{TRUE/FALSE}. Can only be set to TRUE if the function is not run in parallel.} 51 | 52 | \item{inParallel}{ \code{TRUE/FALSE}. An optional boolean to specify if the loop should be run in parallel.} 53 | 54 | \item{cluster}{ An optional numeric or character value that defines the cluster. By specifying a single number, the cluster option uses the provided number of nodes to parallellize. By specifying a cluster using the \code{makeCluster}-command in the \code{doParallel}-package, the loop can be run on multiple nodes/cores. E.g., \code{cluster = makeCluster(12, type="FORK")}.} 55 | 56 | } 57 | \details{ 58 | 59 | The \code{inertiaStat()}-function calculates an endogenous statistic that measures whether events have a tendency to be repeated with the same sender and target over the entire event sequence. 60 | 61 | The effect is calculated as follows. 62 | 63 | \deqn{G_t = G_t(E) = (A, B, w_t), }{G_t = G_t(E) = (A, B, w_t),} 64 | 65 | \eqn{G_t} represents the network of past events and includes all events \eqn{E}. These events consist 66 | each of a sender \eqn{a \in A}{a in A} and a target \eqn{b \in B}{b in B} and a weight function \eqn{w_t}: 67 | 68 | \deqn{ w_t(i, j) = \sum_{e:a = i, b = j} | w_e | \cdot e^{-(t-t_e)\cdot\frac{ln(2)}{T_{1/2}}} \cdot \frac{ln(2)}{T_{1/2}}, }{ w_t(i, j) = \sum_{e:a = i, b = j} | w_e | * exp^{-(t-t_e)* (ln(2)/T_{1/2})} * (ln(2)/T_{1/2}),} 69 | 70 | where \eqn{w_e} is the event weight (usually a constant set to 1 for each event), \eqn{t} is the current event time, \eqn{t_e} is the past event time and \eqn{T_{1/2}} is a halflife parameter. 71 | 72 | For the inertia effect, the past events \eqn{G_t} are filtered to include only events 73 | where the senders and targets are identical to the current sender and target. 74 | 75 | \deqn{inertia(G_t , a , b) = w_t(a, b)} 76 | 77 | An exponential decay function is used to model the effect of time on the endogenous statistics. Each past event that contains the same sender and target and fulfills additional filtering options specivied via event type or event attributes is weighted with an exponential decay. The further apart the past event is from the present event, the less weight is given to this event. The halflife parameter in the \code{inertiaStat()}-function determins at which rate the weights of past events should be reduced. 78 | 79 | The \code{eventfiltervar}- and \code{eventtypevar}-options help filter the past events more specifically. How they are filtered depends on the \code{eventfiltervalue}- and \code{eventtypevalue}-option. 80 | 81 | } 82 | % \value{ 83 | % 84 | % } 85 | % \references{ 86 | % 87 | % } 88 | % \note{ 89 | % 90 | % } 91 | \author{ 92 | Laurence Brandenberger \email{laurence.brandenberger@eawag.ch} 93 | } 94 | \seealso{ 95 | \link{rem-package} 96 | } 97 | \examples{ 98 | # create some data with 'sender', 'target' and a 'time'-variable 99 | # (Note: Data used here are random events from the Correlates of War Project) 100 | sender <- c('TUN', 'NIR', 'NIR', 'TUR', 'TUR', 'USA', 'URU', 101 | 'IRQ', 'MOR', 'BEL', 'EEC', 'USA', 'IRN', 'IRN', 102 | 'USA', 'AFG', 'ETH', 'USA', 'SAU', 'IRN', 'IRN', 103 | 'ROM', 'USA', 'USA', 'PAN', 'USA', 'USA', 'YEM', 104 | 'SYR', 'AFG', 'NAT', 'NAT', 'USA') 105 | target <- c('BNG', 'ZAM', 'JAM', 'SAU', 'MOM', 'CHN', 'IRQ', 106 | 'AFG', 'AFG', 'EEC', 'BEL', 'ITA', 'RUS', 'UNK', 107 | 'IRN', 'RUS', 'AFG', 'ISR', 'ARB', 'USA', 'USA', 108 | 'USA', 'AFG', 'IRN', 'IRN', 'IRN', 'AFG', 'PAL', 109 | 'ARB', 'USA', 'EEC', 'BEL', 'PAK') 110 | time <- c('800107', '800107', '800107', '800109', '800109', 111 | '800109', '800111', '800111', '800111', '800113', 112 | '800113', '800113', '800114', '800114', '800114', 113 | '800116', '800116', '800116', '800119', '800119', 114 | '800119', '800122', '800122', '800122', '800124', 115 | '800125', '800125', '800127', '800127', '800127', 116 | '800204', '800204', '800204') 117 | type <- sample(c('cooperation', 'conflict'), 33, 118 | replace = TRUE) 119 | 120 | # combine them into a data.frame 121 | dt <- data.frame(sender, target, time, type) 122 | 123 | # create event sequence and order the data 124 | dt <- eventSequence(datevar = dt$time, dateformat = "\%y\%m\%d", 125 | data = dt, type = "continuous", 126 | byTime = "daily", returnData = TRUE, 127 | sortData = TRUE) 128 | 129 | # create counting process data set (with null-events) - conditional logit setting 130 | dts <- createRemDataset(dt, dt$sender, dt$target, 131 | dt$event.seq.cont, eventAttribute = dt$type, 132 | atEventTimesOnly = TRUE, untilEventOccurrs = TRUE, 133 | returnInputData = TRUE) 134 | ## divide up the results: counting process data = 1, original data = 2 135 | dtrem <- dts[[1]] 136 | dt <- dts[[2]] 137 | ## merge all necessary event attribute variables back in 138 | dtrem$type <- dt$type[match(dtrem$eventID, dt$eventID)] 139 | # manually sort the data set 140 | dtrem <- dtrem[order(dtrem$eventTime), ] 141 | 142 | # manually sort the data set 143 | dtrem <- dtrem[order(dtrem$eventTime), ] 144 | 145 | # calculate inertia statistics 146 | dtrem$inertia <- inertiaStat(data = dtrem, time = dtrem$eventTime, 147 | sender = dtrem$sender, target = dtrem$target, 148 | eventvar = dtrem$eventDummy, 149 | halflife = 2, returnData = FALSE, 150 | showprogressbar = FALSE) 151 | 152 | # plot inertia over time 153 | library("ggplot2") 154 | ggplot(dtrem, aes ( eventTime, inertia, 155 | group = factor(eventDummy), color = factor(eventDummy)) ) + 156 | geom_point() + geom_smooth() 157 | 158 | # inertia with typematch (e.g. for 'cooperation' events only count 159 | # past 'cooperation' events) 160 | dtrem$inertia.tm <- inertiaStat(data = dtrem, time = dtrem$eventTime, 161 | sender = dtrem$sender, target = dtrem$target, 162 | eventvar = dtrem$eventDummy, 163 | halflife = 2, 164 | eventtypevar = dtrem$type, 165 | eventtypevalue = "valuematch", 166 | returnData = FALSE, 167 | showprogressbar = FALSE) 168 | 169 | # inertia with valuemix: for each combination of types 170 | # in the eventtypevar, create a variable 171 | dtrem <- inertiaStat(data = dtrem, time = dtrem$eventTime, 172 | sender = dtrem$sender, target = dtrem$target, 173 | eventvar = dtrem$eventDummy, 174 | halflife = 2, 175 | eventtypevar = dtrem$type, 176 | eventtypevalue = "valuemix", 177 | returnData = TRUE, 178 | showprogressbar = FALSE) 179 | } 180 | %\keyword{key} 181 | 182 | 183 | 184 | 185 | -------------------------------------------------------------------------------- /man/createRemDataset.Rd: -------------------------------------------------------------------------------- 1 | \name{createRemDataset} 2 | \alias{createRemDataset} 3 | \title{Create REM data set with dynamic risk sets} 4 | % 5 | \description{The function creates counting process data sets with dynamic risk sets for relational event models. For each event in the event sequence, null-events are generated and represent possible events that could have happened at that time but did not. A data set with true and null-events is returned with an event dummy for whether the event occurred or was simply possible (variable \code{eventdummy}). The returned data set also includes a variable \code{eventTime} which represents the true time of the reported event.} 6 | \usage{ 7 | createRemDataset(data, sender, target, eventSequence, 8 | eventAttribute = NULL, time = NULL, 9 | start = NULL, startDate = NULL, 10 | end = NULL, endDate = NULL, 11 | timeformat = NULL, 12 | atEventTimesOnly = TRUE, untilEventOccurrs = TRUE, 13 | includeAllPossibleEvents = FALSE, possibleEvents = NULL, 14 | returnInputData = FALSE) 15 | } 16 | \arguments{ 17 | \item{data}{ A data frame containing all the events.} 18 | \item{sender}{ A string (or factor or numeric) variable that represents the sender of the event.} 19 | \item{target}{ A string (or factor or numeric) variable that represents the target of the event.} 20 | \item{eventSequence}{ Numeric variable that represents the event sequence. The variable has to be sorted in ascending order.} 21 | \item{eventAttribute}{ An optional variable that represents an attribute to an event. Repeated events affect the construction of the counting process data set. Use the \code{eventAttribute}-variable to specify the uniqueness of an event. If \code{eventAttribute = NULL}, events are defines as sender-target nodes only.} 22 | \item{time}{ An optional date variable that represents the date an event took place. The variable is used if \code{startDate} or \code{endDate} are specified. \code{timeformat} should be used to specify which format the date variable is in, in case it was not yet converted to a Date-variable.} 23 | \item{start}{ An optional numeric variable that indicates at which point in the event sequence a specific event was at risk. The variable has to be numerical and correspond to the variable \code{eventSequence}. If this option is used, each event in the event data set will be considered at risk from the specified value onwards. If it is not specified, \code{start} is defined as the first value in the event sequence. In case of repeated events, the start-value for each duplicated event is one event-unit after the last such event.} 24 | \item{startDate}{ An optional date variable that represents the date an event started being at risk. \code{timeformat} should be used to specify which format the date variable is in, incase it was not yet converted to a Date-variable.} 25 | \item{end}{ An optional numeric variable that indicates at which point in the event sequence a specific event stopped being at risk. The variable has to be numerical and correspond to the variable \code{eventSequence}. If this option is used, each event in the event data set will be considered at risk until the specified value.} 26 | \item{endDate}{ An optional date variable that represents the date an event stoped being at risk. \code{timeformat} should be used to specify which format the date variable is in, incase it was not yet converted to a Date-variable.} 27 | \item{timeformat}{ A character string indicating the format of the \code{datevar}. see \code{\link{as.Date}}} 28 | \item{atEventTimesOnly}{ \code{TRUE/FALSE}. Boolean option for continuous event sequences. If \code{atEventTimesOnly = TRUE}, null-events are only created at times, when an event occurred. If \code{atEventTimesOnly = FALSE}, null-events are created on each event-unit from \code{min(eventSequence):max(eventSequence)}. 29 | For instance: Given an event sequence with three events at \code{c(1, 4, 6)}: 30 | If \code{atEventTimesOnly = TRUE} null events are created for events 1, 4 and 6. If \code{atEventTimesOnly = FALSE} null-events are also created for days 2, 3 and 5. } 31 | \item{untilEventOccurrs}{ \code{TRUE/FALSE}. Boolean option to define whether null events should be an option even after an event takes place. If \code{untilEventOccurrs = TRUE} a conditional logisitc logic is applied in that events are only at risk as long as they have not taken place yet. If \code{untilEventOccurrs = FALSE} events continue to be at risk after they have occurred. Note that \code{untilEventOccurrs = TRUE} overwrites the \code{end}-Variable, if specified.} 32 | \item{includeAllPossibleEvents}{ \code{TRUE/FALSE}. Boolean option to allow a more dynamic and specified creation of the risk set. If \code{includeAllPossibleEvents = TRUE}, a data set has to be provided to \code{possibleEvents}.} 33 | \item{possibleEvents}{ An optional data set with the form: column 1 = sender, column 2 = target, 3 = start, 4 = end, 5 = event attribute, 6... . The data set provides all possible events for the entire event sequence and gives each possible event a start and end value to determine when each event could have been possible. This is useful if the risk set follows a complex pattern that cannot be resolved with the above options. E.g., providing a \code{startDate}-variable and setting \code{atEventTimesOnly == FALSE} will result in an error since in a continuous time setting the start variable will be matched to the closest date, rather than to the exact value of said date in the event sequence. Manually coding the possible events is neccessary.} 34 | \item{returnInputData}{ \code{TRUE/FALSE}. Boolean option to check the original data set (handed over in \code{data}) against the created start and stop variables. If \code{returnInputData = TRUE}, a list of two data sets is returned. The first data set is the counting process data set with null-events, the second the modified \code{data}.} 35 | } 36 | \details{ 37 | To follow. 38 | } 39 | % \value{ 40 | % 41 | % } 42 | % \references{ 43 | % 44 | % } 45 | % \note{ 46 | % 47 | % } 48 | \author{ 49 | Laurence Brandenberger \email{laurence.brandenberger@eawag.ch} 50 | } 51 | \seealso{ 52 | \link{rem-package} 53 | } 54 | \examples{ 55 | ## Example 1: standard conditional logistic set-up 56 | dt <- data.frame( 57 | sender = c('a', 'c', 'd', 'a', 'a', 'f', 'c'), 58 | target = c('b', 'd', 'd', 'b', 'b', 'a', 'd'), 59 | eventSequence = c(1, 2, 2, 3, 3, 4, 6) 60 | ) 61 | count.data <- createRemDataset( 62 | data = dt, sender = dt$sender, 63 | target = dt$target, eventSequence = dt$eventSequence, 64 | eventAttribute = NULL, time = NULL, 65 | start = NULL, startDate = NULL, 66 | end = NULL, endDate = NULL, 67 | timeformat = NULL, 68 | atEventTimesOnly = TRUE, untilEventOccurrs = TRUE, 69 | includeAllPossibleEvents = FALSE, possibleEvents = NULL, 70 | returnInputData = FALSE) 71 | 72 | ## Example 2: add 2 attributes to the event-classification 73 | dt <- data.frame( 74 | sender = c('a', 'c', 'd', 'a', 'a', 'f', 'c'), 75 | target = c('b', 'd', 'd', 'b', 'b', 'a', 'd'), 76 | pro.con = c('pro', 'pro', 'con', 'pro', 'con', 'pro', 'pro'), 77 | attack = c('yes', 'no', 'no', 'yes', 'yes', 'no', 'yes'), 78 | eventSequence = c(1, 2, 2, 3, 3, 4, 6) 79 | ) 80 | count.data <- createRemDataset( 81 | data = dt, sender = dt$sender, 82 | target = dt$target, eventSequence = dt$eventSequence, 83 | eventAttribute = paste0(dt$pro.con, dt$attack), time = NULL, 84 | start = NULL, startDate = NULL, 85 | end = NULL, endDate = NULL, 86 | timeformat = NULL, 87 | atEventTimesOnly = TRUE, untilEventOccurrs = TRUE, 88 | includeAllPossibleEvents = FALSE, possibleEvents = NULL, 89 | returnInputData = FALSE) 90 | 91 | ## Example 3: adding start and end variables 92 | # Note: the start and end variables will be overwritten 93 | # if there are duplicate events. If you want to 94 | # keep the strict start and stop values that you set, use 95 | # includeAllPossibleEvents = TRUE and specify a 96 | # possibleEvents-data set. 97 | # Note 2: if untilEventOccurrs = TRUE and an end 98 | # variable is provided, this end variable is 99 | # overwritten. Set untilEventOccurrs 0 FALSE and 100 | # provide the end variable if you want the events 101 | # possibilities to stop at these exact event times. 102 | dt <- data.frame( 103 | sender = c('a', 'c', 'd', 'a', 'a', 'f', 'c'), 104 | target = c('b', 'd', 'd', 'b', 'b', 'a', 'd'), 105 | eventSequence = c(1, 2, 2, 3, 3, 4, 6), 106 | start = c(0, 0, 1, 1, 1, 3, 3), 107 | end = rep(6, 7) 108 | ) 109 | count.data <- createRemDataset( 110 | data = dt, sender = dt$sender, 111 | target = dt$target, eventSequence = dt$eventSequence, 112 | eventAttribute = NULL, time = NULL, 113 | start = dt$start, startDate = NULL, 114 | end = dt$end, endDate = NULL, 115 | timeformat = NULL, 116 | atEventTimesOnly = TRUE, untilEventOccurrs = TRUE, 117 | includeAllPossibleEvents = FALSE, possibleEvents = NULL, 118 | returnInputData = FALSE) 119 | 120 | ## Example 4: using start (and stop) dates 121 | dt <- data.frame( 122 | sender = c('a', 'c', 'd', 'a', 'a', 'f', 'c'), 123 | target = c('b', 'd', 'd', 'b', 'b', 'a', 'd'), 124 | eventSequence = c(1, 2, 2, 3, 3, 4, 6), 125 | date = c('01.02.1971', rep('02.02.1971', 2), 126 | rep('03.02.1971', 2), '04.02.1971', '06.02.1971'), 127 | dateAtRisk = c(rep('21.01.1971', 2), rep('01.02.1971', 5)), 128 | dateRiskEnds = rep('01.03.1971', 7) 129 | ) 130 | count.data <- createRemDataset( 131 | data = dt, sender = dt$sender, target = dt$target, 132 | eventSequence = dt$eventSequence, 133 | eventAttribute = NULL, time = dt$date, 134 | start = NULL, startDate = dt$dateAtRisk, 135 | end = NULL, endDate = NULL, 136 | timeformat = '\%d.\%m.\%Y', 137 | atEventTimesOnly = TRUE, untilEventOccurrs = TRUE, 138 | includeAllPossibleEvents = FALSE, possibleEvents = NULL, 139 | returnInputData = FALSE) 140 | # if you want to include null-events at times when no event happened, 141 | # either see Example 5 or create a start-variable by yourself 142 | # by using the eventSequence()-command with the option 143 | # 'returnDateSequenceData = TRUE' in this package. With the 144 | # generated sequence, dates from startDate can be matched 145 | # to the event sequence values (using the match()-command). 146 | 147 | ## Example 5: using start and stop dates and including 148 | # possible events whenever no event occurred. 149 | possible.events <- data.frame( 150 | sender = c('a', 'c', 'd', 'f'), 151 | target = c('b', 'd', 'd', 'a'), 152 | start = c(0, 0, 1, 1), 153 | end = c(rep(8, 4))) 154 | count.data <- createRemDataset( 155 | data = dt, sender = dt$sender, target = dt$target, 156 | eventSequence = dt$eventSequence, 157 | eventAttribute = NULL, time = NULL, 158 | start = NULL, startDate = NULL, 159 | end = NULL, endDate = NULL, 160 | timeformat = NULL, 161 | atEventTimesOnly = TRUE, untilEventOccurrs = TRUE, 162 | includeAllPossibleEvents = TRUE, possibleEvents = possible.events, 163 | returnInputData = FALSE) 164 | # now you can set 'atEventTimesOnly = FALSE' to include 165 | # null-events where none occurred until the events happened 166 | count.data <- createRemDataset( 167 | data = dt, sender = dt$sender, target = dt$target, 168 | eventSequence = dt$eventSequence, 169 | eventAttribute = NULL, time = NULL, 170 | start = NULL, startDate = NULL, 171 | end = NULL, endDate = NULL, 172 | timeformat = NULL, 173 | atEventTimesOnly = FALSE, untilEventOccurrs = TRUE, 174 | includeAllPossibleEvents = TRUE, possibleEvents = possible.events, 175 | returnInputData = FALSE) 176 | # plus you can set to get the full range of the events 177 | # (bounded by max(possible.events$end)) 178 | count.data <- createRemDataset( 179 | data = dt, sender = dt$sender, target = dt$target, 180 | eventSequence = dt$eventSequence, 181 | eventAttribute = NULL, time = NULL, 182 | start = NULL, startDate = NULL, 183 | end = NULL, endDate = NULL, 184 | timeformat = NULL, 185 | atEventTimesOnly = FALSE, untilEventOccurrs = FALSE, 186 | includeAllPossibleEvents = TRUE, possibleEvents = possible.events, 187 | returnInputData = FALSE) 188 | } 189 | %\keyword{key} 190 | 191 | 192 | 193 | 194 | -------------------------------------------------------------------------------- /man/reciprocityStat.Rd: -------------------------------------------------------------------------------- 1 | \name{reciprocityStat} 2 | \alias{reciprocityStat} 3 | \alias{reciprocity} 4 | \title{Calculate reciprocity statistics} 5 | % 6 | \description{Calculate the endogenous network statistic \code{reciprocity} for relational event models. \code{reciprocity} measures the tendency for senders to reciprocate prior events where they were targeted by other senders. One-mode network statistic only.} 7 | \usage{ 8 | reciprocityStat(data, time, sender, target, halflife, 9 | weight = NULL, 10 | eventtypevar = NULL, 11 | eventtypevalue = "valuematch", 12 | eventfiltervar = NULL, 13 | eventfiltervalue = NULL, 14 | eventvar = NULL, 15 | variablename = "recip", 16 | returnData = FALSE, 17 | showprogressbar = FALSE, 18 | inParallel = FALSE, cluster = NULL) 19 | } 20 | \arguments{ 21 | \item{data}{ A data frame containing all the variables.} 22 | \item{time}{ Numeric variable that represents the event sequence. The variable has to be sorted in ascending order.} 23 | \item{sender}{ A string (or factor or numeric) variable that represents the sender of the event.} 24 | \item{target}{ A string (or factor or numeric) variable that represents the target of the event.} 25 | \item{halflife}{ A numeric value that is used in the decay function. 26 | The vector of past events is weighted by an exponential decay function using the specified halflife. The halflife parameter determines after how long a period the event weight should be halved. E.g. if \code{halflife = 5}, the weight of an event that occurred 5 units in the past is halved. Smaller halflife values give more importance to more recent events, while larger halflife values should be used if time does not affect the time between events that much.} 27 | \item{weight}{ An optional numeric variable that represents the weight of each event. If \code{weight = NULL} each event is given an event weight of \code{1}. 28 | } 29 | \item{eventtypevar}{ An optional variable that represents the type of the event. Use \code{eventtypevalue} to specify how the \code{eventtypevar} should be used to filter past events. 30 | } 31 | \item{eventtypevalue}{ An optional value (or set of values) used to specify how 32 | paste events should be filtered depending on their type. 33 | \code{eventtypevalue = "valuematch"} indicates that only past events that have the same type as the current event should be used to calculate the reciprocity statistic. 34 | \code{eventtypevalue = "valuemix"} indicates that past and present events of specific types should be used for the reciprocity statistic. All the possible combinations of the eventtypevar-values will be used. E.g. if \code{eventtypevar} contains three unique values "a" and "b", 4 reciprocity statistics will be 35 | calculated. The first variable calculates the reciprocity effect where the present event is of type "a" and all the past events are of type "b". The next variable calculates reciprocity for present events of type "b" and past events of type "a". Additionally, a variable is calculated, where present events as well as past events are of type "a" and a fourth variable calculates reciprocity for events with type "b" (i.e. valuematch on value "b"). 36 | \code{eventtypevalue = c(.., ..)}, similar to the "\code{nodmix}"-option, all different combinations of the values specified in \code{eventtypevalue} are used to create reciprocity statistics. 37 | } 38 | \item{eventfiltervar}{ An optional numeric/character/or factor variable for each event. If \code{eventfiltervar} is specified, \code{eventfiltervalue} has to be provided as well.} 39 | 40 | \item{eventfiltervalue}{ An optional character string that represents the value for which past events should be filtered. To filter the current events, use \code{eventtypevar}.} 41 | 42 | \item{eventvar}{ An optional dummy variable with 0 values for null-events and 1 values for true events. If the \code{data} is in the form of counting process data, use the \code{eventvar}-option to specify which variable contains the 0/1-dummy for event occurrence. If this variable is not specified, all events in the past will be considered for the calulation of the reciprocity statistic, regardless if they occurred or not (= are null-events).} 43 | 44 | \item{variablename}{ An optional value (or values) with the name the reciprocity 45 | statistic variable should be given. To be used if \code{returnData = TRUE} or 46 | multiple reciprocity statistics are calculated.} 47 | \item{returnData}{ \code{TRUE/FALSE}. Set to \code{FALSE} by default. The new 48 | variable(s) are bound directly to the \code{data.frame} provided and the 49 | data frame is returned in full.} 50 | 51 | \item{showprogressbar}{ \code{TRUE/FALSE}. Can only be set to TRUE if the function is not run in parallel.} 52 | 53 | \item{inParallel}{ \code{TRUE/FALSE}. An optional boolean to specify if the loop should be run in parallel.} 54 | 55 | \item{cluster}{ An optional numeric or character value that defines the cluster. By specifying a single number, the cluster option uses the provided number of nodes to parallellize. By specifying a cluster using the \code{makeCluster}-command in the \code{doParallel}-package, the loop can be run on multiple nodes/cores. E.g., \code{cluster = makeCluster(12, type="FORK")}.} 56 | } 57 | \details{ 58 | 59 | The \code{reciprocityStat()}-function calculates an endogenous statistic that measures whether senders have a tendency to reciprocate events. 60 | 61 | The effect is calculated as follows: 62 | 63 | \deqn{G_t = G_t(E) = (A, B, w_t), }{G_t = G_t(E) = (A, B, w_t),} 64 | 65 | \eqn{G_t} represents the network of past events and includes all events \eqn{E}. These events consist each of a sender \eqn{a \in A}{a in A} and a target \eqn{b \in B}{b in B} and a weight function \eqn{w_t}: 66 | 67 | \deqn{ w_t(i, j) = \sum_{e:a = i, b = j} | w_e | \cdot e^{-(t-t_e)\cdot\frac{ln(2)}{T_{1/2}}} \cdot \frac{ln(2)}{T_{1/2}}, }{ w_t(i, j) = \sum_{e:a = i, b = j} | w_e | * exp^{-(t-t_e)* (ln(2)/T_{1/2})} * (ln(2)/T_{1/2}),} 68 | 69 | where \eqn{w_e} is the event weight (usually a constant set to 1 for each event), \eqn{t} is the current event time, \eqn{t_e} is the past event time and \eqn{T_{1/2}} is a halflife parameter. 70 | 71 | For the reciprocity effect, the past events \eqn{G_t} are filtered to include only events where the senders are the present targets and the targets are the present senders: 72 | 73 | \deqn{reciprocity(G_t , a , b) = w_t(b, a)} 74 | 75 | An exponential decay function is used to model the effect of time on the endogenous statistics. Each past event that involves the sender as target and the target as sender, and fulfills additional filtering options specified via event type or event attributes, is weighted with an exponential decay. The further apart the past event is from the present event, the less weight is given to this event. The halflife parameter in the \code{reciprocityStat()}-function determines at which rate the weights of past events should be reduced. 76 | 77 | The \code{eventtypevar}- and \code{eventattributevar}-options help filter the past events more specifically. How they are filtered depends on the \code{eventtypevalue}- and \code{eventattributevalue}-option. 78 | 79 | } 80 | % \value{ 81 | % 82 | % } 83 | % \references{ 84 | % 85 | % } 86 | % \note{ 87 | % 88 | % } 89 | \author{ 90 | Laurence Brandenberger \email{laurence.brandenberger@eawag.ch} 91 | } 92 | \seealso{ 93 | \link{rem-package} 94 | } 95 | \examples{ 96 | # create some data with 'sender', 'target' and a 'time'-variable 97 | # (Note: Data used here are random events from the Correlates of War Project) 98 | sender <- c('TUN', 'NIR', 'NIR', 'TUR', 'TUR', 'USA', 'URU', 99 | 'IRQ', 'MOR', 'BEL', 'EEC', 'USA', 'IRN', 'IRN', 100 | 'USA', 'AFG', 'ETH', 'USA', 'SAU', 'IRN', 'IRN', 101 | 'ROM', 'USA', 'USA', 'PAN', 'USA', 'USA', 'YEM', 102 | 'SYR', 'AFG', 'NAT', 'NAT', 'USA') 103 | target <- c('BNG', 'ZAM', 'JAM', 'SAU', 'MOM', 'CHN', 'IRQ', 104 | 'AFG', 'AFG', 'EEC', 'BEL', 'ITA', 'RUS', 'UNK', 105 | 'IRN', 'RUS', 'AFG', 'ISR', 'ARB', 'USA', 'USA', 106 | 'USA', 'AFG', 'IRN', 'IRN', 'IRN', 'AFG', 'PAL', 107 | 'ARB', 'USA', 'EEC', 'BEL', 'PAK') 108 | time <- c('800107', '800107', '800107', '800109', '800109', 109 | '800109', '800111', '800111', '800111', '800113', 110 | '800113', '800113', '800114', '800114', '800114', 111 | '800116', '800116', '800116', '800119', '800119', 112 | '800119', '800122', '800122', '800122', '800124', 113 | '800125', '800125', '800127', '800127', '800127', 114 | '800204', '800204', '800204') 115 | type <- sample(c('cooperation', 'conflict'), 33, 116 | replace = TRUE) 117 | important <- sample(c('important', 'not important'), 33, 118 | replace = TRUE) 119 | 120 | # combine them into a data.frame 121 | dt <- data.frame(sender, target, time, type, important) 122 | 123 | # create event sequence and order the data 124 | dt <- eventSequence(datevar = dt$time, dateformat = "\%y\%m\%d", 125 | data = dt, type = "continuous", 126 | byTime = "daily", returnData = TRUE, 127 | sortData = TRUE) 128 | 129 | # create counting process data set (with null-events) - conditional logit setting 130 | dts <- createRemDataset(dt, dt$sender, dt$target, dt$event.seq.cont, 131 | eventAttribute = dt$type, 132 | atEventTimesOnly = TRUE, untilEventOccurrs = TRUE, 133 | returnInputData = TRUE) 134 | ## divide up the results: counting process data = 1, original data = 2 135 | dtrem <- dts[[1]] 136 | dt <- dts[[2]] 137 | ## merge all necessary event attribute variables back in 138 | dtrem$type <- dt$type[match(dtrem$eventID, dt$eventID)] 139 | dtrem$important <- dt$important[match(dtrem$eventID, dt$eventID)] 140 | # manually sort the data set 141 | dtrem <- dtrem[order(dtrem$eventTime), ] 142 | 143 | # calculate reciprocity statistic 144 | dtrem$recip <- reciprocityStat(data = dtrem, 145 | time = dtrem$eventTime, 146 | sender = dtrem$sender, 147 | target = dtrem$target, 148 | eventvar = dtrem$eventDummy, 149 | halflife = 2) 150 | 151 | # plot sender-outdegree over time 152 | library("ggplot2") 153 | ggplot(dtrem, aes(eventTime, recip, 154 | group = factor(eventDummy), color = factor(eventDummy)) ) + 155 | geom_point()+ geom_smooth() 156 | 157 | # calculate reciprocity statistic with typematch 158 | # if a cooperated with b in the past, does 159 | # b cooperate with a now? 160 | dtrem$recip.typematch <- reciprocityStat(data = dtrem, 161 | time = dtrem$eventTime, 162 | sender = dtrem$sender, 163 | target = dtrem$target, 164 | eventvar = dtrem$eventDummy, 165 | eventtypevar = dtrem$type, 166 | eventtypevalue = 'valuematch', 167 | halflife = 2) 168 | 169 | # calculate reciprocity with valuemix on type 170 | dtrem <- reciprocityStat(data = dtrem, 171 | time = dtrem$eventTime, 172 | sender = dtrem$sender, 173 | target = dtrem$target, 174 | eventvar = dtrem$eventDummy, 175 | eventtypevar = dtrem$type, 176 | eventtypevalue = 'valuemix', 177 | halflife = 2, 178 | returnData = TRUE) 179 | 180 | # calculate reciprocity and count important events only 181 | dtrem$recip.filtered <- reciprocityStat(data = dtrem, 182 | time = dtrem$eventTime, 183 | sender = dtrem$sender, 184 | target = dtrem$target, 185 | eventvar = dtrem$eventDummy, 186 | eventfiltervar = dtrem$important, 187 | eventfiltervalue = 'important', 188 | halflife = 2) 189 | } 190 | %\keyword{key} 191 | 192 | 193 | 194 | 195 | -------------------------------------------------------------------------------- /man/fourCycleStat.Rd: -------------------------------------------------------------------------------- 1 | \name{fourCycleStat} 2 | \alias{fourCycleStat} 3 | \alias{fourCycle} 4 | \title{Calculate four cycle statistics} 5 | % 6 | \description{Calculate the endogenous network statistic \code{fourCycle} that 7 | measures the tendency for events to close four cycles in two-mode event sequences.} 8 | \usage{ 9 | fourCycleStat(data, time, sender, target, halflife, 10 | weight = NULL, 11 | eventtypevar = NULL, 12 | eventtypevalue = 'standard', 13 | eventfiltervar = NULL, 14 | eventfilterAB = NULL, eventfilterAJ = NULL, 15 | eventfilterIB = NULL, eventfilterIJ = NULL, 16 | eventvar = NULL, 17 | variablename = 'fourCycle', 18 | returnData = FALSE, 19 | dataPastEvents = NULL, 20 | showprogressbar = FALSE, 21 | inParallel = FALSE, cluster = NULL 22 | ) 23 | } 24 | \arguments{ 25 | \item{data}{ A data frame containing all the variables.} 26 | 27 | \item{time}{ Numeric variable that represents the event sequence. The variable 28 | has to be sorted in ascending order.} 29 | 30 | \item{sender}{ A string (or factor or numeric) variable that represents the sender of the event.} 31 | 32 | \item{target}{ A string (or factor or numeric) variable that represents the target of the event.} 33 | 34 | \item{halflife}{ A numeric value that is used in the decay function. 35 | The vector of past events is weighted by an exponential decay function using the specified halflife. The halflife parameter determins after how long a period the event weight should be halved. E.g. if \code{halflife = 5}, the weight of an event that occured 5 units in the past is halved. Smaller halflife values give more importance to more recent events, while larger halflife values should be used if time does not affect the sequence of events that much.} 36 | 37 | \item{weight}{ An optional numeric variable that represents the weight of each event. If \code{weight = NULL} each event is given an event weight of \code{1}. 38 | } 39 | 40 | \item{eventtypevar}{ An optional variable that represents the type of the event. Use \code{eventtypevalue} to specify how the \code{eventtypevar} should be used to filter past events. 41 | } 42 | 43 | \item{eventtypevalue}{ An optional value (or set of values) used to specify how paste events should be filtered depending on their type. \code{'standard'}, \code{'positive'} or \code{'negative'} may be used. Default set to \code{'standard'}. \code{'standard'} referrs to closing four cylces where the type of the events is irrelevant. \code{'positive'} closing four cycles can be classified as reciprocity via the second mode. It indicates whether senders have a tendency to reciprocate or show support by engaging in targets that close a four cycle between two senders. \code{'negative'} closing four cycles represent opposition between two senders, where the current event is more likely if the two senders have opposed each other in the past. Support or opposition is represented by the \code{eventtypevar} value for each event.} 44 | 45 | \item{eventfiltervar}{ An optinoal variable that allows filtering of past events using an event attribute. It can be a sender attribute, a target attribute, time or dyad attribute. 46 | Use \code{eventfilterAB}, \code{eventfilterAJ}, \code{eventfilterIB} or \code{eventfilterIJ} to specify how the \code{eventfiltervar} should be used.} 47 | 48 | \item{eventfilterAB}{ An optional value used to specify how 49 | paste events should be filtered depending on their attribute. Each distinct edge that form a four cycle can be filtered. \code{eventfilterAB} refers to the current event. \code{eventfilterAJ} refers to the event involving the current sender and target \code{j} that has been used by the current as well as the second actor in the past. \code{eventfilterIB} refers to the event involving the second sender and the current target. \code{eventfilterIJ} filters events that involve the second sender and the second target. See the four cycle formula in the \code{details} section for more information.} 50 | 51 | \item{eventfilterAJ}{ see \code{eventfilterAB}.} 52 | 53 | \item{eventfilterIB}{see \code{eventfilterAB}.} 54 | 55 | \item{eventfilterIJ}{see \code{eventfilterAB}.} 56 | 57 | \item{eventvar}{ An optional dummy variable with 0 values for null-events and 1 values for true events. If the \code{data} is in the form of counting process data, use the \code{eventvar}-option to specify which variable contains the 0/1-dummy for event occurrence. If this variable is not specified, all events in the past will be considered for the calulation of the four cycle statistic, regardless if they occurred or not (= are null-events). Misspecification could result in grievous errors in the calculation of the network statistic.} 58 | 59 | \item{variablename}{ An optional value (or values) with the name the four cycle statistic variable should be given. To be used if \code{returnData = TRUE}.} 60 | 61 | \item{returnData}{ \code{TRUE/FALSE}. Set to \code{FALSE} by default. The new variable(s) are bound directly to the \code{data.frame} provided and the data frame is returned in full.} 62 | 63 | \item{dataPastEvents}{ An optional \code{data.frame} with the following variables: 64 | column 1 = time variable, 65 | column 2 = sender variable, 66 | column 3 = target on other variable (or all "1"), 67 | column 4 = weight variable (or all "1"), 68 | column 5 = event type variable (or all "1"), 69 | column 6 = event filter variable (or all "1"). Make sure that the data frame does not contain null events. Filter it out for true events only.} 70 | 71 | \item{showprogressbar}{\code{TRUE/FALSE}. To be implemented.} 72 | 73 | \item{inParallel}{ \code{TRUE/FALSE}. An optional boolean to specify if the loop should be run in parallel.} 74 | 75 | \item{cluster}{ An optional numeric or character value that defines the cluster. By specifying a single number, the cluster option uses the provided number of nodes to parallellize. By specifying a cluster using the \code{makeCluster}-command in the \code{doParallel}-package, the loop can be run on multiple nodes/cores. E.g., \code{cluster = makeCluster(12, type="FORK")}.} 76 | 77 | } 78 | \details{ 79 | The \code{fourCycleStat()}-function calculates an endogenous statistic that measures whether events have a tendency to form four cycles. 80 | 81 | The effect is calculated as follows: 82 | 83 | \deqn{G_t = G_t(E) = (A, B, w_t), }{G_t = G_t(E) = (A, B, w_t),} 84 | 85 | \eqn{G_t} represents the network of past events and includes all events \eqn{E}. These events consist 86 | each of a sender \eqn{a \in A}{a in A} and a target \eqn{b \in B}{b in B} and a weight function \eqn{w_t}: 87 | 88 | \deqn{ w_t(i, j) = \sum_{e:a = i, b = j} | w_e | \cdot e^{-(t-t_e)\cdot\frac{ln(2)}{T_{1/2}}} \cdot \frac{ln(2)}{T_{1/2}}, }{ w_t(i, j) = \sum_{e:a = i, b = j} | w_e | * exp^{-(t-t_e)* (ln(2)/T_{1/2})} * (ln(2)/T_{1/2}),} 89 | 90 | where \eqn{w_e} is the event weight (usually a constant set to 1 for each event), \eqn{t} is the current event time, \eqn{t_e} is the past event time and \eqn{T_{1/2}} is a halflife parameter. 91 | 92 | For the four-cylce effect, the past events \eqn{G_t} are filtered to include only events 93 | where the current event closes an open four-cycle in the past. 94 | 95 | \deqn{fourCycle(G_t , a , b) = \sqrt[3]{\sum_{i \in A \& j \in B} w_t(a, j) \cdot w_t(i, b) \cdot w_t(i, j)}}{fourCycle(G_t , a , b) = (\sum_{i in A and j in B} w_t(a, j) * w_t(i, b) * w_t(i, j))^(1/3)} 96 | 97 | An exponential decay function is used to model the effect of time on the endogenous statistics. The further apart the past event is from the present event, the less weight is given to this event. The halflife parameter in the \code{fourCycleStat()}-function determins at which rate the weights of past events should be reduced. Therefore, if the one (or more) of the three events in the four cycle have ocurred further in the past, less weight is given to this four cycle because it becomes less likely that the two senders reacted to each other in the way the four cycle assumes. 98 | 99 | The \code{eventtypevar}- and \code{eventfiltervar}-options help filter the past events more specifically. How they are filtered depends on the \code{eventtypevalue}- and \code{eventfilter__}-option. 100 | } 101 | % \value{ 102 | % 103 | % } 104 | % \references{ 105 | % 106 | % } 107 | % \note{ 108 | % 109 | % } 110 | \author{ 111 | Laurence Brandenberger \email{laurence.brandenberger@eawag.ch} 112 | } 113 | \seealso{ 114 | \link{rem-package} 115 | } 116 | \examples{ 117 | # create some data two-mode network event sequence data with 118 | # a 'sender', 'target' and a 'time'-variable 119 | sender <- c('A', 'B', 'A', 'C', 'A', 'D', 'F', 'G', 'A', 'B', 120 | 'B', 'C', 'D', 'E', 'F', 'B', 'C', 'D', 'E', 'C', 121 | 'A', 'F', 'E', 'B', 'C', 'E', 'D', 'G', 'A', 'G', 122 | 'F', 'B', 'C') 123 | target <- c('T1', 'T2', 'T3', 'T2', 'T1', 'T4', 'T6', 'T2', 124 | 'T4', 'T5', 'T5', 'T5', 'T1', 'T6', 'T7', 'T2', 125 | 'T3', 'T1', 'T1', 'T4', 'T5', 'T6', 'T8', 'T2', 126 | 'T7', 'T1', 'T6', 'T7', 'T3', 'T4', 'T7', 'T8', 'T2') 127 | time <- c('03.01.15', '04.01.15', '10.02.15', '28.02.15', '01.03.15', 128 | '07.03.15', '07.03.15', '12.03.15', '04.04.15', '28.04.15', 129 | '06.05.15', '11.05.15', '13.05.15', '17.05.15', '22.05.15', 130 | '09.08.15', '09.08.15', '14.08.15', '16.08.15', '29.08.15', 131 | '05.09.15', '25.09.15', '02.10.15', '03.10.15', '11.10.15', 132 | '18.10.15', '20.10.15', '28.10.15', '04.11.15', '09.11.15', 133 | '10.12.15', '11.12.15', '12.12.15') 134 | type <- sample(c('con', 'pro'), 33, replace = TRUE) 135 | important <- sample(c('important', 'not important'), 33, 136 | replace = TRUE) 137 | 138 | # combine them into a data.frame 139 | dt <- data.frame(sender, target, time, type, important) 140 | 141 | # create event sequence and order the data 142 | dt <- eventSequence(datevar = dt$time, dateformat = '\%d.\%m.\%y', 143 | data = dt, type = 'continuous', 144 | byTime = "daily", returnData = TRUE, 145 | sortData = TRUE) 146 | 147 | # create counting process data set (with null-events) - conditional logit setting 148 | dts <- createRemDataset(dt, dt$sender, dt$target, dt$event.seq.cont, 149 | eventAttribute = dt$type, 150 | atEventTimesOnly = TRUE, untilEventOccurrs = TRUE, 151 | returnInputData = TRUE) 152 | ## divide up the results: counting process data = 1, original data = 2 153 | dtrem <- dts[[1]] 154 | dt <- dts[[2]] 155 | ## merge all necessary event attribute variables back in 156 | dtrem$type <- dt$type[match(dtrem$eventID, dt$eventID)] 157 | dtrem$important <- dt$important[match(dtrem$eventID, dt$eventID)] 158 | # manually sort the data set 159 | dtrem <- dtrem[order(dtrem$eventTime), ] 160 | 161 | # calculate closing four-cycle statistic 162 | dtrem$fourCycle <- fourCycleStat(data = dtrem, 163 | time = dtrem$eventTime, 164 | sender = dtrem$sender, 165 | target = dtrem$target, 166 | eventvar = dtrem$eventDummy, 167 | halflife = 20) 168 | 169 | # plot closing four-cycles over time: 170 | library("ggplot2") 171 | ggplot(dtrem, aes (eventTime, fourCycle, 172 | group = factor(eventDummy), color = factor(eventDummy)) ) + 173 | geom_point()+ geom_smooth() 174 | 175 | # calculate positive closing four-cycles: general support 176 | dtrem$fourCycle.pos <- fourCycleStat(data = dtrem, 177 | time = dtrem$eventTime, 178 | sender = dtrem$sender, 179 | target = dtrem$target, 180 | eventvar = dtrem$eventDummy, 181 | eventtypevar = dtrem$type, 182 | eventtypevalue = 'positive', 183 | halflife = 20) 184 | 185 | # calculate negative closing four-cycles: general opposition 186 | dtrem$fourCycle.neg <- fourCycleStat(data = dtrem, 187 | time = dtrem$eventTime, 188 | sender = dtrem$sender, 189 | target = dtrem$target, 190 | eventvar = dtrem$eventDummy, 191 | eventtypevar = dtrem$type, 192 | eventtypevalue = 'negative', 193 | halflife = 20) 194 | } 195 | %\keyword{key} 196 | 197 | 198 | 199 | 200 | -------------------------------------------------------------------------------- /man/triadStat.Rd: -------------------------------------------------------------------------------- 1 | \name{triadStat} 2 | \alias{triadStat} 3 | \alias{triad} 4 | \title{Calculate triad statistics} 5 | % 6 | \description{Calculate the endogenous network statistic \code{triads} that measures the tendency for events to close open triads.} 7 | \usage{ 8 | triadStat(data, time, sender, target, halflife, 9 | weight = NULL, 10 | eventtypevar = NULL, 11 | eventtypevalues = NULL, 12 | eventfiltervar = NULL, 13 | eventfilterAI = NULL, 14 | eventfilterBI = NULL, 15 | eventfilterAB = NULL, 16 | eventvar = NULL, 17 | variablename = 'triad', 18 | returnData = FALSE, 19 | showprogressbar = FALSE, 20 | inParallel = FALSE, cluster = NULL 21 | ) 22 | } 23 | \arguments{ 24 | \item{data}{ A data frame containing all the variables.} 25 | 26 | \item{time}{ Numeric variable that represents the event sequence. The variable has to be sorted in ascending order.} 27 | 28 | \item{sender}{ A string (or factor or numeric) variable that represents the sender of the event.} 29 | 30 | \item{target}{ A string (or factor or numeric) variable that represents the target of the event.} 31 | 32 | \item{halflife}{ A numeric value that is used in the decay function. The vector of past events is weighted by an exponential decay function using the specified halflife. The halflife parameter determins after how long a period the event weight should be halved. E.g. if \code{halflife = 5}, the weight of an event that occured 5 units in the past is halved. Smaller halflife values give more importance to more recent events, while larger halflife values should be used if time does not affect the sequence of events that much.} 33 | 34 | \item{weight}{ An optional numeric variable that represents the weight of each event. If \code{weight = NULL} each event is given an event weight of \code{1}.} 35 | 36 | \item{eventtypevar}{ An optional dummy variable that represents the type of the event. Use \code{eventtypevalues} to specify how the \code{eventtypevar} should be used to filter past events. Specifying the \code{eventtypevar} is needed to calculate effects of social balance theory, such as 'friend-of-friend' or 'enemy-of-enemy' statistics.} 37 | 38 | \item{eventtypevalues}{ Two string values that represent the type of the past events. The first string value represents the eventtype that exists for all past events that include the current sender (either as sender or target) and a third actor. The second value represents the eventtype for all past events that include the target (either as sender or target) as well as the third actor. 39 | An example: Let the \code{eventtypevar} indicate whether an event is of cooperative or hostile nature. 40 | To test whether the hypothesis 'the friend of my friend is my friend' holds, both \code{eventtypevalues} must be the same and point to the cooperative type (e.g. \code{eventtypevalues = c("cooperation", "cooperation")}) depending on 41 | how the \code{eventtypevar} is coded. 42 | To test whether the hypothesis 'the friend of my enemy is my enemy' holds, 43 | the first value in \code{eventtypevalues} represents the hostile event between current sender and a third actor and the second value represents the cooperative event between the third actor and the target. 44 | To test the hypothesis 'the enemy of my enemy is my friend', the first value represents the hostile events between current sender and a third actor and the second value represents the hostile event between the current target and the third actor. 45 | For the fourth hypothesis, to test social balance theory 'the enemy of my friend is my enemy', the first value represents a cooperative event between the current sender and a third actor and the second value represents a hostile event between the current target and the third actor.} 46 | 47 | \item{eventfiltervar}{ An optional string (or factor or numeric) variable that can be used to filter past and current events. Use \code{eventfilterAI}, \code{eventfilterBI} or \code{eventfilterAB} to specify which past events should be filtered and by what value.} 48 | 49 | \item{eventfilterAI}{ An optional value used to specify how paste events should be filtered depending on their attribute. Each distinct edge that form a triad can be filtered. \code{eventfilterAI} refers to the past event involving the current sender (a) and a third actor (i). \code{eventfilterBI}referrs to past events involving target (b) and the third actor (i). \code{eventfilterAB} refers to the current event involving sender (a) and target (b).} 50 | 51 | \item{eventfilterBI}{ see \code{eventfilterAI}.} 52 | 53 | \item{eventfilterAB}{ see \code{eventfilterAI}.} 54 | 55 | \item{eventvar}{ An optional dummy variable with 0 values for null-events and 1 values for true events. If the \code{data} is in the form of counting process data, use the \code{eventvar}-option to specify which variable contains the 0/1-dummy for event occurrence. If this variable is not specified, all events in the past will be considered for the calulation of the triad statistic, regardless if they occurred or not (= are null-events).} 56 | 57 | \item{variablename}{ An optional value (or values) with the name the triad 58 | statistic variable should be given. To be used if \code{returnData = TRUE}.} 59 | 60 | \item{returnData}{ \code{TRUE/FALSE}. Set to \code{FALSE} by default. The new 61 | variable is bound directly to the \code{data.frame} provided and the 62 | data frame is returned in full.} 63 | 64 | \item{showprogressbar}{ \code{TRUE/FALSE}. Can only be set to TRUE if the function is not run in parallel.} 65 | 66 | \item{inParallel}{ \code{TRUE/FALSE}. An optional boolean to specify if the loop should be run in parallel.} 67 | 68 | \item{cluster}{ An optional numeric or character value that defines the cluster. By specifying a single number, the cluster option uses the provided number of nodes to parallellize. By specifying a cluster using the \code{makeCluster}-command in the \code{doParallel}-package, the loop can be run on multiple nodes/cores. E.g., \code{cluster = makeCluster(12, type="FORK")}.} 69 | } 70 | \details{ 71 | 72 | The \code{triadStat()}-function calculates an endogenous statistic that measures whether events have a tendency to form closing triads. 73 | 74 | The effect is calculated as follows: 75 | 76 | \deqn{G_t = G_t(E) = (A, B, w_t), }{G_t = G_t(E) = (A, B, w_t),} 77 | 78 | \eqn{G_t} represents the network of past events and includes all events \eqn{E}. These events consist 79 | each of a sender \eqn{a \in A}{a in A} and a target \eqn{b \in B}{b in B} and a weight function \eqn{w_t}: 80 | 81 | \deqn{ w_t(i, j) = \sum_{e:a = i, b = j} | w_e | \cdot e^{-(t-t_e)\cdot\frac{ln(2)}{T_{1/2}}} \cdot \frac{ln(2)}{T_{1/2}}, }{ w_t(i, j) = \sum_{e:a = i, b = j} | w_e | * exp^{-(t-t_e)* (ln(2)/T_{1/2})} * (ln(2)/T_{1/2}),} 82 | 83 | where \eqn{w_e} is the event weight (usually a constant set to 1 for each event), \eqn{t} is the current event time, \eqn{t_e} is the past event time and \eqn{T_{1/2}} is a halflife parameter. 84 | 85 | For the triad effect, the past events \eqn{G_t} are filtered to include only events 86 | where the current event closes an open triad in the past. 87 | 88 | \deqn{triad(G_t , a , b) = \sqrt{\sum_{i \in A} w_t(a, i) \cdot w_t(i, b)}}{triad(G_t , a , b) = (\sum_{i in A} w_t(a, i) * w_t(i, b))^(1/2)} 89 | 90 | An exponential decay function is used to model the effect of time on the endogenous statistics. The further apart the past event is from the present event, the less weight is given to this event. The halflife parameter in the \code{triadStat()}-function determines at which rate the weights of past events should be reduced. Therefore, if the one (or more) of the two events in the triad have occurred further in the past, less weight is given to this triad because it becomes less likely that the sender and target actors reacted to each other in the way the triad assumes. 91 | 92 | The \code{eventtypevar}- and \code{eventattributevar}-options help filter the past events more specifically. How they are filtered depends on the \code{eventtypevalue}- and \code{eventattributevalue}-option. 93 | 94 | 95 | } 96 | % \value{ 97 | % 98 | % } 99 | % \references{ 100 | % 101 | % } 102 | % \note{ 103 | % 104 | % } 105 | \author{ 106 | Laurence Brandenberger \email{laurence.brandenberger@eawag.ch} 107 | } 108 | \seealso{ 109 | \link{rem-package} 110 | } 111 | \examples{ 112 | # create some data with 'sender', 'target' and a 'time'-variable 113 | # (Note: Data used here are random events from the Correlates of War Project) 114 | sender <- c('TUN', 'UNK', 'NIR', 'TUR', 'TUR', 'USA', 'URU', 115 | 'IRQ', 'MOR', 'BEL', 'EEC', 'USA', 'IRN', 'IRN', 116 | 'USA', 'AFG', 'ETH', 'USA', 'SAU', 'IRN', 'IRN', 117 | 'ROM', 'USA', 'USA', 'PAN', 'USA', 'USA', 'YEM', 118 | 'SYR', 'AFG', 'NAT', 'UNK', 'IRN') 119 | target <- c('BNG', 'RUS', 'JAM', 'SAU', 'MOM', 'CHN', 'IRQ', 120 | 'AFG', 'AFG', 'EEC', 'BEL', 'ITA', 'RUS', 'UNK', 121 | 'IRN', 'RUS', 'AFG', 'ISR', 'ARB', 'USA', 'USA', 122 | 'USA', 'AFG', 'IRN', 'IRN', 'IRN', 'AFG', 'PAL', 123 | 'ARB', 'USA', 'EEC', 'IRN', 'CHN') 124 | time <- c('800107', '800107', '800107', '800109', '800109', 125 | '800109', '800111', '800111', '800111', '800113', 126 | '800113', '800113', '800114', '800114', '800114', 127 | '800116', '800116', '800116', '800119', '800119', 128 | '800119', '800122', '800122', '800122', '800124', 129 | '800125', '800125', '800127', '800127', '800127', 130 | '800204', '800204', '800204') 131 | type <- sample(c('cooperation', 'conflict'), 33, 132 | replace = TRUE) 133 | important <- sample(c('important', 'not important'), 33, 134 | replace = TRUE) 135 | 136 | # combine them into a data.frame 137 | dt <- data.frame(sender, target, time, type, important) 138 | 139 | # create event sequence and order the data 140 | dt <- eventSequence(datevar = dt$time, dateformat = "\%y\%m\%d", 141 | data = dt, type = "continuous", 142 | byTime = "daily", returnData = TRUE, 143 | sortData = TRUE) 144 | 145 | # create counting process data set (with null-events) - conditional logit setting 146 | dts <- createRemDataset(dt, dt$sender, dt$target, dt$event.seq.cont, 147 | eventAttribute = dt$type, 148 | atEventTimesOnly = TRUE, untilEventOccurrs = TRUE, 149 | returnInputData = TRUE) 150 | dtrem <- dts[[1]] 151 | dt <- dts[[2]] 152 | # manually sort the data set 153 | dtrem <- dtrem[order(dtrem$eventTime), ] 154 | # merge type-variable back in 155 | dtrem$type <- dt$type[match(dtrem$eventID, dt$eventID)] 156 | 157 | # calculate triad statistic 158 | dtrem$triad <- triadStat(data = dtrem, time = dtrem$eventTime, 159 | sender = dtrem$sender, target = dtrem$target, 160 | eventvar = dtrem$eventDummy, 161 | halflife = 2) 162 | 163 | # calculate friend-of-friend statistic 164 | dtrem$triad.fof <- triadStat(data = dtrem, time = dtrem$eventTime, 165 | sender = dtrem$sender, target = dtrem$target, 166 | halflife = 2, eventtypevar = dtrem$type, 167 | eventtypevalues = c("cooperation", 168 | "cooperation"), 169 | eventvar = dtrem$eventDummy) 170 | 171 | # calculate friend-of-enemy statistic 172 | dtrem$triad.foe <- triadStat(data = dtrem, time = dtrem$eventTime, 173 | sender = dtrem$sender, target = dtrem$target, 174 | halflife = 2, eventtypevar = dtrem$type, 175 | eventtypevalues = c("conflict", 176 | "cooperation"), 177 | eventvar = dtrem$eventDummy) 178 | 179 | # calculate enemy-of-friend statistic 180 | dtrem$triad.eof <- triadStat(data = dtrem, time = dtrem$eventTime, 181 | sender = dtrem$sender, target = dtrem$target, 182 | halflife = 2, eventtypevar = dtrem$type, 183 | eventtypevalues = c("cooperation", 184 | "conflict"), 185 | eventvar = dtrem$eventDummy) 186 | 187 | # calculate enemy-of-enemy statistic 188 | dtrem$triad.eoe <- triadStat(data = dtrem, time = dtrem$eventTime, 189 | sender = dtrem$sender, target = dtrem$target, 190 | halflife = 2, eventtypevar = dtrem$type, 191 | eventtypevalues = c("conflict", 192 | "conflict"), 193 | eventvar = dtrem$eventDummy) 194 | } 195 | %\keyword{key} 196 | 197 | 198 | 199 | 200 | -------------------------------------------------------------------------------- /man/similarityStat.Rd: -------------------------------------------------------------------------------- 1 | \name{similarityStat} 2 | \alias{similarityStat} 3 | \alias{similarity} 4 | \title{Calculate similarity statistics} 5 | % 6 | \description{Calculate the endogenous network statistic \code{similarity} for relational event models. \code{similarityStat} measures the tendency for senders to adapt their behavior to that of their peers.} 7 | \usage{ 8 | similarityStat(data, time, sender, target, 9 | senderOrTarget = 'sender', 10 | whichSimilarity = NULL, 11 | halflifeLastEvent = NULL, 12 | halflifeTimeBetweenEvents = NULL, 13 | eventtypevar = NULL, 14 | eventfiltervar = NULL, 15 | eventfiltervalue = NULL, 16 | eventvar = NULL, 17 | variablename = 'similarity', 18 | returnData = FALSE, 19 | dataPastEvents = NULL, 20 | showprogressbar = FALSE, 21 | inParallel = FALSE, cluster = NULL 22 | ) 23 | } 24 | 25 | \arguments{ 26 | \item{data}{ A data frame containing all the variables.} 27 | 28 | \item{time}{ Numeric variable that represents the event sequence. The variable has to be sorted in ascending order.} 29 | 30 | \item{sender}{ A string (or factor or numeric) variable that represents the sender of the event.} 31 | 32 | \item{target}{ A string (or factor or numeric) variable that represents the target of the event.} 33 | 34 | \item{senderOrTarget}{ \code{sender} or \code{target}. Indicates on which variable (sender or target) the similarity should be calculated on. Sender similarity measures how many targets the current sender has in common with other senders who used the same targets in the past. Target similarity measures how many senders have used the current target as well as another target that the current sender used in the past.} 35 | 36 | \item{whichSimilarity}{ \code{"total"} or \code{"average"}. Indicates how the variable should be aggregated. \code{"total"} counts the number of similar events there are in the past event history. \code{"average"} divides the count of similar events by the number of senders or the number of targets, depending on which mode of similarity is chosen.} 37 | 38 | \item{halflifeLastEvent}{ A numeric value that is used in the decay function. The vector of past events is weighted by an exponential decay function using the specified halflife. The halflife parameter determines after how long a period the event weight should be halved. For sender similarity: The halflife determines the weight of the count of targets that two actors have in common. The further back the second sender was active, the less weight is given the similarity between this sender and the current sender. For target similarity: The halflife determines the weight of the count of targets that have used both been used by other senders in the past. The longer ago the current sender engaged in an event with the other target, the less weight is given the count.} 39 | 40 | \item{halflifeTimeBetweenEvents}{ A numeric value that is used in the decay function. Instead of counting each past event for the similarity statistic, each event is reduced depending on the time that passed between the current event and the past event. For sender similarity: Each target that two actors have in common is weighted by the time that passed between the two events. For target similarity: Each sender that two targets have in common is weighted by the time that passed between the two events. } 41 | 42 | \item{eventtypevar}{ An optional dummy variable that represents the type of the event. If specified, only past events are considered for the count that reflect the same type as the current event (typematch).} 43 | 44 | \item{eventfiltervar}{ An optional variable that filters past events by the \code{eventfiltervalue} specified. } 45 | 46 | \item{eventfiltervalue}{ A string that represents an event attribute by which all past events have to be filtered by.} 47 | 48 | \item{eventvar}{ An optional dummy variable with 0 values for null-events and 1 values for true events. If the \code{data} is in the form of counting process data, use the \code{eventvar}-option to specify which variable contains the 0/1-dummy for event occurrence. If this variable is not specified, all events in the past will be considered for the calulation of the similarity statistic, regardless if they occurred or not (= are null-events). Misspecification could result in grievous errors in the calculation of the network statistic.} 49 | 50 | \item{variablename}{ An optional value (or values) with the name the similarity statistic variable should be given. To be used if \code{returnData = TRUE}.} 51 | 52 | \item{returnData}{ \code{TRUE/FALSE}. Set to \code{FALSE} by default. The new variable(s) are bound directly to the \code{data.frame} provided and the data frame is returned in full.} 53 | 54 | \item{dataPastEvents}{ An optional \code{data.frame} with the following variables: 55 | column 1 = time variable, 56 | column 2 = sender variable, 57 | column 3 = target on other variable (or all "1"), 58 | column 4 = event type variable (or all "1"), 59 | column 5 = event filter variable (or all "1"). Make sure that the data frame does not contain null events. Filter it out for true events only.} 60 | 61 | 62 | \item{showprogressbar}{\code{TRUE/FALSE}. To be implemented.} 63 | 64 | \item{inParallel}{ \code{TRUE/FALSE}. An optional boolean to specify if the loop should be run in parallel.} 65 | 66 | \item{cluster}{ An optional numeric or character value that defines the cluster. By specifying a single number, the cluster option uses the provided number of nodes to parallellize. By specifying a cluster using the \code{makeCluster}-command in the \code{doParallel}-package, the loop can be run on multiple nodes/cores. E.g., \code{cluster = makeCluster(12, type="FORK")}.} 67 | 68 | } 69 | \details{ 70 | 71 | The \code{similiarityStat()}-function calculates an endogenous statistic that measures whether sender (or targets) have a tendency to cluster together. Tow distinct types of similarity measures can be calculated: sender similarity or target similarity. 72 | 73 | Sender similarity: How many targets does the current sender have in common with senders who used the current target in the past? How likely is it that two senders are alike? 74 | 75 | The function proceeds as follows: 76 | \enumerate{ 77 | \item First it filters out all the targets that the present sender \eqn{a} used in the past 78 | \item Next it filters out all the senders that have also used the current target \eqn{b} 79 | \item For each of the senders found in (2) it compiles a list of targets that this sender has used in the past 80 | \item For each of the senders found in (2) it cross-checks the two lists generated in (1) and (3) and count how many targets the two senders have in common. 81 | } 82 | 83 | % Procedure of the sender similarity calcuation: 84 | % list - Filter out all the targets that $a$ has used in the past 85 | % - Filter out all the senders that also used the current target $b$ 86 | % - Filter out events that involve senders that have used $b$ in the past 87 | % - Check how many targets the current sender and the past sender (that also 88 | % used $b$) have in common 89 | 90 | Target similarity: How many senders have used the same two concepts that the current sender has used (in the past and is currently using)? For each target that the current sender has used in the past, how many senders have also used these past targets as well as the current target? How likely is it that two targets are used together? 91 | 92 | The function proceeds as follows: 93 | \enumerate{ 94 | \item First filter out all the targets that the current sender \eqn{a} has used in the past 95 | \item Next it filters out all the senders that have also used the current target \eqn{b} 96 | \item For each target found in (1) it compiles a list of senders that have also used this target in the past 97 | \item For each target found in (1) it cross-checks the list of senders that have used \eqn{b} (found under (2)) and the list of senders that also used one other target that \eqn{a} used (found under (3)) 98 | } 99 | 100 | % list - - Filter out all the targets that $a$ has used in the past 101 | % - Filter out all the senders that also used the current target $b$ 102 | % - Filter out events that involve a target that $a$ has used in the past 103 | % - Check how many senders have used the current topic as well as one other 104 | % topic used by $a$ in the past 105 | 106 | Two decay functions may be used in the calculation of the similarity score for each event. 107 | 108 | %% Additional info needed here? 109 | 110 | } 111 | % \value{ 112 | % 113 | % } 114 | % \references{ 115 | % 116 | % } 117 | % \note{ 118 | % 119 | % } 120 | \author{ 121 | Laurence Brandenberger \email{laurence.brandenberger@eawag.ch} 122 | } 123 | \seealso{ 124 | \link{rem-package} 125 | } 126 | \examples{ 127 | # create some data with 'sender', 'target' and a 'time'-variable 128 | # (Note: Data used here are random events from the Correlates of War Project) 129 | sender <- c('TUN', 'NIR', 'NIR', 'TUR', 'TUR', 'USA', 'URU', 130 | 'IRQ', 'MOR', 'BEL', 'EEC', 'USA', 'IRN', 'IRN', 131 | 'USA', 'AFG', 'ETH', 'USA', 'SAU', 'IRN', 'IRN', 132 | 'ROM', 'USA', 'USA', 'PAN', 'USA', 'USA', 'YEM', 133 | 'SYR', 'AFG', 'NAT', 'NAT', 'USA') 134 | target <- c('BNG', 'ZAM', 'JAM', 'SAU', 'MOM', 'CHN', 'IRQ', 135 | 'AFG', 'AFG', 'EEC', 'BEL', 'ITA', 'RUS', 'UNK', 136 | 'IRN', 'RUS', 'AFG', 'ISR', 'ARB', 'USA', 'USA', 137 | 'USA', 'AFG', 'IRN', 'IRN', 'IRN', 'AFG', 'PAL', 138 | 'ARB', 'USA', 'EEC', 'BEL', 'PAK') 139 | time <- c('800107', '800107', '800107', '800109', '800109', 140 | '800109', '800111', '800111', '800111', '800113', 141 | '800113', '800113', '800114', '800114', '800114', 142 | '800116', '800116', '800116', '800119', '800119', 143 | '800119', '800122', '800122', '800122', '800124', 144 | '800125', '800125', '800127', '800127', '800127', 145 | '800204', '800204', '800204') 146 | type <- sample(c('cooperation', 'conflict'), 33, 147 | replace = TRUE) 148 | important <- sample(c('important', 'not important'), 33, 149 | replace = TRUE) 150 | 151 | # combine them into a data.frame 152 | dt <- data.frame(sender, target, time, type, important) 153 | 154 | # create event sequence and order the data 155 | dt <- eventSequence(datevar = dt$time, dateformat = "\%y\%m\%d", 156 | data = dt, type = "continuous", 157 | byTime = "daily", returnData = TRUE, 158 | sortData = TRUE) 159 | 160 | # create counting process data set (with null-events) - conditional logit setting 161 | dts <- createRemDataset(dt, dt$sender, dt$target, dt$event.seq.cont, 162 | eventAttribute = dt$type, 163 | atEventTimesOnly = TRUE, untilEventOccurrs = TRUE, 164 | returnInputData = TRUE) 165 | ## divide up the results: counting process data = 1, original data = 2 166 | dtrem <- dts[[1]] 167 | dt <- dts[[2]] 168 | ## merge all necessary event attribute variables back in 169 | dtrem$type <- dt$type[match(dtrem$eventID, dt$eventID)] 170 | dtrem$important <- dt$important[match(dtrem$eventID, dt$eventID)] 171 | # manually sort the data set 172 | dtrem <- dtrem[order(dtrem$eventTime), ] 173 | 174 | # average sender similarity 175 | dtrem$s.sim.av <- similarityStat(data = dtrem, 176 | time = dtrem$eventTime, 177 | sender = dtrem$sender, 178 | target = dtrem$target, 179 | eventvar = dtrem$eventDummy, 180 | senderOrTarget = "sender", 181 | whichSimilarity = "average") 182 | 183 | # average target similarity 184 | dtrem$t.sim.av <- similarityStat(data = dtrem, 185 | time = dtrem$eventTime, 186 | sender = dtrem$sender, 187 | target = dtrem$target, 188 | eventvar = dtrem$eventDummy, 189 | senderOrTarget = "target", 190 | whichSimilarity = "average") 191 | 192 | # Calculate sender similarity with 1 halflife 193 | # parameter: This parameter makes sure, that those other 194 | # senders (with whom you compare your targets) have been 195 | # active in the past. THe longer they've done nothing, the 196 | # less weight is given to the number of similar targets. 197 | dtrem$s.sim.hl2 <- similarityStat(data = dtrem, 198 | time = dtrem$eventTime, 199 | sender = dtrem$sender, 200 | target = dtrem$target, 201 | eventvar = dtrem$eventDummy, 202 | senderOrTarget = "sender", 203 | halflifeLastEvent = 2) 204 | 205 | # Calculate sender similarity with 2 halflife parameters: 206 | # The first parameter makes sure that the actors against 207 | # whom you compare yourself have been active in the 208 | # recent past. The second halflife parameter makes 209 | # sure that the two events containing the same 210 | # targets (once by the current actor, once by the other 211 | # actor) are not that far apart. The longer apart, the 212 | # less likely it is that the current sender will remember 213 | # how the similar-past sender has acted. 214 | dtrem$s.sim.hl2.hl1 <- similarityStat(data = dtrem, 215 | time = dtrem$eventTime, 216 | sender = dtrem$sender, 217 | target = dtrem$target, 218 | eventvar = dtrem$eventDummy, 219 | senderOrTarget = "sender", 220 | halflifeLastEvent = 2, 221 | halflifeTimeBetweenEvents = 1) 222 | } 223 | %\keyword{key} 224 | 225 | 226 | 227 | 228 | -------------------------------------------------------------------------------- /man/degreeStat.Rd: -------------------------------------------------------------------------------- 1 | \name{degreeStat} 2 | \alias{degreeStat} 3 | \alias{degree} 4 | \alias{outdegree} 5 | \alias{indegree} 6 | \title{Calculate (in/out)-degree statistics} 7 | % 8 | \description{Calculate the endogenous network statistic \code{indegree/outdegree} for relational event models. \code{indegree/outdegree} measures the senders' tendency to be involved in events (sender activity, sender out- or indegree) or the tendency of events to surround a specific target (target popularity, target in- or outdegree)} 9 | \usage{ 10 | degreeStat(data, time, degreevar, halflife, 11 | weight = NULL, 12 | eventtypevar = NULL, 13 | eventtypevalue = "valuematch", 14 | eventfiltervar = NULL, 15 | eventfiltervalue = NULL, 16 | eventvar = NULL, 17 | degreeOnOtherVar = NULL, 18 | variablename = "degree", 19 | returnData = FALSE, 20 | dataPastEvents = NULL, 21 | showprogressbar = FALSE, 22 | inParallel = FALSE, cluster = NULL) 23 | } 24 | \arguments{ 25 | \item{data}{ A data frame containing all the variables.} 26 | \item{time}{ Numeric variable that represents the event sequence. The variable has to be sorted in ascending order.} 27 | 28 | \item{degreevar}{ A string (or factor or numeric) variable that represents the sender or target of the event. The degree statistic will calculate how often in the past, a given sender or target has been active by counting the number of events in the past where the \code{degreevar} is repeated. See \code{details} for more information on which variable to chose as \code{degreevar} for one- and two-mode networks.} 29 | 30 | \item{halflife}{ A numeric value that is used in the decay function. The vector of past events is weighted by an exponential decay function using the specified halflife. The halflife parameter determines after how long a period the event weight should be halved. E.g. if \code{halflife = 5}, the weight of an event that occurred 5 units in the past is halved. Smaller halflife values give more importance to more recent events, while larger halflife values should be used if time does not affect the sequence of events that much.} 31 | 32 | \item{weight}{ An optional numeric variable that represents the weight of each event. If \code{weight = NULL} each event is given an event weight of \code{1}.} 33 | 34 | \item{eventtypevar}{ An optional variable that represents the type of the event. Use \code{eventtypevalue} to specify how the \code{eventtypevar} should be used to filter past events.} 35 | 36 | \item{eventtypevalue}{ An optional value (or set of values) used to specify how paste events should be filtered depending on their type. 37 | \code{eventtypevalue = "valuematch"} indicates that only past events that have the same type should be used to calculate the degree statistic. 38 | \code{eventtypevalue = "valuemix"} indicates that past and present events of specific types should be used for the degree statistic. All the possible combinations of the eventtypevar-values will be used. E.g. if \code{eventtypevar} contains two unique values "a" and "b", 4 degree statistics will be calculated. The first variable calculates the degree effect where the present event is of type "a" and all the past events are of type "b". The next variable calculates the degree statistic for present events of type "b" and past events of type "a". Additionally, a variable is calculated, where present events as well as past events are of type "a" and a fourth variable calculates the degree statistic for events with type "b" (i.e. valuematch on value "b"). 39 | \code{eventtypevalue = c("..", "..")} is similar to the \code{"nodemix"}-option, all different combinations of the values specified in \code{eventtypevalue} are used to create the degree statistics.} 40 | 41 | \item{eventfiltervar}{ An optional numeric/character/or factor variable for each event. If \code{eventfiltervar} is specified, \code{eventfiltervalue} has to be provided as well.} 42 | 43 | \item{eventfiltervalue}{ An optional character string that represents the value for which past events should be filtered. To filter the current events, use \code{eventtypevar}.} 44 | 45 | \item{eventvar}{ An (optional) dummy variable with 0 values for null-events and 1 values for true events. If the \code{data} is in the form of counting process data, use the \code{eventvar}-option to specify which variable contains the 0/1-dummy for event occurrence. If this variable is not specified, all events in the past will be considered for the calulation of the degree statistic, regardless if they occurred or not (= are null-events).} 46 | 47 | \item{degreeOnOtherVar}{ A string (or factor or numeric) variable that represents the sender or target of the event. It can be used to calculate target-outdegree or sender-indegree statistics in one-mode networks. For the sender indegree statistic, fill the sender variable into the \code{degreevar} and the target variable into the \code{degree.on.other.var}. For the target-outdegree statistic, fill the target variable into the \code{degreevar} and the sender variable into the \code{degree.on.other.var}.} 48 | 49 | \item{variablename}{ An optional value (or values) with the name the degree statistic variable should be given. Default "degree" is used. To be used if \code{returnData = TRUE} or multiple degree statistics are calculated.} 50 | 51 | \item{returnData}{ \code{TRUE/FALSE}. Set to \code{FALSE} by default. The new variable(s) are bound directly to the \code{data.frame} provided and the data frame is returned in full.} 52 | 53 | \item{dataPastEvents}{ An optional \code{data.frame} with the following variables: 54 | column 1 = time variable, 55 | column 2 = degree variable, 56 | column 3 = degree on other variable (or all "1"), 57 | column 4 = event dummy (or all 1), 58 | column 5 = weight variable (or all "1"), 59 | column 6 = event type variable (or all "1"), 60 | column 7 = event filter variable (or all "1").} 61 | 62 | \item{showprogressbar}{ \code{TRUE/FALSE}. Can only be set to TRUE if the function is not run in parallel.} 63 | 64 | \item{inParallel}{ \code{TRUE/FALSE}. An optional boolean to specify if the loop should be run in parallel.} 65 | 66 | \item{cluster}{ An optional numeric or character value that defines the cluster. By specifying a single number, the cluster option uses the provided number of nodes to parallellize. By specifying a cluster using the \code{makeCluster}-command in the \code{doParallel}-package, the loop can be run on multiple nodes/cores. E.g., \code{cluster = makeCluster(12, type="FORK")}.} 67 | 68 | } 69 | 70 | \details{ 71 | 72 | The \code{degreeStat()}-function calculates an endogenous statistic that measures whether events have a tendency to include either the same sender or the same target over the entire event sequence. 73 | 74 | The effect is calculated as follows. 75 | 76 | \deqn{G_t = G_t(E) = (A, B, w_t), }{G_t = G_t(E) = (A, B, w_t),} 77 | 78 | \eqn{G_t} represents the network of past events and includes all events \eqn{E}. These events consist 79 | each of a sender \eqn{a \in A}{a in A} and a target \eqn{b \in B}{b in B} (in one-mode networks \eqn{A = B}{A = B}) and a weight function \eqn{w_t}: 80 | 81 | \deqn{ w_t(i, j) = \sum_{e:a = i, b = j} | w_e | \cdot e^{-(t-t_e)\cdot\frac{ln(2)}{T_{1/2}}} \cdot \frac{ln(2)}{T_{1/2}}, }{ w_t(i, j) = \sum_{e:a = i, b = j} | w_e | * exp^{-(t-t_e)* (ln(2)/T_{1/2})} * (ln(2)/T_{1/2}),} 82 | 83 | where \eqn{w_e} is the event weight (usually a constant set to 1 for each event), \eqn{t} is the current event time, \eqn{t_e} is the past event time and \eqn{T_{1/2}} is a halflife parameter. 84 | 85 | For the degree effect, the past events \eqn{G_t} are filtered to include only events 86 | where the senders or targets are identical to the current sender or target. 87 | 88 | \deqn{sender-outdegree(G_t , a , b) = \sum_{j \in B} w_t(a, j)}{sender-outdegree(G_t , a , b) = \sum_{j in B} w_t(a, j)} 89 | 90 | \deqn{target-indegree(G_t , a , b) = \sum_{i \in A} w_t(i, b)}{target-indegree(G_t , a , b) = \sum_{i in A} w_t(i, b)} 91 | 92 | \deqn{sender-indegree(G_t , a , b) = \sum_{i \in A} w_t(i, a)}{sender-indegree(G_t , a , b) = \sum_{i in A} w_t(i, a)} 93 | 94 | \deqn{target-outdegree(G_t , a , b) = \sum_{j \in B} w_t(b, j)}{target-outdegree(G_t , a , b) = \sum_{j in B} w_t(b, j)} 95 | 96 | Depending on whether the degree statistic is measured on the sender variable or the target variable, either activity or popularity effects are calculated. 97 | 98 | For one-mode networks: Four distinct statistics can be calculated: sender-indegree, sender-outdegree, target-indegree or target-outdegree. The sender-indegree measures how often the current sender was targeted by other senders in the past (i.e. how popular were current senders). The sender-outedegree measures how often the current sender was involved in an event, where they were also marked as sender (i.e. how active the current sender has been in the past). The target-indegree statistic measures how often the current targets were targeted in the past (i.e. how popular were current targets). And the target-outdegree measures how often the current targets were senders in the past (i.e. how active were current targets in the past). 99 | 100 | For two-mode networks: Two distinct statistics can be calculated: sender-outdegree and target-indegree. Sender-outdegree measures how often the current sender has been involved in an event in the past (i.e. how active the sender has been up until now). The target-indegree statistic measures how often the current target has been involved in an event in the past (i.e. how popular a given target has been before the current event). 101 | 102 | An exponential decay function is used to model the effect of time on the endogenous statistics. Each past event that contains the same sender or the same target (depending on the variable specified in \code{degreevar}) and fulfills additional filtering options (specified via event type or event attributes) is weighted with an exponential decay. The further apart the past event is from the present event, the less weight is given to this event. The halflife parameter in the \code{degreeStat()}-function determines at which rate the weights of past events should be reduced. 103 | 104 | The \code{eventtypevar}- and \code{eventattributevar}-options help filter the past events more specifically. How they are filtered depends on the \code{eventtypevalue}- and \code{eventattributevalue}-option. 105 | 106 | } 107 | % \value{ 108 | % 109 | % } 110 | % \references{ 111 | % 112 | % } 113 | % \note{ 114 | % 115 | % } 116 | \author{ 117 | Laurence Brandenberger \email{laurence.brandenberger@eawag.ch} 118 | } 119 | \seealso{ 120 | \link{rem-package} 121 | } 122 | \examples{ 123 | # create some data with 'sender', 'target' and a 'time'-variable 124 | # (Note: Data used here are random events from the Correlates of War Project) 125 | sender <- c('TUN', 'NIR', 'NIR', 'TUR', 'TUR', 'USA', 'URU', 126 | 'IRQ', 'MOR', 'BEL', 'EEC', 'USA', 'IRN', 'IRN', 127 | 'USA', 'AFG', 'ETH', 'USA', 'SAU', 'IRN', 'IRN', 128 | 'ROM', 'USA', 'USA', 'PAN', 'USA', 'USA', 'YEM', 129 | 'SYR', 'AFG', 'NAT', 'NAT', 'USA') 130 | target <- c('BNG', 'ZAM', 'JAM', 'SAU', 'MOM', 'CHN', 'IRQ', 131 | 'AFG', 'AFG', 'EEC', 'BEL', 'ITA', 'RUS', 'UNK', 132 | 'IRN', 'RUS', 'AFG', 'ISR', 'ARB', 'USA', 'USA', 133 | 'USA', 'AFG', 'IRN', 'IRN', 'IRN', 'AFG', 'PAL', 134 | 'ARB', 'USA', 'EEC', 'BEL', 'PAK') 135 | time <- c('800107', '800107', '800107', '800109', '800109', 136 | '800109', '800111', '800111', '800111', '800113', 137 | '800113', '800113', '800114', '800114', '800114', 138 | '800116', '800116', '800116', '800119', '800119', 139 | '800119', '800122', '800122', '800122', '800124', 140 | '800125', '800125', '800127', '800127', '800127', 141 | '800204', '800204', '800204') 142 | type <- sample(c('cooperation', 'conflict'), 33, 143 | replace = TRUE) 144 | 145 | # combine them into a data.frame 146 | dt <- data.frame(sender, target, time, type) 147 | 148 | # create event sequence and order the data 149 | dt <- eventSequence(datevar = dt$time, dateformat = "\%y\%m\%d", 150 | data = dt, type = "continuous", 151 | byTime = "daily", returnData = TRUE, 152 | sortData = TRUE) 153 | 154 | # create counting process data set (with null-events) - conditional logit setting 155 | dts <- createRemDataset(dt, dt$sender, dt$target, dt$event.seq.cont, 156 | eventAttribute = dt$type, 157 | atEventTimesOnly = TRUE, untilEventOccurrs = TRUE, 158 | returnInputData = TRUE) 159 | ## divide up the results: counting process data = 1, original data = 2 160 | dtrem <- dts[[1]] 161 | dt <- dts[[2]] 162 | ## merge all necessary event attribute variables back in 163 | dtrem$type <- dt$type[match(dtrem$eventID, dt$eventID)] 164 | dtrem$important <- dt$important[match(dtrem$eventID, dt$eventID)] 165 | # manually sort the data set 166 | dtrem <- dtrem[order(dtrem$eventTime), ] 167 | 168 | # calculate sender-outdegree statistic 169 | dtrem$sender.outdegree <- degreeStat(data = dtrem, 170 | time = dtrem$eventTime, 171 | degreevar = dtrem$sender, 172 | halflife = 2, 173 | eventvar = dtrem$eventDummy, 174 | returnData = FALSE) 175 | 176 | # plot sender-outdegree over time 177 | library("ggplot2") 178 | ggplot(dtrem, aes(eventTime, sender.outdegree, 179 | group = factor(eventDummy), color = factor(eventDummy) ) ) + 180 | geom_point()+ geom_smooth() 181 | 182 | # calculate sender-indegree statistic 183 | dtrem$sender.indegree <- degreeStat(data = dtrem, 184 | time = dtrem$eventTime, 185 | degreevar = dtrem$sender, 186 | halflife = 2, 187 | eventvar = dtrem$eventDummy, 188 | degreeOnOtherVar = dtrem$target, 189 | returnData = FALSE) 190 | 191 | # calculate target-indegree statistic 192 | dtrem$target.indegree <- degreeStat(data = dtrem, 193 | time = dtrem$eventTime, 194 | degreevar = dtrem$target, 195 | halflife = 2, 196 | eventvar = dtrem$eventDummy, 197 | returnData = FALSE) 198 | 199 | # calculate target-outdegree statistic 200 | dtrem$target.outdegree <- degreeStat(data = dtrem, 201 | time = dtrem$eventTime, 202 | degreevar = dtrem$target, 203 | halflife = 2, 204 | eventvar = dtrem$eventDummy, 205 | degreeOnOtherVar = dtrem$sender, 206 | returnData = FALSE) 207 | 208 | # calculate target-indegree with typematch 209 | dtrem$target.indegree.tm <- degreeStat(data = dtrem, 210 | time = dtrem$eventTime, 211 | degreevar = dtrem$target, 212 | halflife = 2, 213 | eventtypevar = dtrem$type, 214 | eventtypevalue = "valuematch", 215 | eventvar = dtrem$eventDummy, 216 | returnData = FALSE) 217 | } 218 | %\keyword{key} 219 | 220 | 221 | 222 | 223 | -------------------------------------------------------------------------------- /src/RcppExports.cpp: -------------------------------------------------------------------------------- 1 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #include 5 | 6 | using namespace Rcpp; 7 | 8 | // fourCycleCpp 9 | double fourCycleCpp(std::vector sender, std::string currentSender, std::vector target, std::string currentTarget, std::vector typevar, std::string currentType, NumericVector time, double currentTime, NumericVector weightvar, double xlog, std::vector attrvarAaj, std::string attrAaj, std::vector attrvarBib, std::string attrBib, std::vector attrvarCij, std::string attrCij, std::string fourCycleType, std::vector w, std::vector x, int i, int begin); 10 | RcppExport SEXP _rem_fourCycleCpp(SEXP senderSEXP, SEXP currentSenderSEXP, SEXP targetSEXP, SEXP currentTargetSEXP, SEXP typevarSEXP, SEXP currentTypeSEXP, SEXP timeSEXP, SEXP currentTimeSEXP, SEXP weightvarSEXP, SEXP xlogSEXP, SEXP attrvarAajSEXP, SEXP attrAajSEXP, SEXP attrvarBibSEXP, SEXP attrBibSEXP, SEXP attrvarCijSEXP, SEXP attrCijSEXP, SEXP fourCycleTypeSEXP, SEXP wSEXP, SEXP xSEXP, SEXP iSEXP, SEXP beginSEXP) { 11 | BEGIN_RCPP 12 | Rcpp::RObject rcpp_result_gen; 13 | Rcpp::RNGScope rcpp_rngScope_gen; 14 | Rcpp::traits::input_parameter< std::vector >::type sender(senderSEXP); 15 | Rcpp::traits::input_parameter< std::string >::type currentSender(currentSenderSEXP); 16 | Rcpp::traits::input_parameter< std::vector >::type target(targetSEXP); 17 | Rcpp::traits::input_parameter< std::string >::type currentTarget(currentTargetSEXP); 18 | Rcpp::traits::input_parameter< std::vector >::type typevar(typevarSEXP); 19 | Rcpp::traits::input_parameter< std::string >::type currentType(currentTypeSEXP); 20 | Rcpp::traits::input_parameter< NumericVector >::type time(timeSEXP); 21 | Rcpp::traits::input_parameter< double >::type currentTime(currentTimeSEXP); 22 | Rcpp::traits::input_parameter< NumericVector >::type weightvar(weightvarSEXP); 23 | Rcpp::traits::input_parameter< double >::type xlog(xlogSEXP); 24 | Rcpp::traits::input_parameter< std::vector >::type attrvarAaj(attrvarAajSEXP); 25 | Rcpp::traits::input_parameter< std::string >::type attrAaj(attrAajSEXP); 26 | Rcpp::traits::input_parameter< std::vector >::type attrvarBib(attrvarBibSEXP); 27 | Rcpp::traits::input_parameter< std::string >::type attrBib(attrBibSEXP); 28 | Rcpp::traits::input_parameter< std::vector >::type attrvarCij(attrvarCijSEXP); 29 | Rcpp::traits::input_parameter< std::string >::type attrCij(attrCijSEXP); 30 | Rcpp::traits::input_parameter< std::string >::type fourCycleType(fourCycleTypeSEXP); 31 | Rcpp::traits::input_parameter< std::vector >::type w(wSEXP); 32 | Rcpp::traits::input_parameter< std::vector >::type x(xSEXP); 33 | Rcpp::traits::input_parameter< int >::type i(iSEXP); 34 | Rcpp::traits::input_parameter< int >::type begin(beginSEXP); 35 | rcpp_result_gen = Rcpp::wrap(fourCycleCpp(sender, currentSender, target, currentTarget, typevar, currentType, time, currentTime, weightvar, xlog, attrvarAaj, attrAaj, attrvarBib, attrBib, attrvarCij, attrCij, fourCycleType, w, x, i, begin)); 36 | return rcpp_result_gen; 37 | END_RCPP 38 | } 39 | // similarityTotalAverageCpp 40 | double similarityTotalAverageCpp(std::vector sender, std::string currentSender, std::vector target, std::string currentTarget, NumericVector time, double currentTime, std::vector eventAttributeVar, std::string eventAttribute, std::vector eventTypeVar, std::string currentType, std::string totalAverageSim, std::string matchNomatchSim, std::string senderTargetSim, std::vector v, std::vector w, int i, int begin); 41 | RcppExport SEXP _rem_similarityTotalAverageCpp(SEXP senderSEXP, SEXP currentSenderSEXP, SEXP targetSEXP, SEXP currentTargetSEXP, SEXP timeSEXP, SEXP currentTimeSEXP, SEXP eventAttributeVarSEXP, SEXP eventAttributeSEXP, SEXP eventTypeVarSEXP, SEXP currentTypeSEXP, SEXP totalAverageSimSEXP, SEXP matchNomatchSimSEXP, SEXP senderTargetSimSEXP, SEXP vSEXP, SEXP wSEXP, SEXP iSEXP, SEXP beginSEXP) { 42 | BEGIN_RCPP 43 | Rcpp::RObject rcpp_result_gen; 44 | Rcpp::RNGScope rcpp_rngScope_gen; 45 | Rcpp::traits::input_parameter< std::vector >::type sender(senderSEXP); 46 | Rcpp::traits::input_parameter< std::string >::type currentSender(currentSenderSEXP); 47 | Rcpp::traits::input_parameter< std::vector >::type target(targetSEXP); 48 | Rcpp::traits::input_parameter< std::string >::type currentTarget(currentTargetSEXP); 49 | Rcpp::traits::input_parameter< NumericVector >::type time(timeSEXP); 50 | Rcpp::traits::input_parameter< double >::type currentTime(currentTimeSEXP); 51 | Rcpp::traits::input_parameter< std::vector >::type eventAttributeVar(eventAttributeVarSEXP); 52 | Rcpp::traits::input_parameter< std::string >::type eventAttribute(eventAttributeSEXP); 53 | Rcpp::traits::input_parameter< std::vector >::type eventTypeVar(eventTypeVarSEXP); 54 | Rcpp::traits::input_parameter< std::string >::type currentType(currentTypeSEXP); 55 | Rcpp::traits::input_parameter< std::string >::type totalAverageSim(totalAverageSimSEXP); 56 | Rcpp::traits::input_parameter< std::string >::type matchNomatchSim(matchNomatchSimSEXP); 57 | Rcpp::traits::input_parameter< std::string >::type senderTargetSim(senderTargetSimSEXP); 58 | Rcpp::traits::input_parameter< std::vector >::type v(vSEXP); 59 | Rcpp::traits::input_parameter< std::vector >::type w(wSEXP); 60 | Rcpp::traits::input_parameter< int >::type i(iSEXP); 61 | Rcpp::traits::input_parameter< int >::type begin(beginSEXP); 62 | rcpp_result_gen = Rcpp::wrap(similarityTotalAverageCpp(sender, currentSender, target, currentTarget, time, currentTime, eventAttributeVar, eventAttribute, eventTypeVar, currentType, totalAverageSim, matchNomatchSim, senderTargetSim, v, w, i, begin)); 63 | return rcpp_result_gen; 64 | END_RCPP 65 | } 66 | // similaritySimpleCpp 67 | double similaritySimpleCpp(std::vector sender, std::string currentSender, std::vector target, std::string currentTarget, NumericVector time, double currentTime, double xlog, std::vector eventAttributeVar, std::string eventAttribute, std::vector eventTypeVar, std::string currentType, std::string matchNomatchSim, std::string senderTargetSim, std::vector v, std::vector w, int i, int begin); 68 | RcppExport SEXP _rem_similaritySimpleCpp(SEXP senderSEXP, SEXP currentSenderSEXP, SEXP targetSEXP, SEXP currentTargetSEXP, SEXP timeSEXP, SEXP currentTimeSEXP, SEXP xlogSEXP, SEXP eventAttributeVarSEXP, SEXP eventAttributeSEXP, SEXP eventTypeVarSEXP, SEXP currentTypeSEXP, SEXP matchNomatchSimSEXP, SEXP senderTargetSimSEXP, SEXP vSEXP, SEXP wSEXP, SEXP iSEXP, SEXP beginSEXP) { 69 | BEGIN_RCPP 70 | Rcpp::RObject rcpp_result_gen; 71 | Rcpp::RNGScope rcpp_rngScope_gen; 72 | Rcpp::traits::input_parameter< std::vector >::type sender(senderSEXP); 73 | Rcpp::traits::input_parameter< std::string >::type currentSender(currentSenderSEXP); 74 | Rcpp::traits::input_parameter< std::vector >::type target(targetSEXP); 75 | Rcpp::traits::input_parameter< std::string >::type currentTarget(currentTargetSEXP); 76 | Rcpp::traits::input_parameter< NumericVector >::type time(timeSEXP); 77 | Rcpp::traits::input_parameter< double >::type currentTime(currentTimeSEXP); 78 | Rcpp::traits::input_parameter< double >::type xlog(xlogSEXP); 79 | Rcpp::traits::input_parameter< std::vector >::type eventAttributeVar(eventAttributeVarSEXP); 80 | Rcpp::traits::input_parameter< std::string >::type eventAttribute(eventAttributeSEXP); 81 | Rcpp::traits::input_parameter< std::vector >::type eventTypeVar(eventTypeVarSEXP); 82 | Rcpp::traits::input_parameter< std::string >::type currentType(currentTypeSEXP); 83 | Rcpp::traits::input_parameter< std::string >::type matchNomatchSim(matchNomatchSimSEXP); 84 | Rcpp::traits::input_parameter< std::string >::type senderTargetSim(senderTargetSimSEXP); 85 | Rcpp::traits::input_parameter< std::vector >::type v(vSEXP); 86 | Rcpp::traits::input_parameter< std::vector >::type w(wSEXP); 87 | Rcpp::traits::input_parameter< int >::type i(iSEXP); 88 | Rcpp::traits::input_parameter< int >::type begin(beginSEXP); 89 | rcpp_result_gen = Rcpp::wrap(similaritySimpleCpp(sender, currentSender, target, currentTarget, time, currentTime, xlog, eventAttributeVar, eventAttribute, eventTypeVar, currentType, matchNomatchSim, senderTargetSim, v, w, i, begin)); 90 | return rcpp_result_gen; 91 | END_RCPP 92 | } 93 | // similarityComplexCpp 94 | double similarityComplexCpp(std::vector sender, std::string currentSender, std::vector target, std::string currentTarget, NumericVector time, double currentTime, double xlog, double halflifeTimeDifference, std::vector eventAttributeVar, std::string eventAttribute, std::vector eventTypeVar, std::string currentType, std::string matchNomatchSim, std::string senderTargetSim, std::vector v, std::vector w, int i, int begin); 95 | RcppExport SEXP _rem_similarityComplexCpp(SEXP senderSEXP, SEXP currentSenderSEXP, SEXP targetSEXP, SEXP currentTargetSEXP, SEXP timeSEXP, SEXP currentTimeSEXP, SEXP xlogSEXP, SEXP halflifeTimeDifferenceSEXP, SEXP eventAttributeVarSEXP, SEXP eventAttributeSEXP, SEXP eventTypeVarSEXP, SEXP currentTypeSEXP, SEXP matchNomatchSimSEXP, SEXP senderTargetSimSEXP, SEXP vSEXP, SEXP wSEXP, SEXP iSEXP, SEXP beginSEXP) { 96 | BEGIN_RCPP 97 | Rcpp::RObject rcpp_result_gen; 98 | Rcpp::RNGScope rcpp_rngScope_gen; 99 | Rcpp::traits::input_parameter< std::vector >::type sender(senderSEXP); 100 | Rcpp::traits::input_parameter< std::string >::type currentSender(currentSenderSEXP); 101 | Rcpp::traits::input_parameter< std::vector >::type target(targetSEXP); 102 | Rcpp::traits::input_parameter< std::string >::type currentTarget(currentTargetSEXP); 103 | Rcpp::traits::input_parameter< NumericVector >::type time(timeSEXP); 104 | Rcpp::traits::input_parameter< double >::type currentTime(currentTimeSEXP); 105 | Rcpp::traits::input_parameter< double >::type xlog(xlogSEXP); 106 | Rcpp::traits::input_parameter< double >::type halflifeTimeDifference(halflifeTimeDifferenceSEXP); 107 | Rcpp::traits::input_parameter< std::vector >::type eventAttributeVar(eventAttributeVarSEXP); 108 | Rcpp::traits::input_parameter< std::string >::type eventAttribute(eventAttributeSEXP); 109 | Rcpp::traits::input_parameter< std::vector >::type eventTypeVar(eventTypeVarSEXP); 110 | Rcpp::traits::input_parameter< std::string >::type currentType(currentTypeSEXP); 111 | Rcpp::traits::input_parameter< std::string >::type matchNomatchSim(matchNomatchSimSEXP); 112 | Rcpp::traits::input_parameter< std::string >::type senderTargetSim(senderTargetSimSEXP); 113 | Rcpp::traits::input_parameter< std::vector >::type v(vSEXP); 114 | Rcpp::traits::input_parameter< std::vector >::type w(wSEXP); 115 | Rcpp::traits::input_parameter< int >::type i(iSEXP); 116 | Rcpp::traits::input_parameter< int >::type begin(beginSEXP); 117 | rcpp_result_gen = Rcpp::wrap(similarityComplexCpp(sender, currentSender, target, currentTarget, time, currentTime, xlog, halflifeTimeDifference, eventAttributeVar, eventAttribute, eventTypeVar, currentType, matchNomatchSim, senderTargetSim, v, w, i, begin)); 118 | return rcpp_result_gen; 119 | END_RCPP 120 | } 121 | // triadCpp 122 | double triadCpp(std::vector v, std::vector sender, std::vector target, NumericVector time, NumericVector weightvar, std::vector typevar, std::string typeA, std::string typeB, std::vector attributevarAI, std::string attrAI, std::vector attributevarBI, std::string attrBI, double xlog, int i, std::string currentSender, std::string currentTarget, double currentTime); 123 | RcppExport SEXP _rem_triadCpp(SEXP vSEXP, SEXP senderSEXP, SEXP targetSEXP, SEXP timeSEXP, SEXP weightvarSEXP, SEXP typevarSEXP, SEXP typeASEXP, SEXP typeBSEXP, SEXP attributevarAISEXP, SEXP attrAISEXP, SEXP attributevarBISEXP, SEXP attrBISEXP, SEXP xlogSEXP, SEXP iSEXP, SEXP currentSenderSEXP, SEXP currentTargetSEXP, SEXP currentTimeSEXP) { 124 | BEGIN_RCPP 125 | Rcpp::RObject rcpp_result_gen; 126 | Rcpp::RNGScope rcpp_rngScope_gen; 127 | Rcpp::traits::input_parameter< std::vector >::type v(vSEXP); 128 | Rcpp::traits::input_parameter< std::vector >::type sender(senderSEXP); 129 | Rcpp::traits::input_parameter< std::vector >::type target(targetSEXP); 130 | Rcpp::traits::input_parameter< NumericVector >::type time(timeSEXP); 131 | Rcpp::traits::input_parameter< NumericVector >::type weightvar(weightvarSEXP); 132 | Rcpp::traits::input_parameter< std::vector >::type typevar(typevarSEXP); 133 | Rcpp::traits::input_parameter< std::string >::type typeA(typeASEXP); 134 | Rcpp::traits::input_parameter< std::string >::type typeB(typeBSEXP); 135 | Rcpp::traits::input_parameter< std::vector >::type attributevarAI(attributevarAISEXP); 136 | Rcpp::traits::input_parameter< std::string >::type attrAI(attrAISEXP); 137 | Rcpp::traits::input_parameter< std::vector >::type attributevarBI(attributevarBISEXP); 138 | Rcpp::traits::input_parameter< std::string >::type attrBI(attrBISEXP); 139 | Rcpp::traits::input_parameter< double >::type xlog(xlogSEXP); 140 | Rcpp::traits::input_parameter< int >::type i(iSEXP); 141 | Rcpp::traits::input_parameter< std::string >::type currentSender(currentSenderSEXP); 142 | Rcpp::traits::input_parameter< std::string >::type currentTarget(currentTargetSEXP); 143 | Rcpp::traits::input_parameter< double >::type currentTime(currentTimeSEXP); 144 | rcpp_result_gen = Rcpp::wrap(triadCpp(v, sender, target, time, weightvar, typevar, typeA, typeB, attributevarAI, attrAI, attributevarBI, attrBI, xlog, i, currentSender, currentTarget, currentTime)); 145 | return rcpp_result_gen; 146 | END_RCPP 147 | } 148 | // weightTimesSummationCpp 149 | double weightTimesSummationCpp(NumericVector pastSenderTimes, double xlog, double currentTime, NumericVector weightvar); 150 | RcppExport SEXP _rem_weightTimesSummationCpp(SEXP pastSenderTimesSEXP, SEXP xlogSEXP, SEXP currentTimeSEXP, SEXP weightvarSEXP) { 151 | BEGIN_RCPP 152 | Rcpp::RObject rcpp_result_gen; 153 | Rcpp::RNGScope rcpp_rngScope_gen; 154 | Rcpp::traits::input_parameter< NumericVector >::type pastSenderTimes(pastSenderTimesSEXP); 155 | Rcpp::traits::input_parameter< double >::type xlog(xlogSEXP); 156 | Rcpp::traits::input_parameter< double >::type currentTime(currentTimeSEXP); 157 | Rcpp::traits::input_parameter< NumericVector >::type weightvar(weightvarSEXP); 158 | rcpp_result_gen = Rcpp::wrap(weightTimesSummationCpp(pastSenderTimes, xlog, currentTime, weightvar)); 159 | return rcpp_result_gen; 160 | END_RCPP 161 | } 162 | // createNullEvents 163 | DataFrame createNullEvents(std::vector eventID, std::vector sender, std::vector target, std::vector eventAttribute, std::vector time, std::vector start, std::vector end, std::vector allEventTimes, double nrows); 164 | RcppExport SEXP _rem_createNullEvents(SEXP eventIDSEXP, SEXP senderSEXP, SEXP targetSEXP, SEXP eventAttributeSEXP, SEXP timeSEXP, SEXP startSEXP, SEXP endSEXP, SEXP allEventTimesSEXP, SEXP nrowsSEXP) { 165 | BEGIN_RCPP 166 | Rcpp::RObject rcpp_result_gen; 167 | Rcpp::RNGScope rcpp_rngScope_gen; 168 | Rcpp::traits::input_parameter< std::vector >::type eventID(eventIDSEXP); 169 | Rcpp::traits::input_parameter< std::vector >::type sender(senderSEXP); 170 | Rcpp::traits::input_parameter< std::vector >::type target(targetSEXP); 171 | Rcpp::traits::input_parameter< std::vector >::type eventAttribute(eventAttributeSEXP); 172 | Rcpp::traits::input_parameter< std::vector >::type time(timeSEXP); 173 | Rcpp::traits::input_parameter< std::vector >::type start(startSEXP); 174 | Rcpp::traits::input_parameter< std::vector >::type end(endSEXP); 175 | Rcpp::traits::input_parameter< std::vector >::type allEventTimes(allEventTimesSEXP); 176 | Rcpp::traits::input_parameter< double >::type nrows(nrowsSEXP); 177 | rcpp_result_gen = Rcpp::wrap(createNullEvents(eventID, sender, target, eventAttribute, time, start, end, allEventTimes, nrows)); 178 | return rcpp_result_gen; 179 | END_RCPP 180 | } 181 | // absoluteDiffAverageWeightEventAttributeCpp 182 | NumericVector absoluteDiffAverageWeightEventAttributeCpp(std::vector sender, std::vector target, NumericVector time, NumericVector weightvar, std::vector eventattributevar, std::string eventattribute, double xlog); 183 | RcppExport SEXP _rem_absoluteDiffAverageWeightEventAttributeCpp(SEXP senderSEXP, SEXP targetSEXP, SEXP timeSEXP, SEXP weightvarSEXP, SEXP eventattributevarSEXP, SEXP eventattributeSEXP, SEXP xlogSEXP) { 184 | BEGIN_RCPP 185 | Rcpp::RObject rcpp_result_gen; 186 | Rcpp::RNGScope rcpp_rngScope_gen; 187 | Rcpp::traits::input_parameter< std::vector >::type sender(senderSEXP); 188 | Rcpp::traits::input_parameter< std::vector >::type target(targetSEXP); 189 | Rcpp::traits::input_parameter< NumericVector >::type time(timeSEXP); 190 | Rcpp::traits::input_parameter< NumericVector >::type weightvar(weightvarSEXP); 191 | Rcpp::traits::input_parameter< std::vector >::type eventattributevar(eventattributevarSEXP); 192 | Rcpp::traits::input_parameter< std::string >::type eventattribute(eventattributeSEXP); 193 | Rcpp::traits::input_parameter< double >::type xlog(xlogSEXP); 194 | rcpp_result_gen = Rcpp::wrap(absoluteDiffAverageWeightEventAttributeCpp(sender, target, time, weightvar, eventattributevar, eventattribute, xlog)); 195 | return rcpp_result_gen; 196 | END_RCPP 197 | } 198 | 199 | static const R_CallMethodDef CallEntries[] = { 200 | {"_rem_fourCycleCpp", (DL_FUNC) &_rem_fourCycleCpp, 21}, 201 | {"_rem_similarityTotalAverageCpp", (DL_FUNC) &_rem_similarityTotalAverageCpp, 17}, 202 | {"_rem_similaritySimpleCpp", (DL_FUNC) &_rem_similaritySimpleCpp, 17}, 203 | {"_rem_similarityComplexCpp", (DL_FUNC) &_rem_similarityComplexCpp, 18}, 204 | {"_rem_triadCpp", (DL_FUNC) &_rem_triadCpp, 17}, 205 | {"_rem_weightTimesSummationCpp", (DL_FUNC) &_rem_weightTimesSummationCpp, 4}, 206 | {"_rem_createNullEvents", (DL_FUNC) &_rem_createNullEvents, 9}, 207 | {"_rem_absoluteDiffAverageWeightEventAttributeCpp", (DL_FUNC) &_rem_absoluteDiffAverageWeightEventAttributeCpp, 7}, 208 | {NULL, NULL, 0} 209 | }; 210 | 211 | RcppExport void R_init_rem(DllInfo *dll) { 212 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 213 | R_useDynamicSymbols(dll, FALSE); 214 | } 215 | -------------------------------------------------------------------------------- /R/temp.R: -------------------------------------------------------------------------------- 1 | ################################################################################ 2 | ## Triads (one-mode statistic) 3 | ################################################################################ 4 | 5 | triadStatold <- function(data, time, sender, target, halflife, weight = NULL, 6 | eventtypevar = NULL, eventtypevalues = NULL, 7 | eventattributevar = NULL, eventattributeAI = NULL, 8 | eventattributeBI = NULL, eventattributeAB = NULL, 9 | variablename = "triad", returnData = FALSE, 10 | showprogressbar = FALSE){ 11 | 12 | ####### check inputs 13 | ## check if sender input is available 14 | if ( is.null(sender) ) { 15 | stop("No 'sender' argument was provided.") 16 | }else{ 17 | sender <- as.character(sender) 18 | } 19 | 20 | ## check if target input is available 21 | if ( is.null(target) ) { 22 | stop("No 'target' argument was provided.") 23 | }else{ 24 | target <- as.character(target) 25 | } 26 | 27 | ## check if event.sequence is well defined (numeric and ever-increasing) 28 | if ( is.null(time) ) { 29 | stop("No 'time' argument was provided.") 30 | }else{ 31 | #test if weight-var is in ascending order 32 | if ( is.unsorted(time) ) { 33 | stop("'", time, "' is not sorted. Sort data frame according to the event 34 | sequence.") 35 | } 36 | } 37 | 38 | ## check if vaiables are of same length 39 | if ( length(sender) != length(target) ){ 40 | stop("'sender' and 'target' are not of same length.") 41 | } 42 | if ( length(sender) != length(time) ){ 43 | stop("'sender' and 'time' are not of same length.") 44 | } 45 | 46 | ## check if weight-var is defined (if not -> create it) 47 | if ( is.null(weight) ) { 48 | weight <- rep(1, length(time)) 49 | } 50 | if ( !is.numeric(weight) ) { 51 | stop("'", as.name(weight), "' variable is not numeric.") 52 | } 53 | 54 | ## check if event-type inputs are available and correctly specified 55 | if ( !is.null(eventtypevar) ) { 56 | # check if variable is of same length as sender 57 | if ( length(sender) != length(eventtypevar) ){ 58 | stop("'sender' and 'eventtypevar' are not of same length.") 59 | } 60 | # transform variable 61 | eventtypevar <- as.character(eventtypevar) 62 | if ( length(unique(eventtypevar)) != 2 ){ 63 | stop("'eventtypevar' is not a dummy variable.") 64 | } 65 | if ( is.null(eventtypevalues) ){ 66 | stop("No 'eventtypevalues' provided. ") 67 | } 68 | if ( length(eventtypevalues) != 2 ){ 69 | stop("'eventtypevalues' not specified correctly. Two values need to be 70 | provided that will reflect either a 'friend-of-friend', a 'friend- 71 | of-enemy', a 'enemy-of-friend' or a 'enemy-of-enemy' triad. The two 72 | values indicate which value in the 'eventtypevar' relates to 73 | 'friend' (or 'enemy') depending on the triad type.") 74 | } 75 | if ( length(grep(eventtypevalues[1], eventtypevar)) == 0 ) { 76 | stop("First value '", eventattributeAB, "' is not an element of '", 77 | deparse(substitute(eventattributevar)) , "'.") 78 | } 79 | if ( length(grep(eventtypevalues[2], eventtypevar)) == 0 ) { 80 | stop("Second value '", eventattributeAB, "' is not an element of '", 81 | deparse(substitute(eventattributevar)) , "'.") 82 | } 83 | } 84 | 85 | ## check if event-attribute inputs are available and correctly specified 86 | if ( is.null(eventattributevar) == FALSE ) { 87 | # check length of variable 88 | if ( length(sender) != length(eventattributevar) ){ 89 | stop("'sender' and 'eventattributevar' are not of same length.") 90 | } 91 | # transform variable 92 | eventattributevar <- as.character(eventattributevar) 93 | if ( is.null(eventattributeAB) & is.null(eventattributeAI) & 94 | is.null(eventattributeBI) ){ 95 | stop("No 'eventattribute__' provided. Provide a string value by which the 96 | events are filtered.", ) 97 | } 98 | # check if eventattributevalue is part of the variable 99 | if ( is.null(eventattributeAB) == FALSE){ 100 | if ( length(grep(eventattributeAB, eventattributevar)) == 0 ) { 101 | stop("Value '", eventattributeAB, "' is not an element of '", 102 | deparse(substitute(eventattributevar)) , "'.") 103 | } 104 | } 105 | if ( is.null(eventattributeAI) == FALSE){ 106 | if ( length(grep(eventattributeAI, eventattributevar)) == 0 ) { 107 | stop("Value '", eventattributeAI, "' is not an element of '", 108 | deparse(substitute(eventattributevar)) , "'.") 109 | } 110 | } 111 | if ( is.null(eventattributeBI) == FALSE){ 112 | if ( length(grep(eventattributeBI, eventattributevar)) == 0 ) { 113 | stop("Value '", eventattributeBI, "' is not an element of '", 114 | deparse(substitute(eventattributevar)) , "'.") 115 | } 116 | } 117 | } 118 | 119 | ## check if variablename makes sense (no " " etc.) 120 | variablename <- gsub(" ", "", variablename, fixed = TRUE) 121 | 122 | ## create simple data set to be returned for degree calcuations with more than 1 output-variable 123 | ##TODO: should there be an event-id-variable?? => that would be useful here 124 | data.short <- data.frame(time) 125 | 126 | ## calculate part of decay function 127 | xlog <- log(2)/halflife 128 | 129 | ####### calculate stat 130 | ## create placeholder-variables to be used in the cpp-Function 131 | placeholder <- rep("1", length(time)) 132 | 133 | ## calculate the triad effects for each event 134 | 135 | ## all the statistics without an event type 136 | if ( is.null(eventtypevar) ){ 137 | ## all stats without an event type and an event attribute 138 | if ( is.null(eventattributevar) ){ 139 | ## (1) no type, no attribute. Simple triad-effect 140 | result <- triadCpp(sender, target, time, weight, placeholder, "1", "1", 141 | placeholder, "1", placeholder, "1", placeholder, "1", 142 | xlog ) 143 | if ( returnData == TRUE ) { 144 | data <- cbind(data, result) 145 | names(data)[length(data)] <- variablename 146 | ## return the data frame with the variable bound to it 147 | return(data) 148 | }else{ 149 | ## only return the 1 triad variable that was generated 150 | return(result) 151 | } 152 | }else{ 153 | ## all stats without event type but with event attribute 154 | ## (2) no type, attributeAB 155 | if ( is.null(eventattributeAI) & is.null(eventattributeBI) & is.null(eventattributeAB) == FALSE ){ 156 | result <- triadCpp(sender, target, time, weight, placeholder, "1", "1", 157 | eventattributevar, eventattributeAB, placeholder, "1", 158 | placeholder, "1", xlog ) 159 | if ( returnData == TRUE ) { 160 | data <- cbind(data, result) 161 | names(data)[length(data)] <- variablename 162 | ## return the data frame with the variable bound to it 163 | return(data) 164 | }else{ 165 | ## only return the 1 triad variable that was generated 166 | return(result) 167 | } 168 | } 169 | ## (3) no type, attributeAI 170 | if ( is.null(eventattributeAB) & is.null(eventattributeBI) & is.null(eventattributeAI) == FALSE ){ 171 | result <- triadCpp(sender, target, time, weight, placeholder, "1", "1", 172 | placeholder, "1", eventattributevar, eventattributeAI, 173 | placeholder, "1", xlog ) 174 | if ( returnData == TRUE ) { 175 | data <- cbind(data, result) 176 | names(data)[length(data)] <- variablename 177 | ## return the data frame with the variable bound to it 178 | return(data) 179 | }else{ 180 | ## only return the 1 triad variable that was generated 181 | return(result) 182 | } 183 | } 184 | ## (4) no type, attributeBI 185 | if ( is.null(eventattributeAB) & is.null(eventattributeAI) & is.null(eventattributeBI) == FALSE ){ 186 | result <- triadCpp(sender, target, time, weight, placeholder, "1", "1", 187 | placeholder, "1", placeholder, "1", eventattributevar, 188 | eventattributeBI, xlog ) 189 | if ( returnData == TRUE ) { 190 | data <- cbind(data, result) 191 | names(data)[length(data)] <- variablename 192 | ## return the data frame with the variable bound to it 193 | return(data) 194 | }else{ 195 | ## only return the 1 triad variable that was generated 196 | return(result) 197 | } 198 | } 199 | ## (5) no type, attributeAB & attributeAI 200 | if ( is.null(eventattributeAB) == FALSE & is.null(eventattributeAI) == FALSE & is.null(eventattributeBI) ){ 201 | result <- triadCpp(sender, target, time, weight, placeholder, "1", "1", 202 | eventattributevar, eventattributeAB, eventattributevar, 203 | eventattributeAI, placeholder, "1", xlog ) 204 | if ( returnData == TRUE ) { 205 | data <- cbind(data, result) 206 | names(data)[length(data)] <- variablename 207 | ## return the data frame with the variable bound to it 208 | return(data) 209 | }else{ 210 | ## only return the 1 triad variable that was generated 211 | return(result) 212 | } 213 | } 214 | ## (6) no type, attribute AB & attributeBI 215 | if ( is.null(eventattributeAB) == FALSE & is.null(eventattributeAI) & is.null(eventattributeBI) == FALSE ){ 216 | result <- triadCpp(sender, target, time, weight, placeholder, "1", "1", 217 | eventattributevar, eventattributeAB, placeholder, 218 | "1", eventattributevar, eventattributeBI, xlog ) 219 | if ( returnData == TRUE ) { 220 | data <- cbind(data, result) 221 | names(data)[length(data)] <- variablename 222 | ## return the data frame with the variable bound to it 223 | return(data) 224 | }else{ 225 | ## only return the 1 triad variable that was generated 226 | return(result) 227 | } 228 | } 229 | ## (7) no type, attribute AI & attributeBI 230 | if ( is.null(eventattributeAB) & is.null(eventattributeAI) == FALSE & is.null(eventattributeBI) == FALSE ){ 231 | result <- triadCpp(sender, target, time, weight, placeholder, "1", "1", 232 | placeholder, "1", eventattributevar, 233 | eventattributeAI, eventattributevar, eventattributeBI, xlog ) 234 | if ( returnData == TRUE ) { 235 | data <- cbind(data, result) 236 | names(data)[length(data)] <- variablename 237 | ## return the data frame with the variable bound to it 238 | return(data) 239 | }else{ 240 | ## only return the 1 triad variable that was generated 241 | return(result) 242 | } 243 | } 244 | ## (8) no type, attribute AB & attributeAI & attributeBI 245 | if ( is.null(eventattributeAB) == FALSE & is.null(eventattributeAI) == FALSE & is.null(eventattributeBI) == FALSE ){ 246 | result <- triadCpp(sender, target, time, weight, placeholder, "1", "1", 247 | eventattributevar, eventattributeAB, eventattributevar, 248 | eventattributeAI, eventattributevar, eventattributeBI, xlog ) 249 | if ( returnData == TRUE ) { 250 | data <- cbind(data, result) 251 | names(data)[length(data)] <- variablename 252 | ## return the data frame with the variable bound to it 253 | return(data) 254 | }else{ 255 | ## only return the 1 triad variable that was generated 256 | return(result) 257 | } 258 | } 259 | 260 | }#closes else attributevar != null 261 | }else{ 262 | ## all the statistics with an event type 263 | if ( is.null(eventattributevar) ){ 264 | ## with type, but no attribute 265 | ## (9) type, no attribute 266 | if ( is.null(eventattributeAB) & is.null(eventattributeAI) & is.null(eventattributeBI) ){ 267 | result <- triadCpp(sender, target, time, weight, eventtypevar, eventtypevalues[1], eventtypevalues[2], 268 | placeholder, "1", placeholder, 269 | "1", placeholder, "1", xlog ) 270 | if ( returnData == TRUE ) { 271 | data <- cbind(data, result) 272 | names(data)[length(data)] <- variablename 273 | ## return the data frame with the variable bound to it 274 | return(data) 275 | }else{ 276 | ## only return the 1 triad variable that was generated 277 | return(result) 278 | } 279 | } 280 | 281 | }else{ 282 | ## all stats with type and attribute 283 | ## (10) type, attributeAB 284 | if ( is.null(eventattributeAB) == FALSE & is.null(eventattributeAI) & is.null(eventattributeBI) ){ 285 | result <- triadCpp(sender, target, time, weight, eventtypevar, eventtypevalues[1], eventtypevalues[2], 286 | eventattributevar, eventattributeAB, placeholder, 287 | "1", placeholder, "1", xlog ) 288 | if ( returnData == TRUE ) { 289 | data <- cbind(data, result) 290 | names(data)[length(data)] <- variablename 291 | ## return the data frame with the variable bound to it 292 | return(data) 293 | }else{ 294 | ## only return the 1 triad variable that was generated 295 | return(result) 296 | } 297 | } 298 | 299 | ## (11) type, attributeAI 300 | if ( is.null(eventattributeAB) & is.null(eventattributeAI) == FALSE & is.null(eventattributeBI) ){ 301 | result <- triadCpp(sender, target, time, weight, eventtypevar, eventtypevalues[1], eventtypevalues[2], 302 | placeholder, "1", eventattributevar, 303 | eventattributeAI, placeholder, "1", xlog ) 304 | if ( returnData == TRUE ) { 305 | data <- cbind(data, result) 306 | names(data)[length(data)] <- variablename 307 | ## return the data frame with the variable bound to it 308 | return(data) 309 | }else{ 310 | ## only return the 1 triad variable that was generated 311 | return(result) 312 | } 313 | } 314 | 315 | ## (12) type, attributeBI 316 | if ( is.null(eventattributeAB) & is.null(eventattributeAI) & is.null(eventattributeBI) == FALSE ){ 317 | result <- triadCpp(sender, target, time, weight, eventtypevar, eventtypevalues[1], eventtypevalues[2], 318 | placeholder, "1", placeholder, 319 | "1", eventattributevar, eventattributeBI, xlog ) 320 | if ( returnData == TRUE ) { 321 | data <- cbind(data, result) 322 | names(data)[length(data)] <- variablename 323 | ## return the data frame with the variable bound to it 324 | return(data) 325 | }else{ 326 | ## only return the 1 triad variable that was generated 327 | return(result) 328 | } 329 | } 330 | 331 | ## (13) type, attributeAB & attributeAI 332 | if ( is.null(eventattributeAB) == FALSE & is.null(eventattributeAI) == FALSE & is.null(eventattributeBI) ){ 333 | result <- triadCpp(sender, target, time, weight, eventtypevar, eventtypevalues[1], eventtypevalues[2], 334 | eventattributevar, eventattributeAB, eventattributevar, 335 | eventattributeAI, placeholder, "1", xlog ) 336 | if ( returnData == TRUE ) { 337 | data <- cbind(data, result) 338 | names(data)[length(data)] <- variablename 339 | ## return the data frame with the variable bound to it 340 | return(data) 341 | }else{ 342 | ## only return the 1 triad variable that was generated 343 | return(result) 344 | } 345 | } 346 | 347 | ## (14) type, attribute AB & attributeBI 348 | if ( is.null(eventattributeAB) == FALSE & is.null(eventattributeAI) & is.null(eventattributeBI) == FALSE ){ 349 | result <- triadCpp(sender, target, time, weight, eventtypevar, eventtypevalues[1], eventtypevalues[2], 350 | eventattributevar, eventattributeAB, placeholder, 351 | "1", eventattributevar, eventattributeBI, xlog ) 352 | if ( returnData == TRUE ) { 353 | data <- cbind(data, result) 354 | names(data)[length(data)] <- variablename 355 | ## return the data frame with the variable bound to it 356 | return(data) 357 | }else{ 358 | ## only return the 1 triad variable that was generated 359 | return(result) 360 | } 361 | } 362 | 363 | ## (15) type, attribute AI & attributeBI 364 | if ( is.null(eventattributeAB) & is.null(eventattributeAI) == FALSE & is.null(eventattributeBI) == FALSE ){ 365 | result <- triadCpp(sender, target, time, weight, eventtypevar, eventtypevalues[1], eventtypevalues[2], 366 | placeholder, "1", eventattributevar, 367 | eventattributeAI, eventattributevar, eventattributeBI, xlog ) 368 | if ( returnData == TRUE ) { 369 | data <- cbind(data, result) 370 | names(data)[length(data)] <- variablename 371 | ## return the data frame with the variable bound to it 372 | return(data) 373 | }else{ 374 | ## only return the 1 triad variable that was generated 375 | return(result) 376 | } 377 | } 378 | 379 | ## (16) type, attribute AB & attributeAI & attributeBI 380 | if ( is.null(eventattributeAB) == FALSE & is.null(eventattributeAI) == FALSE & is.null(eventattributeBI) == FALSE ){ 381 | result <- triadCpp(sender, target, time, weight, eventtypevar, eventtypevalues[1], eventtypevalues[2], 382 | eventattributevar, eventattributeAB, eventattributevar, 383 | eventattributeAI, eventattributevar, eventattributeBI, xlog ) 384 | if ( returnData == TRUE ) { 385 | data <- cbind(data, result) 386 | names(data)[length(data)] <- variablename 387 | ## return the data frame with the variable bound to it 388 | return(data) 389 | }else{ 390 | ## only return the 1 triad variable that was generated 391 | return(result) 392 | } 393 | } 394 | 395 | }##closes else attr-var != null 396 | }## closes else-type-var != null 397 | 398 | }#closing 399 | 400 | -------------------------------------------------------------------------------- /src/rem.cpp: -------------------------------------------------------------------------------- 1 | //####################################################################include 2 | #include 3 | using namespace Rcpp; 4 | 5 | //TODO: tidy up functions - within 80char/line 6 | //TODO: similarity-Average-Total: why does target-sim not have "match"-option for vector w? 7 | 8 | //#################################################################### 9 | //#################################################################### 10 | //#################################################################### 11 | 12 | //#################################################################### 13 | // [[Rcpp::export]] 14 | double fourCycleCpp( 15 | std::vector sender, 16 | std::string currentSender, 17 | std::vector target, 18 | std::string currentTarget, 19 | std::vector typevar, 20 | std::string currentType, 21 | NumericVector time, 22 | double currentTime, 23 | NumericVector weightvar, 24 | double xlog, 25 | std::vector attrvarAaj, 26 | std::string attrAaj, 27 | std::vector attrvarBib, 28 | std::string attrBib, 29 | std::vector attrvarCij, 30 | std::string attrCij, 31 | std::string fourCycleType, 32 | std::vector w, //what else has a said? 33 | std::vector x, //who else has used a (same opinion = positive, opposite oppingion = negative) 34 | int i, 35 | int begin) { 36 | 37 | double result; 38 | std::vector y; 39 | std::vector wy; 40 | double weightA; 41 | double weightB; 42 | double weightC; 43 | double tempTotalWeightC; 44 | double tempTotalWeightA; 45 | double tempTotalWeightAPositive; 46 | double tempTotalWeightANegative; 47 | double tempTotalWeightB; 48 | double tempTotalWeightCPositive; 49 | double tempTotalWeightCNegative; 50 | double tempTotalWeightABC; 51 | double tempTotalWeightABCPositive; 52 | double tempTotalWeightABCNegative; 53 | double totalWeightABCPositive; 54 | double totalWeightABCNegative; 55 | double totalWeightABC; 56 | 57 | //in R-loop now: Filter: only current events with given attribute are selected. 58 | //if ( attrvarNow[i] == attrNow ) { 59 | 60 | y.clear(); 61 | totalWeightABCPositive = 0; 62 | totalWeightABCNegative = 0; 63 | tempTotalWeightABC = 0; 64 | tempTotalWeightABCNegative = 0; 65 | tempTotalWeightABCPositive = 0; 66 | totalWeightABC = 0; 67 | 68 | // for each person in the list x (m-loop open) (=y-vector; wy-vector) 69 | for (int m = 0; m < x.size(); m++ ) { 70 | 71 | tempTotalWeightB = 0; 72 | 73 | // What did actor say in past? (n-loop open) 74 | y.clear(); 75 | for ( int n = begin; n < i; n++ ) { 76 | // for each person: find y-vector (list of targets $i$ has used) 77 | if (sender[n] != currentSender && sender[n] == x[m] && target[n] != currentTarget && attrvarCij[n] == attrCij ){ 78 | y.push_back(target[n]); 79 | } 80 | } // n-loop close 81 | 82 | // clean up y (only unique values) 83 | std::sort( y.begin(), y.end() ); 84 | y.erase( unique( y.begin(), y.end() ), y.end() ); 85 | 86 | // interlock between x and y = wy vector 87 | wy.clear(); 88 | std::sort( w.begin(), w.end() ); 89 | std::sort( y.begin(), y.end() ); 90 | std::set_intersection (w.begin(), w.end(), y.begin(), y.end(), std::back_inserter(wy) ); 91 | // erase douplicates 92 | sort( wy.begin(), wy.end() ); 93 | wy.erase( unique( wy.begin(), wy.end() ), wy.end() ); 94 | 95 | // if these two actors (x-vector from a and y-vector from i) interact via a shared concept: calculate weightB (weightB = w_t(i, p)) 96 | // positive/negative four cycle: only choose those events with different type 97 | if ( fourCycleType == "standard" ){ 98 | if (wy.size() != 0) { 99 | for ( int o = begin; o < i; o++ ) { 100 | weightB = 0; 101 | if (sender[o] == x[m] && target[o] == currentTarget && attrvarBib[o] == attrBib && time[o] != currentTime) { 102 | weightB = std::abs(weightvar[o]) * exp( - ( currentTime - time[o] ) * xlog) * xlog; 103 | tempTotalWeightB = tempTotalWeightB + weightB; 104 | } 105 | }// closes o-loop 106 | } 107 | }//closes if fourCycleType == standard 108 | if ( fourCycleType == "positive" ){ 109 | if (wy.size() != 0) { 110 | for ( int o = begin; o < i; o++ ) { 111 | weightB = 0; 112 | if (sender[o] == x[m] && target[o] == currentTarget && typevar[o] == currentType && attrvarBib[o] == attrBib && time[o] != currentTime ) { 113 | weightB = std::abs(weightvar[o]) * exp( - ( currentTime - time[o] ) * xlog) * xlog; 114 | tempTotalWeightB = tempTotalWeightB + weightB; 115 | } 116 | }// closes o-loop 117 | } 118 | }//closes if fourCycleType == positive 119 | if ( fourCycleType == "negative" ){ 120 | if (wy.size() != 0) { 121 | for ( int o = begin; o < i; o++ ) { 122 | weightB = 0; 123 | if (sender[o] == x[m] && target[o] == currentTarget && typevar[o] != currentType && attrvarBib[o] == attrBib && time[o] != currentTime) { 124 | weightB = std::abs(weightvar[o]) * exp( - ( currentTime - time[o] ) * xlog) * xlog; 125 | tempTotalWeightB = tempTotalWeightB + weightB; 126 | } 127 | }// closes o-loop 128 | } 129 | }//closes if fourCycleType == negative 130 | 131 | if ( fourCycleType == "standard"){ 132 | // for each person: for each entry in wy: calculate weightA and weightC (p-loop open; q-loop open) 133 | for (int p = 0; p < wy.size(); p++) { 134 | 135 | tempTotalWeightA = 0; 136 | tempTotalWeightC = 0; 137 | 138 | for ( int q = begin; q < i; q++ ) { 139 | weightA = 0; 140 | weightC = 0; 141 | 142 | // calculate weightC (weightC = w_t(i, j)) 143 | if (sender[q] == x[m] && target[q] == wy[p] && attrvarCij[q] == attrCij && time[q] != currentTime ) { 144 | weightC = std::abs(weightvar[q]) * exp( - ( currentTime - time[q] ) * xlog) * xlog; 145 | tempTotalWeightC = tempTotalWeightC + weightC; 146 | } 147 | // calculate weightA (weightA = w_t(a, j)) 148 | if (sender[q] == currentSender && target[q] == wy[p] && attrvarAaj[q] == attrAaj && time[q] != currentTime ) { 149 | weightA = std::abs(weightvar[q]) * exp( - ( currentTime - time[q] ) * xlog) * xlog; 150 | tempTotalWeightA = tempTotalWeightA + weightA; 151 | } 152 | } //closes q-loop 153 | 154 | // close q-loop (backflash on each actor-concept-actor combination) & calculate weight 155 | // for each person (m) and concept in wy (p): 156 | 157 | tempTotalWeightABC = tempTotalWeightA * tempTotalWeightB * tempTotalWeightC; 158 | 159 | // for each person: for each entry = sum up the multiplications 160 | totalWeightABC = tempTotalWeightABC + totalWeightABC; 161 | }//closes p-loop 162 | }//closes if fourCycleType == standard 163 | if ( fourCycleType == "positive" ){ 164 | // for each person: for each entry in wy: calculate weightA and weightC (p-loop open; q-loop open) 165 | for (int p = 0; p < wy.size(); p++) { 166 | 167 | tempTotalWeightAPositive = 0; 168 | tempTotalWeightCPositive = 0; 169 | tempTotalWeightANegative = 0; 170 | tempTotalWeightCNegative = 0; 171 | 172 | for ( int q = begin; q < i; q++ ) { 173 | weightA = 0; 174 | weightC = 0; 175 | 176 | // if both weightA and weightC events are of same type, do this: 177 | // calculate weightC (weightC = w_t(i, j)) 178 | if (sender[q] == x[m] && target[q] == wy[p] && typevar[q] == currentType && attrvarCij[q] == attrCij && time[q] != currentTime ) { 179 | weightC = std::abs(weightvar[q]) * exp( - ( currentTime - time[q] ) * xlog) * xlog; 180 | tempTotalWeightCPositive = tempTotalWeightCPositive + weightC; 181 | } 182 | // calculate weightA (weightA = w_t(a, j)) 183 | if (sender[q] == currentSender && target[q] == wy[p] && typevar[q] == currentType && attrvarAaj[q] == attrAaj && time[q] != currentTime ) { 184 | weightA = std::abs(weightvar[q]) * exp( - ( currentTime - time[q] ) * xlog) * xlog; 185 | tempTotalWeightAPositive = tempTotalWeightAPositive + weightA; 186 | } 187 | // if both weightA and weightC events are of same type and negative, do this: 188 | // calculate weightC (weightC = w_t(i, j)) 189 | if (sender[q] == x[m] && target[q] == wy[p] && typevar[q] != currentType && attrvarCij[q] == attrCij && time[q] != currentTime) { 190 | weightC = std::abs(weightvar[q]) * exp( - ( currentTime - time[q] ) * xlog) * xlog; 191 | tempTotalWeightCNegative = tempTotalWeightCNegative + weightC; 192 | } 193 | // calculate weightA (weightA = w_t(a, j)) 194 | if (sender[q] == currentSender && target[q] == wy[p] && typevar[q] != currentType && attrvarAaj[q] == attrAaj && time[q] != currentTime) { 195 | weightA = std::abs(weightvar[q]) * exp( - ( currentTime - time[q] ) * xlog) * xlog; 196 | tempTotalWeightANegative = tempTotalWeightANegative + weightA; 197 | } 198 | } //closes q-loop 199 | 200 | // close q-loop (backflash on each actor-concept-actor combination) & calculate weight 201 | // for each person (m) and concept in wy (p): 202 | 203 | tempTotalWeightABCPositive = tempTotalWeightAPositive * tempTotalWeightB * tempTotalWeightCPositive; 204 | tempTotalWeightABCNegative = tempTotalWeightANegative * tempTotalWeightB * tempTotalWeightCNegative; 205 | 206 | // for each person: for each entry = sum up the multiplications 207 | totalWeightABCPositive = tempTotalWeightABCPositive + totalWeightABCPositive; 208 | totalWeightABCNegative = tempTotalWeightABCNegative + totalWeightABCNegative; 209 | }//closes p-loop 210 | }//closes if fourCycleType == positive 211 | if ( fourCycleType == "negative" ){ 212 | // for each person: for each entry in wy: calculate weightA and weightC (p-loop open; q-loop open) 213 | for (int p = 0; p < wy.size(); p++) { 214 | 215 | tempTotalWeightAPositive = 0; 216 | tempTotalWeightCPositive = 0; 217 | tempTotalWeightANegative = 0; 218 | tempTotalWeightCNegative = 0; 219 | 220 | for ( int q = begin; q < i; q++ ) { 221 | weightA = 0; 222 | weightC = 0; 223 | 224 | // if both weightA and weightC events are of opposite type, do this: 225 | // calculate weightC (weightC = w_t(i, j)) 226 | if (sender[q] == x[m] && target[q] == wy[p] && typevar[q] == currentType && attrvarCij[q] == attrCij && time[q] != currentTime ) { 227 | weightC = std::abs(weightvar[q]) * exp( - ( currentTime - time[q] ) * xlog) * xlog; 228 | tempTotalWeightCPositive = tempTotalWeightCPositive + weightC; 229 | } 230 | // calculate weightA (weightA = w_t(a, j)) 231 | if (sender[q] == currentSender && target[q] == wy[p] && typevar[q] != currentType && attrvarAaj[q] == attrAaj && time[q] != currentTime ) { 232 | weightA = std::abs(weightvar[q]) * exp( - ( currentTime - time[q] ) * xlog) * xlog; 233 | tempTotalWeightAPositive = tempTotalWeightAPositive + weightA; 234 | } 235 | // if both weightA and weightC events are negative, do this: 236 | // calculate weightC (weightC = w_t(i, j)) 237 | if (sender[q] == x[m] && target[q] == wy[p] && typevar[q] != currentType && attrvarCij[q] == attrCij && time[q] != currentTime) { 238 | weightC = std::abs(weightvar[q]) * exp( - ( currentTime - time[q] ) * xlog) * xlog; 239 | tempTotalWeightCNegative = tempTotalWeightCNegative + weightC; 240 | } 241 | // calculate weightA (weightA = w_t(a, j)) 242 | if (sender[q] == currentSender && target[q] == wy[p] && typevar[q] == currentType && attrvarAaj[q] == attrAaj && time[q] != currentTime ) { 243 | weightA = std::abs(weightvar[q]) * exp( - ( currentTime - time[q] ) * xlog) * xlog; 244 | tempTotalWeightANegative = tempTotalWeightANegative + weightA; 245 | } 246 | } //closes q-loop 247 | 248 | // close q-loop (backflash on each actor-concept-actor combination) & calculate weight 249 | // for each person (m) and concept in wy (p): 250 | 251 | tempTotalWeightABCPositive = tempTotalWeightAPositive * tempTotalWeightB * tempTotalWeightCPositive; 252 | tempTotalWeightABCNegative = tempTotalWeightANegative * tempTotalWeightB * tempTotalWeightCNegative; 253 | 254 | // for each person: for each entry = sum up the multiplications 255 | totalWeightABCPositive = tempTotalWeightABCPositive + totalWeightABCPositive; 256 | totalWeightABCNegative = tempTotalWeightABCNegative + totalWeightABCNegative; 257 | }//closes p-loop 258 | }//closes if fourCycleType == negative 259 | } // m-loop close 260 | 261 | if ( fourCycleType == "standard"){ 262 | totalWeightABC = std::pow(totalWeightABC, 1/3.); //whyever, there has to be a . behind the 1/3 263 | }else{ 264 | totalWeightABC = std::pow(totalWeightABCPositive, 1/3.) + std::pow(totalWeightABCNegative, 1/3.); //wieso auch immer - aber da muss ein Punkt hinter die 3 265 | } 266 | result = totalWeightABC; 267 | 268 | // attrvarNow => in R-loop now 269 | //}else{ //closes "if ( attrvarNow[i] == attrNow ) {}" 270 | // result = 0.0; 271 | //} 272 | return result; 273 | } 274 | 275 | 276 | //#################################################################### 277 | // [[Rcpp::export]] 278 | double similarityTotalAverageCpp( 279 | std::vector sender, 280 | std::string currentSender, 281 | std::vector target, 282 | std::string currentTarget, 283 | NumericVector time, 284 | double currentTime, 285 | std::vector eventAttributeVar, 286 | std::string eventAttribute, 287 | std::vector eventTypeVar, 288 | std::string currentType, 289 | std::string totalAverageSim, 290 | std::string matchNomatchSim, 291 | std::string senderTargetSim, 292 | std::vector v, // sender-sim: v = who else used b (match= in same way); target-sim: v = what else has a said? 293 | std::vector w, // sender-sim: w = what else has a said?; target-sim: w = who else said b? (??match?? here too for target-sim?) 294 | int i, 295 | int begin) { 296 | 297 | double result = 0.0; 298 | std::vector x; 299 | std::vector xw; 300 | std::vector a_positive; 301 | std::vector a_negative; 302 | std::vector i_negative; 303 | std::vector i_positive; 304 | std::vector xwneg; 305 | double totalNumber; 306 | double numberNoMatch; 307 | double numberMatch; 308 | 309 | i_negative.clear(); 310 | a_negative.clear(); 311 | i_positive.clear(); 312 | a_positive.clear(); 313 | xwneg.clear(); 314 | totalNumber = 0; 315 | 316 | // for each entry in v 317 | for (int k = 0; k < v.size(); k++){ 318 | 319 | x.clear(); 320 | xw.clear(); 321 | 322 | if ( senderTargetSim == "sender" ){ 323 | for (int l = begin; l < i; l++) { 324 | // if the event has concept k in v 325 | if (sender[l] == v[k] && time[l] != currentTime && target[l] != currentTarget && eventAttributeVar[l] == eventAttribute) { 326 | x.push_back(target[l]); 327 | } 328 | }//closes l-loop 329 | }else{ 330 | for (int l = begin; l < i; l++) { 331 | // if the event has concept k in v 332 | if (target[l] == v[k] && time[l] != currentTime && sender[l] != currentSender && eventAttributeVar[l] == eventAttribute) { 333 | x.push_back(sender[l]); 334 | } 335 | }//closes l-loop 336 | } 337 | 338 | // clean up x-vector 339 | std::sort( x.begin(), x.end() ); 340 | x.erase( unique( x.begin(), x.end() ), x.end() ); 341 | 342 | // for each entry in v => get intersection between x and w (w = actors who said p/what else has actor a said?) = filter actors who said p and v[k] 343 | xw.clear(); 344 | std::sort( w.begin(), w.end() ); 345 | std::sort( x.begin(), x.end() ); 346 | std::set_intersection (x.begin(), x.end(), w.begin(), w.end(), std::back_inserter(xw) ); 347 | // erase douplicates 348 | sort( xw.begin(), xw.end() ); 349 | xw.erase( unique( xw.begin(), xw.end() ), xw.end() ); 350 | 351 | if ( matchNomatchSim == "match"){ 352 | 353 | // if there acctually is an intersection in xw 354 | if (xw.size() != 0 ) { 355 | 356 | // for each entry in xw: 357 | for (int m = 0; m < xw.size(); m++) { 358 | 359 | i_negative.clear(); 360 | i_positive.clear(); 361 | a_negative.clear(); 362 | a_positive.clear(); 363 | 364 | // loop back over all events until i 365 | for (int n = begin; n < i; n++){ 366 | if ( senderTargetSim == "sender" ){ 367 | if (sender[n] == v[k] && target[n] == xw[m] && eventTypeVar[n] == currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 368 | i_positive.push_back(time[n]); 369 | } 370 | if (sender[n] == v[k] && target[n] == xw[m] && eventTypeVar[n] != currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 371 | i_negative.push_back(time[n]); 372 | } 373 | if (sender[n] == currentSender && target[n] == xw[m] && eventTypeVar[n] == currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 374 | a_positive.push_back(time[n]); 375 | } 376 | if (sender[n] == currentSender && target[n] == xw[m] && eventTypeVar[n] != currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 377 | a_negative.push_back(time[n]); 378 | } 379 | }else{ 380 | if (target[n] == v[k] && sender[n] == xw[m] && eventTypeVar[n] == currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 381 | i_positive.push_back(time[n]); 382 | } 383 | if (target[n] == v[k] && sender[n] == xw[m] && eventTypeVar[n] != currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 384 | i_negative.push_back(time[n]); 385 | } 386 | if (target[n] == currentTarget && sender[n] == xw[m] && eventTypeVar[n] == currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 387 | a_positive.push_back(time[n]); 388 | } 389 | if (target[n] == currentTarget && sender[n] == xw[m] && eventTypeVar[n] != currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 390 | a_negative.push_back(time[n]); 391 | } 392 | }//closes senderTargetSim == target 393 | }//closes n-loop 394 | }//closes m-loop 395 | 396 | }//closes if xw.size != 0 397 | 398 | numberNoMatch = 0; 399 | numberMatch = 0; 400 | 401 | //how large are the respextive vectors with the matches in them? 402 | if (a_positive.size() >= i_positive.size() && i_positive.size() != 0 ) { 403 | numberMatch = i_positive.size(); 404 | } 405 | if (a_negative.size() >= i_negative.size() && i_negative.size() != 0) { 406 | numberNoMatch = i_negative.size(); 407 | } 408 | if (i_positive.size() > a_positive.size() && a_positive.size() != 0) { 409 | numberMatch = a_positive.size(); 410 | } 411 | if (i_negative.size() > a_negative.size() && a_negative.size() != 0) { 412 | numberNoMatch = a_negative.size(); 413 | } 414 | //// how many actors used concept v[k] in same manner as a? // how many concepts are used by both in same manner? 415 | totalNumber = totalNumber + numberNoMatch + numberMatch; 416 | }else{ // if matchNomatchSim = "nomatch" 417 | // how many actors used concept v[k]? // how many concepts are used by both? 418 | totalNumber = totalNumber + xw.size(); 419 | } 420 | 421 | }//closes k-loop 422 | 423 | if (totalAverageSim == "total") { 424 | result = totalNumber; 425 | } 426 | if (totalAverageSim == "average") { 427 | result = totalNumber/v.size(); //TODO: correct to divide by v.size? 428 | } 429 | 430 | return result; 431 | } 432 | 433 | 434 | //#################################################################### 435 | // [[Rcpp::export]] 436 | double similaritySimpleCpp( 437 | std::vector sender, 438 | std::string currentSender, 439 | std::vector target, 440 | std::string currentTarget, 441 | NumericVector time, 442 | double currentTime, 443 | double xlog, 444 | std::vector eventAttributeVar, 445 | std::string eventAttribute, 446 | std::vector eventTypeVar, 447 | std::string currentType, 448 | std::string matchNomatchSim, 449 | std::string senderTargetSim, 450 | std::vector v, // sender-sim: v = who else used b (match= in same way); target-sim: v = what else has a said? 451 | std::vector w, // sender-sim: w = what else has a said?; target-sim: w = who else said b? (??match?? here too for target-sim?) 452 | int i, 453 | int begin) { 454 | 455 | double result = 0; 456 | std::vector x; 457 | std::vector xw; 458 | double a_positive; 459 | double a_negative; 460 | double i_negative; 461 | double i_positive; 462 | std::vector xwneg; 463 | double totalNumber = 0; 464 | double timePLast = 0; 465 | int counter = 0; 466 | double totalSim = 0; 467 | double weightSim; 468 | 469 | // for each entry in v 470 | for (int k = 0; k < v.size(); k++){ 471 | 472 | x.clear(); 473 | xw.clear(); 474 | totalNumber = 0; 475 | 476 | if ( senderTargetSim == "sender" ){ 477 | for (int l = begin; l < i; l++) { 478 | // if the event has concept k in v 479 | if (sender[l] == v[k] && time[l] != currentTime && target[l] != currentTarget && eventAttributeVar[l] == eventAttribute) { 480 | x.push_back(target[l]); 481 | } 482 | }//closes l-loop 483 | }else{ 484 | for (int l = begin; l < i; l++) { 485 | // if the event has concept k in v 486 | if (target[l] == v[k] && time[l] != currentTime && sender[l] != currentSender && eventAttributeVar[l] == eventAttribute) { 487 | x.push_back(sender[l]); 488 | } 489 | }//closes l-loop 490 | } 491 | 492 | // clean up x-vector 493 | std::sort( x.begin(), x.end() ); 494 | x.erase( unique( x.begin(), x.end() ), x.end() ); 495 | 496 | // for each entry in v => get intersection between x and w (w = actors who said p/what else has actor a said?) = filter actors who said p and v[k] 497 | xw.clear(); 498 | std::sort( w.begin(), w.end() ); 499 | std::sort( x.begin(), x.end() ); 500 | std::set_intersection (x.begin(), x.end(), w.begin(), w.end(), std::back_inserter(xw) ); 501 | // erase douplicates 502 | sort( xw.begin(), xw.end() ); 503 | xw.erase( unique( xw.begin(), xw.end() ), xw.end() ); 504 | 505 | 506 | // Match: check for each overlaping actor/target in xw, whether the type matches 507 | if ( matchNomatchSim == "match"){ 508 | 509 | // if there acctually is an intersection in xw 510 | if (xw.size() != 0 ) { 511 | 512 | // for each entry in xw: 513 | for (int m = 0; m < xw.size(); m++) { 514 | // 515 | i_negative = 0; 516 | i_positive = 0; 517 | a_negative = 0; 518 | a_positive = 0; 519 | 520 | //check if a and i used the same type. If they used a certan type = give them a 1 - then compare if both a and i have 1 in the same type-cateogry 521 | for (int n = begin; n < i; n++){ 522 | if ( senderTargetSim == "sender" ){ 523 | if (sender[n] == v[k] && target[n] == xw[m] && eventTypeVar[n] == currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 524 | i_positive = 1; 525 | } 526 | if (sender[n] == v[k] && target[n] == xw[m] && eventTypeVar[n] != currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 527 | i_negative = 1; 528 | } 529 | if (sender[n] == currentSender && target[n] == xw[m] && eventTypeVar[n] == currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 530 | a_positive = 1; 531 | } 532 | if (sender[n] == currentSender && target[n] == xw[m] && eventTypeVar[n] != currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 533 | a_negative = 1; 534 | } 535 | }else{ 536 | if (target[n] == v[k] && sender[n] == xw[m] && eventTypeVar[n] == currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 537 | i_positive = 1; 538 | } 539 | if (target[n] == v[k] && sender[n] == xw[m] && eventTypeVar[n] != currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 540 | i_negative = 1; 541 | } 542 | if (target[n] == currentTarget && sender[n] == xw[m] && eventTypeVar[n] == currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 543 | a_positive = 1; 544 | } 545 | if (target[n] == currentTarget && sender[n] == xw[m] && eventTypeVar[n] != currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 546 | a_negative = 1; 547 | } 548 | }//closes senderTargetSim == target 549 | }//closes n-loop 550 | // compare a_positive with i_positive and a_negative with i_negative, if they match, add +1 to totalNumber 551 | // technically: totalNumber can be twice xw.size() => if all actors/targets use both positive and negative targets 552 | if(a_positive == 1 && i_positive == 1){ 553 | totalNumber = totalNumber + 1; 554 | } 555 | if(a_negative == 1 && i_negative == 1){ 556 | totalNumber = totalNumber + 1; 557 | } 558 | }//closes m-loop 559 | }//closes if xw.size != 0 560 | 561 | }else{ // if matchNomatchSim = "nomatch" 562 | 563 | // how many actors used concept v[k]? // how many concepts are used by both? 564 | totalNumber = totalNumber + xw.size(); 565 | }//closes matchNomatchSim == "nomatch" 566 | 567 | // how many actors used concept v[k]? // how many concepts are used by both? 568 | if ( xw.size() != 0 ){ 569 | // find time for the time-discount in the simple-similarity equation 570 | if ( senderTargetSim == "sender"){ 571 | // find time, when actor k used concept $p$ last 572 | for (int q = i-1; q >= begin; q--){ 573 | if ( matchNomatchSim == "nomatch"){ 574 | if (sender[q] == v[k] && target[q] == currentTarget && time[q] != currentTime && 575 | eventAttributeVar[q] == eventAttribute){ 576 | timePLast = time[q]; 577 | break; 578 | } 579 | }else if (matchNomatchSim == "match"){ 580 | if (sender[q] == v[k] && target[q] == currentTarget && time[q] != currentTime && 581 | eventAttributeVar[q] == eventAttribute && eventTypeVar[q] == currentType ){ 582 | timePLast = time[q]; 583 | break; 584 | } 585 | } 586 | }//closes q-loop 587 | }else if ( senderTargetSim == "target"){ 588 | // find time, when target k was last used by $a$ 589 | for (int q = i-1; q >= begin; q--){ 590 | if (matchNomatchSim == "nomatch"){ 591 | if (target[q] == v[k] && sender[q] == currentSender && time[q] != currentTime && 592 | eventAttributeVar[q] == eventAttribute){ 593 | timePLast = time[q]; 594 | break; 595 | } 596 | } else if (matchNomatchSim == "match"){ 597 | if (target[q] == v[k] && sender[q] == currentSender && time[q] != currentTime && 598 | eventAttributeVar[q] == eventAttribute && eventTypeVar[q] == currentType ){ 599 | timePLast = time[q]; 600 | break; 601 | } 602 | } 603 | }//closes q-loop 604 | }//closes senderTargetSim == "target" 605 | 606 | // calculate weight of each actor/target 607 | weightSim = totalNumber * exp(-(currentTime - timePLast)*xlog) * xlog; 608 | totalSim = totalSim + weightSim; 609 | if (weightSim != 0) { 610 | counter++; 611 | } 612 | }//closes if xw.size != 0 613 | }//closes k-loop 614 | 615 | if (counter == 0) { 616 | result = 0.0; 617 | }else{ 618 | result = (totalSim/counter); 619 | } 620 | return result; 621 | } 622 | 623 | 624 | //#################################################################### 625 | // [[Rcpp::export]] 626 | double similarityComplexCpp( 627 | std::vector sender, 628 | std::string currentSender, 629 | std::vector target, 630 | std::string currentTarget, 631 | NumericVector time, 632 | double currentTime, 633 | double xlog, 634 | double halflifeTimeDifference, 635 | std::vector eventAttributeVar, 636 | std::string eventAttribute, 637 | std::vector eventTypeVar, 638 | std::string currentType, 639 | std::string matchNomatchSim, 640 | std::string senderTargetSim, 641 | std::vector v, // sender-sim: v = who else used b (match= in same way); target-sim: v = what else has a said? 642 | std::vector w, // sender-sim: w = what else has a said?; target-sim: w = who else said b? (??match?? here too for target-sim?) 643 | int i, 644 | int begin) { 645 | 646 | double result = 0.0; 647 | std::vector x; 648 | std::vector xw; 649 | std::vector xwneg; 650 | std::vector a_positive; 651 | std::vector a_negative; 652 | std::vector i_negative; 653 | std::vector i_positive; 654 | std::vector i_sendertarget; 655 | std::vector a_sendertarget; 656 | double timePLast = 0.0; 657 | int counter = 0; 658 | double totalSim = 0.0; 659 | double weightSim; 660 | double sumCouplePositive; 661 | double sumCoupleNegative; 662 | double couple; 663 | double sumCoupleNoMatch; 664 | double sumConcept = 0.0; 665 | 666 | // for each entry in v 667 | for (int k = 0; k < v.size(); k++){ 668 | 669 | x.clear(); 670 | xw.clear(); 671 | 672 | if ( senderTargetSim == "sender" ){ 673 | for (int l = 0; l < i; l++) { 674 | // if the event has concept k in v 675 | if (sender[l] == v[k] && time[l] != currentTime && target[l] != currentTarget && eventAttributeVar[l] == eventAttribute) { 676 | x.push_back(target[l]); 677 | } 678 | }//closes l-loop 679 | }else{ 680 | for (int l = 0; l < i; l++) { 681 | // if the event has concept k in v 682 | if (target[l] == v[k] && time[l] != currentTime && sender[l] != currentSender && eventAttributeVar[l] == eventAttribute) { 683 | x.push_back(sender[l]); 684 | } 685 | }//closes l-loop 686 | } 687 | 688 | // clean up x-vector 689 | std::sort( x.begin(), x.end() ); 690 | x.erase( unique( x.begin(), x.end() ), x.end() ); 691 | 692 | // for each entry in v => get intersection between x and w (w = actors who said p/what else has actor a said?) = filter actors who said p and v[k] 693 | xw.clear(); 694 | std::sort( w.begin(), w.end() ); 695 | std::sort( x.begin(), x.end() ); 696 | std::set_intersection (x.begin(), x.end(), w.begin(), w.end(), std::back_inserter(xw) ); 697 | // erase douplicates 698 | sort( xw.begin(), xw.end() ); 699 | xw.erase( unique( xw.begin(), xw.end() ), xw.end() ); 700 | 701 | if ( matchNomatchSim == "match"){ 702 | 703 | // if there acctually is an intersection in xw 704 | if (xw.size() != 0 ) { 705 | 706 | // for each entry in xw: 707 | for (int m = 0; m < xw.size(); m++) { 708 | 709 | i_negative.clear(); 710 | i_positive.clear(); 711 | a_negative.clear(); 712 | a_positive.clear(); 713 | i_sendertarget.clear(); 714 | a_sendertarget.clear(); 715 | 716 | // loop back over all events until i 717 | for (int n = 0; n < i; n++){ 718 | if ( senderTargetSim == "sender" ){ 719 | if (sender[n] == v[k] && target[n] == xw[m] && eventTypeVar[n] == currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 720 | i_positive.push_back(time[n]); 721 | } 722 | if (sender[n] == v[k] && target[n] == xw[m] && eventTypeVar[n] != currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 723 | i_negative.push_back(time[n]); 724 | } 725 | if (sender[n] == currentSender && target[n] == xw[m] && eventTypeVar[n] == currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 726 | a_positive.push_back(time[n]); 727 | } 728 | if (sender[n] == currentSender && target[n] == xw[m] && eventTypeVar[n] != currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 729 | a_negative.push_back(time[n]); 730 | } 731 | }else{ 732 | if (target[n] == v[k] && sender[n] == xw[m] && eventTypeVar[n] == currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 733 | i_positive.push_back(time[n]); 734 | } 735 | if (target[n] == v[k] && sender[n] == xw[m] && eventTypeVar[n] != currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 736 | i_negative.push_back(time[n]); 737 | } 738 | if (target[n] == currentTarget && sender[n] == xw[m] && eventTypeVar[n] == currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 739 | a_positive.push_back(time[n]); 740 | } 741 | if (target[n] == currentTarget && sender[n] == xw[m] && eventTypeVar[n] != currentType && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 742 | a_negative.push_back(time[n]); 743 | } 744 | }//closes senderTargetSim == target 745 | }//closes n-loop 746 | }//closes m-loop 747 | }//closes if xw.size != 0 748 | 749 | sumCouplePositive = 0; 750 | sumCoupleNegative = 0; 751 | couple = 0; 752 | 753 | //how large are the respextive vectors with the matches in them? 754 | if (a_positive.size() >= i_positive.size() && i_positive.size() != 0 ) { 755 | for (int p = 0; p < i_positive.size(); p++){ 756 | couple = 1 * exp(-(std::abs(i_positive[p]-a_positive[p]))*(log(2.0)/halflifeTimeDifference)); 757 | sumCouplePositive = sumCouplePositive + couple; 758 | couple = 0; 759 | } 760 | } 761 | if (a_negative.size() >= i_negative.size() && i_negative.size() != 0) { 762 | for (int p = 0; p < i_negative.size(); p++){ 763 | couple = 1 * exp(-(std::abs(i_negative[p]-a_negative[p]))*(log(2.0)/halflifeTimeDifference)); 764 | sumCoupleNegative = sumCoupleNegative + couple; 765 | couple = 0; 766 | } 767 | } 768 | if (i_positive.size() > a_positive.size() && a_positive.size() != 0) { 769 | for (int p = 0; p < a_positive.size(); p++){ 770 | couple = 1 * exp(-(std::abs(i_positive[p]-a_positive[p]))*(log(2.0)/halflifeTimeDifference)); 771 | sumCouplePositive = sumCouplePositive + couple; 772 | couple = 0; 773 | } 774 | } 775 | if (i_negative.size() > a_negative.size() && a_negative.size() != 0) { 776 | for (int p = 0; p < a_negative.size(); p++){ 777 | couple = 1 * exp(-(std::abs(i_negative[p]-a_negative[p]))*(log(2.0)/halflifeTimeDifference)); 778 | sumCoupleNegative = sumCoupleNegative + couple; 779 | couple = 0; 780 | } 781 | } 782 | //// how many actors used concept v[k] in same manner as a? // how many concepts are used by both in same manner? 783 | sumConcept = sumConcept + sumCoupleNegative + sumCouplePositive; 784 | }else{ // if matchNomatchSim = "nomatch" 785 | // if there acctually is an intersection in xw 786 | if (xw.size() != 0 ) { 787 | 788 | // for each entry in xw: 789 | for (int m = 0; m < xw.size(); m++) { 790 | i_sendertarget.clear(); 791 | a_sendertarget.clear(); 792 | 793 | // loop back over all events until i 794 | for (int n = 0; n < i; n++){ 795 | if ( senderTargetSim == "sender" ){ 796 | if (sender[n] == v[k] && target[n] == xw[m] && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 797 | i_sendertarget.push_back(time[n]); 798 | } 799 | if (sender[n] == currentSender && target[n] == xw[m] && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 800 | a_sendertarget.push_back(time[n]); 801 | } 802 | }else{ 803 | if (target[n] == v[k] && sender[n] == xw[m] && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 804 | i_sendertarget.push_back(time[n]); 805 | } 806 | if (target[n] == currentTarget && sender[n] == xw[m] && time[n] != currentTime && eventAttributeVar[n] == eventAttribute){ 807 | a_sendertarget.push_back(time[n]); 808 | } 809 | }//closes senderTargetSim == target 810 | }//closes n-loop 811 | }//closes m-loop 812 | }//closes xw.size() != 0 813 | 814 | sumCoupleNoMatch = 0; 815 | 816 | //how large are the respextive vectors with the matches in them? 817 | if (a_sendertarget.size() >= i_sendertarget.size() && i_sendertarget.size() != 0) { 818 | for (int p = 0; p < i_negative.size(); p++){ 819 | couple = 1 * exp(-(std::abs(i_sendertarget[p]-a_sendertarget[p]))*(log(2.0)/halflifeTimeDifference)); 820 | sumCoupleNoMatch = sumCoupleNoMatch + couple; 821 | couple = 0; 822 | } 823 | } 824 | if (i_sendertarget.size() > a_sendertarget.size() && a_sendertarget.size() != 0) { 825 | for (int p = 0; p < a_positive.size(); p++){ 826 | couple = 1 * exp(-(std::abs(i_sendertarget[p]-a_sendertarget[p]))*(log(2.0)/halflifeTimeDifference)); 827 | sumCoupleNoMatch = sumCoupleNoMatch + couple; 828 | couple = 0; 829 | } 830 | } 831 | //add them together 832 | sumConcept = sumConcept + sumCoupleNoMatch; 833 | }//closes matchNomatchSim == "nomatch" 834 | 835 | // how many actors used concept v[k]? // how many concepts are used by both? 836 | if ( xw.size() != 0 ){ 837 | // find time for the time-discount in the simple-similarity equation 838 | if ( senderTargetSim == "sender"){ 839 | // find time, when actor k used concept $p$ last 840 | for (int q = i-1; q >= 0; q--){ 841 | if ( matchNomatchSim == "nomatch"){ 842 | if (sender[q] == v[k] && target[q] == currentTarget && time[q] != currentTime && 843 | eventAttributeVar[q] == eventAttribute){ 844 | timePLast = time[q]; 845 | break; 846 | } 847 | }else if (matchNomatchSim == "match"){ 848 | if (sender[q] == v[k] && target[q] == currentTarget && time[q] != currentTime && 849 | eventAttributeVar[q] == eventAttribute && eventTypeVar[q] == currentType){ 850 | timePLast = time[q]; 851 | break; 852 | } 853 | } 854 | }//closes q-loop 855 | }else if ( senderTargetSim == "target"){ 856 | // find time, when target k was last used by $a$ 857 | for (int q = i-1; q >= 0; q--){ 858 | if (matchNomatchSim == "nomatch"){ 859 | if (target[q] == v[k] && sender[q] == currentSender && time[q] != currentTime && 860 | eventAttributeVar[q] == eventAttribute){ 861 | timePLast = time[q]; 862 | break; 863 | } 864 | } else if (matchNomatchSim == "match"){ 865 | if (target[q] == v[k] && sender[q] == currentSender && time[q] != currentTime && 866 | eventAttributeVar[q] == eventAttribute && eventTypeVar[q] == currentType){ 867 | timePLast = time[q]; 868 | break; 869 | } 870 | } 871 | }//closes q-loop 872 | }//closes senderTargetSim == "target" 873 | 874 | // calculate weight of each actor/target 875 | weightSim = sumConcept * exp(-(currentTime-timePLast)*xlog) * xlog; 876 | totalSim = totalSim + weightSim; 877 | if (weightSim != 0) { 878 | counter++; 879 | } 880 | }//closes if xw.size != 0 881 | }//closes k-loop 882 | 883 | if (counter == 0) { 884 | result = 0.0; 885 | }else{ 886 | result = (totalSim/counter); 887 | } 888 | return result; 889 | } 890 | 891 | 892 | //#################################################################### 893 | // [[Rcpp::export]] 894 | double triadCpp( 895 | std::vector v, // intersection x and y 896 | std::vector sender, 897 | std::vector target, 898 | NumericVector time, 899 | NumericVector weightvar, 900 | std::vector typevar, 901 | std::string typeA, 902 | std::string typeB, 903 | std::vector attributevarAI, 904 | std::string attrAI, 905 | std::vector attributevarBI, 906 | std::string attrBI, 907 | double xlog, 908 | int i, 909 | std::string currentSender, 910 | std::string currentTarget, 911 | double currentTime) { 912 | 913 | double result = 0.0; 914 | double weighta; 915 | double weightb; 916 | double totalweighta; 917 | double totalweightb; 918 | double weightab = 0.0; 919 | double totalweight = 0.0; 920 | 921 | // for each entry in v 922 | for (int j = 0; j < v.size(); j++) { 923 | totalweighta = 0.0; 924 | totalweightb = 0.0; 925 | for ( int z = 0; z < i-1; z++ ) { 926 | weighta = 0.0; 927 | weightb = 0.0; 928 | //caluculate weighta 929 | if ( ( (sender[z] == currentSender && target[z] == v[j]) || 930 | (target[z] == currentSender && sender[z] == v[j]) ) && typevar[z] == typeA && 931 | attributevarAI[z] == attrAI && time[z] != currentTime ){ 932 | weighta = std::abs(weightvar[z]) * exp( - ( currentTime - time[z] ) * xlog) * xlog; 933 | totalweighta = totalweighta + weighta; 934 | } 935 | //calculate weightb 936 | if ( ( (sender[z] == currentTarget && target[z] == v[j]) || 937 | (target[z] == currentTarget && sender[z] == v[j]) ) && typevar[z] == typeB && 938 | attributevarBI[z] == attrBI && time[z] != currentTime ){ 939 | weightb = std::abs(weightvar[z]) * exp( - ( currentTime- time[z] ) * xlog) * xlog; 940 | totalweightb = totalweightb + weightb; 941 | } 942 | } //closes z-loop 943 | 944 | // multiply totalweighta times totalweightb 945 | weightab = totalweighta * totalweightb; 946 | totalweight = totalweight + weightab; 947 | } //closes j-loop 948 | //take the squared rood of totalweight 949 | result = sqrt(totalweight); 950 | return result; 951 | } 952 | 953 | 954 | //#################################################################### 955 | // [[Rcpp::export]] 956 | double weightTimesSummationCpp( 957 | NumericVector pastSenderTimes, 958 | double xlog, 959 | double currentTime, 960 | NumericVector weightvar) { 961 | 962 | double totalWeight = 0.0; 963 | double weight = 0.0; 964 | double result = 0.0; 965 | 966 | // for each bill that the current sender has cosponsored in past 967 | for (int j = 0; j < pastSenderTimes.size(); j++){ 968 | weight = weightvar[j] * exp( - ( currentTime - pastSenderTimes[j] ) * xlog) * xlog; 969 | totalWeight = totalWeight + weight ; 970 | }// close j-loop 971 | 972 | result = totalWeight; 973 | return result; 974 | } 975 | 976 | 977 | // //#################################################################### 978 | // // [[Rcpp::export]] 979 | // DataFrame createNullEvents( 980 | // std::vector eventID, 981 | // std::vector sender, 982 | // std::vector target, 983 | // std::vector eventAttribute, 984 | // std::vector time, 985 | // std::vector start, 986 | // std::vector end, 987 | // std::vector allEventTimes) { 988 | // 989 | // DataFrame result; 990 | // std::vector eventIDNew; 991 | // std::vector senderNew; 992 | // std::vector targetNew; 993 | // std::vector eventAttributeNew; 994 | // NumericVector startNew; 995 | // NumericVector endNew; 996 | // NumericVector eventTime; 997 | // NumericVector eventDummy; 998 | // 999 | // //for each event in the sequence 1000 | // for (int i = 0; i < sender.size(); i++){ 1001 | // 1002 | // //for each event in allEventTimes 1003 | // for(int w = 0; w < allEventTimes.size(); w++){ 1004 | // 1005 | // //for each eventtime between start[i] and end[i] 1006 | // if(allEventTimes[w] >= start[i] && allEventTimes[w] <= end[i]){ 1007 | // 1008 | // eventIDNew.push_back(eventID[i]); 1009 | // senderNew.push_back(sender[i]); 1010 | // targetNew.push_back(target[i]); 1011 | // eventAttributeNew.push_back(eventAttribute[i]); 1012 | // startNew.push_back(start[i]); 1013 | // endNew.push_back(end[i]); 1014 | // eventTime.push_back(allEventTimes[w]); 1015 | // //is it a null-event or a true-event? 1016 | // if(time[i] == allEventTimes[w]){ 1017 | // eventDummy.push_back(1); 1018 | // }else{ 1019 | // eventDummy.push_back(0); 1020 | // } 1021 | // 1022 | // } 1023 | // }//closes w-loop 1024 | // }//closes i-loop 1025 | // 1026 | // //combine all vectors into one 1027 | // result = Rcpp::DataFrame::create(Rcpp::Named("eventID") = eventIDNew, 1028 | // Rcpp::Named("sender") = senderNew, 1029 | // Rcpp::Named("target") = targetNew, 1030 | // Rcpp::Named("eventTime") = eventTime, 1031 | // Rcpp::Named("eventDummy") = eventDummy, 1032 | // Rcpp::Named("eventAtRiskFrom") = startNew, 1033 | // Rcpp::Named("eventAtRiskUntil") = endNew, 1034 | // Rcpp::Named("eventAttribute") = eventAttributeNew); 1035 | // return Rcpp::wrap(result); 1036 | // } 1037 | 1038 | //#################################################################### 1039 | // [[Rcpp::export]] 1040 | DataFrame createNullEvents( 1041 | std::vector eventID, 1042 | std::vector sender, 1043 | std::vector target, 1044 | std::vector eventAttribute, 1045 | std::vector time, 1046 | std::vector start, 1047 | std::vector end, 1048 | std::vector allEventTimes, 1049 | double nrows) { 1050 | 1051 | DataFrame result; 1052 | std::vector eventIDNew(nrows); 1053 | std::vector senderNew(nrows); 1054 | std::vector targetNew(nrows); 1055 | std::vector eventAttributeNew(nrows); 1056 | NumericVector startNew(nrows); 1057 | NumericVector endNew(nrows); 1058 | NumericVector eventTime(nrows); 1059 | NumericVector eventDummy(nrows); 1060 | double counter; 1061 | 1062 | counter = 0; 1063 | 1064 | //for each event in the sequence 1065 | for (int i = 0; i < sender.size(); i++){ 1066 | 1067 | //for each event in allEventTimes 1068 | for(int w = 0; w < allEventTimes.size(); w++){ 1069 | 1070 | //for each eventtime between start[i] and end[i] 1071 | if(allEventTimes[w] >= start[i] && allEventTimes[w] <= end[i]){ 1072 | 1073 | eventIDNew[counter] = eventID[i]; 1074 | senderNew[counter] = sender[i]; 1075 | targetNew[counter] = target[i]; 1076 | eventAttributeNew[counter] = eventAttribute[i]; 1077 | startNew[counter] = start[i]; 1078 | endNew[counter] = end[i]; 1079 | eventTime[counter] = allEventTimes[w]; 1080 | //is it a null-event or a true-event? 1081 | if(time[i] == allEventTimes[w]){ 1082 | eventDummy[counter] = 1; 1083 | }else{ 1084 | eventDummy[counter] = 0; 1085 | } 1086 | 1087 | counter++; 1088 | 1089 | } 1090 | }//closes w-loop 1091 | }//closes i-loop 1092 | 1093 | //combine all vectors into one 1094 | result = Rcpp::DataFrame::create(Rcpp::Named("eventID") = eventIDNew, 1095 | Rcpp::Named("sender") = senderNew, 1096 | Rcpp::Named("target") = targetNew, 1097 | Rcpp::Named("eventTime") = eventTime, 1098 | Rcpp::Named("eventDummy") = eventDummy, 1099 | Rcpp::Named("eventAtRiskFrom") = startNew, 1100 | Rcpp::Named("eventAtRiskUntil") = endNew, 1101 | Rcpp::Named("eventAttribute") = eventAttributeNew); 1102 | return Rcpp::wrap(result); 1103 | } --------------------------------------------------------------------------------