Using SINT

This guide shows how to specify, analyze and simulate social influence network models with SINT. It is organized by task: each section answers one practical question and can be read on its own after the first two.

The model

SINT is built around the Friedkin-Johnsen model of social influence (Friedkin and Johnsen 1990, 1999). A group of \(n\) agents holds opinions \(y(t) \in \mathbb{R}^n\) that evolve in discrete time as

\[y(t+1) = \Lambda W y(t) + (I - \Lambda) y(0),\]

where \(W = [w_{ij}]\) is the influence matrix, \(w_{ij}\) being the weight that agent \(i\) gives to the opinion of agent \(j\), and \(\Lambda = \mathrm{diag}(\lambda_1, \dots, \lambda_n)\) collects the susceptibilities. Each agent combines the opinions of others, with weight \(\lambda_i\), and its own initial opinion, with weight \(1 - \lambda_i\). With \(\Lambda = I\) the model reduces to the consensus model of DeGroot (1974).

The package has three layers, which can be used separately:

the latent dynamics above, analyzed in closed form (fj_check(), fj_equilibrium(), fj_influence()) or simulated (fj_simulate(), sint_simulate());
an optional response stage that maps latent opinions to manifest responses (response_logistic(), response_threshold(), climate_balance());
an aggregation stage that maps manifest responses to a collective outcome (aggregate_quota()).

Specifying a model

A model is given by a square matrix W, a vector of susceptibilities lambda and a vector of initial opinions y0. When W is non-negative it must be row-stochastic. Influence weights are often easier to state on an arbitrary scale and then normalize with row_normalize():

raw <- matrix(c(3, 1, 0, 0,
                1, 2, 1, 0,
                0, 1, 2, 1,
                0, 0, 1, 3), nrow = 4, byrow = TRUE,
              dimnames = list(LETTERS[1:4], LETTERS[1:4]))
W <- row_normalize(raw)
W
#>      A    B    C    D
#> A 0.75 0.25 0.00 0.00
#> B 0.25 0.50 0.25 0.00
#> C 0.00 0.25 0.50 0.25
#> D 0.00 0.00 0.25 0.75

lambda <- c(0.9, 0.6, 0.6, 0.9)
y0 <- c(0, 0.3, 0.7, 1)

lambda may also be a single number, which is recycled. A susceptibility of 0 makes an agent fully anchored to its initial opinion; a susceptibility of 1 makes it fully open to influence. Row and column names of W are carried to the results.

Network data stored as igraph graphs or network objects can be converted with influence_matrix(), which extracts the adjacency matrix, optionally valued with an edge attribute, and normalizes its rows. By default an edge from \(i\) to \(j\) means that \(i\) attends to \(j\); use direction = "influence" when edges point from the influencing agent to the influenced one. Agents without ties are given a unit self-weight, with a warning.

g <- igraph::graph_from_adjacency_matrix(raw, mode = "directed",
                                         weighted = TRUE)
all.equal(influence_matrix(g, weights = "weight"), W)
#> [1] TRUE

Checking convergence

fj_check() validates the inputs and reports the spectral radius of \(\Lambda W\) and its infinity norm:

fj_check(W, lambda)
#> $n
#> [1] 4
#> 
#> $signed
#> [1] FALSE
#> 
#> $spectral_radius
#> [1] 0.7779211
#> 
#> $norm_inf
#> [1] 0.9
#> 
#> $converges
#> [1] TRUE

When the spectral radius is below one, \((I - \Lambda W)\) is invertible and the dynamics converge to a unique fixed point from any initial condition; converges is then TRUE. The infinity norm is an upper bound for the spectral radius and equals \(\max_i \lambda_i\) when W is row-stochastic, so \(\lambda_i < 1\) for all agents is sufficient for convergence. It is not necessary: agents with \(\lambda_i = 1\) are allowed as long as the influence of anchored agents reaches them.

fj_check(W, c(1, 1, 0.5, 1))$converges
#> [1] TRUE

In the DeGroot case no agent is anchored, the spectral radius is one and there is no unique fixed point:

fj_check(W, 1)$converges
#> [1] FALSE

Computing equilibria and total influence

The fixed point is

\[y^* = (I - \Lambda W)^{-1} (I - \Lambda) y(0) = V y(0),\]

and fj_equilibrium() computes it directly:

fj_equilibrium(W, lambda, y0)
#>         A         B         C         D 
#> 0.2505155 0.3618557 0.6381443 0.7494845

The matrix \(V = (I - \Lambda W)^{-1} (I - \Lambda)\), returned by fj_influence(), gives the total effect of each initial opinion (columns) on each equilibrium opinion (rows), after all direct and indirect paths of influence have been accounted for:

V <- fj_influence(W, lambda)
round(V, 3)
#>       A     B     C     D
#> A 0.365 0.496 0.125 0.014
#> B 0.083 0.716 0.180 0.021
#> C 0.021 0.180 0.716 0.083
#> D 0.014 0.125 0.496 0.365

When W is non-negative the rows of V sum to one, so each equilibrium opinion is a weighted average of the initial opinions. The diagonal of V shows how much of its own initial opinion each agent retains, and the column sums summarize how much each agent’s initial opinion contributes to the equilibrium opinions of the group:

rowSums(V)
#> A B C D 
#> 1 1 1 1
diag(V)
#>         A         B         C         D 
#> 0.3649129 0.7163171 0.7163171 0.3649129
colSums(V)
#>         A         B         C         D 
#> 0.4827586 1.5172414 1.5172414 0.4827586

Both functions stop with an error when the dynamics do not converge.

Reproducing a published example

Parsegov et al. (2017) analyze a group of four actors whose influence matrix was reconstructed from experimental data with the method of Friedkin and Johnsen (1999). The susceptibilities follow the coupling condition \(\Lambda = I - \mathrm{diag}(W)\), and actor 3, with \(w_{33} = 1\), is totally stubborn:

W_p <- matrix(c(0.220, 0.120, 0.360, 0.300,
                0.147, 0.215, 0.344, 0.294,
                0,     0,     1,     0,
                0.090, 0.178, 0.446, 0.286), nrow = 4, byrow = TRUE)
lambda_p <- 1 - diag(W_p)
lambda_p
#> [1] 0.780 0.785 0.000 0.714

The authors consider opinions on two independent issues, with initial opinions \((25, 25, 75, 85)\) and \((25, 15, -50, 5)\), and report the equilibria \((60, 60, 75, 75)\) and \((-19.3, -21.5, -50, -23.2)\). Since the issues are independent, each is a separate Friedkin-Johnsen model:

round(fj_equilibrium(W_p, lambda_p, c(25, 25, 75, 85)), 1)
#> [1] 60 60 75 75
round(fj_equilibrium(W_p, lambda_p, c(25, 15, -50, 5)), 1)
#> [1] -19.3 -21.5 -50.0 -23.2

The results agree with the published values up to their rounding. The package test suite checks this example.

Simulating trajectories

fj_simulate() iterates the dynamics until the largest change between two steps falls below tol or max_steps is reached, and returns the whole trajectory:

sim <- fj_simulate(W, lambda, y0)
sim$steps
#> [1] 67
sim$converged
#> [1] TRUE
tail(sim$trajectory, 1)
#>               A         B         C         D
#> [68,] 0.2505155 0.3618557 0.6381443 0.7494845

matplot(0:sim$steps, sim$trajectory, type = "l", lty = 1,
        xlab = "t", ylab = "opinion")

Unlike fj_equilibrium(), fj_simulate() also runs when the dynamics do not converge to a unique fixed point. In the DeGroot case it shows the approach to consensus:

tail(fj_simulate(W, 1, y0, max_steps = 5000)$trajectory, 1)
#>          A   B   C   D
#> [131,] 0.5 0.5 0.5 0.5

Working with signed networks

Negative weights represent antagonistic ties, through which an agent moves away from the opinion of another (Altafini 2013). A signed W is accepted when the absolute values in each row sum to at most one, and row_normalize() produces such a matrix from signed raw weights:

raw_signed <- matrix(c( 3,  1, -1,  0,
                        1,  2,  0, -1,
                       -1,  0,  2,  1,
                        0, -1,  1,  3), nrow = 4, byrow = TRUE)
Ws <- row_normalize(raw_signed)
fj_check(Ws, lambda)
#> $n
#> [1] 4
#> 
#> $signed
#> [1] TRUE
#> 
#> $spectral_radius
#> [1] 0.7698571
#> 
#> $norm_inf
#> [1] 0.9
#> 
#> $converges
#> [1] TRUE
fj_equilibrium(Ws, lambda, y0)
#> [1] -0.18943519  0.04365821  0.52777036  0.40682649

With signed weights the rows of \(V\) need not sum to one, equilibrium opinions are no longer weighted averages of the initial opinions and may fall outside their range. The convergence criterion is the same.

Representing external sources

A source whose opinion does not change, such as a media outlet or an advocacy organization, is an agent with susceptibility 0 and a unit self-weight. Its row in W is a row of the identity matrix, so it influences others without being influenced:

raw_src <- cbind(raw, S = c(2, 0, 0, 0))
raw_src <- rbind(raw_src, S = c(0, 0, 0, 0, 1))
W_src <- row_normalize(raw_src)
lambda_src <- c(lambda, 0)
y0_src <- c(y0, 1)
names(y0_src) <- rownames(W_src)

fj_equilibrium(W_src, lambda_src, y0_src)
#>         A         B         C         D         S 
#> 0.6700585 0.4568813 0.6620540 0.7660374 1.0000000

The source holds opinion 1 and pulls agent A, and through A the rest of the group, towards it.

Making influence depend on time and state

sint_simulate() accepts W and lambda either as fixed objects or as functions with arguments (t, y, P), where t is the current time, y the current latent opinions and P the current manifest responses (NULL when there is no response stage). Each function must return a valid input for fj_check(). The simulation runs for a fixed number of steps. When W is a function, agent names are taken from y0.

Here the source is active only at times 1 to 3, when it raises agent A’s susceptibility:

lambda_campaign <- function(t, y, P) {
  if ((t + 1) %in% 1:3) c(0.98, 0.6, 0.6, 0.9, 0) else lambda_src
}
sim_t <- sint_simulate(W_src, lambda_campaign, y0_src, steps = 8)
round(sim_t$y, 3)
#>           A     B     C     D S
#>  [1,] 0.000 0.300 0.700 1.000 1
#>  [2,] 0.376 0.315 0.685 0.932 1
#>  [3,] 0.562 0.374 0.673 0.884 1
#>  [4,] 0.663 0.417 0.670 0.848 1
#>  [5,] 0.661 0.445 0.671 0.823 1
#>  [6,] 0.664 0.453 0.672 0.807 1
#>  [7,] 0.667 0.456 0.670 0.795 1
#>  [8,] 0.669 0.458 0.669 0.788 1
#>  [9,] 0.669 0.458 0.667 0.782 1

The function receives the current time t and returns the susceptibilities used to compute \(y(t+1)\), hence the test on t + 1.

Adding a response stage

Latent opinions need not coincide with what agents express. A response function maps the latent state to manifest responses. SINT provides two constructors, which return functions with arguments (t, y, P).

response_logistic() gives binary responses with \(\Pr(P_i = 1) = \mathrm{logit}^{-1}(\beta_i (y_i - \delta) + \gamma_i S_i)\), where \(S_i\) is a normative pressure. With stochastic = FALSE it returns the probabilities:

f_log <- response_logistic(beta = 6, delta = 0.5, stochastic = FALSE)
round(f_log(1, y = c(0.1, 0.5, 0.9), P = NULL), 3)
#> [1] 0.083 0.500 0.917

set.seed(1)
f_bin <- response_logistic(beta = 6, delta = 0.5)
f_bin(1, y = c(0.1, 0.5, 0.9), P = NULL)
#> [1] 0 1 1

response_threshold() gives ternary responses: with \(z_i = \beta_i (y_i - \delta) + \gamma_i S_i\), agent \(i\) expresses \(+1\) if \(z_i > \theta\), \(-1\) if \(z_i < -\theta\), and stays silent (0) otherwise. With stochastic = TRUE a logistic error is added to \(z_i\), which gives an ordered logit model:

f_thr <- response_threshold(delta = 0.5, theta = 0.3)
f_thr(1, y = c(0.1, 0.5, 0.9), P = NULL)
#> [1] -1  0  1

The pressure S can be a number, a vector with one value per agent, or a function of the previous manifest responses. climate_balance() computes the balance between expressed support and opposition, \((n^+ - n^-) / (n^+ + n^- + \epsilon)\), and is designed for this use:

f_clim <- response_threshold(delta = 0.5, theta = 0.3, gamma = 0.4,
                             S = function(P) climate_balance(P, eps = 0.1))
f_clim(1, y = c(0.45, 0.5, 0.55), P = NULL)
#> [1] 0 0 0
f_clim(1, y = c(0.45, 0.5, 0.55), P = c(1, 1, 1))
#> [1] 1 1 1

In a simulation, pass the response function to sint_simulate(). Response functions apply to all agents, so a wrapper is useful when some agents, such as external sources, should not respond:

agents <- 1:4
f_group <- response_threshold(
  delta = 0.5, theta = 0.3, gamma = 0.4,
  S = function(P) climate_balance(P[agents], eps = 0.1)
)
respond <- function(t, y, P) {
  out <- f_group(t, y, P)
  out[-agents] <- 0L
  out
}
sim_r <- sint_simulate(W_src, lambda_campaign, y0_src, steps = 8,
                       response = respond)
sim_r$P[, agents]
#>        A B C D
#>  [1,] -1 0 0 1
#>  [2,]  0 0 0 1
#>  [3,]  1 0 1 1
#>  [4,]  1 1 1 1
#>  [5,]  1 1 1 1
#>  [6,]  1 1 1 1
#>  [7,]  1 1 1 1
#>  [8,]  1 1 1 1
#>  [9,]  1 1 1 1

The manifest state can in turn shape influence. In this variant agents give more weight to others who express an opinion than to silent ones:

W_visible <- function(t, y, P) {
  visibility <- 0.2 + 0.8 * abs(P)
  row_normalize(sweep(raw_src, 2, visibility, `*`))
}
sim_v <- sint_simulate(W_visible, lambda_campaign, y0_src, steps = 8,
                       response = respond)
sim_v$P[, agents]
#>        A B C D
#>  [1,] -1 0 0 1
#>  [2,] -1 0 0 1
#>  [3,]  0 0 0 1
#>  [4,]  1 0 1 1
#>  [5,]  1 1 1 1
#>  [6,]  1 1 1 1
#>  [7,]  1 1 1 1
#>  [8,]  1 1 1 1
#>  [9,]  1 1 1 1

Aggregating outcomes

aggregate_quota() maps manifest responses to a collective outcome. It returns 1 when the number of responses equal to 1 exceeds a quota of the group, and 0 otherwise; abstentions and opposing responses count as not in favor. Applied to a matrix, it returns one outcome per time step:

aggregate_quota(sim_r$P[, agents])
#> [1] 0 0 1 1 1 1 1 1 1
aggregate_quota(sim_r$P[, agents], quota = 3 / 4)
#> [1] 0 0 0 1 1 1 1 1 1

Timing conventions in `sint_simulate()`

At each step from \(t\) to \(t + 1\), sint_simulate():

calls W(t, y, P) and lambda(t, y, P) with the state at time \(t\);
computes \(y(t+1) = \Lambda(t) W(t) y(t) + (I - \Lambda(t)) y(0)\);
calls response(t + 1, y, P) with the new latent state \(y(t+1)\) and the previous manifest state \(P(t)\).

When P0 is not supplied, the initial manifest state is response(0, y0, NULL). Response functions built with response_logistic() or response_threshold() treat a functional pressure as 0 when there is no previous manifest state. The anchor \(y(0)\) is always the initial opinion vector y0.