Ch. 8
End-of-Chapter Problems

Q1 The social interactions among a group of 18 monks were recorded by S. Sampson. The data include information about the top three choices for the networks ‘liking at time 3’, ‘disliking’, ‘positive influence’ and ‘negative influence’. Calculate the indegree for each of these four networks, where the networks are dichotomized. Next calculate the heterogeneity of incoming tie types using the IQV measure.


#grab needed matrices

samp = Sampson_Monastery[8:12]

#dichotomize

dsamp = lapply(samp,xDichotomize)

#transpose so we are looking at incoming ties

tdsamp = lapply(dsamp,t)

#get indegree

indeg = sapply(tdsamp,rowSums)

#get heterogeneity of tie types

temp = xMultipleTieComposition(tdsamp,Measures="IQVType")

#display indegree side by side with IQV

cbind(indeg,temp[,6,drop=F])


LikeT1 LikeT2 LikeT3 NegativeInfluence PositiveInfluence IQVType

ROMUALD 1 1 0 1 1 0.9375000

BONAVENTURE 5 7 6 0 2 0.8937500

AMBROSE 2 1 4 0 3 0.8750000

BERTHOLD 1 2 2 5 1 0.8884298

PETER 3 5 4 8 5 0.9720000

LOUIS 2 2 2 2 4 0.9722222

VICTOR 4 2 2 2 0 0.9000000

WINFRID 1 4 6 3 4 0.9490741

JOHN_BOSCO 9 8 4 1 6 0.9343112

GREGORY 7 8 6 3 11 0.9653061

HUGH 6 2 2 1 1 0.8506944

BONIFACE 1 2 2 0 2 0.9183673

MARK 4 3 5 2 6 0.9687500

ALBERT 2 2 1 2 1 0.9765625

AMAND 2 2 2 4 1 0.9504132

BASIL 2 1 3 4 2 0.9548611

ELIAS 1 2 2 6 2 0.8875740

SIMPLICIUS 2 3 3 6 1 0.9222222

Q2 What would the IQV measure tell us if we were to apply it to Sampson’s liking network at three time points?


#grab the three liking matrices

samp = Sampson_Monastery[8:10]

#dichotomize

dsamp = lapply(samp,xDichotomize)

#transpose

tdsamp = lapply(dsamp,t)

#get heterogeneity of tie types

temp = xMultipleTieComposition(tdsamp,Measures="IQVType")

#display just the IQV measure

temp[,4,drop=F]


IQVType

ROMUALD 0.7500000

BONAVENTURE 0.9907407

AMBROSE 0.8571429

BERTHOLD 0.9600000

PETER 0.9791667

LOUIS 1.0000000

VICTOR 0.9375000

WINFRID 0.8429752

JOHN_BOSCO 0.9523810

GREGORY 0.9931973

HUGH 0.8400000

BONIFACE 0.9600000

MARK 0.9791667

ALBERT 0.9600000

AMAND 1.0000000

BASIL 0.9166667

ELIAS 0.9600000

SIMPLICIUS 0.9843750


We can see that Louis and Amand have equal numbers of incoming ties across time periods. Romuald has the most variety, because he doesn't have any ties in Time 3. But all of the monks have fairly equal numbers of ties across time periods.

Q3 Bernard and Killworth recorded the number of amateur ham radio calls made over a one-month period, as monitored by a voice-activated recording device. Using the valued ties in the Ham Radio dataset, calculate the average and standard deviation of tie strength using the calls data.


#grab the calls data

calls = Bernard_HamRadio$Calls

#calculate statistics

temp = xValuedTieComposition(calls,Measures=c("AvStrength","SDStrength"))

#display just the mean and SD of tie strength

temp[,c(2,3)]


AvStrength SDStrength

a01 0.04651163 0.3049971

a02 3.81395349 7.3945147

a03 0.02325581 0.1524986

a04 0.90697674 2.3483931

a05 0.02325581 0.1524986

a06 0.04651163 0.3049971

a07 4.60465116 8.9286578

a08 0.02325581 0.1524986

a09 0.04651163 0.2130826

a10 0.44186047 1.0533919

a11 0.04651163 0.2130826

a12 0.04651163 0.3049971

a13 0.13953488 0.9149914

a14 0.41860465 0.9815575

a15 0.04651163 0.3049971

a16 1.51162791 3.9902983

a17 0.02325581 0.1524986

a18 2.72093023 4.7775546

a19 0.11627907 0.3909270

a20 0.27906977 0.7965874

a21 0.06976744 0.2577696

a22 0.93023256 2.6131112

a23 0.00000000 0.0000000

a24 0.72093023 1.9064500

a25 0.04651163 0.2130826

a26 0.34883721 1.1102063

a27 0.44186047 1.0757572

a28 0.72093023 1.5169767

a29 0.04651163 0.2130826

a30 0.02325581 0.1524986

a31 3.09302326 6.2519100

a32 0.20930233 0.5588312

a33 2.83720930 5.3715752

a34 0.00000000 0.0000000

a35 0.11627907 0.4980582

a36 0.00000000 0.0000000

a37 0.41860465 1.1387662

a38 0.65116279 1.6018400

a39 0.51162791 1.3517553

a40 0.04651163 0.2130826

a41 0.02325581 0.1524986

a42 0.30232558 0.6375132

a43 2.25581395 7.9195148

a44 0.39534884 1.1980050

>

Q4 Lin Freeman collected friendship networks of 32 network scientists at two time points, as well as the number of citations of each of the scientists’ work in the Social Sciences Citation Index. Dichotomize the network data at time 1, so that a tie exists when the colleague is considered a friend or close friend. Calculate the average number of citations of each person's alters.


#get the network data

t1 = xDichotomize(Freeman_EIES$AcquaintanceT1)

#get the citations data

cit = Freeman_EIES$Attributes$Citations

#calculate composition measures

temp = xAlterCompositionCon(t1, cit)

#display each person's own citations along with their alters' citations

cbind(cit,temp[,"AvAlterV",drop=F])

#is there a correlation between a person's citations and their friends'?

cor(cit,temp[,"AvAlterV"])


cit AvAlterV

b01 19 23.032258

b02 3 19.709677

b03 170 17.322581

b06 23 21.709677

b08 16 16.096774

b10 6 5.387097

b11 1 9.096774

b13 9 18.225806

b14 6 4.483871

b18 40 21.838710

b19 15 20.935484

b20 54 15.387097

b21 4 20.096774

b22 46 21.903226

b23 17 20.709677

b24 32 16.161290

b25 23 18.677419

b26 1 12.774194

b27 34 20.483871

b32 64 20.838710

b33 11 22.903226

b35 11 18.870968

b36 31 19.709677

b37 18 22.580645

b38 4 21.580645

b39 0 22.290323

b40 4 17.225806

b41 56 11.516129

b42 12 21.322581

b43 2 17.419355

b44 0 18.387097

b45 1 9.290323

> cor(cit,temp[,"AvAlterV"])

[1] 0.08908977

>

Q5 Freeman also collected the discipline of each scientist (with codes 1 = sociology, 2 = anthropology, 3 = mathematics/statistics, 4 = other). Using the same network data as in the previous question, calculate the diversity with respect to discipline of each person's ego network.


#get the network data (as we did before)

t1 = xDichotomize(Freeman_EIES$AcquaintanceT1)

#get the discipline data

dis = Freeman_EIES$Attributes$Discipline

#calculate composition measures

temp = xAlterCompositionCat(t1, dis)

#display just the part we want

temp[,"IQV",drop=F]


IQV

b01 0.8657648

b02 0.9166667

b03 0.6452426

b06 0.7712665

b08 0.7327824

b10 0.8888889

b11 0.7916667

b13 0.8429752

b14 0.9256198

b18 0.7962963

b19 0.8216761

b20 0.7210884

b21 0.8661333

b22 0.8129252

b23 0.8115942

b24 0.7572016

b25 0.8051708

b26 0.7210884

b27 0.6893424

b32 0.7327824

b33 0.7722667

b35 0.7654321

b36 0.4270833

b37 0.7712665

b38 0.6648199

b39 0.7253333

b40 0.9135802

b41 0.6574331

b42 0.7712665

b43 0.8806584

b44 0.8836292

b45 0.9479167

>

Q6 Considering the discipline data for the same scientists, see if there is any evidence of homophily. In other words, calculate a measure of ego–alter similarity. We recommend Yule's Q.


#get the network data (as before)

t1 = xDichotomize(Freeman_EIES$AcquaintanceT1)

#get the discipline data (as before)

dis = Freeman_EIES$Attributes$Discipline

#calculate ego-alter similarity measures for categorical attributes

temp = xEgoAlterSimilarityCat(t1, dis)

#display just the part we want

temp[,"YulesQ",drop=F]


YulesQ

b01 NaN

b02 1.00000000

b03 -0.72602740

b06 0.64705882

b08 -0.66666667

b10 -0.28000000

b11 -0.19148936

b13 0.28000000

b14 0.83132530

b18 0.55555556

b19 0.36842105

b20 0.44000000

b21 1.00000000

b22 1.00000000

b23 0.36842105

b24 -0.17241379

b25 -0.03225806

b26 0.44000000

b27 0.77777778

b32 0.71929825

b33 1.00000000

b35 0.43089431

b36 0.89090909

b37 0.64705882

b38 0.73333333

b39 1.00000000

b40 1.00000000

b41 0.73333333

b42 0.64705882

b43 0.54838710

b44 1.00000000

b45 1.00000000

>

Q7 Consider Padgett’s marriage network of Florentine families. Characterize the wealth of the families that each family is connected to.


#get the network data

m = Padgett_FlorentineFamilies$Marriage

#get the wealth data

w = Padgett_FlorentineFamilies$Attributes$Wealth

#calculate measures characterizing wealth of families connected by marriage

temp = xAlterCompositionCon(m, w)

#display just the part we want

temp[,c("MinAlterV","MaxAlterV","WAvAlterV")]


MinAlterV MaxAlterV WAvAlterV

ACCIAIUOLI 103 103 103.00000

ALBIZZI 8 103 47.66667

BARBADORI 20 103 61.50000

BISCHERI 8 146 67.66667

CASTELLANI 49 146 83.33333

GINORI 36 36 36.00000

GUADAGNI 36 48 42.50000

LAMBERTESCHI 8 8 8.00000

MEDICI 10 55 31.00000

PAZZI 10 10 10.00000

PERUZZI 20 146 70.00000

PUCCI Inf -Inf NaN

RIDOLFI 48 146 99.00000

SALVIATI 48 103 75.50000

STROZZI 20 49 35.00000

TORNABUONI 8 103 46.00000

Q8 Consider Padgett’s marriage network again. Calculate the constraint measure of structural holes, as well as the density and fragmentation of each node’s ego network.


#get the network data (if you haven't already)

m = Padgett_FlorentineFamilies$Marriage

#calculate measures of structural holes

temp = xStructuralHoles(m, Measures="Constraint", Include="EgoNetwork")

#display just the part we want

temp[,c(2,3)]