################### RscriptSienaTimeTest.r ################################ # # This is an R script to illustrate the use of the # SienaTimeTest function, constructed by Josh Lospinoso, # implementing a test for time heterogeneity # applying the score-type test developed by Michael Schweinberger. # Reference: # Lospinoso, J.A., Schweinberger, M., Snijders, T.A.B, and Ripley, R.M. # "Assessing and Accounting for Time Heterogeneity # in Stochastic Actor Oriented Models". # Advances in Data Analysis and Computation (2011), 5, 147-176. # Also see the sections "Time heterogeneity in model parameters" and # "Testing time heterogeneity in parameters" in the Siena manual . # # R script written by Tom Snijders. # Version January 16, 2017. # This script uses the van de Bunt data (available from the Siena website). # # The earlier version of timeTest used a different, and less appropriate, # way of controlling for the other effects in the effect-wise tests. # At the time of writing the newer, corrected version of timeTest # is available only in RSienaTest. # Earlier versions of this script coded the data wrongly # (so that the data used in Siena had no missing values). # This was corrected in later versions. ############################################################################### # Read the van de Bunt data. # For meaning and codes, consult the Siena website # or the Siena manual. vdb.w0 <- as.matrix(read.table("VRND32T0.DAT")) vdb.w1 <- as.matrix(read.table("VRND32T1.DAT")) vdb.w2 <- as.matrix(read.table("VRND32T2.DAT")) vdb.w3 <- as.matrix(read.table("VRND32T3.DAT")) vdb.w4 <- as.matrix(read.table("VRND32T4.DAT")) vdb.w5 <- as.matrix(read.table("VRND32T5.DAT")) vdb.w6 <- as.matrix(read.table("VRND32T6.DAT")) vdb.attr <- as.matrix(read.table("VARS.DAT")) vdb.w0[vdb.w0 %in% c(6,9)] <- NA vdb.w1[vdb.w1 %in% c(6,9)] <- NA vdb.w2[vdb.w2 %in% c(6,9)] <- NA vdb.w3[vdb.w3 %in% c(6,9)] <- NA vdb.w4[vdb.w4 %in% c(6,9)] <- NA vdb.w5[vdb.w5 %in% c(6,9)] <- NA vdb.w6[vdb.w6 %in% c(6,9)] <- NA # Recode 4 (acquaintance) and 5 (difficult) to no tie vdb.w0[vdb.w0 %in% c(4,5)] <- 0 vdb.w1[vdb.w1 %in% c(4,5)] <- 0 vdb.w2[vdb.w2 %in% c(4,5)] <- 0 vdb.w3[vdb.w3 %in% c(4,5)] <- 0 vdb.w4[vdb.w4 %in% c(4,5)] <- 0 vdb.w5[vdb.w5 %in% c(4,5)] <- 0 vdb.w6[vdb.w6 %in% c(4,5)] <- 0 # Use the "friendly relation" relation by recoding: vdb.w0[vdb.w0 %in% c(1,2,3)] <- 1 vdb.w1[vdb.w1 %in% c(1,2,3)] <- 1 vdb.w2[vdb.w2 %in% c(1,2,3)] <- 1 vdb.w3[vdb.w3 %in% c(1,2,3)] <- 1 vdb.w4[vdb.w4 %in% c(1,2,3)] <- 1 vdb.w5[vdb.w5 %in% c(1,2,3)] <- 1 vdb.w6[vdb.w6 %in% c(1,2,3)] <- 1 # The version of timeTest in RSienaTest is better # (more elaborate, and with a better control for other effects # in the effect-wise tests) than the version in RSiena: library(RSienaTest) # Use waves 1-5: friends <- sienaDependent(array(c(vdb.w1,vdb.w2,vdb.w3,vdb.w4,vdb.w5), dim=c(32, 32, 5))) # Attributes: sex <- coCovar(vdb.attr[,1]) program <- coCovar(vdb.attr[,2]) smoke <- coCovar(vdb.attr[,3]) vdb.data <- sienaDataCreate(friends,sex,program,smoke) vdb.eff <- getEffects(vdb.data) # Model specification: vdb.eff <- includeEffects(vdb.eff,transTrip,cycle3) vdb.eff <- includeEffects(vdb.eff,egoX,altX,simX,interaction1="sex") vdb.eff <- includeEffects(vdb.eff,simX,interaction1="program") vdb.eff <- includeEffects(vdb.eff,simX,interaction1="smoke") vdb.eff # Run the basic model: vdb.algo <- sienaAlgorithmCreate(projname = 'vdb_12345') vdb.ans1 <- siena07(vdb.algo, data=vdb.data, effects=vdb.eff) vdb.ans1 timetest.1 <- sienaTimeTest(vdb.ans1) summary(timetest.1) plot(timetest.1, effects=c(1,3)) # Plots of the one step estimates and approximate standard errors are presented # alongside the diagnostic test results. Type ?sienaTimeTest # for more information on how to use these tools. # The overall heterogeneity test shows strong time heterogeneity. ############################################################################### # We now explore how to deal with the finding of # time heterogeneity, which is one kind of lack of fit, # by allowing heterogeneity in some of the effects. # The aim is to achieve a well-fitting model for this data set. # The outdegree and transitive triplets effect seem to have # time heterogeneity. # First add heterogeneity to the outdegree effect: vdb.eff <- includeTimeDummy(vdb.eff, density, timeDummy="all") vdb.ans2 <- siena07(vdb.algo, data=vdb.data, effects=vdb.eff) vdb.ans2 timetest.2 <- sienaTimeTest(vdb.ans2) summary(timetest.2) plot(timetest.2, effects=c(2,3)) # Repeat in case that the convergence ratios are not all less than 0.10: vdb.ans2 <- siena07(vdb.algo, data=vdb.data, effects=vdb.eff, prevAns=vdb.ans2) vdb.ans2 timetest.2 <- sienaTimeTest(vdb.ans2) summary(timetest.2) plot(timetest.2, effects=c(2,3)) # Four individual dummy variables for time are significant. # The transitive triplets effect has the highest chi-squared value # (although this may differ depending on the random simulations) # and therefore heterogeneity is added to this effect: vdb.eff <- includeTimeDummy(vdb.eff, transTrip, timeDummy="all") vdb.ans3 <- siena07(vdb.algo, data=vdb.data, effects=vdb.eff, prevAns=vdb.ans2) vdb.ans3 timetest.3 <- sienaTimeTest(vdb.ans3) summary(timetest.3) # Now the p-value for overall time heterogeneity has become larger # and the chi-squared value correspondingly, # but it still is strongly significant. # Of the effect-wise heterogeneity tests, only three-cycles effect # shows the strongest time heterogeneity. # Heterogeneity is added to this effect, too. vdb.eff <- includeTimeDummy(vdb.eff, cycle3, timeDummy="all") vdb.ans4 <- siena07(vdb.algo, data=vdb.data, effects=vdb.eff, prevAns=vdb.ans3) vdb.ans4 timetest.4 <- sienaTimeTest(vdb.ans4) summary(timetest.4) # Now the model shows no time heterogeneity any more in the overall test. ############################################################################### # You should note that, as an alternative to the function includeTimeDummy, # # you can define time dummies yourself directly, with identical results. # # This is demonstrated in the help file for sienaTimeTest (from January 2017).# ############################################################################### # Next we explore how to deal with the time heterogeneity # by using the information in the period-wise tests. # The result of timetest.1 for the first model vdb.ans1 # has strongly significant values for periods 1 and 4. # This shows that these two periods differ significantly from the other three, # if it would be assumed that the other three are homogeneous. # Let us drop wave 5. friends1234 <- sienaNet(array(c(vdb.w1,vdb.w2,vdb.w3,vdb.w4), dim=c(32, 32, 4))) vdb.data1234 <- sienaDataCreate(friends1234,sex,program,smoke) vdb.eff1234 <- getEffects(vdb.data1234) # Model specification: vdb.eff1234 <- includeEffects(vdb.eff1234,transTrip,cycle3) vdb.eff1234 <- includeEffects(vdb.eff1234,egoX,altX,simX, interaction1="sex") vdb.eff1234 <- includeEffects(vdb.eff1234,simX,interaction1="program") vdb.eff1234 <- includeEffects(vdb.eff1234,simX,interaction1="smoke") vdb.eff1234 # Run the basic model: vdb.algo1234 <- sienaModelCreate(projname = 'vdb_1234') vdb.ans1234_1 <- siena07(vdb.algo1234, data=vdb.data1234, effects=vdb.eff1234) vdb.ans1234_1 # Do the timetest: timetest.1234_1 <- sienaTimeTest(vdb.ans1234_1) summary(timetest.1234_1) # The result shows no time heterogeneity for waves 1-2-3-4. # When focusing only on period 1 (wave 1 to 2), # there is some indication for time heterogeneity. # But the overall test is not significant. # Now let us see what happens if we drop the first instead of the last wave: friends2345 <- sienaNet(array(c(vdb.w2,vdb.w3,vdb.w4,vdb.w5), dim=c(32, 32, 4))) vdb.data2345 <- sienaDataCreate(friends2345,sex,program,smoke) vdb.eff2345 <- getEffects(vdb.data2345) # Model specification: vdb.eff2345 <- includeEffects(vdb.eff2345,transTrip,cycle3) vdb.eff2345 <- includeEffects(vdb.eff2345,egoX,altX,simX, interaction1="sex") vdb.eff2345 <- includeEffects(vdb.eff2345,simX,interaction1="program") vdb.eff2345 <- includeEffects(vdb.eff2345,simX,interaction1="smoke") vdb.eff2345 # Run the basic model: vdb.algo2345 <- sienaAlgorithmCreate(projname = 'vdb_2345') vdb.ans2345_1 <- siena07(vdb.algo2345, data=vdb.data2345, effects=vdb.eff2345) vdb.ans2345_1 # Do the timetest: timetest.2345_1 <- sienaTimeTest(vdb.ans2345_1) summary(timetest.2345_1) # The result still shows time heterogeneity for waves 2-3-4-5. # Dropping waves at the start or the end of the study is usually # a more satisfactory way of dealing with time heterogeneity # than letting effects become heterogeneous; # therefore the best summary conclusion here is that waves 1-2-3-4 # do not deviate significantly from time homogeneity. ###############################################################################