SOCR - User contributions [en]

SMHS DataSimulation

2016-05-23T14:00:26Z

Imoubara: /* Simulate New Data to Match the Properties/Characteristics of Observed Data */

==[[SMHS| Scientific Methods for Health Sciences]] - Data Simulation ==

===Importing observed data for exploratory analytics===

Using the [[SOCR_Simulated_HELP_Data|SOCR Health Evaluation and Linkage to Primary (HELP) Care Dataset]] we can [https://umich.instructure.com/files/354289/download?download_frd=1 extract some sample data (00_Tiny_SOCR_HELP_Data_Simmulation.csv)].

# data_1 <- read.csv('00_Tiny_SOCR_HELP_Data_Simmulation.csv',as.is=T, header=T)
# data_1 = read.csv(file.choose( ))
# data_1 <- read.table('00_Tiny_SOCR_HELP_Data_Simmulation.csv', header=TRUE, sep=",", row.names="ID")

attach(data_1)
# to ensure all variables are accessible within R, e.g., using age instead of data_1$\$$age
# i2 maximum number of drinks (standard units) consumed per day (in the past 30 days range 0–184) see also i1
# treat randomization group (0=usual care, 1=HELP clinic)
# pcs SF-36 Physical Component Score (range 14-75)
# mcs SF-36 Mental Component Score(range 7-62)
# cesd Center for Epidemiologic Studies Depression scale (range 0–60)
# indtot Inventory of Drug Use Con-sequences (InDUC) total score (range 4–45)
# pss_fr perceived social supports (friends, range 0–14) see also dayslink
# drugrisk Risk-Assessment Battery(RAB) drug risk score (range0–21)
# satreat any BSAS substance abuse treatment at baseline (0=no,1=yes)

===Fragment of the data===

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
! ID ||i2 ||age ||treat ||homeless ||pcs ||mcs ||cesd ||indtot ||pss_fr ||drugrisk ||sexrisk ||satreat ||female ||substance ||racegrp
|-
| 1 ||0 ||25 ||0 ||0 ||49 ||7 ||46 ||37 ||0 ||1 ||6 ||0 ||0 ||cocaine ||black
|-
| 2 ||18 ||31 ||0 ||0 ||48 ||34 ||17 ||48 ||0 ||0 ||11 ||0 ||0 ||alcohol ||white
|-
| 3 ||39 ||36 ||0 ||0 ||76 ||9 ||33 ||41 ||12 ||19 ||4 ||0 ||0 ||heroin ||black
|-
| … || || || || || || || || || || || || || || ||
|-
| 100 ||81 ||22 ||0 ||0 ||37 ||17 ||19 ||30 ||3 ||0 ||10 ||0 ||0 ||alcohol ||other
|}
</center>

===Testing section===

summary(data_1)

x.norm <- rnorm(n=200, m=10, sd=20)
hist(x.norm, main="N(10,20) Histogram")
hist(x.norm, main="N(10,20) Histogram")
mean(data_1$\$$age)
sd(data_1$\$$age)

==Simulate New Data to Match the Properties/Characteristics of Observed Data==

*i2 [0: 184]
*age m=34,sd=12
*treat {0,1}
*homeless {0,1}
*pcs 14-75
*mcs 7-62
*cesd 0–60
*indtot 4-45
*pss_fr 0-14
*drugrisk 0-21
*sexrisk
*satreat (0=no,1=yes)
*female (0=no,1=yes)
*racegrp (black, white, other)

# Demographics variables
Sex <- ifelse(runif(NumSubj)<.5,0,1)
Weight <- as.integer(rnorm(NumSubj, 80,10))
Age <- as.integer(rnorm(NumSubj, 62,10))

# Diagnosis:
Dx <- c(rep("PD", 100), rep("HC", 100), rep("SWEDD", 82))

# Genetics
chr12_rs34637584_GT <- c(ifelse(runif(100)<.3,0,1), ifelse(runif(100)<.6,0,1), ifelse(runif(82)<.4,0,1)) # NumSubj Bernoulli trials
chr17_rs11868035_GT <- c(ifelse(runif(100)<.7,0,1), ifelse(runif(100)<.4,0,1), ifelse(runif(82)<.5,0,1)) # NumSubj Bernoulli trials

# Clinical # rpois(NumSubj, 15) + rpois(NumSubj, 6)
UPDRS_part_I <- c( ifelse(runif(100)<.7,0,1)+ifelse(runif(100)<.7,0,1),
ifelse(runif(100)<.6,0,1)+ ifelse(runif(100)<.6,0,1),
ifelse(runif(82)<.4,0,1)+ ifelse(runif(82)<.4,0,1) )
UPDRS_part_II <- c(sample.int(20, 100, replace=T), sample.int(14, 100, replace=T),
sample.int(18, 82, replace=T) )
UPDRS_part_III <- c(sample.int(30, 100, replace=T), sample.int(20, 100, replace=T),
sample.int(25, 82, replace=T) )

# Time: VisitTime – done automatically below in aggregator

# Data (putting all components together)
sim_PD_Data <- cbind(
rep(Cases, each= NumTime), # Cases
rep(L_caudate_ComputeArea, each= NumTime), # Imaging
rep(Sex, each= NumTime), # Demographics
rep(Weight, each= NumTime),
rep(Age, each= NumTime),
rep(Dx, each= NumTime), # Dx
rep(chr12_rs34637584_GT, each= NumTime), # Genetics
rep(chr17_rs11868035_GT, each= NumTime),
rep(UPDRS_part_I, each= NumTime), # Clinical
rep(UPDRS_part_II, each= NumTime),
rep(UPDRS_part_III, each= NumTime),
rep(c(0,6,12,18), NumSubj) # Time
)

# Assign the column names
colnames(sim_PD_Data) <- c(
"Cases",
"L_caudate_ComputeArea",
"Sex", "Weight", "Age",
"Dx", "chr12_rs34637584_GT", "chr17_rs11868035_GT",
"UPDRS_part_I", "UPDRS_part_II", "UPDRS_part_III",
"Time"
)

# some QC
summary(sim_PD_Data)
dim(sim_PD_Data)
head(sim_PD_Data)

.....

<center>[[Image:SMHS_DataSimulation_Fig1.png|500px]] </center>

....

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_DataSimulation}}

SMHS LinearModeling LMM Assumptions

2016-05-23T13:58:56Z

Imoubara: /* Example of Logistic Regression */

==[[SMHS_LinearModeling_LMM| Linear mixed effects analyses]] - Mixed Effect Model Assumptions==

First review the [[SMHS_LinearModeling_LMM | Linear mixed effects analyses section]].

The [[SMHS_LinearModeling_MLR_VizModelCoeff |same conditions we have in the fixed effect multivariate linear model]] apply to mixed and random effect models – co-linearity, influential data points, homoscedasticity, and lack of normality. These assumptions can be checked by creating residual plots, histogram plots of the residuals or a Q-Q normal probability plots.

The fixed effect independence condition is relaxed in mixed/random effect models, as this was the main motivation for mixed models – to resolve dependencies in the data. Mixed effect models still require independence, e.g., when ignoring independent and including just a fixed effect for a variable of interest. For instance, working with a model that does not include a random effect “Player”, we have multiple Weight responses per Player. This would violate the LME model independence assumption. Careful selection of fixed effects and random effects is necessary to resolve potential dependencies in the data.

The function dfbeta() can’t be used for assessing influential data points in mixed effects linear models the way it can for fixed effect models. To check for influential points in mixed effect models the package influence.ME15 or a leave-one-out validation can be employed.

For example, we can define a vector of size equal to the number of rows in the data. Iterating over each row (i), we estimate a new mixed model excluding the current row index (data[-i,]). The function fixef() extracts the coefficients of interest, which can be adapted to the specific analysis. Running fixef() on the linear model yields the position of the relevant coefficient. For example, position “1” refers to the intercept (which is always the first coefficient mentioned in the coefficient table) and position “2” reflects the effect of “Height” appears second in the list of coefficients.

df <- as.data.frame(data)
all.res=numeric(nrow(df))
for(i in 1:nrow(df))
{ # Generic
# myfullmodel=lmer(response~predictor+ (1+predictor|randomeffect))
# results[i]=fixef(myfullmodel)[parameter position index]
fullmodel=lmer(Weight~Height+ (1+Height|Team), data=data[-i,])
results[i]=fixef(fullmodel)[2]
echo ("Row = ", i)
}

Comments

Fixed effects represent explanatory predictors that are expected to have a systematic and predictable influence on the data (response). Whereas random effects represent covariates expected to have a non-systematic, idiosyncratic, unpredictable, or “random” influence on the response variable. Examples of such random effects in experimental studies include “subject/patient/player/unit” and “Age”, as we generally have no control over idiosyncrasies of individual subjects or their age at time of observation.

Often fixed effects are expected to exhaust the population of interest, or the levels of a factor. In the MLB study the factor “Team” may not exhaust the space as there are other teams/leagues. However, for MLB at a fixed time, the “Team” factor may be fully exhaustive. Same with Height. Random effects represent sub-samples from the population of interest and may not “exhaust” the population as more players or teams could be included in the study. The levels of random factor may only represent a small sub-subset of all levels of the factor.

===Hands-on Activity===
Use these cancer data (http://www.ats.ucla.edu/stat/data/hdp.csv), representing cancer phenotypes and predictors (e.g., "IL6", "CRP", "LengthofStay", "Experience") and outcome measures (e.g., remission) collected on patients, nested within doctors (DID) and within hospitals (HID). To fit a mixed model (http://www.ats.ucla.edu/stat/r/dae/melogit.htm) and examine remissions as cancer outcomes.

This lung cancer dataset includes a variety of outcomes collected on patients, nested within doctors, who are in turn nested within hospitals. Doctor level variables include experience.
hdp <- read.csv("http://www.ats.ucla.edu/stat/data/hdp.csv")
hdp <- within(hdp, {
Married <- factor(Married, levels = 0:1, labels = c("no", "yes"))
DID <- factor(DID)
HID <- factor(HID)
})

Plot several continuous predictor variables to examine the distributions and catch coding errors (e.g., if values range from 0 to 7, but we see a 999), and explore the relationship among our variables.
# install.packages("ggally")
# library(GGally)
# library("ggplot2")
# ggpairs (hdp[, c("IL6", "CRP", "LengthofStay", "Experience")])

<center>[[Image:SMHS_LinearModeling_Fig35.png|500px]]</center>

Are there strong linear relations among the continuous variables? Examine CancerStage and LengthofStay closer. The area of bubbles is proportional to the number of observations with the corresponding values.

Violin plots may be used for continuous predictors. We can render all raw data separated by CancerStage. To reduce overlaying, we can add some random noise (along the x axis) or alternatively set the alpha opacity level.
Note that IL6 and CRP have skewed distributions indicating that we use a square root scale on the y axes. The distributions appear normal and symmetric with long right tails, even after square root transformation.
ggplot(hdp, aes(x = CancerStage, y = LengthofStay)) +
stat_sum(aes(size = ..n.., group = 1)) +
scale_size_area(max_size=10)

<center>[[Image:SMHS_LinearModeling_Fig36.png|500px]]</center>

# install.packages("reshape")
# library(reshape)
tmp <- melt(hdp[, c("CancerStage", "IL6", "CRP")], id.vars="CancerStage")
ggplot(tmp, aes(x = CancerStage, y = value)) +
geom_jitter(alpha = .1) +
geom_violin(alpha = .75) +
facet_grid(variable ~ .) +
scale_y_sqrt()

<center>[[Image:SMHS_LinearModeling_Fig37.png|500px]]</center>

The distribution of continuous variables at each level of the binary outcome to provide a better depiction of the change of the binary variables over levels of continuous variables.
tmp <- melt(hdp[, c("remission", "IL6", "CRP", "LengthofStay", "Experience")], id.vars="remission")
ggplot(tmp, aes(factor(remission), y = value, fill=factor(remission)))+ geom_boxplot() + facet_wrap(~variable, scales="free_y")

<center>[[Image:SMHS_LinearModeling_Fig38.png|500px]]</center>

===Types of Data Analyses16===

*Mixed effects logistic regression, the focus of this page.
*Mixed effects probit regression is very similar to mixed effects logistic regression, but it uses the normal CDF instead of the logistic CDF. Both model binary outcomes and can include fixed and random effects. (Note: This link function, aka Probit link, defined in the 1930’s by biologists studying the dosage-cure rate link, refers to the “probability unit”. It’s kind of the inverse CDF, of the model: if Y = Φ(Xβ+ ε), then Probit link = Φ^(-1) (Y).
*Fixed effects logistic regression is limited in this case because it may ignore necessary random effects and/or non-independence in the data.
*Fixed effects probit regression is limited in this case because it may ignore necessary random effects and/or non-independence in the data.
*Logistic regression with clustered standard errors. These can adjust for non-independence but does not allow for random effects.
*Probit regression with clustered standard errors. These can adjust for non-independence but does not allow for random effects.

===Mixed Effects Logistic Regression===

The glmer model can be used to estimate a mixed effects logistic regression model with Il6, CRP, and LengthofStay as patient level continuous predictors, CancerStage as a patient level categorical predictor (I, II, III, or IV), Experience as a doctor level continuous predictor, and a random intercept by DID, doctor ID.
Estimating and interpreting generalized linear mixed models (GLMMs, of which mixed effects logistic regression is one) can be quite challenging.
# estimate the model and store results in m
# library("lme4")
m1 <- glmer(remission ~ IL6 + CRP + CancerStage + LengthofStay + Experience +
(1 | DID), data = hdp, family = binomial, control = glmerControl(optimizer = "bobyqa"), nAGQ = 10)

# print the mod results without correlations among fixed effects
print(m1, corr = FALSE)

Generalized linear mixed model fit by maximum likelihood
(Adaptive Gauss-Hermite Quadrature, nAGQ = 10) [glmerMod]
Family: binomial ( logit )

This part conforms the estimates (based on an adaptive Gaussian Hermite approximation of the likelihood) using 10 integrations. More integration points improves the approximation (convergnce to the ML estimates), however, increase the computational requirements. 
To avoid a warning of nonconvergence, we specify a different optimizer with the argument control=glmerControl(optimizer="bobyqa"). Although the model will produce nearly identical results without the new argument, we prefer to use models without such warnings.

Formula: 
remission ~ IL6 + CRP + CancerStage + LengthofStay + Experience + (1 | DID) 
Data: hdp
<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
|AIC||BIC||LogLik||Deviance||df. resid.
|-
|7397.276||7460.733||-3689.638||7379.276||8516
|}
</center>

Random effects:

<center> Random Effects
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
|Groups Name||Std. Deviation.
|-
|DID (Intercept)||2.015
|}
Number of obs: 8525, groups: DID, 407 </center>

This section gives the basic information to compare models, and lists the random effect estimates. This represents the estimated variability in the intercept on the logit scale. When there are other random effects, e.g., random slopes, they are included here.

The total number of observations, and the number of level 2 observations, the total number of patients (8,525) and doctors (407) are reported.

<center> Fixed Effects
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
|(Intercept)||IL6||CRP||CancerStageII
|-
|-2.05271||-0.05677||-0.02148||-0.41393
|-
|CancerStageIII||CancerStageIV||LengthofStay||Experience
|-
|-1.00346||-2.33703||-0.12118||7379.276||0.12009
|}
</center>

The part includes a table of the fixed effects estimates. The estimates represent the regression coefficients, which are raw/unstandardized on the logit scale.

The estimates are followed by their standard errors (SEs). As is common in GLMs, the SEs are obtained by inverting the observed information matrix (negative second derivative matrix). However, for GLMMs, this is again an approximation. The approximations of the coefficient estimates likely stabilize faster than do those for the SEs. Thus if you are using fewer integration points, the estimates may be reasonable, but the approximation of the SEs may be less accurate. The Wald tests, Estimate/SE, rely on asymptotic theory, here referring to as the highest level unit size converges to infinity, these tests will be normally distributed, and from that, p values (the probability of obtaining the observed estimate or more extreme, given the true estimate is 0).

To obtain confidence intervals (CIs) using the SE estimates:

se <- sqrt(diag(vcov(m1)))
# table of estimates with 95% CI, fixef = Extract fixed-effects estimates
(tab <- cbind(Est = fixef(m1), LL = fixef(m1) - 1.96 * se, UL = fixef(m1) + 1.96 * se))

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
| ||Est||LL||UL
|-
|(Intercept)||-2.05270650||-3.09434022||-1.011072788
|-
|IL6||-0.05677184||-0.07934785||-0.034195828
|-
|CRP||-0.02148295||-0.04151100||-0.001454894
|-
|CancerStageII||-0.41393353||-0.56243063||-0.265436433
|-
|CancerStageIII||-1.00346481||-1.19609924||-0.810830385
|-
|CancerStageIV||-2.33703403||-2.64682910||-2.027238952
|-
|LengthofStay||-0.12118216||-0.18710346||-0.055260857
|-
|Experience||0.12008900||0.06628364||0.173894365
|}
</center>

Instead of coefficients on the logit scale, we can report the add odds ratios by exponentiating the estimates and CIs. 
exp(tab)

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
| ||Est||LL||UL
|-
|(Intercept)||0.12838695||0.04530489||0.3638285
|-
|IL6||0.94480962||0.92371856||0.9663822
|-
|CRP||0.97874617||0.95933878||0.9985462
|-
|CancerStageII||0.66104489||0.56982235||0.7668712
|-
|CancerStageIII||0.36660701||0.30237139||0.4444888
|-
|CancerStageIV||0.09661377||0.07087560||0.1316986
|-
|LengthofStay||0.88587258||0.82935793||0.9462383
|-
|Experience||1.12759721||1.06852976||1.1899299
|}
</center>

r1 <- ranef(m1) # Extract the modes of the random effects
r1.order <- r1[order(r1$\$$DID),]
# install.packages("lattice")
dotplot(ranef(m1,condVar=TRUE), lattice.options=list(layout=c(1,2)))

# Inference
VarCorr(m1); anova(m1); intervals(m1)

===Example of Logistic Regression===
(1) Logistic curve:
$y=f(x)=\frac{1}{1+e^{-x}}$,

where y and x represent probability and quantitative-predictor values, respectively.

x <- seq(-10,10,1)
plot(x,1/(1+exp(-x)), type="l")

<center>[[Image:SMHS_LinearModeling_Fig39.png|500px]]</center>

The point of this logistic curve is: 
$y=\frac{1}{1+e^{-x}}$ ⇔ $x=ln(\frac{y}{1-y})$, 
which is the '''log-odds'''17 (when y is the probability of an event of interest)

(2)Logistic regression equation model to estimate the probability of specific outcomes: 
(''Estimate of'') ''P'' (''Y''=1|$x_1,x_2,...,x_1)=\frac{1}{1+e^{-(a_o+\sum_{k=1}a_kx_k)}}$ 
the coefficients ao, (intercept) and $a_k, k = 1,2,...,l$, are estimated using GLM according to a maximum likelihood approach. Using this model allows us to estimate the probability of the dependent (outcome) variable ''Y''=1 (CO), i.e., surviving surgery, given the observed values of the predictors $X_k,k = 1,2,...,l.$

Probability of Surviving a Heart Transplant Based on Surgeon’s Experience: 
A group of 20 patients undergo heart transplantation with different surgeons having experience in the range {0(least), 2…, 10(most)}, representing 100’s of operating/surgery hours. How does the surgeon’s experience affect the probability of the patient survival? 
The data is shown below and represents each patient and the outcome of the surgery (1=survival) or (0=death).

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
|Surgeon's Experience||1||1.5||2||2.5||3||3.5||3.5||4||4.5||5||5.5||6||6.5||7||8||8.5||9||9.5||10||10
|-
|Clinical Outcome||0||0||0||0||0||0||1||0||1||0||1||0||1||0||1||1||1||1||1||1
|}
</center>

mydata <- read.csv('https://umich.instructure.com/files/405273/download?download_frd=1&verifier=AOny2eq3wF7WqWAV5YsT6e9zakRTEbZpcuNYRdtM') # 01_HeartSurgerySurvivalData.csv
# estimates a logistic regression model for the clinical outcome (CO), survival, using the glm
# (generalized linear model) function.
# convert Surgeon’s Experience (SE) to a factor to indicate it should be treated as a categorical variable.
# mydata$\$$rank <- factor(mydata$\$$SE)
mylogit <- glm(CO ~ SE, data = mydata, family = "binomial")

# library(ggplot2)
ggplot(mydata, aes(x=SE, y=CO)) + geom_point() +
stat_smooth(method="glm", family="binomial", se=FALSE)

<center>Graph of a Logistic Regression Curve Showing Probability of Surviving the Surgery versus Surgeon’s Experience.</center>
<center>[[Image:SMHS_LinearModeling_Fig40.png|500px]]</center>

The graph shows the probability of the clinical outcome, survival, (Y-axis) versus the surgeon’s experience (X-axis), with the logistic regression curve fitted to the data.

mylogit <- glm(CO ~ SE, data = mydata, family = "binomial")
summary(mylogit)

The logistic regression analysis gives the following output.

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
| ||Estimate Std.||Error||z value||Pr (>z) Wald
|-
|(Intercept)||-4.1030||1.7629||-2.327||0.0199 *
|-
|SE||0.7583||0.3139||2.416||0.0157 *
|}
</center>

The output indicates that surgeon’s experience (SE) is significantly associated with the probability of surviving the surgery (0.0157, Wald test). The output also provides the coefficients for:

''Intercept'' = -4.1030 and ''SE'' = 0.7583.

*Probability of surviving heart surgery CO =1/(1+exp(-(-4.1030+0.7583×SE)))
*For example, for a patient who is operated by a surgeon with 200 hours of operating experience (SE=2), we plug in the value 2 in the equation to get an estimated probability of survival, p=0.07:

SE=2; 
CO =1/(1+exp(-(-4.1030+0.7583*SE))) 
> CO 
[1] 0.07001884

*Similarly, a patient undergoing heart surgery with a doctor that has 400 operating hours experience (SE=4), the estimated probability of survival is p=0.26:
SE=4; CO =1/(1+exp(-(-4.1030+0.7583*SE))); CO 
> CO 
[1] 0.2554411

The table below shows the probability of surviving surgery for several values of surgeons’ experience:
<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
|Surgeon's Experience||Probability of Patient Survival (Clinical Outcome)
|-
|1||0.034
|-
|2||0.07
|-
|3||0.14
|-
|4||0.26
|-
|5||0.423
|}
</center>

The output from the logistic regression analysis gives a p-value of p=0.0157, which is based on the Wald z-score. In addition to the Wald method, we can calculate the p-value for logistic regression (mylogit <- glm(CO ~ SE,data = mydata,family = "binomial")) using the Likelihood Ratio Test (LRT), which for these data give 0.0006476922.

<center>

{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
| ||Estimate Std.||Error||z value||Pr (>z) Wald
|-
|SE||0.7583||0.3139||2.416||0.0157 *
|}
</center>

The logit of a number $0≤p≤1$ given by the formula: $logit(p) = log(\frac{p}{1-p})$ representing the log-odds (of survival in this case).

confint(mylogit)

So, why exponentiating the coefficients? Because,

$logit(p)=log(\frac{p}{1-p})→ e^{logit(p)}=e^{log(\frac{p}{1-p})}→ RHS=\frac{p}{1-p}$ (odds-ratio, OR)

> exp(coef(mylogit)) # exponentiated logit model coefficients
(Intercept) SE
0.01652254 2.13474149 ## == exp(0.7583456)
> coef(mylogit) # raw logit model coefficients
(Intercept) SE
-4.1030298 0.7583456

exp(cbind(OR = coef(mylogit), confint(mylogit)))

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
| ||OR||2.5%||97.5%
|-
|(Intercept)||0.01652254||0.0001825743||0.277290
|-
|SE||2.13474149||1.3083794719||4.839986

|}
</center>

with(mylogit, df.null - df.residual)

Finally, the LRT (likelihood-ratio test) p-value can be obtained using:

with(mylogit, pchisq(null.deviance - deviance, df.null - df.residual, lower.tail = FALSE))

[1] 0.0006476922

The LRT p_value < 0.001 tells us that our model as a whole fits significantly better than an empty model. The deviance residual is -2*log likelihood, and to see the model's log likelihood:

logLik(mylogit)
'log Lik.' -8.046117 (df=2)

Side-note: The LRT compares the data fit of two models. For instance, removing predictor variables from a model will reduce model quality (i.e., a model will have a lower log likelihood). To statistically assess whether the observed difference in model fit is significant, the LRT compares the difference of the log likelihoods of the two models. When this difference is statistically significant, the full model (the one with more variables) is a better fit to the data, compared to the reduced model. LRT is computed from the log likelihoods of the models:

$LRT=-2ln\Big(\frac{L(m1)}{L(m2)}\Big)=2(ll(m2)-ll(m1)) $,

Where m1 and m2 are the reduced and the full models, respectively, L(m1) and L(m2) denote the likelihoods of the 2 models, and ll(m1) and ll(m2) represent the log likelihood (natural log of the model likelihood.

The distribution of the LRT is chi-squared with degrees of freedom equal to the number of parameters that are reduced (i.e., the number of variables removed from the model). In our case,

$LRT \sim X^2_{df=2}$ as we have an intercept and one predictor (SE), and the null model is empty (no parameters).

===Footnotes===
* 15 http://cran.r-project.org/web/packages/influence.ME/influence.ME.pdf
* 16 http://www.ats.ucla.edu/stat/mult_pkg/glmm.htm
* 17 http://wiki.socr.umich.edu/index.php/SMHS_OR_RR

==Next See==
[[SMHS_LinearModeling_MachineLearning|Machine Learning Algorithms section]] for data modeling, training , testing, forecasting, prediction, and simulation.

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_LinearModeling_LMM_Assumptions}}

SMHS LinearModeling LMM Assumptions

2016-05-23T13:58:12Z

Imoubara: /* Types of Data Analyses16 */

==[[SMHS_LinearModeling_LMM| Linear mixed effects analyses]] - Mixed Effect Model Assumptions==

First review the [[SMHS_LinearModeling_LMM | Linear mixed effects analyses section]].

The [[SMHS_LinearModeling_MLR_VizModelCoeff |same conditions we have in the fixed effect multivariate linear model]] apply to mixed and random effect models – co-linearity, influential data points, homoscedasticity, and lack of normality. These assumptions can be checked by creating residual plots, histogram plots of the residuals or a Q-Q normal probability plots.

The fixed effect independence condition is relaxed in mixed/random effect models, as this was the main motivation for mixed models – to resolve dependencies in the data. Mixed effect models still require independence, e.g., when ignoring independent and including just a fixed effect for a variable of interest. For instance, working with a model that does not include a random effect “Player”, we have multiple Weight responses per Player. This would violate the LME model independence assumption. Careful selection of fixed effects and random effects is necessary to resolve potential dependencies in the data.

The function dfbeta() can’t be used for assessing influential data points in mixed effects linear models the way it can for fixed effect models. To check for influential points in mixed effect models the package influence.ME15 or a leave-one-out validation can be employed.

For example, we can define a vector of size equal to the number of rows in the data. Iterating over each row (i), we estimate a new mixed model excluding the current row index (data[-i,]). The function fixef() extracts the coefficients of interest, which can be adapted to the specific analysis. Running fixef() on the linear model yields the position of the relevant coefficient. For example, position “1” refers to the intercept (which is always the first coefficient mentioned in the coefficient table) and position “2” reflects the effect of “Height” appears second in the list of coefficients.

df <- as.data.frame(data)
all.res=numeric(nrow(df))
for(i in 1:nrow(df))
{ # Generic
# myfullmodel=lmer(response~predictor+ (1+predictor|randomeffect))
# results[i]=fixef(myfullmodel)[parameter position index]
fullmodel=lmer(Weight~Height+ (1+Height|Team), data=data[-i,])
results[i]=fixef(fullmodel)[2]
echo ("Row = ", i)
}

Comments

Fixed effects represent explanatory predictors that are expected to have a systematic and predictable influence on the data (response). Whereas random effects represent covariates expected to have a non-systematic, idiosyncratic, unpredictable, or “random” influence on the response variable. Examples of such random effects in experimental studies include “subject/patient/player/unit” and “Age”, as we generally have no control over idiosyncrasies of individual subjects or their age at time of observation.

Often fixed effects are expected to exhaust the population of interest, or the levels of a factor. In the MLB study the factor “Team” may not exhaust the space as there are other teams/leagues. However, for MLB at a fixed time, the “Team” factor may be fully exhaustive. Same with Height. Random effects represent sub-samples from the population of interest and may not “exhaust” the population as more players or teams could be included in the study. The levels of random factor may only represent a small sub-subset of all levels of the factor.

===Hands-on Activity===
Use these cancer data (http://www.ats.ucla.edu/stat/data/hdp.csv), representing cancer phenotypes and predictors (e.g., "IL6", "CRP", "LengthofStay", "Experience") and outcome measures (e.g., remission) collected on patients, nested within doctors (DID) and within hospitals (HID). To fit a mixed model (http://www.ats.ucla.edu/stat/r/dae/melogit.htm) and examine remissions as cancer outcomes.

This lung cancer dataset includes a variety of outcomes collected on patients, nested within doctors, who are in turn nested within hospitals. Doctor level variables include experience.
hdp <- read.csv("http://www.ats.ucla.edu/stat/data/hdp.csv")
hdp <- within(hdp, {
Married <- factor(Married, levels = 0:1, labels = c("no", "yes"))
DID <- factor(DID)
HID <- factor(HID)
})

Plot several continuous predictor variables to examine the distributions and catch coding errors (e.g., if values range from 0 to 7, but we see a 999), and explore the relationship among our variables.
# install.packages("ggally")
# library(GGally)
# library("ggplot2")
# ggpairs (hdp[, c("IL6", "CRP", "LengthofStay", "Experience")])

<center>[[Image:SMHS_LinearModeling_Fig35.png|500px]]</center>

Are there strong linear relations among the continuous variables? Examine CancerStage and LengthofStay closer. The area of bubbles is proportional to the number of observations with the corresponding values.

Violin plots may be used for continuous predictors. We can render all raw data separated by CancerStage. To reduce overlaying, we can add some random noise (along the x axis) or alternatively set the alpha opacity level.
Note that IL6 and CRP have skewed distributions indicating that we use a square root scale on the y axes. The distributions appear normal and symmetric with long right tails, even after square root transformation.
ggplot(hdp, aes(x = CancerStage, y = LengthofStay)) +
stat_sum(aes(size = ..n.., group = 1)) +
scale_size_area(max_size=10)

<center>[[Image:SMHS_LinearModeling_Fig36.png|500px]]</center>

# install.packages("reshape")
# library(reshape)
tmp <- melt(hdp[, c("CancerStage", "IL6", "CRP")], id.vars="CancerStage")
ggplot(tmp, aes(x = CancerStage, y = value)) +
geom_jitter(alpha = .1) +
geom_violin(alpha = .75) +
facet_grid(variable ~ .) +
scale_y_sqrt()

<center>[[Image:SMHS_LinearModeling_Fig37.png|500px]]</center>

The distribution of continuous variables at each level of the binary outcome to provide a better depiction of the change of the binary variables over levels of continuous variables.
tmp <- melt(hdp[, c("remission", "IL6", "CRP", "LengthofStay", "Experience")], id.vars="remission")
ggplot(tmp, aes(factor(remission), y = value, fill=factor(remission)))+ geom_boxplot() + facet_wrap(~variable, scales="free_y")

<center>[[Image:SMHS_LinearModeling_Fig38.png|500px]]</center>

===Types of Data Analyses16===

*Mixed effects logistic regression, the focus of this page.
*Mixed effects probit regression is very similar to mixed effects logistic regression, but it uses the normal CDF instead of the logistic CDF. Both model binary outcomes and can include fixed and random effects. (Note: This link function, aka Probit link, defined in the 1930’s by biologists studying the dosage-cure rate link, refers to the “probability unit”. It’s kind of the inverse CDF, of the model: if Y = Φ(Xβ+ ε), then Probit link = Φ^(-1) (Y).
*Fixed effects logistic regression is limited in this case because it may ignore necessary random effects and/or non-independence in the data.
*Fixed effects probit regression is limited in this case because it may ignore necessary random effects and/or non-independence in the data.
*Logistic regression with clustered standard errors. These can adjust for non-independence but does not allow for random effects.
*Probit regression with clustered standard errors. These can adjust for non-independence but does not allow for random effects.

===Mixed Effects Logistic Regression===

The glmer model can be used to estimate a mixed effects logistic regression model with Il6, CRP, and LengthofStay as patient level continuous predictors, CancerStage as a patient level categorical predictor (I, II, III, or IV), Experience as a doctor level continuous predictor, and a random intercept by DID, doctor ID.
Estimating and interpreting generalized linear mixed models (GLMMs, of which mixed effects logistic regression is one) can be quite challenging.
# estimate the model and store results in m
# library("lme4")
m1 <- glmer(remission ~ IL6 + CRP + CancerStage + LengthofStay + Experience +
(1 | DID), data = hdp, family = binomial, control = glmerControl(optimizer = "bobyqa"), nAGQ = 10)

# print the mod results without correlations among fixed effects
print(m1, corr = FALSE)

Generalized linear mixed model fit by maximum likelihood
(Adaptive Gauss-Hermite Quadrature, nAGQ = 10) [glmerMod]
Family: binomial ( logit )

This part conforms the estimates (based on an adaptive Gaussian Hermite approximation of the likelihood) using 10 integrations. More integration points improves the approximation (convergnce to the ML estimates), however, increase the computational requirements. 
To avoid a warning of nonconvergence, we specify a different optimizer with the argument control=glmerControl(optimizer="bobyqa"). Although the model will produce nearly identical results without the new argument, we prefer to use models without such warnings.

Formula: 
remission ~ IL6 + CRP + CancerStage + LengthofStay + Experience + (1 | DID) 
Data: hdp
<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
|AIC||BIC||LogLik||Deviance||df. resid.
|-
|7397.276||7460.733||-3689.638||7379.276||8516
|}
</center>

Random effects:

<center> Random Effects
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
|Groups Name||Std. Deviation.
|-
|DID (Intercept)||2.015
|}
Number of obs: 8525, groups: DID, 407 </center>

This section gives the basic information to compare models, and lists the random effect estimates. This represents the estimated variability in the intercept on the logit scale. When there are other random effects, e.g., random slopes, they are included here.

The total number of observations, and the number of level 2 observations, the total number of patients (8,525) and doctors (407) are reported.

<center> Fixed Effects
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
|(Intercept)||IL6||CRP||CancerStageII
|-
|-2.05271||-0.05677||-0.02148||-0.41393
|-
|CancerStageIII||CancerStageIV||LengthofStay||Experience
|-
|-1.00346||-2.33703||-0.12118||7379.276||0.12009
|}
</center>

The part includes a table of the fixed effects estimates. The estimates represent the regression coefficients, which are raw/unstandardized on the logit scale.

The estimates are followed by their standard errors (SEs). As is common in GLMs, the SEs are obtained by inverting the observed information matrix (negative second derivative matrix). However, for GLMMs, this is again an approximation. The approximations of the coefficient estimates likely stabilize faster than do those for the SEs. Thus if you are using fewer integration points, the estimates may be reasonable, but the approximation of the SEs may be less accurate. The Wald tests, Estimate/SE, rely on asymptotic theory, here referring to as the highest level unit size converges to infinity, these tests will be normally distributed, and from that, p values (the probability of obtaining the observed estimate or more extreme, given the true estimate is 0).

To obtain confidence intervals (CIs) using the SE estimates:

se <- sqrt(diag(vcov(m1)))
# table of estimates with 95% CI, fixef = Extract fixed-effects estimates
(tab <- cbind(Est = fixef(m1), LL = fixef(m1) - 1.96 * se, UL = fixef(m1) + 1.96 * se))

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
| ||Est||LL||UL
|-
|(Intercept)||-2.05270650||-3.09434022||-1.011072788
|-
|IL6||-0.05677184||-0.07934785||-0.034195828
|-
|CRP||-0.02148295||-0.04151100||-0.001454894
|-
|CancerStageII||-0.41393353||-0.56243063||-0.265436433
|-
|CancerStageIII||-1.00346481||-1.19609924||-0.810830385
|-
|CancerStageIV||-2.33703403||-2.64682910||-2.027238952
|-
|LengthofStay||-0.12118216||-0.18710346||-0.055260857
|-
|Experience||0.12008900||0.06628364||0.173894365
|}
</center>

Instead of coefficients on the logit scale, we can report the add odds ratios by exponentiating the estimates and CIs. 
exp(tab)

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
| ||Est||LL||UL
|-
|(Intercept)||0.12838695||0.04530489||0.3638285
|-
|IL6||0.94480962||0.92371856||0.9663822
|-
|CRP||0.97874617||0.95933878||0.9985462
|-
|CancerStageII||0.66104489||0.56982235||0.7668712
|-
|CancerStageIII||0.36660701||0.30237139||0.4444888
|-
|CancerStageIV||0.09661377||0.07087560||0.1316986
|-
|LengthofStay||0.88587258||0.82935793||0.9462383
|-
|Experience||1.12759721||1.06852976||1.1899299
|}
</center>

r1 <- ranef(m1) # Extract the modes of the random effects
r1.order <- r1[order(r1$\$$DID),]
# install.packages("lattice")
dotplot(ranef(m1,condVar=TRUE), lattice.options=list(layout=c(1,2)))

# Inference
VarCorr(m1); anova(m1); intervals(m1)

===Example of Logistic Regression===
(1) Logistic curve:
$y=f(x)=\frac{1}{1+e^{-x}}$,

where y and x represent probability and quantitative-predictor values, respectively.

x <- seq(-10,10,1)
plot(x,1/(1+exp(-x)), type="l")

<center>[[Image:SMHS_LinearModeling_Fig39.png|500px]]</center>

The point of this logistic curve is: 
$y=\frac{1}{1+e^{-x}}$ ⇔ $x=ln(\frac{y}{1-y})$, 
which is the '''log-odds'''17 (when y is the probability of an event of interest)

(2)Logistic regression equation model to estimate the probability of specific outcomes: 
(''Estimate of'') ''P'' (''Y''=1|$x_1,x_2,...,x_1)=\frac{1}{1+e^{-(a_o+\sum_{k=1}a_kx_k)}}$ 
the coefficients ao, (intercept) and $a_k, k = 1,2,...,l$, are estimated using GLM according to a maximum likelihood approach. Using this model allows us to estimate the probability of the dependent (outcome) variable ''Y''=1 (CO), i.e., surviving surgery, given the observed values of the predictors $X_k,k = 1,2,...,l.$

Probability of Surviving a Heart Transplant Based on Surgeon’s Experience: 
A group of 20 patients undergo heart transplantation with different surgeons having experience in the range {0(least), 2…, 10(most)}, representing 100’s of operating/surgery hours. How does the surgeon’s experience affect the probability of the patient survival? 
The data is shown below and represents each patient and the outcome of the surgery (1=survival) or (0=death).

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
|Surgeon's Experience||1||1.5||2||2.5||3||3.5||3.5||4||4.5||5||5.5||6||6.5||7||8||8.5||9||9.5||10||10
|-
|Clinical Outcome||0||0||0||0||0||0||1||0||1||0||1||0||1||0||1||1||1||1||1||1
|}
</center>

mydata <- read.csv('https://umich.instructure.com/files/405273/download?download_frd=1&verifier=AOny2eq3wF7WqWAV5YsT6e9zakRTEbZpcuNYRdtM') # 01_HeartSurgerySurvivalData.csv
# estimates a logistic regression model for the clinical outcome (CO), survival, using the glm
# (generalized linear model) function.
# convert Surgeon’s Experience (SE) to a factor to indicate it should be treated as a categorical variable.
# mydata$\$$rank <- factor(mydata$\$$SE)
mylogit <- glm(CO ~ SE, data = mydata, family = "binomial")

# library(ggplot2)
ggplot(mydata, aes(x=SE, y=CO)) + geom_point() +
stat_smooth(method="glm", family="binomial", se=FALSE)

<center>Graph of a Logistic Regression Curve Showing Probability of Surviving the Surgery versus Surgeon’s Experience.</center>
<center>[[Image:SMHS_LinearModeling_Fig40.png|500px]]</center>

The graph shows the probability of the clinical outcome, survival, (Y-axis) versus the surgeon’s experience (X-axis), with the logistic regression curve fitted to the data.

mylogit <- glm(CO ~ SE, data = mydata, family = "binomial")
summary(mylogit)

The logistic regression analysis gives the following output.

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
| ||Estimate Std.||Error||z value||Pr (>z) Wald
|-
|(Intercept)||-4.1030||1.7629||-2.327||0.0199 *
|-
|SE||0.7583||0.3139||2.416||0.0157 *
|}
</center>

The output indicates that surgeon’s experience (SE) is significantly associated with the probability of surviving the surgery (0.0157, Wald test). The output also provides the coefficients for:

''Intercept'' = -4.1030 and ''SE'' = 0.7583.

<li>Probability of surviving heart surgery CO =1/(1+exp(-(-4.1030+0.7583×SE)))</li>
<li>For example, for a patient who is operated by a surgeon with 200 hours of operating experience (SE=2), we plug in the value 2 in the equation to get an estimated probability of survival, p=0.07:</li>

SE=2; 
CO =1/(1+exp(-(-4.1030+0.7583*SE))) 
> CO 
[1] 0.07001884

<li>Similarly, a patient undergoing heart surgery with a doctor that has 400 operating hours experience (SE=4), the estimated probability of survival is p=0.26:</li>
SE=4; CO =1/(1+exp(-(-4.1030+0.7583*SE))); CO 
> CO 
[1] 0.2554411

The table below shows the probability of surviving surgery for several values of surgeons’ experience:
<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
|Surgeon's Experience||Probability of Patient Survival (Clinical Outcome)
|-
|1||0.034
|-
|2||0.07
|-
|3||0.14
|-
|4||0.26
|-
|5||0.423
|}
</center>

The output from the logistic regression analysis gives a p-value of p=0.0157, which is based on the Wald z-score. In addition to the Wald method, we can calculate the p-value for logistic regression (mylogit <- glm(CO ~ SE,data = mydata,family = "binomial")) using the Likelihood Ratio Test (LRT), which for these data give 0.0006476922.

<center>

{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
| ||Estimate Std.||Error||z value||Pr (>z) Wald
|-
|SE||0.7583||0.3139||2.416||0.0157 *
|}
</center>

The logit of a number $0≤p≤1$ given by the formula: $logit(p) = log(\frac{p}{1-p})$ representing the log-odds (of survival in this case).

confint(mylogit)

So, why exponentiating the coefficients? Because,

$logit(p)=log(\frac{p}{1-p})→ e^{logit(p)}=e^{log(\frac{p}{1-p})}→ RHS=\frac{p}{1-p}$ (odds-ratio, OR)

> exp(coef(mylogit)) # exponentiated logit model coefficients
(Intercept) SE
0.01652254 2.13474149 ## == exp(0.7583456)
> coef(mylogit) # raw logit model coefficients
(Intercept) SE
-4.1030298 0.7583456

exp(cbind(OR = coef(mylogit), confint(mylogit)))

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
| ||OR||2.5%||97.5%
|-
|(Intercept)||0.01652254||0.0001825743||0.277290
|-
|SE||2.13474149||1.3083794719||4.839986

|}
</center>

with(mylogit, df.null - df.residual)

Finally, the LRT (likelihood-ratio test) p-value can be obtained using:

with(mylogit, pchisq(null.deviance - deviance, df.null - df.residual, lower.tail = FALSE))

[1] 0.0006476922

The LRT p_value < 0.001 tells us that our model as a whole fits significantly better than an empty model. The deviance residual is -2*log likelihood, and to see the model's log likelihood:

logLik(mylogit)
'log Lik.' -8.046117 (df=2)

Side-note: The LRT compares the data fit of two models. For instance, removing predictor variables from a model will reduce model quality (i.e., a model will have a lower log likelihood). To statistically assess whether the observed difference in model fit is significant, the LRT compares the difference of the log likelihoods of the two models. When this difference is statistically significant, the full model (the one with more variables) is a better fit to the data, compared to the reduced model. LRT is computed from the log likelihoods of the models:

$LRT=-2ln\Big(\frac{L(m1)}{L(m2)}\Big)=2(ll(m2)-ll(m1)) $,

Where m1 and m2 are the reduced and the full models, respectively, L(m1) and L(m2) denote the likelihoods of the 2 models, and ll(m1) and ll(m2) represent the log likelihood (natural log of the model likelihood.

The distribution of the LRT is chi-squared with degrees of freedom equal to the number of parameters that are reduced (i.e., the number of variables removed from the model). In our case,

$LRT \sim X^2_{df=2}$ as we have an intercept and one predictor (SE), and the null model is empty (no parameters).

===Footnotes===
* 15 http://cran.r-project.org/web/packages/influence.ME/influence.ME.pdf
* 16 http://www.ats.ucla.edu/stat/mult_pkg/glmm.htm
* 17 http://wiki.socr.umich.edu/index.php/SMHS_OR_RR

==Next See==
[[SMHS_LinearModeling_MachineLearning|Machine Learning Algorithms section]] for data modeling, training , testing, forecasting, prediction, and simulation.

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_LinearModeling_LMM_Assumptions}}

SMHS LinearModeling MLR VizModelCoeff

2016-05-23T13:57:02Z

Imoubara: /* Protocols for Rectifying Residual Plots Indicating Nonlinearity */

==[[SMHS_LinearModeling_MLR|Multiple Linear Regression]] - Visualizing the Regression-Model coefficients==

First see the [[SMHS_LinearModeling_MLR|Multiple Linear Regression section]], where we discuss linear modeling, review, and demonstrate computing and visualizing the regression-model coefficients (effect-sizes), (fixed-effect) linear model assumptions, examination of residual plots, and independence.

To visualize the Regression-Model coefficients (effect-sizes) we can use the '''arm''' package:
#library("arm")
# data <- read.table('01a_data.txt',as.is=T, header=T)
data <- read.table('01a_data.txt',as.is=T, header=T)
attach(data)

df.2 = data.frame(Age, Weight, Height, Position, Team)
lm.2 = lm(Weight ~ Age + Height+ Position + Team, df.2)
lm.3 = lm(Weight ~ Age*Height+ Position*Team, df.2)
lm.4 = lm(Weight ~ Age*Team + Position*Height, df.2)

par (mfrow=c(1,1))
# coefplot(lm.2, xlim=c(-2, 2), intercept=TRUE)
coefplot(lm.2, vertical=FALSE, col.pts="green")
coefplot(lm.3, vertical=FALSE, add=TRUE, col.pts="red", offset=0.2)
coefplot(lm.3a, vertical=FALSE, add=TRUE, col.pts="black", offset=0.4)
coefplot(lm.4, vertical=FALSE, add=TRUE, col.pts="blue", offset=0.6)

<center>[[Image:SMHS_LinearModeling_Fig16.png|500px]]</center>

===(Fixed-Effect) Linear Model Assumptions===

The linear modeling approach (above) is referred to as a linear model, as opposed to another type of model (e.g., non-linear, exponential, etc.) for 2 reasons. First, functional analytic representation of the model involves linear terms of the predictive variables. Second, the model assumptions dictate linear relationships among the covariates and between covariates and response.

Linearity

The response variable (Y=Weight, in our case) can be expressed via a linear combination formula of the independent variable (e.g., Height, Age, etc.). If its assumption is invalid, the residual plot may include patterns (e.g., quadratic curve or non-linear trend) indicating another type of model may be appropriate. For instance, the residuals may include a pair of lines when we have dichotomous categorical data. Similarly, the QQ Normal Probability Plot may not be perfectly linear (e.g., S-shaped), which again indicates the distribution of the residuals (observed minus fitted (predicted) values) may not be IID Normal (Gaussian distributed).

This plot shows the age/pitch relationship along with the depiction of the residuals:
# Weight ~ Age + Height + Position + Team + e
# lm.4 = lm(Weight ~ Age.centered + Height+ Position + Team, df.2)

lm.4.res = resid(lm.4)
plot(Height, lm.4.res, ylab="(Weight) Residuals", xlab="Height", main="MLB (lm.4) model residuals")
abline(0, 0)

<center>[[Image:SMHS_LinearModeling_Fig17.png|500px]]</center>

# Weight ~ Age + Height + Position + Team + e
# lm.4 = lm(Weight ~ Age.centered + Height+ Position + Team, df.2)
# lm.4.res = resid(lm.4)
qqnorm(lm.4.res) # A quantile normal plot - good for checking normality
qqline(lm.4.res)

<center>[[Image:SMHS_LinearModeling_Fig18.png|500px]]</center>

Mind that now, for illustrative purposes, we change the model to (lm.2: Weight ~ Age)!

# lm.2 = lm(Weight ~ Age, df.2)
# calculate residuals and predicted values
lm.2.res = resid(lm.2)
residuals <- signif(lm.2.res, 5)
predicted <- predict(lm.2)

plot(Age, Weight, main="Visualization of the Residuals of Model: Weight ~ Age", xlab="Age", ylab="Weight", pch=19)
abline(lm(Weight ~ Age), col="red")
# plot distances between points and the regression line
segments(Age, Weight, Age, predicted, col="blue")

# add residual-value labels to (Age) points
# install.packages("calibrate")
# library("calibrate", lib.loc="~/R/win-library/3.1")
library(calibrate)
textxy(Age, Weight, residuals, cx=0.7)

<center>[[Image:SMHS_LinearModeling_Fig19.png|500px]]</center>

The blue lines indicate the (magnitude of the) residuals and represent the deviations of the observed data points from the model-predicted values (fitted values). The sum of all residuals (positive and negative) is zero, ensured by the least-squares method for estimating the linear model parameters (intercept and slope).

An alternative view is to plot the fitted values (predicted means) on the horizontal line and the residuals, as deviations, on the vertical line.

plot(fitted(lm.2),residuals(lm.2))

<center>[[Image:SMHS_LinearModeling_Fig20.png|500px]]</center>

===Protocols for Rectifying Residual Plots Indicating Nonlinearity===

Model may be excluding important fixed effects that interact with fixed effects already accounted for in the model. If new fixed effects are added, the pattern in the residual plot may disappear.
*Variable transformation – Perform a nonlinear transformation of the response, e.g., log, or reciprocal transform. See this SOCR Activity5.
*Perform a nonlinear transformation to explanatory variables. For instance, if Age is related to Weight in a U-shaped way (e.g., quadratic relation), then the model could include Age and Age2 as predictors.
*If residual plots include stripes, then there may be categorical variables playing role, which may necessitate alternative class of models, such as logistic or multinomial models.

===Lack of Collinearity===

A pair of (linearly) correlated predictors are also called collinear. Suppose Age and Height are correlated (which is certainly to be expected!), then including both as predictors of Weight presents a collinearity problem. In the presence of significant variable collinearity, the interpretation of the model becomes challenging. Depending on which correlated predictors are included in the model, the fixed effects may (incorrectly) become significant or insignificant. Significant findings for these correlated or collinear fixed effects is difficult to interpret as there may be trading-off between the "explanatory power" of the pair of covariates. Multiple predictors that are very similar (linearly correlated) inhibit our ability to decide what plays a big role and what has only marginal impact on the response.

Collinearity may be avoided early during the study-design/data-collection phase of the study to collect fewer fixed effects known to not be linearly correlated. Alternatively, we can selectively include/exclude predictors (e.g., only include in model the most meaningful independent variable and drop the others). Dimensionality reduction methods (e.g., Principal/Independent Component Analyses) also identify (fuse) linearly correlated variables into factors (representing linear combinations transforming several correlated variables into one component variable, which can be used as new fixed effect).

===Heteroskedasticity (lack of homoscedasticity)===

If the variance of the data is (approximately) stable across the range of the predicted values, then the process is homoscedastic (equal variance assumption). Otherwise, when the homoscedasticity criterion is violated, the process is called heteroskedastic (unequal variances).

Satisfying the homoscedasticity assumption requires the model residuals to roughly have a similar amount of deviation from the predicted values. This can be checked by examining the residual plot.

# lm.2 = lm(Weight ~ Age, df.2)
lm.2.res = resid(lm.2)
plot(Age, lm.2.res, ylab="(Weight) Residuals", xlab="Age", main="MLB (lm.2) model residuals")
abline(0, 0)

<center>[[Image:SMHS_LinearModeling_Fig21.png|500px]]</center>

Overall, these data are mostly homoscedastic. A good residual plot essentially looks like a random blob cluster. For instance, using real (simulated) random data, we can see the expectation for the residuals under the linear model assumptions:

plot(rnorm(1000), rbeta(1000, 1,1)-0.5)
abline(0, 0)

<center>[[Image:SMHS_LinearModeling_Fig22.png|500px]]</center>

This creates two sets of 1,000 random numbers (x and y axes representing Normal(mean=0,SD=1) and Beta(1,1) distributions, respectively6). Redoing this simulation multiple times and recreating the residual plots will *not* change the appearance of the scatter!

However, there are many situations where the residual plots may show clear heteroskedasticity:

set.seed(11) # see the random generator with some integer
n <- 256 # define sample size
X <- (1:n)/n # The set of the predictor X values (uniform steps of 1/n from 0 to 1)
E <- rnorm(n, sd=1) # A set of *normally distributed* random noise E values
i <- order(runif(n, max=dnorm(E))) # Reorder E, by putting larger errors at the end, on average
Y <- 1 + 5 * X + E[rev(i)] # Simulate new (observed responses) Y values, X plus "error" `E`.
lm.5 <- lm(Y ~ X) # Regress `Y` against `X`.
par(mfrow=c(1,3)) # Set up 1 row of 3 plots for drawing the graphs
plot(X,Y, main="Simulated Noisy Data (Y) across time/index", cex=0.8)
abline(coef(lm.5), col="Red")
hist(residuals(lm.5), main="Linear Model Residuals")
plot(predict(lm.5), residuals(lm.5), cex=0.8, main="Residuals vs. Predicted (Heteroskedasticity)")

<center>[[Image:SMHS_LinearModeling_Fig23.png|500px]]</center>

In this example, larger fitted values correspond with larger residuals (the opposite may be true as well). Transforming the data often helps resolve such Heteroskedasticity.

===Normality of residuals===

The normality of residuals assumption (parametric assumptions) is also important. Linear models may be robust and gracefully handle certain some violations of the normality assumption.

# lm.2 = lm(Weight ~ Age, df.2)
par(mfrow=c(1,2))
hist(residuals(lm.2))
qqnorm(residuals(lm.2))
qqline(lm.2.res, col="red")

<center>[[Image:SMHS_LinearModeling_Fig24.png|500px]]</center>

The histogram (left) is relatively bell-shaped and the Q-Q normal probability plot (right) indicates the residuals are mostly on a straight line (suggesting errors (observed-predicted) are similar to a normal distribution). Thus, there is no strong evidence suggesting possible violation of the normality assumption.

===Outliers (influential data points)===

Data should not include extreme influential points, otherwise the linear model may be heavily biased. Outliers (influential data points) can drastically change the interpretation of model results and inference, similarly to variable collinearity.

The R function dfbeta() computes some of the regression (leave-one-out deletion) diagnostics for linear models and allows us to check for outliers.

Coefficients

[[SMHS_LinearModeling_LMM|Linear mixed effects analyses]] for scientific inference based on fixed and random effect models, assumptions, and mixed effects logistic regression.

#lm.2 = lm(Weight ~ Age, df.2)
df.results <- dfbeta (lm.2)
head(df.results)

#lm.2 = lm(Weight ~ Age, df.2)
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 179.6684 4.3418 41.381 < 2e-16 ***
Age 0.7672 0.1494 5.135 3.37e-07 ***

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
| ||Intercept||Age
|-
|1||-0.1654198377||0.0051723556
|-
|2||-0.0690980186||0.0026986682
|-
|3||-0.0139731950||0.0007125283
|-
|4||-0.0284523604||0.0010963970
|-
|5||0.1803531368||-0.0069199855
|-
|6||0.0001719468||-0.0008892050
|}
</center>

For each coefficient of the lm.2 model (intercept, Age, etc.), dfbeta gives the DFbeta values. The first row means that the coefficient for Age (0.7672) has to be adjusted by 0.0051723556 if data point 1 is excluded. In other words, the Age coefficient of the model without the first data point would be -‐0.7723724 (=0.7672 + 0.0051723556). If the slope is negative, DFbeta values are subtracted; if the slope is positive, DFbeta values are added.

Interpretation of large or a small DFbeta values is similarly "open" as the interpretation of p-values (case-specific). However, if the DFbeta value changes, the sign of the coefficient slope, then this data point is an outlier candidate (influential point) that needs special attention. Excluding that 1 point would change the interpretation of the model results.

For small to medium size (''n'') data, |DFbeta| > 1 is generally suspicious (outlier). For larger datasets, a rule of thumb criterion is |''DFbeta''| > 2&frasl;√n

par(mfrow=c(1,1))
plot(df.results, pch=23, bg= 'orange', cex=2, ylab="BFBeta(Weight)")

<center>[[Image:SMHS_LinearModeling_Fig25.png|500px]]</center>

Excluding outliers and reporting results using the reduced data set is not an optimal solution. Running and reporting both the analyses with/without the influential points may be a better strategy. We can exclude influential points when there evidence that these represent technical errors.

===Independence===

The independence linear model assumption is the most important limitation (which plays role in most statistical tests). Each data point is supposed to be independent from all the others (e.g., observations come from different subjects).

Violations of the independence assumption make the interpretation of the model results impractical. All assumptions are important; however, the independence assumption is critical. Violating independence may inflate the chance of finding spurious effects, bias the results and generate meaningless p‐values.

Independence is mostly a question of the experimental design which is tightly intertwined with the subsequent statistical analyses. When the study design demands collection of more data per subject, repeated measure designs, the data will have (time) dependencies and the appropriate statistical methodologies for interrogating such data involve mixed linear models.

===Footnotes===

5 http://wiki.socr.umich.edu/index.php/SOCR_EduMaterials_Activities_PowerTransformFamily_Graphs 

6 http://socr.umich.edu/html/dist/

===See next===

* [[SMHS_LinearModeling_LMM|Linear mixed effects analyses]] where we present scientific inference based on fixed and random effect models, assumptions, and mixed effects logistic regression.

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_LinearModeling_MLR_VizModelCoeff}}

SMHS BigDataBigSci SEM Ex1

2016-05-23T13:51:27Z

Imoubara: /* Output */

==[[SMHS_BigDataBigSci_SEM| Structural Equation Modeling (SEM)]] - Hands-on Example 1 (School Kids Mental Abilities) ==

These data (Holzinger & Swineford 1939) include mental ability test scores of 7 & 8 grade children from two schools (Pasteur and Grant-White). This version of the dataset includes only 9 (out of the 26) tests. We can build and test a confirmatory factor analysis (CFA) SEM model for 3 correlated latent variables (or factors), each with three indicators:

*'''visual''' factor measured by 3 variables: x1, x2 and x3,
*'''textual''' factor measured by 3 variables: x4, x5 and x6,
*'''speed''' factor measured by 3 variables: x7, x8 and x9.

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|id||lhs||op||rhs||user||free||ustart
|-
|1 ||Visual||=~||x1||1||0||1
|-
|2 ||Visual||=~||x2||1||1||NA
|-
|3 ||Visual||=~||x3||1||2||NA
|-
|4 ||Textual||=~||x4||1||0||1
|-
|5||Textual||=~||x5||1||3||NA
|-
|6||Textual||=~||x6||1||4||NA
|-
|7 ||Speed||=~||x7||1||0||1
|-
|8 ||Speed||=~||x8||1||5||NA
|-
|9 ||Speed||=~||x9||1||6||NA
|-
|10 ||x1||~~||x1||0||7||NA
|-
|11||x2||~~||x2||0||8||NA
|-
|12||x3||~~||x3||0||9||NA
|-
|13||x4||~~||x4||0||10||NA
|-
|14||x5||~~||x5||0||11||NA
|-
|15||x6||~~||x6||0||12||NA
|-
|16||x7||~~||x7||0||13||NA
|-
|17||x8||~~||x8||0||14||NA
|-
|18||x9||~~||x9||0||15||47.8
|-
|19||Visual||~~||Visual||0||16||NA
|-
|20||Textual||~~||Textual||0||17||NA
|-
|21||Speed||~~||Speed||boy||18||NA
|-
|22||Visual||~~||Textual||girl||19||NA
|-
|23||Visual||~~||Speed||girl||20||NA
|-
|24||Textual||~~||Speed||boy||21||NA
|}
</center>

There are 3 latent variables (factors) in this model, each with 3 indicators, resulting in 9 factor loadings that need to be estimated. There are also 3 covariances among the latent variables {another three parameters}.

These 12 parameters are represented in the path diagram as single-headed and double-headed arrows, respectively. We also need to estimate the residual variances of the 9 observed variables and the variances of the 3 latent variables, resulting in 12 additional free parameters. In total, we have 24 parameters.

<center>[[Image:SMHS_BigDataBigSci2.png|200px]]</center>

To fully identify the model we need to set the metric of the latent variables. There are 2 ways to do this:
*for each latent variable, fix the factor loading of one of the indicators (typically the first) to a constant (e.g., 1.0), or
*standardize the variances of the 3 latent variables.

Either way, we fix 3 of these 24 parameters, and 21 parameters remain free.

The parTable(fit) method, generates this table output.

The `rhs', `op' and `lhs' columns define the parameters of the model.
All parameters with the `=~' operator are factor loadings, whereas all parameters with the `~~' operator are variances or covariances. Nonzero elements in the `free' column are the free parameters of the model. Zero elements in the `free' column correspond to fixed parameters, whose value is found in the `start' column.

Lavaan’s user-friendly model-specification approach is implemented in the fitting functions: cfa() and sem().

Since these data contain 3 latent variables, and no regressions, the minimalist syntax is:

data.model <- 'visual =~ x1 + x2 + x3
textual =~ x4 + x5 + x6
speed =~ x7 + x8 + x9'

Fit the CFA model:

fit.1 <- cfa(data.model, data = HolzingerSwineford1939)

The `user' column (parTabale) shows which parameters were explicitly contained in the user-specified model syntax (= 1), and which parameters were added by the cfa() function (= 0).
parTable(fit.1)

If we prefer not to fix the factor loadings of the first indicator, but instead want to fix the variances of the latent variances, the model syntax would be changed to:
fit.2 <- 'visual =~ NA*x1 + x2 + x3
textual =~ NA*x4 + x5 + x6
speed =~ NA*x7 + x8 + x9
visual ~~ 1*visual
textual ~~ 1*textual
speed ~~ 1*speed'

More complex model specifications can be made using the full '''lavaan''' model syntax:

fit.full <- ' # latent variables
visual =~ 1*x1 + x2 + x3
textual =~ 1*x4 + x5 + x6
speed =~ 1*x7 + x8 + x9
# residual variances observed variables
x1 ~~ x1
x2 ~~ x2
x3 ~~ x3
x4 ~~ x4
x5 ~~ x5
x6 ~~ x6
x7 ~~ x7
x8 ~~ x8
x9 ~~ x9
# factor variances
visual ~~ visual
textual ~~ textual
speed ~~ speed
# factor covariances
visual ~~ textual + speed
textual ~~ speed'
fit.3 <- lavaan(fit.full, data = HolzingerSwineford1939)

We can specify the model where the first factor loadings are explicitly fixed to one, and the covariances among the factors are added manually.

fit.mixed <- ' # latent variables
visual =~ 1*x1 + x2 + x3
textual =~ 1*x4 + x5 + x6
speed =~ 1*x7 + x8 + x9
# factor covariances
visual ~~ textual + speed
textual ~~ speed'
fit <- lavaan(fit.mixed, data = HolzingerSwineford1939, auto.var = TRUE)

The best method to view results from a SEM fitted with lavaan is summary(), which can be called with optional arguments like fit.measures, standardized, and rsquare.

===Core Lavaan Methods===
*summary() print a long summary of the model results
*show() print a short summary of the model results
*coef() returns the estimates of the free parameters in the model as a named numeric vector
*fitted() returns the implied moments (covariance matrix and mean vector) of the model
*resid() returns the raw, normalized or standardized residuals (difference between implied and observed moments)
*vcov() returns the covariance matrix of the estimated parameters
*predict() compute factor scores
*logLik() returns the log-likelihood of the fitted model (if maximum likelihood estimation was used)
*AIC(), BIC() compute information criteria (if maximum likelihood estimation is used)
*update() update a fitted lavaan object
*inspect() peek into the internal representation of the model; by default, it returns a list of model matrices counting the free parameters in the model; can also be used to extract starting values, gradient values, and much more

If these args are set to TRUE, the output includes additional fit measures, standardized estimates, and R2 values for the dependent variables, respectively

fit.model <- 'visual =~ x1 + x2 + x3
textual =~ x4 + x5 + x6
speed =~ x7 + x8 + x9'
fit <- cfa(fit.model, data = HolzingerSwineford1939)
summary(fit, fit.measures = TRUE)

fit <- cfa(fit.model, data=HolzingerSwineford1939, estimator="GLS", group="sex")
fit.4 <- cfa(fit.model, data=HolzingerSwineford1939, estimator="GLD", group="sex", group.equal="regressions")
anova(fit, fit.4)

===Output===
The output consists of three sections.

*The first section (first 6 lines) contains the package version number, an indication whether the model has converged (and in how many iterations), and the effective number of observations used in the analysis.

*The second section contains the model χ^2 test statistic, degrees of freedom, and a p value are printed. If fit.measures = TRUE, it also prints the test statistic of the baseline model (where all observed variables are assumed to be uncorrelated) and several popular fit indices. If maximum likelihood estimation is used, this section will also contain information about the log-likelihood, the AIC, and the BIC.

*The third section provides an overview of the parameter estimates, including the type of standard errors used and whether the observed or expected information matrix was used to compute standard errors. Then, for each model parameter, the estimate and the standard error are displayed, and if appropriate, a z value based on the Wald test and a corresponding two-sided p value are also shown. To ease the reading of the parameter estimates, they are grouped into three blocks:
*factor loadings,
*factor covariances, and
*residual variances of both observed variables and factors.</li>

The summary() method provides a nice summary of the model results for visualization purposes. The parameterEstimates() method returns the actual parameter estimates as a data.frame, which can be processed further.

<center>parameterEstimates(fit)
{| class="wikitable" style="text-align:center; " border="1"
|-
|Index||lhs||op||rhs||est||se||z||pvalue||ci.lower||ci.upper
|-
|1||visual||=~||x1||1||0||NA||NA||1||1
|-
|2||visual||=~||x2||0.553||0.1||5.554||0||0.358||0.749
|-
|3||visual||=~||x3||0.729||0.109||6.685||0||0.516||0.943
|-
|4||textual||=~||x4||1||0||NA||NA||1||1
|-
|5||textual||=~||x5||1.113||0.065||17.014||0||0.985||1.241
|-
|6||textual||=~||x6||0.926||0.055||16.703||0||0.817||1.035
|-
|7||speed||=~||x7||1||0||NA||NA||1||1
|-
|8||speed||=~||x8||1.18||0.165||7.152||0||0.857||1.503
|-
|9||speed||=~||x9||1.082||0.151||7.155||0||0.785||1.378
|-
|10||x1||~~||x1||0.549||0.114||4.833||0||0.326||0.772
|-
|11||x2||~~||x2||1.134||0.102||11.146||0||0.934||1.333
|-
|12||x3||~~||x3||0.844||0.091||9.317||0||0.667||1.022
|-
|13||x4||~~||x4||0.371||0.048||7.779||0||0.278||0.465
|-
|14||x5||~~||x5||0.446||0.058||7.642||0||0.332||0.561
|-
|15||x6||~~||x6||0.356||0.043||8.277||0||0.272||0.441
|-
|16||x7||~~||x7||0.799||0.081||9.823||0||0.64||0.959
|-
|17||x8||~~||x8||0.488||0.074||6.573||0||0.342||0.633
|-
|18||x9||~~||x9||0.566||0.071||8.003||0||0.427||0.705
|-
|19||visual||~~||visual||0.809||0.145||5.564||0||0.524||1.094
|-
|20||textual||~~||textual||0.979||0.112||8.737||0||0.76||1.199
|-
|21||speed||~~||speed||0.384||0.086||4.451||0||0.215||0.553
|-
|22||visual||~~||textual||0.408||0.074||5.552||0||0.264||0.552
|-
|23||visual||~~||speed||0.262||0.056||4.66||0||0.152||0.373
|-
|24||textual||~~||speed||0.173||0.049||3.518||0||0.077||0.27
|}
</center>

The confidence level can be changed by setting the level argument. To obtain several standardized versions of the estimates, we can use standardized = TRUE:

<center>est <- parameterEstimates(fit, ci = FALSE, standardized = TRUE)
subset(est, op == "=~") 

{| class="wikitable" style="text-align:center; " border="1"
|-
|Index||lhs||op||rhs||est||se||z||pvalue||std.lv||std.all||std.nox
|-
|1||visual||=~||x1||1||0||NA||NA||0.9||0.772||0.772
|-
|2||visual||=~||x2||0.553||0.1||5.554||0||0.498||0.424||0.424
|-
|3||visual||=~||x3||0.729||0.109||6.685||0||0.656||0.581||0.581
|-
|4||textual||=~||x4||1||0||NA||NA||0.99||0.852||0.852
|-
|5||textual||=~||x5||1.113||0.065||17.014||0||1.102||0.855||0.855
|-
|6||textual||=~||x6||0.926||0.055||16.703||0||0.917||0.838||0.838
|-
|7||speed||=~||x7||1||0||NA||NA||0.619||0.57||0.57
|-
|8||speed||=~||x8||1.18||0.165||7.152||0||0.731||0.723||0.723
|-
|9||speed||=~||x9||1.082||0.151||7.155||0||0.67||0.665||0.665
|}
</center>

This only shows the factor loadings are shown but 3 additional columns with standardized values are added.
*In the first column (std.lv), only the latent variables have been standardized;
*In the second column (std.all), both the latent and the observed variables have been standardized;
* In the third column (std.nox), both the latent and the observed variables have been standardized, except for the exogenous observed variables. This option may be useful if the standardization of exogenous observed variables has little meaning (for example, binary covariates). Since there are no exogenous covariates in this model, the last two columns are identical in this output.

library("semPlot")
# semPaths(fit, "std", "show")
semPaths(fit, "std", curvePivot = TRUE, edge.label.cex = 1.0)
# get the margines right:
# semPaths(fit, "std", curvePivot = TRUE, edge.label.cex = 1.0, mar = c(10, 3, 10, 3))
# semPaths(fit, "std", curvePivot = TRUE, edge.label.cex = 1.0, mar = c(10, 3, 10, 3), as.expression = c("nodes",
# "edges"), sizeMan = 3, sizeInt = 1, sizeLat = 4)

[[Image:SMHS_BigDataBigSci3.png|500px]]

==See also==
* [[SMHS_BigDataBigSci_SEM| Back to Structural Equation Modeling (SEM)]]
* [[SMHS_BigDataBigSci_SEM_Ex2| Next Section: SEM Example 2: Parkinson’s Disease data]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_BigDataBigSci_SEM_Ex1}}

SMHS TimeSeriesAnalysis

2016-05-23T13:49:44Z

Imoubara: /* Exponential Models */

==[[SMHS| Scientific Methods for Health Sciences]] - Time Series Analysis ==

===Questions===
* Why are trends, patterns or predictions from models/data important?
* How to detect, model and utilize trends in longitudinal data?

Time series analysis represents a class of statistical methods applicable for series data aiming to extract meaningful information, trend and characterization of the process using observed longitudinal data. These trends may be used for time series forecasting and for prediction of future values based on retrospective observations. Note that classical linear modeling (e.g., regression analysis) may also be employed for prediction & testing of associations using the values of one or more independent variables and their effect on the value of another variable. However, time series analysis allows dependencies (e.g., seasonal effects to be accounted for).

===Time-series representation===

There are 3 (distinct and complementary) types of time series patterns that most time-series analyses are trying to identify, model and analyze. These include:

* Trend: A trend is a long-term increase or decrease in the data that may be linear or non-linear, but is generally continuous (mostly monotonic). The trend may be referred to as direction.
* Seasonal: A seasonal pattern is influence in the data, like seasonal factors (e.g., the quarter of the year, the month, or day of the week), which is always of a fixed known period.
* Cyclic: A cyclic pattern of fluctuations corresponds to rises and falls that are not of fixed period.

<center>[[Image:SMHS_TimeSeries1.png|300px]]</center>

For example, the following code shows several time series with different types of time series patterns.

par(mfrow=c(3,2))

n <- 98
X <- cbind(1:n) # time points (annually)
Trend1 <- LakeHuron+0.2*X # series 1
Trend2 <- LakeHuron-0.5*X # series 2

Season1 <- X; Season2 <- X; # series 1 & 2
for(i in 1:n) {
Season1[i] <- LakeHuron[i] + 5*(i%%4)
Season2[i] <- LakeHuron[i] -2*(i%%10)
}

Cyclic1 <- X; Cyclic2 <- X; # series 1 & 2
for(i in 1:n) {
rand1 <- as.integer(runif(1, 1, 10))
Cyclic1[i] <- LakeHuron[i] + 3*(i%%rand1)
Cyclic2[i] <- LakeHuron[i] - 1*(i%%rand1)
}

plot(X, Trend1, xlab="Year",ylab=" Trend1", main="Trend1 (LakeHuron+0.2*X)")
plot(X, Trend2, xlab="Year",ylab=" Trend2" , main="Trend2 (LakeHuron-0.5*X)")
plot(X, Season1, xlab="Year",ylab=" Season1", main=" Season1=Trend1 (LakeHuron+5(i%%4))")
plot(X, Season2, xlab="Year",ylab=" Season2", main=" Season2=Trend1 (LakeHuron-2(i%%10))")
plot(X, Cyclic1, xlab="Year",ylab=" Cyclic1", main=" Cyclic1=Trend1 (LakeHuron+3*(i%%rand1))")
plot(X, Cyclic2, xlab="Year",ylab=" Cyclic2", main=" Cyclic2 = Trend1 (LakeHuron-(i%%rand1))")

Note: If you get this run-time graphics error:
“Error in plot.new() : figure margins too large” 
You need to make sure your graphics window is large enough or print to PDF:

pdf("myplot.pdf"); plot(x); dev.off()

<center>[[Image:SMHS_TimeSeries2.png|300px]]</center>

Let’s look at the delta (Δ) changes - Lagged Differences, using diff, which returns suitably lagged and iterated differences.

## Default lag = 1
par(mfrow=c(1,1))
hist(diff(Trend1), prob=T, col="red") # Plot histogram
lines(density(diff(Trend1)),lwd=2) # plot density estimate
x<-seq(-4,4,length=100); y<-dnorm(x, mean(diff(Trend1)), sd(diff(Trend1)))
lines(x,y,lwd=2,col="blue") # plot MLE Normal Fit

===Time series decomposition===

Denote the time series $yt$ including the three components: a seasonal effect, a trend-cycle effect (containing both trend and cycle), and a remainder component (containing the residual variability in the time series).

Additive model:
$yt=St+Tt+Et,$ where $yt$ is the data at period $t, St$ is the seasonal component at period $t, Tt$ is the trend-cycle component at period $t$ and $Et$ is the remainder (error) component at period $t$. This additive model is appropriate if the magnitude of the seasonal fluctuations or the variation around the trend-cycle does not vary with the level of the time series.

Multiplicative model: $yt=St×Tt×Et$. When the variation in the seasonal pattern, or the variation around the trend-cycle, are proportional to the level of the time series, then a multiplicative model is more appropriate. Note that when using a multiplicative model, we can transform the data to stabilize the variation in the series over time, and then use an additive model. For instance, a log transformation decomposes the multiplicative model from:

$yt=St×Tt×Et$ 
to the additive model: 
$log(yt)=log(St)+log(Tt)+log(Et).$

We can examine the Seasonal trends by decomposing the Time Series by loess (Local Polynomial Regression) Fitting into Seasonal, Trend and irregular components using Loess - Local Polynomial Regression Fitting (stl function, in the default “stats” package):

# using Monthly Males Deaths from Lung Diseases in UK from bronchitis, emphysema and asthma, 1974–1979
mdeaths # is.ts(mdeaths)
fit <- stl(mdeaths, s.window=5)
plot(mdeaths, col="gray", main=" Lung Diseases in UK ", ylab=" Lung Diseases Deaths", xlab="")
lines(fit\$\$$time.series[,2],col="red",ylab="Trend")
plot(fit) # data, seasonal, trend, residuals

<center>“stl” function parameters</center>

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|x||Univariate time series to be decomposed. This should be an object of class "ts" with a frequency greater than one.
|-
|s.window||either the character string "periodic" or the span (in lags) of the loess window for seasonal extraction, which should be odd and at least 7, according to Cleveland et al. This has no default.
|-
|s.degree||degree of locally-fitted polynomial in seasonal extraction. Should be zero or one.
|-
|t.window||the span (in lags) of the loess window for trend extraction, which should be odd. If NULL, the default, nextodd(ceiling((1.5*period) / (1-(1.5/s.window)))), is taken.
|-
|t.degree||degree of locally-fitted polynomial in trend extraction. Should be zero or one.
|-
|l.window||the span (in lags) of the loess window of the low-pass filter used for each subseries. Defaults to the smallest odd integer greater than or equal to frequency(x) which is recommended since it prevents competition between the trend and seasonal components. If not an odd integer its given value is increased to the next odd one.
|-
|l.degree||degree of locally-fitted polynomial for the subseries low-pass filter. Must be 0 or 1.
|-
|s.jump, t.jump, l.jump||integers at least one to increase speed of the respective smoother. Linear interpolation happens between every *.jumpth value.
|-
|robust||logical indicating if robust fitting be used in the loess procedure.
|-
|inner||integer; the number of ‘inner’ (backfitting) iterations; usually very few (2) iterations suffice.
|-
|outer||integer; the number of ‘outer’ robustness iterations.
|-
|na.action||action on missing values.
|}
</center>

<center>[[Image:SMHS_TimeSeries3.png|400px]] [[Image:SMHS_TimeSeries4.png|400px]]</center>

monthplot(fit$\$$time.series[,"seasonal"], main="", ylab="Seasonal", lwd=5)
#As the “fit <- stl(mdeaths, s.window=5)” object has 3 time-series components (seasonal; trend; remainder)
#we can alternatively plot them separately:
#monthplot(fit, choice = "seasonal", cex.axis = 0.8)
#monthplot(fit, choice = "trend", cex.axis = 0.8)
#monthplot(fit, choice = "remainder", type = "h", cex.axis = 1.2) # histogramatic

<center>[[Image:SMHS_TimeSeries5.png|400px]]</center>

These are the seasonal plots and seasonal sub-series plots of the seasonal component illustrating the variation in the seasonal component over time (over the years).

Using historical weather (average daily temperature at the University of Michigan, Ann Arbor):
[http://weather-warehouse.com/WeatherHistory/PastWeatherData_AnnArborUnivOfMi_AnnArbor_MI_January.html]
(See meta-data description and provenance online: [http://weather-warehouse.com/WxWfaqs.html]).

<center>Mean Temperature, (F), UMich, Ann Arbor (1900-2015)</center>
<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
!Year||Jan||Feb||Mar||Apr||May||Jun||Jul||Aug||Sep||Oct||Nov||Dec
|-
|2015||26.3||14.4||34.9||49||64.2||68||71.2||70.2||68.7||53.9||NR||NR
|-
|2014||24.4||19.4||29||48.9||60.7||69.7||68.8||70.8||63.2||52.1||35.4||33.3
|-
|2013||22.7||26.1||33.3||46||63.1||68.5||72.9||70.2||64.6||53.2||37.6||26.7
|-
|2012||22.4||32.8||50.7||49.2||65.2||71.4||78.9||72.2||63.9||51.7||39.6||34.8
|-
|...|| || || || || || || || || || || ||
|-
|...||17||15.3||31.4||47.3||57||69||76.6||72||63.4||52.2||35.2||23.7
|-
|1900||21.4||19.2||24.7||47.8||60.2||66.3||72||75.4||67.2||59||37.6||29.2
|}
</center>

# data: 07_UMich_AnnArbor_MI_TempPrecipitation_HistData_1900_2015.csv
# more complete data is available here: 07_UMich_AnnArbor_MI_TempPrecipitation_HistData_1900_2015.xls umich_data <- read.csv("https://umich.instructure.com/files/702739/download?download_frd=1", header=TRUE)

head(umich_data)

# https://cran.r-project.org/web/packages/mgcv/mgcv.pdf
# install.packages("mgcv"); require(mgcv)

# install.packages("gamair"); require(gamair)
par(mfrow=c(1,1))

The data are in wide format – convert to long format for plotting

# library("reshape2")
long_data <- melt(umich_data, id.vars = c("Year"), value.name = "temperature")
l.sort <- long_data[order(long_data$\$$Year),]
head(l.sort); tail(l.sort)

plot(l.sort$\$$temperature, data = l.sort, type = "l")

Fit the GAMM Model (Generalized Additive Mixed Model)

<center>[[Image:SMHS_TimeSeries6.png|400px]]</center>

Fit a model with trend and seasonal components --- computation may be slow:

# define the parameters controlling the process of model-fitting/parameter-estimation
ctrl <- list(niterEM = 0, msVerbose = TRUE, optimMethod="L-BFGS-B")

# First try this model
mod <- gamm(as.numeric(temperature) ~ s(as.numeric(Year)) + s(as.numeric(variable)), data = l.sort, method = "REML", correlation=corAR1(form = ~ 1|Year), knots=list(Variable = c(1, 12)), na.action=na.omit, control = ctrl)

#Correlation: corStruct object defineing correlation structures in lme. Grouping factors in the formula for this 
#object are assumed to be nested within any random effect grouping factors, without the need to make this 
#explicit in the formula (somewhat different from the behavior of lme). 
#This is similar to the GEE approach to correlation in the generalized case. 
#Knots: an optional list of user specified knot values to be used for basis construction -- 
#different terms can use different numbers of knots, unless they share a covariate. 
#If you revise the model like this (below), it will compare nicely with 3 ARMA models (later) 
mod <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12),
data = l.sort, correlation = corAR1(form = ~ 1|Year), control = ctrl)

Summary of the fitted model:

summary(mod$\$$gam)

Visualize the model trend (year) and seasonal terms (months)

plot(mod$\$$gam, pages = 1)
t <- cbind(1: 1392) # define the time

<center>[[Image:SMHS_TimeSeries7.png|500px]]</center>

Plot the trend on the observed data -- with prediction:

pred2 <- predict(mod$\$$gam, newdata = l.sort, type = "terms")
ptemp2 <- attr(pred2, "constant") + pred2[,1]

# pred2[,1] = trend; pred2[,2] = seasonal effects
# mod$\$$gam is a GAM object containing information to use predict, summary and print methods, but not to use e.g. the anova method function to compare models
plot(temperature ~ t, data = l.sort, type = "l", xlab = "year", ylab = expression(Temperature ~ (degree*F)))
lines(ptemp2 ~ t, data = l.sort, col = "blue", lwd = 2)

<center>[[Image:SMHS_TimeSeries8.png|500px]]</center>

Plot the seasonal model

pred <- predict(mod$\$$gam, newdata = l.sort, type = "terms")
ptemp <- attr(pred, "constant") + pred[,2]

plot(l.sort$\$$temperature ~ t, data = l.sort, type = "l", xlab = "year", ylab = expression(Temperature ~ (degree*F)))
lines(ptemp, data = l.sort, col = "red", lwd = 0.5)

<center>[[Image:SMHS_TimeSeries9.png|500px]]</center>

Zoom in first 100 temps (1:100)

plot(l.sort$\$$temperature ~ t, data = l.sort, type = "l", xlim=c(0, 120), xlab = "year", ylab = expression(Temperature ~ (degree*F))); lines(ptemp, data = l.sort, col = "red", lwd = 0.5)

<center>[[Image:SMHS_TimeSeries10.png|500px]]</center>

To examine how much the estimated trend has changed over the 116 year period, we can use the data contained in pred to compute the difference between the start (Jan 1900) and the end (Dec 2015) of the series in the trend component only:

tail(pred[,1], 1) - head(pred[,1], 1) # subtract the predicted temp [,1] in 1900 (head) from the temp in 2015 (tail)

# names(attributes(pred)); str(pred) # to see the components of the GAM prediction model object (pred)

Assess autocorrelation in residuals

# head(umich_data); tail(umich_data)
acf(resid(mod$\$$lme), lag.max = 36, main = "ACF")
# acf = Auto-correlation and Cross-Covariance Function computes and plots the estimates of the autocovariance or autocorrelation function.
# pacf is the function used for the partial autocorrelations.
# ccf computes the cross-correlation or cross-covariance of two univariate series.
pacf(resid(mod$\$$lme), lag.max = 36, main = "pACF")

Looking at the residuals of this model, using the (partial) autocorrelation function, we see that there may be some residual autocorrelation in the data that the trend term didn’t account for. The shapes of the ACF and the pACF suggest an AR(p) model might be appropriate.

Fit and compare 4 alternative autoregressive models (original mod, AR1, AR2 and AR3)

## AR(1)
m1 <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12),
data = l.sort, correlation = corARMA(form = ~ 1|Year, p = 1), control = ctrl)

## AR(2)
m2 <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12),
data = l.sort, correlation = corARMA(form = ~ 1|Year, p = 2), control = ctrl)

## AR(3)
m3 <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12),
data = l.sort, correlation = corARMA(form = ~ 1|Year, p = 3), control = ctrl)

Note that the correlation argument is specified by corARMA(form = ~ 1|Year, p = x), which fits an ARMA (auto-regressive moving average) process to the residuals, where p indicates the order for the AR part of the ARMA model, and form = ~ 1|Year specifies that the ARMA is nested within each year. This may expedite the model fitting but may also hide potential residual variation from one year to another.

Let’s compare the candidate models by using the generalized likelihood ratio test via the anova() method for lme objects; see our previous mixed effects modeling notes 1 , 2. This model selection is justified as we work with nested models -- going from the AR(3) to the AR(1) by setting some of the AR coefficients to 0. The models also vary in terms of the coefficient estimates for the splines terms which may require fixing some values while choosing the AR structure.

<center>anova(mod$\$$lme, m1$\$$lme, m2$\$$lme, m3$\$$lme)</center>
<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Model||df||AIC||BIC||logLik||Test||L.Ratio||p-value
|-
|mod$\$$lme||1||7||7455.609||7492.228|| -3720.805|| || ||
|-
|m1$\$$lme||2|| 7||7455.609||7492.228|| -3720.805|| || ||
|-
|m2$\$$lme||3|| 8||7453.982||7495.832|| -3718.991||2 vs 3||3.627409||0.0568
|-
|m3$\$$lme||4|| 9||7455.966||7503.048|| -3718.983|| 3 vs 4||0.015687||0.9003
|}
</center>

Interpretation 

The AR(1) model (m1) does not provide a substantial increase in fit over the naive model (mod), and the AR(2) model (m2) only provides a marginal increase in the AR(1) model fit (m1). There is no improvement in moving from m2 to AR(3) model (m3).

Let’s plot the AR(2) model (m2) to inspect how over-fitted the naive model with uncorrelated errors was in terms of the trend term, which shows similar smoothness compared to the initial (mod) model.

plot(m2$\$$gam, scale = 0) # plot(mod2$\$$gam, scale = 0) # “scale=0” ensures optimal y-axis cropping of plot

<center>[[Image:SMHS_TimeSeries11.png|500px]]</center>

Investigation of residual patterns

layout(matrix(1:2, ncol = 2))
# original (mod) model
acf(resid(mod$\$$lme), lag.max = 36, main = "ACF"); pacf(resid(mod$\$$lme), lag.max = 36, main = "pACF")
# pACF controls for the values of the time series at all shorter lags, which contrasts the ACF which does not control for other lags.

<center>[[Image:SMHS_TimeSeries12.png|500px]]</center>

This illustrates that there is some (month=1) Auto-correlation (ACF) and partial auto correlation in the residuals.

# ARM(2) model (m2)
layout(matrix(1:2, ncol = 2))
res <- resid(m2$\$$lme, type = "normalized");
acf(res, lag.max = 36, main = "ACF - AR(2) errors"); pacf(res, lag.max = 36, main = "pACF- AR(2) errors")
layout(1)

<center>[[Image:SMHS_TimeSeries13.png|500px]]</center>

No residual auto-correlation remains in m2. The resulting fitted Generalized Additive Mixed Model (GAMM) object contains information about the trend and the contributions to the fitted values. The package '''mgcv'''3 can spit the information using predict() for each of the 4 models.

# require(mgcv); require(gamair)
# m2 <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12), data = l.sort, correlation = corARMA(form = ~ 1|Year, p = 2), control = ctrl)

pred2 <- predict(m2$\$$gam, newdata = l.sort, type = "terms")
pred_trend2 <- attr(pred2, "constant") + pred2[,1] # trend
pred_season2 <- attr(pred2, "constant") + pred2[,2] # seasonal effects
# plot(m2$\$$gam, scale = 0) # plot pure effects

# Convert the 2 columns (Year and Month/variable) to R Date object
# df_time <- as.Date(paste(as.numeric(l.sort$\$$Year), as.numeric(l.sort$\$$variable), "1", sep="-")); df_time

plot(x=df_time, y=l.sort$\$$temperature, data = l.sort, type = "l", xlim=c(as.Date("1950-02-01"),as.Date("1960-01-01")), xlab = "year", ylab = expression(Temperature ~ (degree*F)))
lines(x=df_time, y=pred_trend2, data = l.sort, col = "red", lwd = 2);
lines(x=df_time, y=pred_season2, data = l.sort, col = "blue", lwd = 2)

<center>[[Image:SMHS_TimeSeries14.png|500px]]</center>

===Moving average smoothing===

A moving average of order $m=2k+1$ can be expressed as:
$T_{t}=\frac{1}{2k+1}\sum_{j=-k}^{k}Y_{t+j}$ .

The ''m''-MA represents an order m moving average, $T_t$, or the estimate of the trend-cycle at time ''t'', obtained by averaging values of the time series within ''k'' periods (left and right) of ''t''. This averaging process denoises the data (eliminates randomness in the data) and produces a smoother trend-cycle component.

The 5-MA contains the values of $T_t$ with ''k''=2. To see what the trend-cycle estimate looks like, we plot it along with the original data

# print the moving average results (k=3 ↔ m=7)
# library("forecast")
plot(l.sort$\$$temperature, data = l.sort, type = "l", main=" UMich/AA Temp (1900-2015) ", ylab=" Temperature (F)", xlab="Year")
lines(ma(l.sort$\$$temperature, 12), col="red", lwd=5)
lines(ma(l.sort$\$$temperature, 36), col="blue", lwd=3)

legend(0, 80, # places a legend at the appropriate place
c("Raw", "k=12 smoother", "k=36 smoothest"), # puts text in the legend
lty=c(1,1,1), # gives the legend appropriate symbols (lines)
cex=1.0, # label sizes
lwd=c(2.5,2.5), col=c("black", "red", "blue")) # gives the legend lines the correct color and width

<center>[[Image:SMHS_TimeSeries15.png|500px]]</center>

The blue trend (''k''=36) (3 yrs) is smoother than the original (raw) data (black) and the 1-yr average (''k''=12). It captures the main movement of the time series without all the minor fluctuations. We can’t estimate $T_t$ where ''t'' is close to the ends as there is not enough data there to compute the averages. The red trend (''k''=12) is smoother than the original (raw) data (black) but more jagged than the 3-yr average. The order of the moving average (''m'') determines the smoothness of the trend-cycle estimate. A larger order implies a smoother curve.

===Simulation of a time-series analysis and prediction===

(1) Simulate a time series

# the ts() function converts a numeric vector into an R time series object.
# format is ts(vector, start=, end=, frequency=) where start and end are the times of the first and last observation
# and frequency is the number of observations per unit time (1=annual, 4=quarterly, 12=monthly, etc.)
Note that ''ling Rate'' = $\frac{1}{Frequency}$

# save a numeric vector containing 16-years (192 monthly) observations
# from Jan 2000 to Dec 2015 as a time series object
sim_ts <- ts(as.integer(runif(192,0,10)), start=c(2000, 1), end=c(2015, 12), frequency=12)
sim_ts

# subset the time series (June 2014 to December 2015)
sim_ts2 <- window(sim_ts, start=c(2014, 6), end=c(2015, 12))
sim_ts2

# plot series
plot(sim_ts)
lines(sim_ts2, col="blue", lwd=3)

<center>[[Image:SMHS_TimeSeries16.png|500px]]</center>

====Seasonal Decomposition====

*The additive and seasonal trends, and irregular components, of time-series may be decomposed using the stl() function. Series with multiplicative effects can by transformed into series with additive effects through a log transformation (i.e., '''ln_sim_ts <- log(sim_ts)).
# Seasonal decomposition
fit_stl <- stl(sim_ts, s.window="period") '''# Seasonal Decomposition of Time Series by Loess'''
plot(fit_stl)

# inspect the distribution of the residuals
hist(fit_stl$\$$time.series[,3]); # this contains the residuals: fit_stl$\$$time.series [,"remainder"], or seasonal, trend

<center>[[Image:SMHS_TimeSeries17.png|500px]]</center>

# additional plots
monthplot(sim_ts) # plots the seasonal subseries of a time series. For each season, a time series is plotted.

# library(forecast)
seasonplot(sim_ts)

====Exponential Models====

*The '''HoltWinters()''' function ('''stats''' package), and the '''ets()''' function ('''forecast''' package) can fit exponential models.
# simple exponential - models level
fit_HW <- HoltWinters(sim_ts, beta=FALSE, gamma=FALSE)

# double exponential - models level and trend
fit_HW2<- HoltWinters(sim_ts, gamma=FALSE)

# triple exponential - models level, trend, and seasonal components
fit_HW3 <- HoltWinters(sim_ts)

plot(fit_HW, col='black')
par(new=TRUE)
plot(fit_HW2, ann=FALSE, axes=FALSE, col='blue')
par(new=TRUE)
plot(fit_HW3, axes=FALSE, col='red')
# clear plot:
# dev.off()
<center>[[Image:SMHS_TimeSeries18.png|500px]]</center>

===Auto-regressive Integrated Moving Average (ARIMA) Models4 ===

There are 2 types of ARIMA time-series models: 
$ X_t= \mu+ \underbrace{\sum_{i=1}^{p}{φ_iX_{t-i}}}_\text{auto-regressive (p) part} +
\underbrace{\sum_{j=1}^{q}{θ_jε_{t-j}}}_\text{moving-average (q) part} +
\underbrace{ ε_t }_\text{error term}.$

====Non-seasonal ARIMA models====
The Non-seasonal ARIMA models are denoted by ARIMA(p, d, q), where parameters p, d, and q are positive integers,
* p = order of the auto-regressive model,
* d = degree of differencing, when ''d''=2, the '''''dth'' difference''' is $(X_t-X_{t-1})-(X_{t-1}-X_{t-2})= X_t-2X_{t-1}+X_{t-2}$. That is, the second difference of ''X'' (d=2) is not the difference between the current period and the value 2 periods ago. It is the first-difference-of-the-first difference, the discrete analog of a second derivative, representing the local acceleration of the series rather than its local trend (first derivative).
* q = order of the moving-average model.

====Seasonal ARIMA models====
The Seasonal AMIMA models are denoted by ''ARIMA(p, d, q)(P, D, Q)m,''
* m = number of periods in each season,
* uppercase P, D, Q represent the auto-regressive, differencing, and moving average terms for the seasonal part of the ARIMA model, and the lower case (p,d,q) are as with non-seasonal ARIMA.

If 2 of the 3 terms are trivial, the model is abbreviated using the non-zero parameter, skipping the "AR", "I" or "MA" from the acronym. For example,

*ARIMA(1,0,0) = AR(1), a stationary and auto-correlated series can be predicted as a multiple of its own previous value, plus a constant. $X_t=μ + φ_1 × X_{t-1}+ \epsilon_t.$ Note that $ε_t=X_t-\hat{X}_t.$

*An ARIMA(0,1,0) = I(1) model, not stationary series, a limiting case of an AR(1) model, the auto-regressive coefficient is equal to 1, i.e., a series with infinitely slow mean reversion, $X_t=μ+X_{t-1}+ε_t,$ a 1-step random walk.

For more complex models:
*An ARIMA(1,1,0), differenced first-order auto-regressive model. $X_t=μ+X_{t-1}+α×(X_{t-1}-X_{t-2})+ε_t.$

*An ARIMA(0,2,2) model is given by $X_t=2X_{t-1}-X_{t-2}+α×ε_{t-1}+β×ε_{t-2}+ ε_t,$ where $α$ and $β$ are the MA(1) and MA(2) coefficients (sometimes these are defined with negative signs). This is a general linear exponential smoothing model that uses exponentially weighted moving averages to estimate both a local level and a local trend in the series. The long-term forecasts from this model converge to a straight line whose slope depends on the average trend observed toward the end of the series.

*ARIMA(1,1,2), $X_t=μ+X_{t-1}+(X_{t-1}+X_{t-2})+α×ε{t}+β×ε_{t-1}$

The '''arima'''() function ('''stats''' package) can be used to fit an auto-regressive integrated moving averages model. Other useful functions include:
* lag(sim_ts, k)      lagged version of time series, shifted back k observations
* diff(sim_ts, differences=d)      difference the time series d times
* ndiffs(sim_ts)      Number of differences required to achieve stationarity (from the forecast package)
* acf(sim_ts)      auto-correlation function
* pacf(sim_ts)      partial auto-correlation function
* adf.test(sim_ts)      Augmented Dickey-Fuller test. Rejecting the null hypothesis suggests that a time series is stationary (from the tseries package)</li>
* Box.test(x, type="Ljung-Box")      Portmanteau test that observations in vector or time series x are independent.

The '''forecast''' package has alternative versions of '''acf()''' and '''pacf()''' called '''Acf()''' and '''Pacf()''' respectively.
# fit an '''ARIMA(P, D, Q) model''' of order:
* P, represents the AR order<
* D, represents the degree of differencing
* Q, represents the MA order.

fit_arima1 <- arima(sim_ts, order=c(3, 1, 2))
# predictive accuracy
library(forecast)
accuracy(fit_arima1)

# predict next 20 observations
library(forecast)
forecast(fit_arima1, 20)
plot(forecast(fit_arima1, 20))

<center>[[Image:SMHS_TimeSeries19.png|600px]]</center>

===Automated Forecasting===

The '''forecast''' package provides functions for the automatic selection of exponential and ARIMA models. The '''ets()''' (exponential TS) function supports both additive and multiplicative models. The '''auto.arima()''' function accounts for seasonal and nonseasonal ARIMA models according to criteria maximizing a cost function.

# library(forecast)

# Automated forecasting using an exponential model
fit_ets <- ets(sim_ts)

# Automated forecasting using an ARIMA model
fit_arima2 <- auto.arima(sim_ts)

# Compare the AIC (model quality) for both models
fit_ets$\$$aic; fit_arima2$\$$aic
accuracy(fit_ets); accuracy(fit_arima2);

'''Akaike’s Information Criterion (AIC)''' = ''-2Log(Likelihood)+2p,'' where ''p'' is he number of estimated parameters.
summary(fit_ets); summary(fit_arima2)

ACF plot of the residuals from the ARIMA(3,1,2) model shows all correlations within the threshold limits indicating that the residuals are behaving like white noise. A portmanteau test returns a large p-value, also suggesting the residuals are white noise.
# acf computes (and by default plots) estimates of the autocovariance or autocorrelation function
acf(residuals(fit_ets))

# Box–Pierce or Ljung–Box test statistic for examining the null hypothesis of independence in a given time series.
# These are sometimes known as ‘portmanteau’ tests.
Box.test(residuals(fit_ets), lag=24, fitdf=4, type="Ljung")
# plot forecast

plot(forecast(fit_arima2))
# more on ARIMA https://www.otexts.org/fpp/8/7

===Footnotes===
* 1 https://umich.instructure.com/files/689861/download?download_frd=1
* 2 https://umich.instructure.com/courses/38100/files
* 3 https://cran.r-project.org/web/packages/mgcv/mgcv.pdf

==See also==
* [[SMHS_TimeSeriesAnalysis_LOS| Applications of Time-series]]

<hr>
* SOCR Home page: http://www.socr.ucla.edu
{{translate|pageName=http://wiki.stat.ucla.edu/socr/index.php?title=SMHS_TimeSeriesAnalysis}}

SMHS TimeSeriesAnalysis

2016-05-23T13:49:32Z

Imoubara: /* Seasonal Decomposition */

==[[SMHS| Scientific Methods for Health Sciences]] - Time Series Analysis ==

===Questions===
* Why are trends, patterns or predictions from models/data important?
* How to detect, model and utilize trends in longitudinal data?

Time series analysis represents a class of statistical methods applicable for series data aiming to extract meaningful information, trend and characterization of the process using observed longitudinal data. These trends may be used for time series forecasting and for prediction of future values based on retrospective observations. Note that classical linear modeling (e.g., regression analysis) may also be employed for prediction & testing of associations using the values of one or more independent variables and their effect on the value of another variable. However, time series analysis allows dependencies (e.g., seasonal effects to be accounted for).

===Time-series representation===

There are 3 (distinct and complementary) types of time series patterns that most time-series analyses are trying to identify, model and analyze. These include:

* Trend: A trend is a long-term increase or decrease in the data that may be linear or non-linear, but is generally continuous (mostly monotonic). The trend may be referred to as direction.
* Seasonal: A seasonal pattern is influence in the data, like seasonal factors (e.g., the quarter of the year, the month, or day of the week), which is always of a fixed known period.
* Cyclic: A cyclic pattern of fluctuations corresponds to rises and falls that are not of fixed period.

<center>[[Image:SMHS_TimeSeries1.png|300px]]</center>

For example, the following code shows several time series with different types of time series patterns.

par(mfrow=c(3,2))

n <- 98
X <- cbind(1:n) # time points (annually)
Trend1 <- LakeHuron+0.2*X # series 1
Trend2 <- LakeHuron-0.5*X # series 2

Season1 <- X; Season2 <- X; # series 1 & 2
for(i in 1:n) {
Season1[i] <- LakeHuron[i] + 5*(i%%4)
Season2[i] <- LakeHuron[i] -2*(i%%10)
}

Cyclic1 <- X; Cyclic2 <- X; # series 1 & 2
for(i in 1:n) {
rand1 <- as.integer(runif(1, 1, 10))
Cyclic1[i] <- LakeHuron[i] + 3*(i%%rand1)
Cyclic2[i] <- LakeHuron[i] - 1*(i%%rand1)
}

plot(X, Trend1, xlab="Year",ylab=" Trend1", main="Trend1 (LakeHuron+0.2*X)")
plot(X, Trend2, xlab="Year",ylab=" Trend2" , main="Trend2 (LakeHuron-0.5*X)")
plot(X, Season1, xlab="Year",ylab=" Season1", main=" Season1=Trend1 (LakeHuron+5(i%%4))")
plot(X, Season2, xlab="Year",ylab=" Season2", main=" Season2=Trend1 (LakeHuron-2(i%%10))")
plot(X, Cyclic1, xlab="Year",ylab=" Cyclic1", main=" Cyclic1=Trend1 (LakeHuron+3*(i%%rand1))")
plot(X, Cyclic2, xlab="Year",ylab=" Cyclic2", main=" Cyclic2 = Trend1 (LakeHuron-(i%%rand1))")

Note: If you get this run-time graphics error:
“Error in plot.new() : figure margins too large” 
You need to make sure your graphics window is large enough or print to PDF:

pdf("myplot.pdf"); plot(x); dev.off()

<center>[[Image:SMHS_TimeSeries2.png|300px]]</center>

Let’s look at the delta (Δ) changes - Lagged Differences, using diff, which returns suitably lagged and iterated differences.

## Default lag = 1
par(mfrow=c(1,1))
hist(diff(Trend1), prob=T, col="red") # Plot histogram
lines(density(diff(Trend1)),lwd=2) # plot density estimate
x<-seq(-4,4,length=100); y<-dnorm(x, mean(diff(Trend1)), sd(diff(Trend1)))
lines(x,y,lwd=2,col="blue") # plot MLE Normal Fit

===Time series decomposition===

Denote the time series $yt$ including the three components: a seasonal effect, a trend-cycle effect (containing both trend and cycle), and a remainder component (containing the residual variability in the time series).

Additive model:
$yt=St+Tt+Et,$ where $yt$ is the data at period $t, St$ is the seasonal component at period $t, Tt$ is the trend-cycle component at period $t$ and $Et$ is the remainder (error) component at period $t$. This additive model is appropriate if the magnitude of the seasonal fluctuations or the variation around the trend-cycle does not vary with the level of the time series.

Multiplicative model: $yt=St×Tt×Et$. When the variation in the seasonal pattern, or the variation around the trend-cycle, are proportional to the level of the time series, then a multiplicative model is more appropriate. Note that when using a multiplicative model, we can transform the data to stabilize the variation in the series over time, and then use an additive model. For instance, a log transformation decomposes the multiplicative model from:

$yt=St×Tt×Et$ 
to the additive model: 
$log(yt)=log(St)+log(Tt)+log(Et).$

We can examine the Seasonal trends by decomposing the Time Series by loess (Local Polynomial Regression) Fitting into Seasonal, Trend and irregular components using Loess - Local Polynomial Regression Fitting (stl function, in the default “stats” package):

# using Monthly Males Deaths from Lung Diseases in UK from bronchitis, emphysema and asthma, 1974–1979
mdeaths # is.ts(mdeaths)
fit <- stl(mdeaths, s.window=5)
plot(mdeaths, col="gray", main=" Lung Diseases in UK ", ylab=" Lung Diseases Deaths", xlab="")
lines(fit\$\$$time.series[,2],col="red",ylab="Trend")
plot(fit) # data, seasonal, trend, residuals

<center>“stl” function parameters</center>

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|x||Univariate time series to be decomposed. This should be an object of class "ts" with a frequency greater than one.
|-
|s.window||either the character string "periodic" or the span (in lags) of the loess window for seasonal extraction, which should be odd and at least 7, according to Cleveland et al. This has no default.
|-
|s.degree||degree of locally-fitted polynomial in seasonal extraction. Should be zero or one.
|-
|t.window||the span (in lags) of the loess window for trend extraction, which should be odd. If NULL, the default, nextodd(ceiling((1.5*period) / (1-(1.5/s.window)))), is taken.
|-
|t.degree||degree of locally-fitted polynomial in trend extraction. Should be zero or one.
|-
|l.window||the span (in lags) of the loess window of the low-pass filter used for each subseries. Defaults to the smallest odd integer greater than or equal to frequency(x) which is recommended since it prevents competition between the trend and seasonal components. If not an odd integer its given value is increased to the next odd one.
|-
|l.degree||degree of locally-fitted polynomial for the subseries low-pass filter. Must be 0 or 1.
|-
|s.jump, t.jump, l.jump||integers at least one to increase speed of the respective smoother. Linear interpolation happens between every *.jumpth value.
|-
|robust||logical indicating if robust fitting be used in the loess procedure.
|-
|inner||integer; the number of ‘inner’ (backfitting) iterations; usually very few (2) iterations suffice.
|-
|outer||integer; the number of ‘outer’ robustness iterations.
|-
|na.action||action on missing values.
|}
</center>

<center>[[Image:SMHS_TimeSeries3.png|400px]] [[Image:SMHS_TimeSeries4.png|400px]]</center>

monthplot(fit$\$$time.series[,"seasonal"], main="", ylab="Seasonal", lwd=5)
#As the “fit <- stl(mdeaths, s.window=5)” object has 3 time-series components (seasonal; trend; remainder)
#we can alternatively plot them separately:
#monthplot(fit, choice = "seasonal", cex.axis = 0.8)
#monthplot(fit, choice = "trend", cex.axis = 0.8)
#monthplot(fit, choice = "remainder", type = "h", cex.axis = 1.2) # histogramatic

<center>[[Image:SMHS_TimeSeries5.png|400px]]</center>

These are the seasonal plots and seasonal sub-series plots of the seasonal component illustrating the variation in the seasonal component over time (over the years).

Using historical weather (average daily temperature at the University of Michigan, Ann Arbor):
[http://weather-warehouse.com/WeatherHistory/PastWeatherData_AnnArborUnivOfMi_AnnArbor_MI_January.html]
(See meta-data description and provenance online: [http://weather-warehouse.com/WxWfaqs.html]).

<center>Mean Temperature, (F), UMich, Ann Arbor (1900-2015)</center>
<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
!Year||Jan||Feb||Mar||Apr||May||Jun||Jul||Aug||Sep||Oct||Nov||Dec
|-
|2015||26.3||14.4||34.9||49||64.2||68||71.2||70.2||68.7||53.9||NR||NR
|-
|2014||24.4||19.4||29||48.9||60.7||69.7||68.8||70.8||63.2||52.1||35.4||33.3
|-
|2013||22.7||26.1||33.3||46||63.1||68.5||72.9||70.2||64.6||53.2||37.6||26.7
|-
|2012||22.4||32.8||50.7||49.2||65.2||71.4||78.9||72.2||63.9||51.7||39.6||34.8
|-
|...|| || || || || || || || || || || ||
|-
|...||17||15.3||31.4||47.3||57||69||76.6||72||63.4||52.2||35.2||23.7
|-
|1900||21.4||19.2||24.7||47.8||60.2||66.3||72||75.4||67.2||59||37.6||29.2
|}
</center>

# data: 07_UMich_AnnArbor_MI_TempPrecipitation_HistData_1900_2015.csv
# more complete data is available here: 07_UMich_AnnArbor_MI_TempPrecipitation_HistData_1900_2015.xls umich_data <- read.csv("https://umich.instructure.com/files/702739/download?download_frd=1", header=TRUE)

head(umich_data)

# https://cran.r-project.org/web/packages/mgcv/mgcv.pdf
# install.packages("mgcv"); require(mgcv)

# install.packages("gamair"); require(gamair)
par(mfrow=c(1,1))

The data are in wide format – convert to long format for plotting

# library("reshape2")
long_data <- melt(umich_data, id.vars = c("Year"), value.name = "temperature")
l.sort <- long_data[order(long_data$\$$Year),]
head(l.sort); tail(l.sort)

plot(l.sort$\$$temperature, data = l.sort, type = "l")

Fit the GAMM Model (Generalized Additive Mixed Model)

<center>[[Image:SMHS_TimeSeries6.png|400px]]</center>

Fit a model with trend and seasonal components --- computation may be slow:

# define the parameters controlling the process of model-fitting/parameter-estimation
ctrl <- list(niterEM = 0, msVerbose = TRUE, optimMethod="L-BFGS-B")

# First try this model
mod <- gamm(as.numeric(temperature) ~ s(as.numeric(Year)) + s(as.numeric(variable)), data = l.sort, method = "REML", correlation=corAR1(form = ~ 1|Year), knots=list(Variable = c(1, 12)), na.action=na.omit, control = ctrl)

#Correlation: corStruct object defineing correlation structures in lme. Grouping factors in the formula for this 
#object are assumed to be nested within any random effect grouping factors, without the need to make this 
#explicit in the formula (somewhat different from the behavior of lme). 
#This is similar to the GEE approach to correlation in the generalized case. 
#Knots: an optional list of user specified knot values to be used for basis construction -- 
#different terms can use different numbers of knots, unless they share a covariate. 
#If you revise the model like this (below), it will compare nicely with 3 ARMA models (later) 
mod <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12),
data = l.sort, correlation = corAR1(form = ~ 1|Year), control = ctrl)

Summary of the fitted model:

summary(mod$\$$gam)

Visualize the model trend (year) and seasonal terms (months)

plot(mod$\$$gam, pages = 1)
t <- cbind(1: 1392) # define the time

<center>[[Image:SMHS_TimeSeries7.png|500px]]</center>

Plot the trend on the observed data -- with prediction:

pred2 <- predict(mod$\$$gam, newdata = l.sort, type = "terms")
ptemp2 <- attr(pred2, "constant") + pred2[,1]

# pred2[,1] = trend; pred2[,2] = seasonal effects
# mod$\$$gam is a GAM object containing information to use predict, summary and print methods, but not to use e.g. the anova method function to compare models
plot(temperature ~ t, data = l.sort, type = "l", xlab = "year", ylab = expression(Temperature ~ (degree*F)))
lines(ptemp2 ~ t, data = l.sort, col = "blue", lwd = 2)

<center>[[Image:SMHS_TimeSeries8.png|500px]]</center>

Plot the seasonal model

pred <- predict(mod$\$$gam, newdata = l.sort, type = "terms")
ptemp <- attr(pred, "constant") + pred[,2]

plot(l.sort$\$$temperature ~ t, data = l.sort, type = "l", xlab = "year", ylab = expression(Temperature ~ (degree*F)))
lines(ptemp, data = l.sort, col = "red", lwd = 0.5)

<center>[[Image:SMHS_TimeSeries9.png|500px]]</center>

Zoom in first 100 temps (1:100)

plot(l.sort$\$$temperature ~ t, data = l.sort, type = "l", xlim=c(0, 120), xlab = "year", ylab = expression(Temperature ~ (degree*F))); lines(ptemp, data = l.sort, col = "red", lwd = 0.5)

<center>[[Image:SMHS_TimeSeries10.png|500px]]</center>

To examine how much the estimated trend has changed over the 116 year period, we can use the data contained in pred to compute the difference between the start (Jan 1900) and the end (Dec 2015) of the series in the trend component only:

tail(pred[,1], 1) - head(pred[,1], 1) # subtract the predicted temp [,1] in 1900 (head) from the temp in 2015 (tail)

# names(attributes(pred)); str(pred) # to see the components of the GAM prediction model object (pred)

Assess autocorrelation in residuals

# head(umich_data); tail(umich_data)
acf(resid(mod$\$$lme), lag.max = 36, main = "ACF")
# acf = Auto-correlation and Cross-Covariance Function computes and plots the estimates of the autocovariance or autocorrelation function.
# pacf is the function used for the partial autocorrelations.
# ccf computes the cross-correlation or cross-covariance of two univariate series.
pacf(resid(mod$\$$lme), lag.max = 36, main = "pACF")

Looking at the residuals of this model, using the (partial) autocorrelation function, we see that there may be some residual autocorrelation in the data that the trend term didn’t account for. The shapes of the ACF and the pACF suggest an AR(p) model might be appropriate.

Fit and compare 4 alternative autoregressive models (original mod, AR1, AR2 and AR3)

## AR(1)
m1 <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12),
data = l.sort, correlation = corARMA(form = ~ 1|Year, p = 1), control = ctrl)

## AR(2)
m2 <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12),
data = l.sort, correlation = corARMA(form = ~ 1|Year, p = 2), control = ctrl)

## AR(3)
m3 <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12),
data = l.sort, correlation = corARMA(form = ~ 1|Year, p = 3), control = ctrl)

Note that the correlation argument is specified by corARMA(form = ~ 1|Year, p = x), which fits an ARMA (auto-regressive moving average) process to the residuals, where p indicates the order for the AR part of the ARMA model, and form = ~ 1|Year specifies that the ARMA is nested within each year. This may expedite the model fitting but may also hide potential residual variation from one year to another.

Let’s compare the candidate models by using the generalized likelihood ratio test via the anova() method for lme objects; see our previous mixed effects modeling notes 1 , 2. This model selection is justified as we work with nested models -- going from the AR(3) to the AR(1) by setting some of the AR coefficients to 0. The models also vary in terms of the coefficient estimates for the splines terms which may require fixing some values while choosing the AR structure.

<center>anova(mod$\$$lme, m1$\$$lme, m2$\$$lme, m3$\$$lme)</center>
<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Model||df||AIC||BIC||logLik||Test||L.Ratio||p-value
|-
|mod$\$$lme||1||7||7455.609||7492.228|| -3720.805|| || ||
|-
|m1$\$$lme||2|| 7||7455.609||7492.228|| -3720.805|| || ||
|-
|m2$\$$lme||3|| 8||7453.982||7495.832|| -3718.991||2 vs 3||3.627409||0.0568
|-
|m3$\$$lme||4|| 9||7455.966||7503.048|| -3718.983|| 3 vs 4||0.015687||0.9003
|}
</center>

Interpretation 

The AR(1) model (m1) does not provide a substantial increase in fit over the naive model (mod), and the AR(2) model (m2) only provides a marginal increase in the AR(1) model fit (m1). There is no improvement in moving from m2 to AR(3) model (m3).

Let’s plot the AR(2) model (m2) to inspect how over-fitted the naive model with uncorrelated errors was in terms of the trend term, which shows similar smoothness compared to the initial (mod) model.

plot(m2$\$$gam, scale = 0) # plot(mod2$\$$gam, scale = 0) # “scale=0” ensures optimal y-axis cropping of plot

<center>[[Image:SMHS_TimeSeries11.png|500px]]</center>

Investigation of residual patterns

layout(matrix(1:2, ncol = 2))
# original (mod) model
acf(resid(mod$\$$lme), lag.max = 36, main = "ACF"); pacf(resid(mod$\$$lme), lag.max = 36, main = "pACF")
# pACF controls for the values of the time series at all shorter lags, which contrasts the ACF which does not control for other lags.

<center>[[Image:SMHS_TimeSeries12.png|500px]]</center>

This illustrates that there is some (month=1) Auto-correlation (ACF) and partial auto correlation in the residuals.

# ARM(2) model (m2)
layout(matrix(1:2, ncol = 2))
res <- resid(m2$\$$lme, type = "normalized");
acf(res, lag.max = 36, main = "ACF - AR(2) errors"); pacf(res, lag.max = 36, main = "pACF- AR(2) errors")
layout(1)

<center>[[Image:SMHS_TimeSeries13.png|500px]]</center>

No residual auto-correlation remains in m2. The resulting fitted Generalized Additive Mixed Model (GAMM) object contains information about the trend and the contributions to the fitted values. The package '''mgcv'''3 can spit the information using predict() for each of the 4 models.

# require(mgcv); require(gamair)
# m2 <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12), data = l.sort, correlation = corARMA(form = ~ 1|Year, p = 2), control = ctrl)

pred2 <- predict(m2$\$$gam, newdata = l.sort, type = "terms")
pred_trend2 <- attr(pred2, "constant") + pred2[,1] # trend
pred_season2 <- attr(pred2, "constant") + pred2[,2] # seasonal effects
# plot(m2$\$$gam, scale = 0) # plot pure effects

# Convert the 2 columns (Year and Month/variable) to R Date object
# df_time <- as.Date(paste(as.numeric(l.sort$\$$Year), as.numeric(l.sort$\$$variable), "1", sep="-")); df_time

plot(x=df_time, y=l.sort$\$$temperature, data = l.sort, type = "l", xlim=c(as.Date("1950-02-01"),as.Date("1960-01-01")), xlab = "year", ylab = expression(Temperature ~ (degree*F)))
lines(x=df_time, y=pred_trend2, data = l.sort, col = "red", lwd = 2);
lines(x=df_time, y=pred_season2, data = l.sort, col = "blue", lwd = 2)

<center>[[Image:SMHS_TimeSeries14.png|500px]]</center>

===Moving average smoothing===

A moving average of order $m=2k+1$ can be expressed as:
$T_{t}=\frac{1}{2k+1}\sum_{j=-k}^{k}Y_{t+j}$ .

The ''m''-MA represents an order m moving average, $T_t$, or the estimate of the trend-cycle at time ''t'', obtained by averaging values of the time series within ''k'' periods (left and right) of ''t''. This averaging process denoises the data (eliminates randomness in the data) and produces a smoother trend-cycle component.

The 5-MA contains the values of $T_t$ with ''k''=2. To see what the trend-cycle estimate looks like, we plot it along with the original data

# print the moving average results (k=3 ↔ m=7)
# library("forecast")
plot(l.sort$\$$temperature, data = l.sort, type = "l", main=" UMich/AA Temp (1900-2015) ", ylab=" Temperature (F)", xlab="Year")
lines(ma(l.sort$\$$temperature, 12), col="red", lwd=5)
lines(ma(l.sort$\$$temperature, 36), col="blue", lwd=3)

legend(0, 80, # places a legend at the appropriate place
c("Raw", "k=12 smoother", "k=36 smoothest"), # puts text in the legend
lty=c(1,1,1), # gives the legend appropriate symbols (lines)
cex=1.0, # label sizes
lwd=c(2.5,2.5), col=c("black", "red", "blue")) # gives the legend lines the correct color and width

<center>[[Image:SMHS_TimeSeries15.png|500px]]</center>

The blue trend (''k''=36) (3 yrs) is smoother than the original (raw) data (black) and the 1-yr average (''k''=12). It captures the main movement of the time series without all the minor fluctuations. We can’t estimate $T_t$ where ''t'' is close to the ends as there is not enough data there to compute the averages. The red trend (''k''=12) is smoother than the original (raw) data (black) but more jagged than the 3-yr average. The order of the moving average (''m'') determines the smoothness of the trend-cycle estimate. A larger order implies a smoother curve.

===Simulation of a time-series analysis and prediction===

(1) Simulate a time series

# the ts() function converts a numeric vector into an R time series object.
# format is ts(vector, start=, end=, frequency=) where start and end are the times of the first and last observation
# and frequency is the number of observations per unit time (1=annual, 4=quarterly, 12=monthly, etc.)
Note that ''ling Rate'' = $\frac{1}{Frequency}$

# save a numeric vector containing 16-years (192 monthly) observations
# from Jan 2000 to Dec 2015 as a time series object
sim_ts <- ts(as.integer(runif(192,0,10)), start=c(2000, 1), end=c(2015, 12), frequency=12)
sim_ts

# subset the time series (June 2014 to December 2015)
sim_ts2 <- window(sim_ts, start=c(2014, 6), end=c(2015, 12))
sim_ts2

# plot series
plot(sim_ts)
lines(sim_ts2, col="blue", lwd=3)

<center>[[Image:SMHS_TimeSeries16.png|500px]]</center>

====Seasonal Decomposition====

*The additive and seasonal trends, and irregular components, of time-series may be decomposed using the stl() function. Series with multiplicative effects can by transformed into series with additive effects through a log transformation (i.e., '''ln_sim_ts <- log(sim_ts)).
# Seasonal decomposition
fit_stl <- stl(sim_ts, s.window="period") '''# Seasonal Decomposition of Time Series by Loess'''
plot(fit_stl)

# inspect the distribution of the residuals
hist(fit_stl$\$$time.series[,3]); # this contains the residuals: fit_stl$\$$time.series [,"remainder"], or seasonal, trend

<center>[[Image:SMHS_TimeSeries17.png|500px]]</center>

# additional plots
monthplot(sim_ts) # plots the seasonal subseries of a time series. For each season, a time series is plotted.

# library(forecast)
seasonplot(sim_ts)

====Exponential Models====

<li>The '''HoltWinters()''' function ('''stats''' package), and the '''ets()''' function ('''forecast''' package) can fit exponential models.</li>
# simple exponential - models level
fit_HW <- HoltWinters(sim_ts, beta=FALSE, gamma=FALSE)

# double exponential - models level and trend
fit_HW2<- HoltWinters(sim_ts, gamma=FALSE)

# triple exponential - models level, trend, and seasonal components
fit_HW3 <- HoltWinters(sim_ts)

plot(fit_HW, col='black')
par(new=TRUE)
plot(fit_HW2, ann=FALSE, axes=FALSE, col='blue')
par(new=TRUE)
plot(fit_HW3, axes=FALSE, col='red')
# clear plot:
# dev.off()
<center>[[Image:SMHS_TimeSeries18.png|500px]]</center>

===Auto-regressive Integrated Moving Average (ARIMA) Models4 ===

There are 2 types of ARIMA time-series models: 
$ X_t= \mu+ \underbrace{\sum_{i=1}^{p}{φ_iX_{t-i}}}_\text{auto-regressive (p) part} +
\underbrace{\sum_{j=1}^{q}{θ_jε_{t-j}}}_\text{moving-average (q) part} +
\underbrace{ ε_t }_\text{error term}.$

====Non-seasonal ARIMA models====
The Non-seasonal ARIMA models are denoted by ARIMA(p, d, q), where parameters p, d, and q are positive integers,
* p = order of the auto-regressive model,
* d = degree of differencing, when ''d''=2, the '''''dth'' difference''' is $(X_t-X_{t-1})-(X_{t-1}-X_{t-2})= X_t-2X_{t-1}+X_{t-2}$. That is, the second difference of ''X'' (d=2) is not the difference between the current period and the value 2 periods ago. It is the first-difference-of-the-first difference, the discrete analog of a second derivative, representing the local acceleration of the series rather than its local trend (first derivative).
* q = order of the moving-average model.

====Seasonal ARIMA models====
The Seasonal AMIMA models are denoted by ''ARIMA(p, d, q)(P, D, Q)m,''
* m = number of periods in each season,
* uppercase P, D, Q represent the auto-regressive, differencing, and moving average terms for the seasonal part of the ARIMA model, and the lower case (p,d,q) are as with non-seasonal ARIMA.

If 2 of the 3 terms are trivial, the model is abbreviated using the non-zero parameter, skipping the "AR", "I" or "MA" from the acronym. For example,

*ARIMA(1,0,0) = AR(1), a stationary and auto-correlated series can be predicted as a multiple of its own previous value, plus a constant. $X_t=μ + φ_1 × X_{t-1}+ \epsilon_t.$ Note that $ε_t=X_t-\hat{X}_t.$

*An ARIMA(0,1,0) = I(1) model, not stationary series, a limiting case of an AR(1) model, the auto-regressive coefficient is equal to 1, i.e., a series with infinitely slow mean reversion, $X_t=μ+X_{t-1}+ε_t,$ a 1-step random walk.

For more complex models:
*An ARIMA(1,1,0), differenced first-order auto-regressive model. $X_t=μ+X_{t-1}+α×(X_{t-1}-X_{t-2})+ε_t.$

*An ARIMA(0,2,2) model is given by $X_t=2X_{t-1}-X_{t-2}+α×ε_{t-1}+β×ε_{t-2}+ ε_t,$ where $α$ and $β$ are the MA(1) and MA(2) coefficients (sometimes these are defined with negative signs). This is a general linear exponential smoothing model that uses exponentially weighted moving averages to estimate both a local level and a local trend in the series. The long-term forecasts from this model converge to a straight line whose slope depends on the average trend observed toward the end of the series.

*ARIMA(1,1,2), $X_t=μ+X_{t-1}+(X_{t-1}+X_{t-2})+α×ε{t}+β×ε_{t-1}$

The '''arima'''() function ('''stats''' package) can be used to fit an auto-regressive integrated moving averages model. Other useful functions include:
* lag(sim_ts, k)      lagged version of time series, shifted back k observations
* diff(sim_ts, differences=d)      difference the time series d times
* ndiffs(sim_ts)      Number of differences required to achieve stationarity (from the forecast package)
* acf(sim_ts)      auto-correlation function
* pacf(sim_ts)      partial auto-correlation function
* adf.test(sim_ts)      Augmented Dickey-Fuller test. Rejecting the null hypothesis suggests that a time series is stationary (from the tseries package)</li>
* Box.test(x, type="Ljung-Box")      Portmanteau test that observations in vector or time series x are independent.

The '''forecast''' package has alternative versions of '''acf()''' and '''pacf()''' called '''Acf()''' and '''Pacf()''' respectively.
# fit an '''ARIMA(P, D, Q) model''' of order:
* P, represents the AR order<
* D, represents the degree of differencing
* Q, represents the MA order.

fit_arima1 <- arima(sim_ts, order=c(3, 1, 2))
# predictive accuracy
library(forecast)
accuracy(fit_arima1)

# predict next 20 observations
library(forecast)
forecast(fit_arima1, 20)
plot(forecast(fit_arima1, 20))

<center>[[Image:SMHS_TimeSeries19.png|600px]]</center>

===Automated Forecasting===

The '''forecast''' package provides functions for the automatic selection of exponential and ARIMA models. The '''ets()''' (exponential TS) function supports both additive and multiplicative models. The '''auto.arima()''' function accounts for seasonal and nonseasonal ARIMA models according to criteria maximizing a cost function.

# library(forecast)

# Automated forecasting using an exponential model
fit_ets <- ets(sim_ts)

# Automated forecasting using an ARIMA model
fit_arima2 <- auto.arima(sim_ts)

# Compare the AIC (model quality) for both models
fit_ets$\$$aic; fit_arima2$\$$aic
accuracy(fit_ets); accuracy(fit_arima2);

'''Akaike’s Information Criterion (AIC)''' = ''-2Log(Likelihood)+2p,'' where ''p'' is he number of estimated parameters.
summary(fit_ets); summary(fit_arima2)

ACF plot of the residuals from the ARIMA(3,1,2) model shows all correlations within the threshold limits indicating that the residuals are behaving like white noise. A portmanteau test returns a large p-value, also suggesting the residuals are white noise.
# acf computes (and by default plots) estimates of the autocovariance or autocorrelation function
acf(residuals(fit_ets))

# Box–Pierce or Ljung–Box test statistic for examining the null hypothesis of independence in a given time series.
# These are sometimes known as ‘portmanteau’ tests.
Box.test(residuals(fit_ets), lag=24, fitdf=4, type="Ljung")
# plot forecast

plot(forecast(fit_arima2))
# more on ARIMA https://www.otexts.org/fpp/8/7

===Footnotes===
* 1 https://umich.instructure.com/files/689861/download?download_frd=1
* 2 https://umich.instructure.com/courses/38100/files
* 3 https://cran.r-project.org/web/packages/mgcv/mgcv.pdf

==See also==
* [[SMHS_TimeSeriesAnalysis_LOS| Applications of Time-series]]

<hr>
* SOCR Home page: http://www.socr.ucla.edu
{{translate|pageName=http://wiki.stat.ucla.edu/socr/index.php?title=SMHS_TimeSeriesAnalysis}}

SMHS TimeSeriesAnalysis LOS

2016-05-23T13:48:42Z

Imoubara:

==[[SMHS_TimeSeriesAnalysis| SMHS: Time-series Analysis]] - Applications ==

===Time series regression studies in environmental epidemiology (London Ozone Study 2002-2006)===
A time series regression analysis of a London ozone dataset including daily observations from 1 January 2002 to 31 December 2006. Each day has records of (mean) '''ozone''' levels that day, and the total number of '''deaths''' that occurred in the city.

====Questions====
*Is there an association between day-to-day variation in ozone levels and daily risk of death?
*Is ozone exposure associated with the outcome is death or other confounders - temperature and relative humidity?

'''Reference:''' Bhaskaran K, Gasparrini A, Hajat S, Smeeth L, Armstrong B. Time series regression studies in environmental epidemiology. ''International Journal of Epidemiology''. 2013;42(4):1187-1195. doi:10.1093/ije/dyt092.
http://www.ncbi.nlm.nih.gov/pmc/articles/PMC3780998/

Load the Data
library(foreign)
#07_LondonOzonPolutionData_2006_TS.csv
#data <- read.csv("https://umich.instructure.com/files/720873/download?download_frd=1")
data <- read.dta("https://umich.instructure.com/files/721042/download?download_frd=1")

#Set the Default Action for Missing Data to na.exclude
options(na.action="na.exclude")

Exploratory Analyses

#set the plotting parameters for the plot

oldpar <- par(no.readonly=TRUE)
par(mex=0.8,mfrow=c(2,1))

#sub-plot for daily deaths, with vertical lines defining years

plot(data$\$$date,data$\$$numdeaths,pch=".",main="Daily deaths over time",
ylab="Daily number of deaths",xlab="Date")
abline(v=data$\$$date[grep("-01-01",data$\$$date)],col=grey(0.6),lty=2)

#plot for ozone levels

plot(data$\$$date,data$\$$ozone,pch=".",main="Ozone levels over time",
ylab="Daily mean ozone level(ug/m3)",xlab="Date")
abline(v=data$\$$date[grep("-01-01",data$\$$date)],col=grey(0.6),lty=2)
par(oldpar)
layout(1)

#descriptive statistics

summary(data)

#correlations

cor(data[,2:4])
#scale exposure
data$\$$ozone10 <- data$\$$ozone/10

Modelling Seasonality and Long-Term Trend

#option 1: time-stratified model 
#generate month and year

data$\$$month <- as.factor(months(data$\$$date,abbr=TRUE))
data$\$$year <- as.factor(substr(data$\$$date,1,4))

#fit a Poisson model with a stratum for each month nested in year 
#(use of quasi-Poisson family for scaling the standard errors)

model1 <- glm(numdeaths ~ month/year,data,family=quasipoisson)
summary(model1)

#compute predicted number of deaths from this model
pred1 <- predict(model1,type="response")

#Figure 2a: Three alternative ways of modelling long-term patterns in the data (seasonality and trends)

plot(data$\$$date,data$\$$numdeaths,ylim=c(100,300),pch=19,cex=0.2,col=grey(0.6),
main="Time-stratified model (month strata)",ylab="Daily number of deaths", xlab="Date")
lines(data$\$$date, pred1,lwd=2)

#Option 2: periodic functions model (fourier terms) 
#use function harmonic, in package '''tsModel'''

install.packages("tsModel"); library(tsModel)

#4 sine-cosine pairs representing different harmonics with period 1 year

data$\$$time <- seq(nrow(data))
fourier <- harmonic(data$\$$time,nfreq=4,period=365.25)

#fit a Poisson model Fourier terms + linear term for trend 
#(use of quasi-Poisson family for scaling the standard errors)

model2 <- glm(numdeaths ~ fourier +time,data,family=quasipoisson)
summary(model2)

#compute predicted number of deaths from this model

pred2 <- predict(model2,type="response")

#Figure 2b

plot(data$\$$date, data$\$$numdeaths,ylim=c(100,300),pch=19,cex=0.2,col=grey(0.6),
main="Sine-cosine functions (Fourier terms)",ylab="Daily number of deaths", xlab="Date")
lines(data$\$$date, pred2,lwd=2)

#Option 3: Spline Model: Flexible Spline Functions 
#generate spline terms, use function '''bs''' in package '''splines'''
library(splines) 
#A CUBIC B-SPLINE WITH 32 EQUALLY-SPACED KNOTS + 2 BOUNDARY KNOTS 
#Note: the 35 basis variables are set as df, with default knots placement. see '''?bs''' 
#other types of splines can be produced with the function ns. see '''?ns'''
spl <- bs(data$\$$time,degree=3,df=35) 
#Fit a Poisson Model Fourier Terms + Linear Term for Trend

model3 <- glm(numdeaths ~ spl,data,family=quasipoisson)
summary(model3)

#compute predicted number of deaths from this model

pred3 <- predict(model3,type="response")

#FIGURE 2C

plot(data$\$$date,data$\$$numdeaths,ylim=c(100,300),pch=19,cex=0.2,col=grey(0.6),
main="Flexible cubic spline model",ylab="Daily number of deaths", xlab="Date")
lines(data$\$$date,pred3,lwd=2)

Plot Response Residuals Over Time From Model 3

#GENERATE RESIDUALS
res3 <- residuals(model3,type="response")
#Figure 3: Residual variation in daily deaths after ‘removing’ (i.e. modelling) season and long-term trend.
plot(data$\$$date,res3,ylim=c(-50,150),pch=19,cex=0.4,col=grey(0.6),
main="Residuals over time",ylab="Residuals (observed-fitted)",xlab="Date")
abline(h=1,lty=2,lwd=2)

Estimate ozone-mortality association - controlling for confounders

#compare the RR (and CI using '''ci.lin''' in package '''Epi''')

install.packages("Epi"); library(Epi)

#unadjusted model

model4 <- glm(numdeaths ~ ozone10,data,family=quasipoisson)
summary(model4)
(eff4 <- ci.lin(model4,subset="ozone10",Exp=T))

#control for seasonality (with spline as in model 3)

model5 <- update(model4, .~. + spl)
summary(model5)
(eff5 <- ci.lin(model5,subset="ozone10",Exp=T))

#control for temperature - temperature modelled with categorical variables for deciles

cutoffs <- quantile(data$\$$temperature,probs=0:10/10)
tempdecile <- cut(data$\$$temperature,breaks=cutoffs,include.lowest=TRUE)
model6 <- update(model5,.~.+tempdecile)
summary(model6)
(eff6 <- ci.lin(model6,subset="ozone10",Exp=T))

Build a summary table with effect as percent increase

tabeff <- rbind(eff4,eff5,eff6)[,5:7]
tabeff <- (tabeff-1)*100
dimnames(tabeff) <- list(c("Unadjusted","Plus season/trend","Plus temperature"), c("RR","ci.low","ci.hi"))
round(tabeff,2)

#explore the lagged (delayed) effects

#SINGLE-LAG MODELS

#prepare the table with estimates

tablag <- matrix(NA,7+1,3,dimnames=list(paste("Lag",0:7), c("RR","ci.low","ci.hi")))

#iterate

for(i in 0:7) {
#lag ozone and temperature variables
ozone10lag <- Lag(data$\$$ozone10,i)
tempdecilelag <- cut(Lag(data$\$$temperature,i),breaks=cutoffs, include.lowest=TRUE)

#define the transformation for temperature

#lag same as above, but with strata terms instead than linear

mod <- glm(numdeaths ~ ozone10lag + tempdecilelag + spl,data, family=quasipoisson)
tablag[i+1,] <- ci.lin(mod,subset="ozone10lag",Exp=T)[5:7]</blockquote>
}
tablag

#Figure 4A: Modelling lagged (delayed) associations between ozone exposure and survival/death outcome.

plot(0:7,0:7,type="n",ylim=c(0.99,1.03),main="Lag terms modelled one at a time", xlab="Lag (days)",
ylab="RR and 95%CI per 10ug/m3 ozone increase")</blockquote>
abline(h=1)
arrows(0:7,tablag[,2],0:7,tablag[,3],length=0.05,angle=90,code=3)
points(0:7,tablag[,1],pch=19)

Model Checking

#generate deviance residuals from unconstrained distributed lag model

res6 <- residuals(model6,type="deviance")

#Figure A1: Plot of deviance residuals over time (London data)

plot(data$\$$date,res6,ylim=c(-5,10),pch=19,cex=0.7,col=grey(0.6),
main="Residuals over time",ylab="Deviance residuals",xlab="Date")
abline(h=0,lty=2,lwd=2)

#Figure A2a: Residual plot for Model6: the residuals relate to the unconstrained distributed lag model with ozone

#(lag days 0 to 7 inclusive), adjusted for temperature at the same lags. The spike in the plot of residuals relate to

#the 2003 European heat wave, and indicate that the current model does not explain the data over this period well.

pacf(res6,na.action=na.omit,main="From original model")

#Include the 1-Day Lagged Residual in the Model

model9 <- update(model6,.~.+Lag(res6,1))

#Figure A2b: residuals related to the unconstrained distributed lag model with ozone (lag days 0 to 7 inclusive),

#adjusted for temperature at the same lags

pacf(residuals(model9,type="deviance"),na.action=na.omit,
main="From model adjusted for residual autocorrelation")

====Irish Longitudinal Study on Ageing Example====

The Irish Longitudinal Study on Ageing (TILDA), 2009-2011 
http://www.icpsr.umich.edu/icpsrweb/ICPSR/studies/34315 
Kenny, Rose Anne. The Irish Longitudinal Study on Ageing (TILDA), 
2009-2011. ICPSR34315-v1. Ann Arbor, MI: Inter-university Consortium 
Bibliographic Citation: for Political and Social Research [distributor], 2014-07-16. 
http://doi.org/10.3886/ICPSR34315.v1

The Irish Longitudinal Study on Ageing (TILDA) is a major inter-institutional initiative led by Trinity College, Dublin, to improve in the quantity and quality of data, research and information related to aging in Ireland. Eligible respondents for this study include individuals aged ≥ 50 and their spouses or partners of any age. Annual interviews on a two yearly basis (N=8,504 people) in Ireland, collecting detailed information on all aspects of their lives, including the economic (pensions, employment, living standards), health (physical, mental, service needs and usage) and social aspects (contact with friends and kin, formal and informal care, social participation). Survey interviews, physical, and biological data are collected along with demographic variables (e.g., age, sex, marital status, household composition, education, and employment), and activities of daily living (ADL), aging, childhood, depression (psychology), education, employment, exercise, eyesight, families, family life, etc.

# download the RDA data object (ICPSR_34315.zip)
# load in the data into RStudio
dataURL <- "https://umich.instructure.com/files/703606/download?download_frd=1"
load(url(dataURL))
head(da34315.0001); data_colnames <- colnames(da34315.0001)
vars <- da34315.0001

vars; head(vars); summary(vars); data_colnames

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|[1]||”ID"||”HOUSEHOLD”
|-
|[3]|| "CLUSTER"||"STRATUM"
|-
|[5]||”REGION”|| "CAPIWEIGHT"
|-
|[7]|| "IN_SCQ"||"SCQ_WEIGHT"
|-
|[9]|| "AGE"||"SEX"
|-
|[11]|| "NML"||"CM003"
|-
|...||||
|-
|[1673]||"HA_WEIGHT"||"IN_HA"
|-
|[1675]|| "SR_HEIGHT_CENTIMETRES"||"HEIGHT"
|-
|[1677]|| "SR_WEIGHT_KILOGRAMMES"||"WEIGHT"
|-
|[1679]||"COGMMSE"||"FRGRIPSTRENGTHD"
|-
|[1681]||"FRGRIPSTRENGTHND"||"VISUALACUITYLEFT"
|-
|[1683]||"VISUALACUITYRIGHT" ||"BPSEATEDSYSTOLIC1"
|-
|[1685]||"BPSEATEDSYSTOLIC2"||"BPSEATEDDIASTOLIC1"
|-
|[1687]||"BPSEATEDDIASTOLIC2"||"BPSEATEDSYSTOLICMEAN"
|-
|[1689]||"BPSEATEDDIASTOLICMEAN"||"BPHYPERTENSION"
|-
|[1691]||"FRBMI"||"FRWAIST"
|-
|[1693]||"FRHIP"||"FRWHR"
|-
|[1695]||"WEARGLASSES"||"WOREGLASSESDURINGTEST"
|-
|[1697]||"BLOODS_CHOL"||"BLOODS_HDL"
|-
|[1699]||"BLOODS_LDL"||"BLOODS_TRIG"
|-
|[1701]||"BLOODS_TIMEBETWEENLASTMEALANDASS"||"DELAY_HA"
|-
|[1703]||"PICMEMSCORE"||"PICRECALLSCORE"
|-
|[1705]||"PICRECOGSCORE"||"VISREASONING"
|-
|[1707]||"GRIPTEST1D"||"GRIPTEST2D"
|-
|[1709]||"GRIPTEST1ND"||"GRIPTEST2ND"
|-
|[1711]||"GRIPTESTDOMINANT"||"GRIPTESTSITTING"
|-
|[1713]||"TEMPERATURE"||"SCQSOCACT1"
|-
|...||||
|-
|[1981]||"SOCPROXCHLD4"||"SCRFLU"
|-
|[1983]||"SCRCHOL"||"SCRPROSTATE"
|-
|[1985]||"SCRBREASTLUMPS"||"SCRMAMMOGRAM"
|-
|[1987]||"BEHALC_FREQ_WEEK"||"BEHALC_DRINKSPERDAY"
|-
|[1989]||"BEHALC_DRINKSPERWEEK"||"BEHALC_DOH_LIMIT"
|-
|[1991]||"BEHSMOKER"||"BEHCAGE"
|}
</center>

# extract some data elements
df1 <- data.frame(vars)

df_Irish_small <- df1[, c("ID", "HOUSEHOLD", "AGE", "SEX" , "HA_WEIGHT", "HEIGHT" ,
"WEIGHT", "COGMMSE", "FRGRIPSTRENGTHD", "VISUALACUITYLEFT",
"VISUALACUITYRIGHT", "BPSEATEDSYSTOLIC1",
"BPSEATEDSYSTOLIC2", "BPSEATEDDIASTOLIC1",
"BPSEATEDDIASTOLIC2", "BPSEATEDSYSTOLICMEAN",
"BPSEATEDDIASTOLICMEAN", "BPHYPERTENSION",
"WEARGLASSES", "WOREGLASSESDURINGTEST",
"BLOODS_CHOL", "BLOODS_HDL",
"BLOODS_LDL", "BLOODS_TRIG",
"PICMEMSCORE", "PICRECALLSCORE",
"PICRECOGSCORE", "VISREASONING",
"TEMPERATURE", "SOCPROXCHLD4", "SCRFLU", "SCRCHOL", "SCRPROSTATE",
"SCRBREASTLUMPS", "SCRMAMMOGRAM",
"BEHALC_FREQ_WEEK", "BEHALC_DRINKSPERDAY",
"BEHALC_DRINKSPERWEEK", "BEHALC_DOH_LIMIT",
"BEHSMOKER", "BEHCAGE" )
]

summary(df_Irish_small); head(df_Irish_small)
write.table(df_Irish_small , "data.csv", sep=",")

===Applications===

====Frailty associations with sustained attention measures5====

Multinomial logistic regression analyses were used to examine frailty as the outcome variable were performed to determine associations between the sustained attention measures and prefrailty or frailty. Binary logistic regression analyses determined significant associations between the sustained attention measures and the individual frailty components. The regression models included age and gender and were also extended to include additional measures of cognitive processing speed (cognitive RT from CRT), executive function (Delta CTT), number of chronic conditions, and number of medications. We also included the quadratic term age2 to allow for any potential nonlinear effects of age on frailty in each regression model. For the independent variables in the multinomial logistic regression models, relative risk (RR) ratios with 95% confidence intervals (CIs) were provided. For the independent variables in the binary logistic regression models, OR with 95% CI were provided.

====Multivariable logistic regression examining the association between social relationships and depression, anxiety, and suicidal ideation6====

5http://psychsocgerontology.oxfordjournals.org/content/early/2013/03/13/geronb.gbt009.full

6http://www.jad-journal.com/article/S0165-0327%2815%2900145-7/fulltext

===Appendix===

==See also==
* [[SMHS_TimeSeriesAnalysis| Previous Section on Time-series analysis]]

<hr>
* SOCR Home page: http://www.socr.ucla.edu

{{translate|pageName=http://wiki.stat.ucla.edu/socr/index.php?title=SMHS_TimeSeriesAnalysis_LOS}}

SMHS TimeSeriesAnalysis

2016-05-23T13:47:59Z

Imoubara: /* Seasonal ARIMA models */

==[[SMHS| Scientific Methods for Health Sciences]] - Time Series Analysis ==

===Questions===
* Why are trends, patterns or predictions from models/data important?
* How to detect, model and utilize trends in longitudinal data?

Time series analysis represents a class of statistical methods applicable for series data aiming to extract meaningful information, trend and characterization of the process using observed longitudinal data. These trends may be used for time series forecasting and for prediction of future values based on retrospective observations. Note that classical linear modeling (e.g., regression analysis) may also be employed for prediction & testing of associations using the values of one or more independent variables and their effect on the value of another variable. However, time series analysis allows dependencies (e.g., seasonal effects to be accounted for).

===Time-series representation===

There are 3 (distinct and complementary) types of time series patterns that most time-series analyses are trying to identify, model and analyze. These include:

* Trend: A trend is a long-term increase or decrease in the data that may be linear or non-linear, but is generally continuous (mostly monotonic). The trend may be referred to as direction.
* Seasonal: A seasonal pattern is influence in the data, like seasonal factors (e.g., the quarter of the year, the month, or day of the week), which is always of a fixed known period.
* Cyclic: A cyclic pattern of fluctuations corresponds to rises and falls that are not of fixed period.

<center>[[Image:SMHS_TimeSeries1.png|300px]]</center>

For example, the following code shows several time series with different types of time series patterns.

par(mfrow=c(3,2))

n <- 98
X <- cbind(1:n) # time points (annually)
Trend1 <- LakeHuron+0.2*X # series 1
Trend2 <- LakeHuron-0.5*X # series 2

Season1 <- X; Season2 <- X; # series 1 & 2
for(i in 1:n) {
Season1[i] <- LakeHuron[i] + 5*(i%%4)
Season2[i] <- LakeHuron[i] -2*(i%%10)
}

Cyclic1 <- X; Cyclic2 <- X; # series 1 & 2
for(i in 1:n) {
rand1 <- as.integer(runif(1, 1, 10))
Cyclic1[i] <- LakeHuron[i] + 3*(i%%rand1)
Cyclic2[i] <- LakeHuron[i] - 1*(i%%rand1)
}

plot(X, Trend1, xlab="Year",ylab=" Trend1", main="Trend1 (LakeHuron+0.2*X)")
plot(X, Trend2, xlab="Year",ylab=" Trend2" , main="Trend2 (LakeHuron-0.5*X)")
plot(X, Season1, xlab="Year",ylab=" Season1", main=" Season1=Trend1 (LakeHuron+5(i%%4))")
plot(X, Season2, xlab="Year",ylab=" Season2", main=" Season2=Trend1 (LakeHuron-2(i%%10))")
plot(X, Cyclic1, xlab="Year",ylab=" Cyclic1", main=" Cyclic1=Trend1 (LakeHuron+3*(i%%rand1))")
plot(X, Cyclic2, xlab="Year",ylab=" Cyclic2", main=" Cyclic2 = Trend1 (LakeHuron-(i%%rand1))")

Note: If you get this run-time graphics error:
“Error in plot.new() : figure margins too large” 
You need to make sure your graphics window is large enough or print to PDF:

pdf("myplot.pdf"); plot(x); dev.off()

<center>[[Image:SMHS_TimeSeries2.png|300px]]</center>

Let’s look at the delta (Δ) changes - Lagged Differences, using diff, which returns suitably lagged and iterated differences.

## Default lag = 1
par(mfrow=c(1,1))
hist(diff(Trend1), prob=T, col="red") # Plot histogram
lines(density(diff(Trend1)),lwd=2) # plot density estimate
x<-seq(-4,4,length=100); y<-dnorm(x, mean(diff(Trend1)), sd(diff(Trend1)))
lines(x,y,lwd=2,col="blue") # plot MLE Normal Fit

===Time series decomposition===

Denote the time series $yt$ including the three components: a seasonal effect, a trend-cycle effect (containing both trend and cycle), and a remainder component (containing the residual variability in the time series).

Additive model:
$yt=St+Tt+Et,$ where $yt$ is the data at period $t, St$ is the seasonal component at period $t, Tt$ is the trend-cycle component at period $t$ and $Et$ is the remainder (error) component at period $t$. This additive model is appropriate if the magnitude of the seasonal fluctuations or the variation around the trend-cycle does not vary with the level of the time series.

Multiplicative model: $yt=St×Tt×Et$. When the variation in the seasonal pattern, or the variation around the trend-cycle, are proportional to the level of the time series, then a multiplicative model is more appropriate. Note that when using a multiplicative model, we can transform the data to stabilize the variation in the series over time, and then use an additive model. For instance, a log transformation decomposes the multiplicative model from:

$yt=St×Tt×Et$ 
to the additive model: 
$log(yt)=log(St)+log(Tt)+log(Et).$

We can examine the Seasonal trends by decomposing the Time Series by loess (Local Polynomial Regression) Fitting into Seasonal, Trend and irregular components using Loess - Local Polynomial Regression Fitting (stl function, in the default “stats” package):

# using Monthly Males Deaths from Lung Diseases in UK from bronchitis, emphysema and asthma, 1974–1979
mdeaths # is.ts(mdeaths)
fit <- stl(mdeaths, s.window=5)
plot(mdeaths, col="gray", main=" Lung Diseases in UK ", ylab=" Lung Diseases Deaths", xlab="")
lines(fit\$\$$time.series[,2],col="red",ylab="Trend")
plot(fit) # data, seasonal, trend, residuals

<center>“stl” function parameters</center>

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|x||Univariate time series to be decomposed. This should be an object of class "ts" with a frequency greater than one.
|-
|s.window||either the character string "periodic" or the span (in lags) of the loess window for seasonal extraction, which should be odd and at least 7, according to Cleveland et al. This has no default.
|-
|s.degree||degree of locally-fitted polynomial in seasonal extraction. Should be zero or one.
|-
|t.window||the span (in lags) of the loess window for trend extraction, which should be odd. If NULL, the default, nextodd(ceiling((1.5*period) / (1-(1.5/s.window)))), is taken.
|-
|t.degree||degree of locally-fitted polynomial in trend extraction. Should be zero or one.
|-
|l.window||the span (in lags) of the loess window of the low-pass filter used for each subseries. Defaults to the smallest odd integer greater than or equal to frequency(x) which is recommended since it prevents competition between the trend and seasonal components. If not an odd integer its given value is increased to the next odd one.
|-
|l.degree||degree of locally-fitted polynomial for the subseries low-pass filter. Must be 0 or 1.
|-
|s.jump, t.jump, l.jump||integers at least one to increase speed of the respective smoother. Linear interpolation happens between every *.jumpth value.
|-
|robust||logical indicating if robust fitting be used in the loess procedure.
|-
|inner||integer; the number of ‘inner’ (backfitting) iterations; usually very few (2) iterations suffice.
|-
|outer||integer; the number of ‘outer’ robustness iterations.
|-
|na.action||action on missing values.
|}
</center>

<center>[[Image:SMHS_TimeSeries3.png|400px]] [[Image:SMHS_TimeSeries4.png|400px]]</center>

monthplot(fit$\$$time.series[,"seasonal"], main="", ylab="Seasonal", lwd=5)
#As the “fit <- stl(mdeaths, s.window=5)” object has 3 time-series components (seasonal; trend; remainder)
#we can alternatively plot them separately:
#monthplot(fit, choice = "seasonal", cex.axis = 0.8)
#monthplot(fit, choice = "trend", cex.axis = 0.8)
#monthplot(fit, choice = "remainder", type = "h", cex.axis = 1.2) # histogramatic

<center>[[Image:SMHS_TimeSeries5.png|400px]]</center>

These are the seasonal plots and seasonal sub-series plots of the seasonal component illustrating the variation in the seasonal component over time (over the years).

Using historical weather (average daily temperature at the University of Michigan, Ann Arbor):
[http://weather-warehouse.com/WeatherHistory/PastWeatherData_AnnArborUnivOfMi_AnnArbor_MI_January.html]
(See meta-data description and provenance online: [http://weather-warehouse.com/WxWfaqs.html]).

<center>Mean Temperature, (F), UMich, Ann Arbor (1900-2015)</center>
<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
!Year||Jan||Feb||Mar||Apr||May||Jun||Jul||Aug||Sep||Oct||Nov||Dec
|-
|2015||26.3||14.4||34.9||49||64.2||68||71.2||70.2||68.7||53.9||NR||NR
|-
|2014||24.4||19.4||29||48.9||60.7||69.7||68.8||70.8||63.2||52.1||35.4||33.3
|-
|2013||22.7||26.1||33.3||46||63.1||68.5||72.9||70.2||64.6||53.2||37.6||26.7
|-
|2012||22.4||32.8||50.7||49.2||65.2||71.4||78.9||72.2||63.9||51.7||39.6||34.8
|-
|...|| || || || || || || || || || || ||
|-
|...||17||15.3||31.4||47.3||57||69||76.6||72||63.4||52.2||35.2||23.7
|-
|1900||21.4||19.2||24.7||47.8||60.2||66.3||72||75.4||67.2||59||37.6||29.2
|}
</center>

# data: 07_UMich_AnnArbor_MI_TempPrecipitation_HistData_1900_2015.csv
# more complete data is available here: 07_UMich_AnnArbor_MI_TempPrecipitation_HistData_1900_2015.xls umich_data <- read.csv("https://umich.instructure.com/files/702739/download?download_frd=1", header=TRUE)

head(umich_data)

# https://cran.r-project.org/web/packages/mgcv/mgcv.pdf
# install.packages("mgcv"); require(mgcv)

# install.packages("gamair"); require(gamair)
par(mfrow=c(1,1))

The data are in wide format – convert to long format for plotting

# library("reshape2")
long_data <- melt(umich_data, id.vars = c("Year"), value.name = "temperature")
l.sort <- long_data[order(long_data$\$$Year),]
head(l.sort); tail(l.sort)

plot(l.sort$\$$temperature, data = l.sort, type = "l")

Fit the GAMM Model (Generalized Additive Mixed Model)

<center>[[Image:SMHS_TimeSeries6.png|400px]]</center>

Fit a model with trend and seasonal components --- computation may be slow:

# define the parameters controlling the process of model-fitting/parameter-estimation
ctrl <- list(niterEM = 0, msVerbose = TRUE, optimMethod="L-BFGS-B")

# First try this model
mod <- gamm(as.numeric(temperature) ~ s(as.numeric(Year)) + s(as.numeric(variable)), data = l.sort, method = "REML", correlation=corAR1(form = ~ 1|Year), knots=list(Variable = c(1, 12)), na.action=na.omit, control = ctrl)

#Correlation: corStruct object defineing correlation structures in lme. Grouping factors in the formula for this 
#object are assumed to be nested within any random effect grouping factors, without the need to make this 
#explicit in the formula (somewhat different from the behavior of lme). 
#This is similar to the GEE approach to correlation in the generalized case. 
#Knots: an optional list of user specified knot values to be used for basis construction -- 
#different terms can use different numbers of knots, unless they share a covariate. 
#If you revise the model like this (below), it will compare nicely with 3 ARMA models (later) 
mod <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12),
data = l.sort, correlation = corAR1(form = ~ 1|Year), control = ctrl)

Summary of the fitted model:

summary(mod$\$$gam)

Visualize the model trend (year) and seasonal terms (months)

plot(mod$\$$gam, pages = 1)
t <- cbind(1: 1392) # define the time

<center>[[Image:SMHS_TimeSeries7.png|500px]]</center>

Plot the trend on the observed data -- with prediction:

pred2 <- predict(mod$\$$gam, newdata = l.sort, type = "terms")
ptemp2 <- attr(pred2, "constant") + pred2[,1]

# pred2[,1] = trend; pred2[,2] = seasonal effects
# mod$\$$gam is a GAM object containing information to use predict, summary and print methods, but not to use e.g. the anova method function to compare models
plot(temperature ~ t, data = l.sort, type = "l", xlab = "year", ylab = expression(Temperature ~ (degree*F)))
lines(ptemp2 ~ t, data = l.sort, col = "blue", lwd = 2)

<center>[[Image:SMHS_TimeSeries8.png|500px]]</center>

Plot the seasonal model

pred <- predict(mod$\$$gam, newdata = l.sort, type = "terms")
ptemp <- attr(pred, "constant") + pred[,2]

plot(l.sort$\$$temperature ~ t, data = l.sort, type = "l", xlab = "year", ylab = expression(Temperature ~ (degree*F)))
lines(ptemp, data = l.sort, col = "red", lwd = 0.5)

<center>[[Image:SMHS_TimeSeries9.png|500px]]</center>

Zoom in first 100 temps (1:100)

plot(l.sort$\$$temperature ~ t, data = l.sort, type = "l", xlim=c(0, 120), xlab = "year", ylab = expression(Temperature ~ (degree*F))); lines(ptemp, data = l.sort, col = "red", lwd = 0.5)

<center>[[Image:SMHS_TimeSeries10.png|500px]]</center>

To examine how much the estimated trend has changed over the 116 year period, we can use the data contained in pred to compute the difference between the start (Jan 1900) and the end (Dec 2015) of the series in the trend component only:

tail(pred[,1], 1) - head(pred[,1], 1) # subtract the predicted temp [,1] in 1900 (head) from the temp in 2015 (tail)

# names(attributes(pred)); str(pred) # to see the components of the GAM prediction model object (pred)

Assess autocorrelation in residuals

# head(umich_data); tail(umich_data)
acf(resid(mod$\$$lme), lag.max = 36, main = "ACF")
# acf = Auto-correlation and Cross-Covariance Function computes and plots the estimates of the autocovariance or autocorrelation function.
# pacf is the function used for the partial autocorrelations.
# ccf computes the cross-correlation or cross-covariance of two univariate series.
pacf(resid(mod$\$$lme), lag.max = 36, main = "pACF")

Looking at the residuals of this model, using the (partial) autocorrelation function, we see that there may be some residual autocorrelation in the data that the trend term didn’t account for. The shapes of the ACF and the pACF suggest an AR(p) model might be appropriate.

Fit and compare 4 alternative autoregressive models (original mod, AR1, AR2 and AR3)

## AR(1)
m1 <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12),
data = l.sort, correlation = corARMA(form = ~ 1|Year, p = 1), control = ctrl)

## AR(2)
m2 <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12),
data = l.sort, correlation = corARMA(form = ~ 1|Year, p = 2), control = ctrl)

## AR(3)
m3 <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12),
data = l.sort, correlation = corARMA(form = ~ 1|Year, p = 3), control = ctrl)

Note that the correlation argument is specified by corARMA(form = ~ 1|Year, p = x), which fits an ARMA (auto-regressive moving average) process to the residuals, where p indicates the order for the AR part of the ARMA model, and form = ~ 1|Year specifies that the ARMA is nested within each year. This may expedite the model fitting but may also hide potential residual variation from one year to another.

Let’s compare the candidate models by using the generalized likelihood ratio test via the anova() method for lme objects; see our previous mixed effects modeling notes 1 , 2. This model selection is justified as we work with nested models -- going from the AR(3) to the AR(1) by setting some of the AR coefficients to 0. The models also vary in terms of the coefficient estimates for the splines terms which may require fixing some values while choosing the AR structure.

<center>anova(mod$\$$lme, m1$\$$lme, m2$\$$lme, m3$\$$lme)</center>
<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Model||df||AIC||BIC||logLik||Test||L.Ratio||p-value
|-
|mod$\$$lme||1||7||7455.609||7492.228|| -3720.805|| || ||
|-
|m1$\$$lme||2|| 7||7455.609||7492.228|| -3720.805|| || ||
|-
|m2$\$$lme||3|| 8||7453.982||7495.832|| -3718.991||2 vs 3||3.627409||0.0568
|-
|m3$\$$lme||4|| 9||7455.966||7503.048|| -3718.983|| 3 vs 4||0.015687||0.9003
|}
</center>

Interpretation 

The AR(1) model (m1) does not provide a substantial increase in fit over the naive model (mod), and the AR(2) model (m2) only provides a marginal increase in the AR(1) model fit (m1). There is no improvement in moving from m2 to AR(3) model (m3).

Let’s plot the AR(2) model (m2) to inspect how over-fitted the naive model with uncorrelated errors was in terms of the trend term, which shows similar smoothness compared to the initial (mod) model.

plot(m2$\$$gam, scale = 0) # plot(mod2$\$$gam, scale = 0) # “scale=0” ensures optimal y-axis cropping of plot

<center>[[Image:SMHS_TimeSeries11.png|500px]]</center>

Investigation of residual patterns

layout(matrix(1:2, ncol = 2))
# original (mod) model
acf(resid(mod$\$$lme), lag.max = 36, main = "ACF"); pacf(resid(mod$\$$lme), lag.max = 36, main = "pACF")
# pACF controls for the values of the time series at all shorter lags, which contrasts the ACF which does not control for other lags.

<center>[[Image:SMHS_TimeSeries12.png|500px]]</center>

This illustrates that there is some (month=1) Auto-correlation (ACF) and partial auto correlation in the residuals.

# ARM(2) model (m2)
layout(matrix(1:2, ncol = 2))
res <- resid(m2$\$$lme, type = "normalized");
acf(res, lag.max = 36, main = "ACF - AR(2) errors"); pacf(res, lag.max = 36, main = "pACF- AR(2) errors")
layout(1)

<center>[[Image:SMHS_TimeSeries13.png|500px]]</center>

No residual auto-correlation remains in m2. The resulting fitted Generalized Additive Mixed Model (GAMM) object contains information about the trend and the contributions to the fitted values. The package '''mgcv'''3 can spit the information using predict() for each of the 4 models.

# require(mgcv); require(gamair)
# m2 <- gamm(as.numeric(temperature) ~ s(as.numeric(Year), k=116) + s(as.numeric(variable), k=12), data = l.sort, correlation = corARMA(form = ~ 1|Year, p = 2), control = ctrl)

pred2 <- predict(m2$\$$gam, newdata = l.sort, type = "terms")
pred_trend2 <- attr(pred2, "constant") + pred2[,1] # trend
pred_season2 <- attr(pred2, "constant") + pred2[,2] # seasonal effects
# plot(m2$\$$gam, scale = 0) # plot pure effects

# Convert the 2 columns (Year and Month/variable) to R Date object
# df_time <- as.Date(paste(as.numeric(l.sort$\$$Year), as.numeric(l.sort$\$$variable), "1", sep="-")); df_time

plot(x=df_time, y=l.sort$\$$temperature, data = l.sort, type = "l", xlim=c(as.Date("1950-02-01"),as.Date("1960-01-01")), xlab = "year", ylab = expression(Temperature ~ (degree*F)))
lines(x=df_time, y=pred_trend2, data = l.sort, col = "red", lwd = 2);
lines(x=df_time, y=pred_season2, data = l.sort, col = "blue", lwd = 2)

<center>[[Image:SMHS_TimeSeries14.png|500px]]</center>

===Moving average smoothing===

A moving average of order $m=2k+1$ can be expressed as:
$T_{t}=\frac{1}{2k+1}\sum_{j=-k}^{k}Y_{t+j}$ .

The ''m''-MA represents an order m moving average, $T_t$, or the estimate of the trend-cycle at time ''t'', obtained by averaging values of the time series within ''k'' periods (left and right) of ''t''. This averaging process denoises the data (eliminates randomness in the data) and produces a smoother trend-cycle component.

The 5-MA contains the values of $T_t$ with ''k''=2. To see what the trend-cycle estimate looks like, we plot it along with the original data

# print the moving average results (k=3 ↔ m=7)
# library("forecast")
plot(l.sort$\$$temperature, data = l.sort, type = "l", main=" UMich/AA Temp (1900-2015) ", ylab=" Temperature (F)", xlab="Year")
lines(ma(l.sort$\$$temperature, 12), col="red", lwd=5)
lines(ma(l.sort$\$$temperature, 36), col="blue", lwd=3)

legend(0, 80, # places a legend at the appropriate place
c("Raw", "k=12 smoother", "k=36 smoothest"), # puts text in the legend
lty=c(1,1,1), # gives the legend appropriate symbols (lines)
cex=1.0, # label sizes
lwd=c(2.5,2.5), col=c("black", "red", "blue")) # gives the legend lines the correct color and width

<center>[[Image:SMHS_TimeSeries15.png|500px]]</center>

The blue trend (''k''=36) (3 yrs) is smoother than the original (raw) data (black) and the 1-yr average (''k''=12). It captures the main movement of the time series without all the minor fluctuations. We can’t estimate $T_t$ where ''t'' is close to the ends as there is not enough data there to compute the averages. The red trend (''k''=12) is smoother than the original (raw) data (black) but more jagged than the 3-yr average. The order of the moving average (''m'') determines the smoothness of the trend-cycle estimate. A larger order implies a smoother curve.

===Simulation of a time-series analysis and prediction===

(1) Simulate a time series

# the ts() function converts a numeric vector into an R time series object.
# format is ts(vector, start=, end=, frequency=) where start and end are the times of the first and last observation
# and frequency is the number of observations per unit time (1=annual, 4=quarterly, 12=monthly, etc.)
Note that ''ling Rate'' = $\frac{1}{Frequency}$

# save a numeric vector containing 16-years (192 monthly) observations
# from Jan 2000 to Dec 2015 as a time series object
sim_ts <- ts(as.integer(runif(192,0,10)), start=c(2000, 1), end=c(2015, 12), frequency=12)
sim_ts

# subset the time series (June 2014 to December 2015)
sim_ts2 <- window(sim_ts, start=c(2014, 6), end=c(2015, 12))
sim_ts2

# plot series
plot(sim_ts)
lines(sim_ts2, col="blue", lwd=3)

<center>[[Image:SMHS_TimeSeries16.png|500px]]</center>

====Seasonal Decomposition====

<li>The additive and seasonal trends, and irregular components, of time-series may be decomposed using the stl() function. Series with multiplicative effects can by transformed into series with additive effects through a log transformation (i.e., '''ln_sim_ts <- log(sim_ts)).</li>

# Seasonal decomposition
fit_stl <- stl(sim_ts, s.window="period") '''# Seasonal Decomposition of Time Series by Loess'''
plot(fit_stl)

# inspect the distribution of the residuals
hist(fit_stl$\$$time.series[,3]); # this contains the residuals: fit_stl$\$$time.series [,"remainder"], or seasonal, trend

<center>[[Image:SMHS_TimeSeries17.png|500px]]</center>

# additional plots
monthplot(sim_ts) # plots the seasonal subseries of a time series. For each season, a time series is plotted.

# library(forecast)
seasonplot(sim_ts)

====Exponential Models====

<li>The '''HoltWinters()''' function ('''stats''' package), and the '''ets()''' function ('''forecast''' package) can fit exponential models.</li>
# simple exponential - models level
fit_HW <- HoltWinters(sim_ts, beta=FALSE, gamma=FALSE)

# double exponential - models level and trend
fit_HW2<- HoltWinters(sim_ts, gamma=FALSE)

# triple exponential - models level, trend, and seasonal components
fit_HW3 <- HoltWinters(sim_ts)

plot(fit_HW, col='black')
par(new=TRUE)
plot(fit_HW2, ann=FALSE, axes=FALSE, col='blue')
par(new=TRUE)
plot(fit_HW3, axes=FALSE, col='red')
# clear plot:
# dev.off()
<center>[[Image:SMHS_TimeSeries18.png|500px]]</center>

===Auto-regressive Integrated Moving Average (ARIMA) Models4 ===

There are 2 types of ARIMA time-series models: 
$ X_t= \mu+ \underbrace{\sum_{i=1}^{p}{φ_iX_{t-i}}}_\text{auto-regressive (p) part} +
\underbrace{\sum_{j=1}^{q}{θ_jε_{t-j}}}_\text{moving-average (q) part} +
\underbrace{ ε_t }_\text{error term}.$

====Non-seasonal ARIMA models====
The Non-seasonal ARIMA models are denoted by ARIMA(p, d, q), where parameters p, d, and q are positive integers,
* p = order of the auto-regressive model,
* d = degree of differencing, when ''d''=2, the '''''dth'' difference''' is $(X_t-X_{t-1})-(X_{t-1}-X_{t-2})= X_t-2X_{t-1}+X_{t-2}$. That is, the second difference of ''X'' (d=2) is not the difference between the current period and the value 2 periods ago. It is the first-difference-of-the-first difference, the discrete analog of a second derivative, representing the local acceleration of the series rather than its local trend (first derivative).
* q = order of the moving-average model.

====Seasonal ARIMA models====
The Seasonal AMIMA models are denoted by ''ARIMA(p, d, q)(P, D, Q)m,''
* m = number of periods in each season,
* uppercase P, D, Q represent the auto-regressive, differencing, and moving average terms for the seasonal part of the ARIMA model, and the lower case (p,d,q) are as with non-seasonal ARIMA.

If 2 of the 3 terms are trivial, the model is abbreviated using the non-zero parameter, skipping the "AR", "I" or "MA" from the acronym. For example,

*ARIMA(1,0,0) = AR(1), a stationary and auto-correlated series can be predicted as a multiple of its own previous value, plus a constant. $X_t=μ + φ_1 × X_{t-1}+ \epsilon_t.$ Note that $ε_t=X_t-\hat{X}_t.$

*An ARIMA(0,1,0) = I(1) model, not stationary series, a limiting case of an AR(1) model, the auto-regressive coefficient is equal to 1, i.e., a series with infinitely slow mean reversion, $X_t=μ+X_{t-1}+ε_t,$ a 1-step random walk.

For more complex models:
*An ARIMA(1,1,0), differenced first-order auto-regressive model. $X_t=μ+X_{t-1}+α×(X_{t-1}-X_{t-2})+ε_t.$

*An ARIMA(0,2,2) model is given by $X_t=2X_{t-1}-X_{t-2}+α×ε_{t-1}+β×ε_{t-2}+ ε_t,$ where $α$ and $β$ are the MA(1) and MA(2) coefficients (sometimes these are defined with negative signs). This is a general linear exponential smoothing model that uses exponentially weighted moving averages to estimate both a local level and a local trend in the series. The long-term forecasts from this model converge to a straight line whose slope depends on the average trend observed toward the end of the series.

*ARIMA(1,1,2), $X_t=μ+X_{t-1}+(X_{t-1}+X_{t-2})+α×ε{t}+β×ε_{t-1}$

The '''arima'''() function ('''stats''' package) can be used to fit an auto-regressive integrated moving averages model. Other useful functions include:
* lag(sim_ts, k)      lagged version of time series, shifted back k observations
* diff(sim_ts, differences=d)      difference the time series d times
* ndiffs(sim_ts)      Number of differences required to achieve stationarity (from the forecast package)
* acf(sim_ts)      auto-correlation function
* pacf(sim_ts)      partial auto-correlation function
* adf.test(sim_ts)      Augmented Dickey-Fuller test. Rejecting the null hypothesis suggests that a time series is stationary (from the tseries package)</li>
* Box.test(x, type="Ljung-Box")      Portmanteau test that observations in vector or time series x are independent.

The '''forecast''' package has alternative versions of '''acf()''' and '''pacf()''' called '''Acf()''' and '''Pacf()''' respectively.
# fit an '''ARIMA(P, D, Q) model''' of order:
* P, represents the AR order<
* D, represents the degree of differencing
* Q, represents the MA order.

fit_arima1 <- arima(sim_ts, order=c(3, 1, 2))
# predictive accuracy
library(forecast)
accuracy(fit_arima1)

# predict next 20 observations
library(forecast)
forecast(fit_arima1, 20)
plot(forecast(fit_arima1, 20))

<center>[[Image:SMHS_TimeSeries19.png|600px]]</center>

===Automated Forecasting===

The '''forecast''' package provides functions for the automatic selection of exponential and ARIMA models. The '''ets()''' (exponential TS) function supports both additive and multiplicative models. The '''auto.arima()''' function accounts for seasonal and nonseasonal ARIMA models according to criteria maximizing a cost function.

# library(forecast)

# Automated forecasting using an exponential model
fit_ets <- ets(sim_ts)

# Automated forecasting using an ARIMA model
fit_arima2 <- auto.arima(sim_ts)

# Compare the AIC (model quality) for both models
fit_ets$\$$aic; fit_arima2$\$$aic
accuracy(fit_ets); accuracy(fit_arima2);

'''Akaike’s Information Criterion (AIC)''' = ''-2Log(Likelihood)+2p,'' where ''p'' is he number of estimated parameters.
summary(fit_ets); summary(fit_arima2)

ACF plot of the residuals from the ARIMA(3,1,2) model shows all correlations within the threshold limits indicating that the residuals are behaving like white noise. A portmanteau test returns a large p-value, also suggesting the residuals are white noise.
# acf computes (and by default plots) estimates of the autocovariance or autocorrelation function
acf(residuals(fit_ets))

# Box–Pierce or Ljung–Box test statistic for examining the null hypothesis of independence in a given time series.
# These are sometimes known as ‘portmanteau’ tests.
Box.test(residuals(fit_ets), lag=24, fitdf=4, type="Ljung")
# plot forecast

plot(forecast(fit_arima2))
# more on ARIMA https://www.otexts.org/fpp/8/7

===Footnotes===
* 1 https://umich.instructure.com/files/689861/download?download_frd=1
* 2 https://umich.instructure.com/courses/38100/files
* 3 https://cran.r-project.org/web/packages/mgcv/mgcv.pdf

==See also==
* [[SMHS_TimeSeriesAnalysis_LOS| Applications of Time-series]]

<hr>
* SOCR Home page: http://www.socr.ucla.edu
{{translate|pageName=http://wiki.stat.ucla.edu/socr/index.php?title=SMHS_TimeSeriesAnalysis}}

SMHS MissingData

2016-05-23T13:46:06Z

Imoubara:

==[[SMHS| Scientific Methods for Health Sciences]] - Missing Data ==

===Questions===
*Why is data usually incomplete?
*What are the best strategies for dealing with missing data- ignore cases, replace them by some population derived values, or impute them?
*What is the impact of data manipulations on the core scientific inference?

===Overview===

Many research studies encounter incomplete (missing) data that require special handling (e.g., processing, statistical analysis, visualization). There are a variety of methods (e.g., multiple imputation) to deal with missing data, detect missingness, impute the data, analyze the completed data-set and compare the characteristics of the raw and imputed data.

Multiple imputation involves 3 steps:

1) Impute: Create sets of plausible values for the missing observations that reflect uncertainty about the non-response model. Each of these sets of plausible values can be used to “fill-in” or complete the data-set.

2) Analyze: process each of these imputed data-sets using complete-data methods.

3) Combine: synthesize the results accounting for the uncertainty within each imputation round.

In a general regression setting, let’s denote the scalar, or vector valued, outcomes by Y, and the corresponding vector of predictors by X. For a given case (e.g., subject, unit), these quantities are either observed (obs) or missing (mis). Thus, Yobs and Xobs represent the observed component of the outcome and the predictors; and Ymis and Xmis denote the unobserved components of the outcome and predictors, respectively. Imputation involves the estimation of the regression parameters β governing the conditional distribution of Y given X: f(Y|X,β). The efficiency, bias and precision of the estimates are important in this process.

The type of missingness in the data is an important factor in the imputation process. The basic patterns of missingness include:

*Missing completely at random (MCAR) assumes that the missing data is not related to any factor, known or unknown, in the study.

*Missingness at random (MAR) assumes that the missingness depends only on observed quantities, which may include outcomes and/or predictors.

*Non-ignorable missingness occurs when the missing data depends on unobserved quantities.

===Multiple Imputation Protocol===

====(1) Imputation:====

Generate a set of $m > 1$ plausible values for $Z_{mis}=(Y_{mis},X_{mis})$.

The imputation step relies upon assumptions regarding the cause of missingness in the dataset. The goal of the imputation is to account for the relationships between the unobserved and observed variables, while taking into account the uncertainty of the imputation. The commonly made MAR assumption for missing data is untestable without additional information. With MAR assumption we can generate imputations (Z{1},Z{2},...Z{m}) from the distribution $f(Z_{mis}|Z_{obs})$, since after conditioning on $Z_{obs}$ the missingness is assumed to be random.

The missingness is monotone when the data matrix can be rearranged so that there is a hierarchy of missingness where observing a particular variable $Z_b$ for a subject implies that $Z_a$ is observed, for $a < b$. In monotone condition settings many imputation methods may be employed including (for continuous variables) propensity methods, predictive mean matching, and (for discrete variables) discriminant analysis or logistic regression. For non-monotonic missingness, Markov Chain Monte Carlo (MCMC) approaches may be used.

Each method has its own assumptions. For instance, predictive mean matching and MCMC approaches require multivariate normality. Predictive mean matching approach employs linear regression for the distribution of a partially observed variable, conditional on other factors. To impute the data using the predictive mean matching approach for a variable $Z_i$ with missing values, we fit a model using complete observations for $Z_1, . . . , Z_{i-1}$ (not monotonicity assumption!):

$E[Z_i|φ]=φ_0+φ_1Z_1+φ_2Z_2+...+φ_{i-1}Z_{i-1}$

Next, new parameters φ* are randomly drawn from the distribution of the parameters (since these values are estimated instead of exactly known). For the 1≤l≤m imputation, the missing values are replaced by:

$Z_i^l= φ_0^* +φ_1^*Z_1 +φ_2^*Z_2+...+φ_{i-1}^*Z_{i-1}+σ^*ϵ$,

where σ* is the estimate of variance from the model and ϵ is a Gaussian, N(0,1). This is the simple regression method. We can impute the observed value of $Z_i$ that is closest to predicted $\hat{Z}_i=Z_i^l$ in the dataset – this is the predictive mean matching method.

The propensity score method uses an alternative model for imputation where the values are imputed from observations that are equally likely to be missing, by fitting a logistic regression model for the missingness indicators. In some situations, propensity score imputation may lead to serious bias for missing covariates. For discrete incomplete variables, discriminant analysis or dichotomous logistic regression may be employed to impute values based on the estimated probability that a missing observation takes on a certain value.

====(2) Analysis:====

Analyze the m datasets using complete-case methods. This second step in the protocol involves carrying out the analysis of interest for each of the m imputed complete-observation datasets and storing the parameter vectors (e.g., effect-size coefficients, β’s) and their standard error estimates.

====(3) Combination:====

Combine the results from the m analyses and calculate the estimates of the within imputation and between imputation variability. If the imputation model is correct (assumptions are valid), these statistics account for the variability of the imputations and provide consistent estimates of the parameters and their standard errors.

===Simulated Example===

set.seed(123)
# create MCAR missing-data generator
create.missing <- function (data, pct.mis = 10)
{
n <- nrow(data)
J <- ncol(data)
if (length(pct.mis) == 1) {
n.mis <- rep((n * (pct.mis/100)), J)

}
else {
if (length(pct.mis) < J)
stop("The length of missing does not equal to the column of the data")
n.mis <- n * (pct.mis/100)

}
for (i in 1:ncol(data)) {
if (n.mis[i] == 0) { # if column has nothing missing, do nothing.
data[, i] <- data[, i]
}
else {
data[sample(1:n, n.mis[i], replace = FALSE), i] <- NA
# For each given column (i), sample the row indices (1:n),
# a number of indices to replace as “missing”, n.mis[i], “NA”,
# without replacement
}
}
return(as.data.frame(data))
}

# Simulate some real multivariate data sim_data={y,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10}
#
n <- 1000; u1 <- rbinom(n, 1, .5); v1 <- log(rnorm(n, 5, 1)); x1 <- u1*exp(v1)
u2 <- rbinom(n, 1, .5); v2 <- log(rnorm(n, 5, 1)); x2 <- u2*exp(v2)
x3 <- rbinom(n, 1, prob=0.45); x4 <- ordered(rep(seq(1, 5),n)[sample(1:n, n)]); x5 <- rep(letters[1:10],n)[sample(1:n, n)]; x6 <- trunc(runif(n, 1, 10)); x7 <- rnorm(n); x8 <- factor(rep(seq(1,10),n)[sample(1:n, n)]); x9 <- runif(n, 0.1, .99); x10 <- rpois(n, 4); y <- x1 + x2 + x7 + x9 + rnorm(n)

# package the simulated data as a data frame object
sim_data <- cbind.data.frame(y, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10)

# randomly create missing values
sim_data_30pct_missing <- create.missing(sim_data, pct.mis=30);
head(sim_data_30pct_missing); summary(sim_data_30pct_missing)

# install.packages("mi")
# install.packages("betareg")
library("betareg"); library("mi")

# get show the missing information matrix
mdf <- missing_data.frame(sim_data_30pct_missing)
show(mdf); mdf@patterns; image(mdf) # remember the visual pattern of this MCAR

# Next try to impute the missing values …
imputations <- mi(sim_data_30pct_missing, n.iter=10, n.chains=3, verbose=TRUE)
hist(imputations)

# Extracts several multiply imputed data.frames from “imputations” object
data.frames <- complete(imputations, 3)

# Compare the summary stats for the original data (prior to introducing missing
# values) with missing data and the re-completed data following imputation
summary(sim_data); summary(sim_data_30pct_missing); summary(data.frames[[1]]);
lapply(data.frames, summary)

<center>
{| class="wikitable" style="text-align:center; width:99%" border="1"
! colspan="22" |Original
|-
|||y||||x1||x2||x3||x4||x5||x6||x7||||x8||x9||x10|| || || || || || || ||
|-
|Min||:-3.046||Min||:0.000||Min.||:0.000||Min||:0.000||0.180555556||a||:100||Min||:1.000||Min.||:-2.880570||1||:100||Min.||:0.1024||Min.||:0.000||
|-
|1st Qu.:2.788||1st Qu.:0.000||1st Qu.:0.000||1st Qu.:0.000||0.222222222||b||:100||1st Qu.:3.000||1st Qu.:-0.687578||2||:100||1st Qu.:0.3356||1st Qu.:2.000||||||||||||||||||
|-
|Median :5.613||Median :3.186||Median :2.024||Median :0.000||0.263888889||c||:100||Median :5.000||Median :0.000836||3||:100||Median :0.5546||Median :4.000||||||||||||||||||
|-
|Mean||:5.658||Mean||:2.626||Mean||:2.480||Mean||:0.459||0.305555556||d||:100||Mean||:4.998||Mean||:-0.020541||4||:100||Mean||:0.5542||Mean||:3.898||
|-
| 3rd Qu.:8.525||3rd Qu.:5.101||3rd Qu.:4.962||3rd Qu.:1.000||0.347222222||e||:100||3rd Qu.:7.000||3rd Qu.:0.635832||5||:100||3rd Qu.:0.7829||3rd Qu.:5.000||||||||||||||||||
|-
| Max.||:17.263||Max.||:8.774||Max.||:8.085||Max||:1.000||f||:100||Max.||:9.000||Max.||:3.281171||6||:100||Max.||:0.9887||Max.||:12.000||||
|-
! colspan="22" |Missing Data
|-
|||y||||x1||x2||x3||x4||x5||x6||x7||||x8||x9||x10||6||:100||||||||||||
|-
| Min.||:-3.046||Min||:0.000||Min.||:0.000||Min.||:0.0000||1||:144||h||:76||Min.||:1.000||Min.||:-2.8806||8||:77||Min.||:0.1024||Min.||:0.000
|-
| 1st Qu.:2.768||1st Qu.:0.000||1st Qu.:0.000||1st Qu.:0.0000||2||:128||a||:72||1st Qu.:3.000||1st Qu.:-0.6974||4||:75||1st Qu.:0.3504||1st Qu.:2.000|| || || || || || || ||
|-
| Median :5.650||Median :3.127||Median :0.000||Median :0.0000||3||:143||d||:72||Median :5.000||Median :-0.0490||9||:72||Median :0.5590||Median :4.000|| || || || || || || ||
|-
| Mean||:5.699||Mean||:2.633||Mean||:2.455||Mean||:0.4586||4||:138||f||:72||Mean||:4.994||Mean||:-0.0261||6||:71||Mean||:0.5619||Mean||:3.853
|-
| 3rd Qu.:8.552||3rd Qu.:5.088||3rd Qu.:4.966||3rd Qu.:1.0000||5||:147||g||:72||3rd Qu.:7.000||3rd Qu.:0.6379||10||:71||3rd Qu.:0.7843||3rd Qu.:5.000|| || || || || || || ||
|-
| Max.||:17.263||Max.||:8.774||Max.||:8.085||Max.||:1.0000||NA's:300||(Other):336||Max.||:9.000||Max.||:2.7863||(Other):334||Max.||:0.9887||Max.||:12.000||||||
|-
| NA's||:300||NA's||:300||NA's||:300||NA's||:300||||NA's||:300||NA's||:300||NA's||:300||NA's||:300||NA's||300||NA's||:300||
|-
! colspan="22" |Imputed
|-
|||y||||x1||x2||x3||x4||x5||x6||x7||||x8||x9||x10||missing y||||||||||||||
|-
| Min.||:-4.646||Min.||:-3.687||Min.||:-4.672||0.381944444||0.199305556||a||:108||Min.||:-1.005||Min.||:-2.88057||4||:114||Min.||:0.04046||Min.||:-2.009||Mode: logical||
|-
| 1st Qu.:3.015||1st Qu.:0.000||1st Qu.:0.000||0.354166667||0.211111111||h||:108||1st Qu.:3.000||1st Qu.:-0.70985||9||:105||1st Qu.:0.36273||1st Qu.:2.352||FALSE:700||||||||||||||||
|-
| Median :5.741||Median :2.836||Median :2.564||0.259722222||d||:107||Median :5.000||Median :-0.03695||5||:103||Median :0.57188||Median :4.000||TRUE :300||||||||||||||||||
|-
| Mean||:5.846||Mean||:2.649||Mean||:2.533||0.297916667||c||:104||Mean||:5.012||Mean||:-0.01444||3||:102||Mean||:0.56607||Mean||:3.858||NA's :0||||
|-
| 3rd Qu.:8.667||3rd Qu.:4.978||3rd Qu.:4.871||0.351388889||j||:100||3rd Qu.:7.000||3rd Qu.:0.70157||6||:102||3rd Qu.:0.78259||3rd Qu.:5.000||||||||||||||||||||
|-
| Max.||:17.263||Max.||:9.979||Max.||:12.833||||f||:99||Max.||:12.178||Max.||:2.78629||8||:102||Max.||:0.99670||Max.||:12.000||||||
|}
</center>

# Check imputation convergence (details provided below)
round(mipply(imputations, mean, to.matrix = TRUE), 3)
Rhats(imputations, statistic = "moments") # assess the convergence of MI algorithm

plot(imputations); hist(imputations); image(imputations); summary(imputations)

# Finally, pool over the m = 5 imputed datasets when we fit the “model”
# Pool from across the 4 chains – in order to estimate a linear regression model
model_results <- pool(y ~ x1+x2+x3+x4+x5+x6+x7+x8+x9+x10, data=imputations, m=5 )
display (model_results); summary (model_results)
# Report the summaries of the imputations
data.frames <- complete(imputations, 3) # extract the first 3 chains
lapply(data.frames, summary)

===TBI Data Example===

See these traumatic brain injury (TBI) data: http://wiki.socr.umich.edu/index.php/SMHS_MissingData#Raw_TBI_data

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|Ind||ID||Age ||Sex ||TBI||field.gcs||er.gcs||icu.gcs||worst.gcs||X6m.gose||X2013.gose||skull.fx||temp.injury||surgery||spikes.hr||min.hr||max.hr||acute.sz||late.sz||ever.sz
|-
|1 ||1||19||M||Fall||10||10||10||10||5||5||0||1||1||NA||NA||NA||1||1||1
|-
|2 ||2||55||M||Blunt||NA||3||3||3||5||7||1||1||1||168.74||14||757||0||1||1
|-
|3 ||3||24||M||Fall||12||12||8||8||7||7||1||0||0||37.37||0||351||0||0||0
|-
|4 ||4||57||F||Fall||4||4||6||4||3||3||1||1||1||4.35||0||59||0||0||0
|-
|5||5||54||F||Peds_vs_Auto||14||11||8||8||5||7||0||1||1||54.59||0||284||0||0||0
|-
|6||6||16||F||MVA||13||7||7||7||7||8||1||1||1||75.92||7||180||0||1||1
|}
</center>

# Load the (raw) data from the table into a plain text file "08_EpiBioSData_Incomplete.csv"
TBI_Data <- read.csv("https://umich.instructure.com/files/720782/download?download_frd=1", na.strings=c("",".","NA"))
summary(TBI_Data)

# Get information matrix of the data
# (1) Convert to a missing_data.frame
# library("betareg"); library("mi")
mdf <- missing_data.frame(TBI_Data) # warnings about missingness patterns
show(mdf); mdf@patterns

# (2) change things: '''mi::change()''' method changes the family, imputation method,
# size, type, and so forth of a missing variable. It’s called
# before calling '''mi''' to affect how the conditional expectation of each
# missing variable is modeled.
mdf <- '''change'''(mdf, y = "spikes.hr", what = "transformation", to = "identity")

<center>
{| class="wikitable" style="text-align:left; " border="1"
|-
|Arg||Description
|-
|y||A character vector naming one or more missing variables within the missing_data.frame specified by the data argument, or a vector of integers or a logical vector indicating which missing_variables to change.
|-
|what||A character string naming what is to be changed, such as "family", "imputation_method", "size","transformation", "type", "link", or "model."
|-
|to||A character string naming what y should be changed to, such as one of the admissible families, imputation methods, transformations, or types. If missing, then possible choices for the "to" argument will be helpfully printed on the screen.
|}
</center>

# (3) examine missingness patterns
summary(mdf); hist(mdf);
image(mdf)

# (4) Perform initial imputation
imputations <- mi(mdf, n.iter=30, n.chains=5, verbose=TRUE)
hist(imputations)

# (5) Extracts several multiply imputed data.frames from “imputations” object
data.frames <- complete(imputations, 5)

# (6) Report a list of “summaries” for each element (imputation instance)
lapply(data.frames, summary)

# (6.a) To cast the imputed numbers as integers (not necessary, but may be useful)
indx <- sapply(data.frames[[5]], is.numeric) # get the indices of numeric columns
data.frames[[5]][indx] <- lapply(data.frames[[5]][indx], function(x) as.numeric(as.integer(x))) # cast each value as integer

# (7) Save results out
write.csv(data.frames[[5]], "C:\\Users\\Dinov\\Desktop\\TBI_MIData.csv")

# (8) Complete Data analytics functions:
# library("mi")
#lm.mi(); glm.mi(); polr.mi(); bayesglm.mi(); bayespolr.mi(); lmer.mi(); glmer.mi()

# (8.1) Define Linear Regression for multiply imputed dataset – Also see Step (10)
##linear regression for each imputed data set - 5 regression models are fit
fit_lm1 <- glm(ever.sz ~ surgery + worst.gcs + factor(sex) + age, data.frames$\$$`chain:1`, family = "binomial"); summary(fit_lm1); display(fit_lm1)

# Fit the appropriate model and pool the results (estimates over MI chains)
model_results <- pool(ever.sz ~ surgery + worst.gcs + factor(sex) + age, family = "binomial", data=imputations, m=5)
display (model_results); summary (model_results)

# Report the summaries of the imputations
data.frames <- complete(imputations, 3) # extract the first 3 chains
lapply(data.frames, summary)

# (9) Validation: we now verify whether enough iterations were conducted.
# Validation criteria demands that the mean of each completed variable should
# be similar for each of the k chains (in this case k=5).
# mipply is wrapper for sapply invoked on mi-class objects to compute the col means
round(mipply(imputations, mean, to.matrix = TRUE), 3)

# Rhat convergence statistics compares the variance between chains to the variance
# across chains.
# Rhat Values ~ 1.0 indicate likely convergence,
# Rhat Values > 1.1 indicate that the chains should be run longer
# (use large number of iterations)
Rhats(imputations, statistic = "moments") # assess the convergence of MI algorithm

# When convergence is unstable, we can continue the iterations for all chains, e.g.
imputations <- mi(imputations, n.iter=20) # add additional 20 iterations

# To plot the produced mi results, for all missing_variables we can generate
# a histogram of the observed, imputed, and completed data.
# We can compare of the completed data to the fitted values implied by the model
# for the completed data, by plotting binned residuals.
# hist function works similarly as plot.
# image function gives a sense of the missingness patterns in the data
plot(imputations); hist(imputations); image(imputations); summary(imputations)

# (10) Finally, pool over the m = 5 imputed datasets when we fit the “model”
# Pool from across the 4 chains – in order to estimate a linear regression model
# and impact ov various predictors

model_results <- pool(ever.sz ~ surgery + worst.gcs + factor(sex) + age, data = imputations, m = 5 ); display (model_results); summary (model_results) 

# Report the summaries of the imputations
data.frames <- complete(imputations, 3) # extract the first 3 chains
lapply(data.frames, summary) # report summaries

===Parkinson's Disease Case Study===

Background: See: http://wiki.socr.umich.edu/index.php/SOCR_Data_PD_BiomedBigMetadata

#imputation for logistic regression
# load the data: 08_PPMI_GSA_clinical.csv
ppmi_new<-read.csv("https://umich.instructure.com/files/330401/download?download_frd=1",header=TRUE)

# install.packages("psych")
library(psych)
# report descriptive statistics

ppmi_new$\$$ResearchGroup <- ifelse(ppmi_new$\$$ResearchGroup == "Control", "Control", "Patient")
ppmi_new$\$$ResearchGroup <- as.factor(ppmi_new$\$$ResearchGroup): table(ppmi_new$\$$ResearchGroup)

# Reduce the Dataset: extract only the columns of interest (to ensure real time calculations)
ppmi_new_1 <- as.data.frame(ppmi_new)[, c("ResearchGroup","R_fusiform_gyrus_Curvedness","Sex","Age","chr12_rs34637584_GT","UPDRS_Part_I_Summary_Score_Baseline","UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Baseline","UPDRS_Part_III_Summary_Score_Baseline", "UPDRS_Part_IV_Summary_Score_Baseline")]

descript <- describe(ppmi_new_1); descript # reports means, SE’s, etc.

dim(ppmi_new); dim(ppmi_new_1) # check dimensions before

# imputation 1
# install.packages("mi"); install.packages("betareg")
library(mi); library(betareg)

mdf<-missing_data.frame(ppmi_new_1[-1,])
apply(ppmi_new_1[-1,],1,mean)
imputations<-mi(mdf, seed=900); summary(imputations)
ppmi_complete<-complete(imputations)

# Save the imputation
# again you may want to cast imputed numerical values as integers, perhaps
# (indx <- sapply(data.frames[[5]], is.numeric) # get the indices of numeric columns
# data.frames[[5]][indx] <- lapply(data.frames[[5]][indx], function(x) as.numeric(as.integer(x))) # cast each value
# write.csv(ppmi_complete,"C:\\Users\\Dinov\\Desktop\\ppmi_new_1_complete.csv")
write.csv(ppmi_complete,"ppmi_new_1_complete.csv")

# Get the imputations of 4 iterations
ppmi_complete_1<- ppmi_complete[[1]]; ppmi_complete_2<- ppmi_complete[[2]];
ppmi_complete_3<- ppmi_complete[[3]]; ppmi_complete_4<- ppmi_complete[[4]]

# average the imputations
ppmi_updrs <- (ppmi_complete_1+ppmi_complete_2+ppmi_complete_4+ppmi_complete_3)/4
# ppmi_top<-cbind(ppmi_new_1[-1,1:335], ppmi_updrs) #delete the first observation
# colnames(ppmi_top)<-colnames(ppmi_new[,1:393])

# Save results – complete dataset
# write.csv(ppmi_top,"C:\\Users\\Dinov\\Desktop\\ppmi_top_complete_1.csv")
# write.csv(ppmi_top,"ppmi_top_complete_1.csv")

# Now, run some Data analytics on complete data:
# library("mi")
#lm.mi(); glm.mi(); polr.mi(); bayesglm.mi(); bayespolr.mi(); lmer.mi(); glmer.mi()
# Define Linear Regression for multiply imputed dataset
##linear regression for each imputed data set - 5 regression models are fit

model_results <- pool(ResearchGroup ~ R_fusiform_gyrus_Curvedness + factor(Sex) + Age +
factor(chr12_rs34637584_GT) + UPDRS_Part_I_Summary_Score_Baseline + UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Baseline + UPDRS_Part_III_Summary_Score_Baseline, family = "binomial", data=imputations, m=3)
display (model_results); summary (model_results)

===[[SMHS_MissingData_Appendix|Appendix]]===

===See also===
* [[SOCR_Simulated_HELP_Data_Activity#Multiple_imputation| The SOCR Simulated HELP data activity provides additional missing data management examples]].
* [http://sites.stat.psu.edu/~jls/mifaq.html Multiple Imputation FAQs].

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_MissingData}}

SMHS BigDataBigSci GEE

2016-05-23T13:44:20Z

Imoubara:

==[[SMHS_BigDataBigSci| Model-based Analytics]] - Generalized Estimating Equation (GEE) Modeling ==

==Questions==

*How to represent dependencies in linear models and examine causal effects?
*Is there a way to study population average effects of a covariate against specific individual effects?

==Overview==

GEE is a marginal longitudinal method that directly assesses the mean relations of interest (i.e., how the mean dependent variable changes over time), accounting for covariances among the observations within subjects, and getting a better estimate and valid significance tests of the relations. Thus, GEE estimates two different equations, (1) for the mean relations, and (2) for the covariance structure. An advantage of GEE over random-effect models is that it does not require the dependent variable to be normally distributed. However, a disadvantage of GEE is that it is less flexible and versatile – commonly employed algorithms for it require a small-to-moderate number of time points evenly (or approximately evenly) spaced, and similarly spaced across subjects. Nevertheless, it is a little more flexible than repeated-measure ANOVA because it permits some missing values and has an easy way to test for and model away the specific form of autocorrelation within subjects.

GEE is mostly used when the study is focused on uncovering the population average effect of a covariate vs. the individual specific effect. These two things are only equivalent for linear models, but not in non-linear models.

==See also==
*[[SMHS_BigDataBigSci| Back to Model-based Analytics]]
*[[SMHS_BigDataBigSci_GCM| Back to Growth Curve Modeling ]]
*[[SMHS_BigDataBigSci_SEM| Back to Structural Equation Modeling (SEM)]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_BigDataBigSci_GEE}}

SMHS BigDataBigSci GCM

2016-05-23T13:44:02Z

Imoubara: /* Appendix */

==[[SMHS_BigDataBigSci| Model-based Analytics]] - Growth Curve Models==

Latent growth curve models may be used to analyze longitudinal or temporal data where the outcome measure is assessed on multiple occasions, and we examine its change over time, e.g., the trajectory over time can be
modeled as a linear or quadratic function. Random effects are used to capture individual differences by conveniently representing (continuous) latent variables, aka growth factors. To fit a linear growth model we may specify a model with two latent variables: a random intercept, and a random slope:

#load data 05_PPMI_top_UPDRS_Integrated_LongFormat.csv ( dim(myData) 661 71), wide
# setwd("/dir/")
myData <- read.csv("https://umich.instructure.com/files/330395/download?download_frd=1&verifier=v6jBvV4x94ka3EYcGKuXXg5BZNaOLBVp0xkJih0H",header=TRUE)
attach(myData)

# dichotomize the "ResearchGroup" variable
table(myData$\$$ResearchGroup)
myData$\$$ResearchGroup <- ifelse(myData$\$$ResearchGroup == "Control", 1, 0)

# linear growth model with 4 timepoints
# intercept (i) and slope (s) with fixed coefficients
# i =~ 1*t1 + 1*t2 + 1*t3 + 1*t4 (intercept/constant)
# s =~ 0*t1 + 1*t2 + 2*t3 + 3*t4 (slope/linear term)
# ??? =~ 0*t1 + 1*t2 + 2*t3 + 3*t4 (quadratic term)

In this model, we have fixed all the coefficients of the linear growth functions:

model4 <-
'
i =~ 1*UPDRS_Part_I_Summary_Score_Baseline + 1*UPDRS_Part_I_Summary_Score_Month_03 +
1*UPDRS_Part_I_Summary_Score_Month_06 + 1*UPDRS_Part_I_Summary_Score_Month_09 +
1*UPDRS_Part_I_Summary_Score_Month_12 + 1*UPDRS_Part_I_Summary_Score_Month_18 +
1*UPDRS_Part_I_Summary_Score_Month_24 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Baseline +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_03 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_06 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_09 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_12 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_18 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_24 +
1*UPDRS_Part_III_Summary_Score_Baseline + 1*UPDRS_Part_III_Summary_Score_Month_03 +
1*UPDRS_Part_III_Summary_Score_Month_06 + 1*UPDRS_Part_III_Summary_Score_Month_09 +
1*UPDRS_Part_III_Summary_Score_Month_12 + 1*UPDRS_Part_III_Summary_Score_Month_18 +
1*UPDRS_Part_III_Summary_Score_Month_24 +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Baseline +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_06 +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_12 +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_24 +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Baseline +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_06 +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_12 +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_24
s =~ 0*UPDRS_Part_I_Summary_Score_Baseline + 1*UPDRS_Part_I_Summary_Score_Month_03 +
2*UPDRS_Part_I_Summary_Score_Month_06 + 3*UPDRS_Part_I_Summary_Score_Month_09 +
4*UPDRS_Part_I_Summary_Score_Month_12 + 5*UPDRS_Part_I_Summary_Score_Month_18 +
6*UPDRS_Part_I_Summary_Score_Month_24 +
0*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Baseline +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_03 +
2*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_06 +
3*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_09 +
4*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_12 +
5*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_18 +
6*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_24 +
0*UPDRS_Part_III_Summary_Score_Baseline + 1*UPDRS_Part_III_Summary_Score_Month_03 +
2*UPDRS_Part_III_Summary_Score_Month_06 + 3*UPDRS_Part_III_Summary_Score_Month_09 +
4*UPDRS_Part_III_Summary_Score_Month_12 + 5*UPDRS_Part_III_Summary_Score_Month_18 +
6*UPDRS_Part_III_Summary_Score_Month_24 +
0*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Baseline +
2*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_06 +
4*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_12 +
6*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_24 +
0*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Baseline +
2*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_06 +
4*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_12 +
6*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_24
'

fit4 <- growth(model4, data=myData)
summary(fit4)
parameterEstimates(fit4) # extracts the values of the estimated parameters, the standard errors,
# the z-values, the standardized parameter values, and returns a data frame
fitted(fit4) # return the model-implied (fitted) covariance matrix (and mean vector) of a fitted model

# resid() function return (unstandardized) residuals of a fitted model including the difference between
# the observed and implied covariance matrix and mean vector
resid(fit4)

==Measures of model quality (Comparative Fit Index (CFI), Root Mean Square Error of Approximation (RMSEA))==

# report the fit measures as a signature vector: Comparative Fit Index (CFI), Root Mean Square Error of
# Approximation (RMSEA)
fitMeasures(fit4, c("cfi", "rmsea", "srmr"))

====Comparative Fit Index====

(CFI) is an incremental measure directly based on the non-centrality measure. If d = χ2(df) where df are the degrees of freedom of the model, the Comparative Fit Index is:
\begin{equation}
\frac{(Null Model)-d(Proposed Model)}{d(Null Model)}.
\end{equation}

$0≤CFI≤1$ (by definition). It is interpreted as:

*$CFI<0.9$ - model fitting is poor.

*$0.9≤CFI≤0.95$ is considered marginal,

*$CFI>0.95$ is good.

CFI is a relative index of model fit – it compare the fit of your model to the fit of (the worst) fitting null model.

====Root Mean Square Error of Approximation====
(RMSEA) - “Ramsey”

An absolute measure of fit based on the non-centrality parameter:

$\sqrt{\frac{X^2-df}{df×(N - 1)}}$,

where N the sample size and df the degrees of freedom of the model. If χ2 < df, then the RMSEA∶=0. It has a penalty for complexity via the chi square to df ratio. The RMSEA is a popular measure of model fit.

*RMSEA < 0.01, excellent,

*RMSEA < 0.05, good

*RMSEA > 0.10 cutoff for poor fitting models

====Standardized Root Mean Square Residual====
(SRMR) is an absolute measure of fit defined as the standardized difference between the observed correlation and the predicted correlation. A value of zero indicates perfect fit. The SRMR has no penalty for model complexity. SRMR <0.08 is considered a good fit.

# inspect the model results (report parameter table)
inspect(fit4)

#install.packages("semTools")
# library("semTools")

A Simpler Model (fit5)

model5 <- '
# intercept and slope with fixed coefficients
i =~ UPDRS_Part_I_Summary_Score_Baseline + UPDRS_Part_I_Summary_Score_Month_03 + UPDRS_Part_I_Summary_Score_Month_24
s =~ 0*UPDRS_Part_I_Summary_Score_Baseline + 1*UPDRS_Part_I_Summary_Score_Month_03 + 6*UPDRS_Part_I_Summary_Score_Month_24
# regressions
i ~ R_fusiform_gyrus_Volume + Weight + ResearchGroup + Age + chr12_rs34637584_GT
s ~ R_fusiform_gyrus_Volume + Weight + ResearchGroup + Age + chr12_rs34637584_GT
# time-varying covariates
UPDRS_Part_I_Summary_Score_Baseline ~ Weight
UPDRS_Part_I_Summary_Score_Month_03 ~ ResearchGroup
UPDRS_Part_I_Summary_Score_Month_24 ~ Age
'

fit5 <- growth(model5, data=myData)
summary(fit5); fitMeasures(fit5, c("cfi", "rmsea", "srmr"))
parameterEstimates(fit5) # extracts the values of the estimated parameters, the standard errors,
# the z-values, the standardized parameter values, and returns a data frame

lavaan (0.5-18) converged normally after 99 iterations
Number of observations 661
Estimator ML
Minimum Function Test Statistic 3.703
Degrees of freedom 1
P-value (Chi-square) 0.054
Parameter estimates:
Information Expected
Standard Errors Standard
Estimate Std.err Z-value P(>|z|)
Latent variables:
i =~
UPDRS_P_I_S_S 1.000
UPDRS_P_I_S_S 1.074
UPDRS_P_I_S_S 1.172
s =~
UPDRS_P_I_S_S 0.000
UPDRS_P_I_S_S 1.000
UPDRS_P_I_S_S 6.000

Regressions:
i ~
R_fsfrm_gyr_V 0.000
Weight 0.003
ResearchGroup -0.880
Age -0.009
c12_34637584_ -0.907
s ~
R_fsfrm_gyr_V -0.000
Weight -0.000
ResearchGroup -0.084
Age 0.002
c12_34637584_ -0.047
UPDRS_Part_I_Summary_Score_Baseline ~
Weight -0.000
UPDRS_Part_I_Summary_Score_Month_03 ~
ResearchGroup 0.693
UPDRS_Part_I_Summary_Score_Month_24 ~
Age -0.002

Covariances:
i ~~
s 0.074

Intercepts:
UPDRS_P_I_S_S 0.000
UPDRS_P_I_S_S 0.000
UPDRS_P_I_S_S 0.000
i 1.633
s -0.023

Variances:
UPDRS_P_I_S_S 1.017
UPDRS_P_I_S_S 1.093
UPDRS_P_I_S_S 2.993
i 1.019
s -0.025

cfi rmsea srmr
0.996 0.064 0.008

fitted(fit5) # return the model-implied (fitted) covariance matrix (and mean vector) of a fitted model
# write.table(fitted(fit5), file="C:\\Users\\Dinov\\Desktop\\test1.txt")

# resid() function return (unstandardized) residuals of a fitted model including the difference between
# the observed and implied covariance matrix and mean vector
resid(fit5)

# report the fit measures as a signature vector
fitMeasures(fit5, c("cfi", "rmsea", "srmr")) # comparative fit index (CFI)

# inspect the model results (report parameter table)
inspect(fit5)

Note: See discussion of SEM modeling pros/cons 2.

==Generalized Estimating Equation (GEE) Modeling==

Generalized Estimating Equations (GEE) modeling3 is used for analyzing data with the following characteristics:
(1) the observations within a group may be correlated, (2) observations in separate clusters are independent, (3) a monotone transformation of the expectation is linearly related to the explanatory variables, and (4) the variance is a function of the expectation. The expectation (#3) and the variance (# 4) are conditional given group-level or individual-level covariates.

GEE is applied to handle correlated discrete and continuous outcome variables. For the outcome variables, it only requires specification of the first 2 moments and correlation among them. The goal is to estimate fixed parameters without specifying their joint distribution. The correlation is specified by one of these 4 alternatives (which is specified in the R call: geeglm(outcome ~ center + treat + sex + baseline + age, data = respiratory, family = "binomial", id = id, corstr = " exchangeable", scale.fix = TRUE):

<center>[[Image:SMHS_BigDataBigSci8.png|300px]]</center>

===Respiratory Illness GEE R example===

This example is based on a data set on respiratory illness 4 and the geepack package. The data is from a clinical study of the treatment effects on patients with respiratory illness. N=111 patients from 2 clinical centers randomized to receive either placebo or active treatments. 4 temporal examinations assessed the respiratory state of patients as good (=1) or poor (=0). Explanatory variables characterizing a patient were: center (1,2), treatment (A=active, P=placebo), sex (M=male, F=female), age (in years) at baseline. The values of the covariates were constant for the repeated elementary observations on each patient.

Table 1 shows the number of patients for the response patterns across the 4 visits split by baseline-status and treatment. Baseline respiratory status = 0 appear to have either low or high number of positive responses. Baseline respiratory status = 1 tend to respond positively. Table 2 describes the distribution of the number of positive responses per patient for sex and center.

# library("geepack")

Table 1: Distribution of patients for different response patterns classified by baseline-respiratory response and treatment. The patterns are ordered according to increasing numbers of positive responses.

<center>
{| class="wikitable" style="text-align:center; width:75%" border="1"
|-
! ||Visit|| colspan="15"| All Possible Response Patterns (2*2*2*2=16 permutation patterns)||
|-
|||1||0||1||0||0||0||1||1||1||0||0||1||1||1||0||1||
|-
|||2||0||0||1||0||0||1||0||0||1||0||1||1||0||1||1||
|-
|||3||0||0||0||1||0||0||1||0||1||1||1||0||1||1||1||
|-
|||4||0||0||0||0||1||0||0||1||0||1||0||1||1||1||1||
|-
!Baseline||Treatment||||||||||||||||||||||||||||||||Sum
|-
| rowspan="2"|0||A||7||2||2||2||1||0||1||0||1||0||1||2||0||4||7||30
|-
|P||18||1||0||2||1||2||0||0||1||0||0||1||2||0||3||31
|-
|rowspan="2"|1||A||0||0||0||0||0||0||1||1||0||0||4||0||1||0||17||24
|-
|P||1||4||1||0||0||0||0||1||1||3||1||1||2||1||10||26
|-
|Sum||||26||7||3||4||2||2||2||2||3||3||6||4||5||5||37||111
|}
</center>

Table 2: Distribution of patients for the number of positive responses across the 4 visits for Sex and Center.

<center>
{| class="wikitable" style="text-align:center; width:75%" border="1"
|-
! colspan="2" rowspan="2"| ||colspan="5"|Number of positive responses
|-
| 0||1||2||3||4
|-
|rowspan="2"|Sex || F||7||3||3||3||7
|-
|M||19||13||9||17||30
|-
|rowspan="2"|Center|| 1||18||9||6||11||12
|-
|2||8||7||6||9||25
|}
</center>

Figure 1 shows a plot of age against the proportion of positive responses for each patient. It indicates a quadratic relationship between the proportions and the age. Fitting a logistic model to the data (which would be appropriate if there were no time effects and no spread in the response probabilities for patients with the same covariate values).

# install.packages("geepack")
library("geepack")

# data include a clinical trial of 111 patients with respiratory illness from two different clinics were randomized to receive either
# placebo (P) or an active (A) treatment. Patients were examined at baseline and at four visits during treatment.
# At each examination, respiratory status (categorized as 1 = good, 0 = poor)
data("respiratory")
head(respiratory)
myData <- respiratory

<center>head(myData)
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Center||ID||Treat||Sex||Age||Baseline||Visit||Outcome
|-
|1 ||1||1||P||M||46||0||1||0
|-
|2 ||1||1||P||M||46||0||2||0
|-
|3 ||1||1||P||M||46||0||3||0
|-
|4 ||1||1||P||M||46||0||4||0
|-
|5||1||2||P||M||28||0||1||0
|-
|6||1||2||P||M||28||0||2||0
|}
</center>

# Get proportions of positive responses
responses <- factor(myData$\$$outcome, labels = c("OutcomePositive", "OutcomeNegative"))
data.frame <- data.frame(responses, myData$\$$age)
head(data.frame)
tab <- prop.table(table(data.frame), 1); tab # compute proportions
sum(tab[1,]) # check proportions (sums to 1.0)?
prop <- tab[1,] # save the proportions of positive responses for each patient
plot(as.numeric(dimnames(tab)$\$$myData.age), tab[1,], xlab = "Age", ylab = "Proportion of Positive Outcomes")
# dimnames(tab) # to see/inspect positive/negative outcomes

[[Image:SMHS_BigDataBigSci9.png|500px]]

x <- as.numeric(dimnames(tab)$\$$myData.age)
poly <- loess( prop ~ x) # fit a Local Polynomial Regression Fitting
plot(x, prop)
lines(predict(poly), col='red', lwd=2)

smoothingSpline <- smooth.spline(x, prop, spar=0.6)
plot(x, prop)
lines(smoothingSpline, col='red', lwd=1.5)
smoothPolySpline <- smooth.spline(x, predict(poly), spar=0.6)
lines(smoothPolySpline, col='blue', lwd=2)
legend("topright", inset=.05, title="Polynomial regression models", c("Raw Poly","Smooth Poly"), fill=c('red', 'blue'), horiz=TRUE)

[[Image:SMHS_BigDataBigSci10.png|500px]]

model.glm <- glm(outcome ~ baseline + center + sex + treat + age + I(age^2), data = respiratory, family = binomial)

summary(model.glm)

<center>Deviance Residuals:
{| class="wikitable" style="text-align:center; " border="1"
|-
|Min||1Q||Median||3Q||Max
|-
| -2.5951||-0.9108||0.4034||0.8336||2.0951
|}
</center>

<center>Coefficients:
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Estimate||Std. Error||z value||$Pr( \gt |z|)$
|-
|(Intercept)||3.3579727||1.0285292||3.265||0.0011 **
|-
|baseline||1.8850421||0.2482959||7.592||3.15e-14 ***
|-
|center||0.5099244||0.2453982||2.078||0.0377 *
|-
|sexM||-0.4510595||0.3166570||-1.424||0.1543
|-
|Treatp||-1.3231587||0.2431603||-5.442||5.28e-08 ***
|-
|age||-0.2072815||0.0472538||-4.387||1.15e-05 ***
|-
|I(age^2)||0.0025650||0.0006324||4.056||4.99e-05 ***
|}
</center>

Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

Null deviance: 609.41 on 443 degrees of freedom

Residual deviance: 468.62 on 437 degrees of freedom

AIC: 482.62

The correlation matrix of the of the outcome measures across visits is shown in Table 3.

attach(myData)
mat1 <- matrix(c(outcome[visit==1], outcome [visit==2], outcome [visit==3],
outcome[visit==4]), ncol = 4)
cor(mat1)

Table 3: Correlation matrix for the outcome measurements at different visits.

<center>Coefficients:
{| class="wikitable" style="text-align:center; " border="1"
|-
|||[,1]||[,2]||[,3]||[,4]
|-
|[,1]||1.0000000||0.5087944||0.4431438||0.5139016
|-
|[,2]||0.5087944||1.0000000||0.5821877||0.5301611
|-
|[,3]||0.4431438||0.5821877||1.0000000||0.5871276
|-
|[,4]||0.5139016||0.5301611||0.5871276||1.0000000
|}
</center>

# We can also examine for multicollinearity problem, using the correlation matrix for X
cor(model.matrix(model.glm)[,-1])

# GEE modeling: R function arguments/options

*corstr= for defining the correlation structure within groups in a GEE model

*id= is used to identify the grouping variable in a GEE model

*scale.fix= when TRUE causes the scale parameter to be fixed (by default at 1) rather than estimated

*waves= names a positive integer-valued variable that is used to identify the order and spacing of observations within groups in a GEE model. This argument is crucial when there are missing values and gaps in the data

gee.model1 <- geeglm(outcome ~ center + treat + sex + baseline + age, data = respiratory, family = "binomial", id = id, corstr = "exchangeable", scale.fix = TRUE)

# The column labeled Wald in the summary table is the square of the z-statistic. The reported p-values are the
# upper tailed probabilities from a chisq1 distribution and test whether the true parameter value ≠0.
summary(gee.model1)

# To test the effect of ''treatment'' using anova()
gee.model1 <- geeglm(outcome ~ center + treat + sex + baseline + age, data = respiratory, family=binomial(link="logit"), id = id, corstr = "exchangeable", std.err="san.se")
gee.model2 <- geeglm(outcome ~ center + sex + baseline + age, data = respiratory, family=binomial(link="logit"), id=id, corstr = "exchangeable", std.err="san.se")
anova(gee.model1, gee.model2)

# To test whether a categorical predictor with more than two levels should be retained in a GEE model we need
# to test the entire set of dummy variables simultaneously as a single construct.
# The geepack package provides a method for the anova function for a multivariate Wald test
# When the anova function is applied to a single geeglm object it returns sequential Wald tests for
# individual predictors with the tests carried out in the order the predictors are listed in the model formula.
anova(gee.model1)

===PD GEE example===

This example used the PPMI/PD data to show GEE analysis.

# 05_PPMI_top_UPDRS_Integrated_LongFormat1.csv
longData <- read.csv("https://umich.instructure.com/files/330397/download?download_frd=1",header=TRUE)

# library("geepack")

# Data Elements: FID_IID L_insular_cortex_ComputeArea L_insular_cortex_Volume R_insular_cortex_ComputeArea R_insular_cortex_Volume L_cingulate_gyrus_ComputeArea L_cingulate_gyrus_Volume R_cingulate_gyrus_ComputeArea R_cingulate_gyrus_Volume L_caudate_ComputeArea L_caudate_Volume R_caudate_ComputeArea R_caudate_Volume L_putamen_ComputeArea L_putamen_Volume R_putamen_ComputeArea R_putamen_Volume Sex Weight ResearchGroup Age chr12_rs34637584_GT chr17_rs11868035_GT chr17_rs11012_GT chr17_rs393152_GT chr17_rs12185268_GT chr17_rs199533_GT UPDRS_part_I UPDRS_part_II UPDRS_part_III time_visit

dim(longData)

data1 = na.omit(longData)
attach(data1)
ControlGroup <- ifelse(ResearchGroup == "Control", 1, 0)

# these calculations take a long time!!!
# if you get “Error in geese.fit(xx, yy, id, offset, soffset, w, waves = waves, zsca, :
# nrow(zsca) and length(y) not match” – this indicates some of the variables are of different lengths
# if you get “glm.fit: algorithm did not converge” – see this discussion: http://goo.gl/lrjBjB

gee.model0 <- geeglm(ControlGroup ~ L_insular_cortex_ComputeArea+L_insular_cortex_Volume+ Sex + Weight + Age + chr17_rs11012_GT + chr17_rs199533_GT + UPDRS_part_I + UPDRS_part_II + time_visit, data = data1, family=binomial(link="logit"), id = FID_IID, corstr = "unstructured", std.err="san.se")

gee.model1 <- geeglm(ControlGroup ~ L_insular_cortex_ComputeArea+L_insular_cortex_Volume+ R_putamen_ComputeArea + R_putamen_Volume + Sex + Weight + Age + chr17_rs11012_GT + chr17_rs199533_GT + UPDRS_part_I + UPDRS_part_II + time_visit, data = data1, family=binomial(link="logit"), id = FID_IID, corstr = "unstructured", std.err="san.se")

# compare 2 gee models
# anova(gee.model0,gee.model1)

# you can try the “family = poisson(link = "log")” model for the ResearchGroup response, as well

gee.model2 <- geeglm(ControlGroup
~ L_insular_cortex_ComputeArea+L_insular_cortex_Volume+R_insular_cortex_ComputeArea+ R_insular_cortex_Volume +L_cingulate_gyrus_ComputeArea + L_cingulate_gyrus_Volume + R_cingulate_gyrus_ComputeArea + R_cingulate_gyrus_Volume + L_caudate_ComputeArea + L_caudate_Volume + R_caudate_ComputeArea + R_caudate_Volume + L_putamen_ComputeArea + L_putamen_Volume + R_putamen_ComputeArea + R_putamen_Volume + Sex + Weight + Age + chr12_rs34637584_GT + chr17_rs11868035_GT + chr17_rs11012_GT + chr17_rs393152_GT + chr17_rs12185268_GT + chr17_rs199533_GT + UPDRS_part_I + UPDRS_part_II + time_visit, data = data1, family=binomial(link="logit"), id = FID_IID, corstr = "unstructured", std.err="san.se")

Remember that we do not interpret GEE coefficients as relating to individuals – GEE models are marginal models and the conclusions drawn are interpreted as population-based. Also, the time element in the model (time_visit) is just another controlling factor. The effect-sizes (betas) associated with each variable/predictor represent the slopes associated with the corresponding covariate, while holding time constant. If we need to examine interactions (e.g., Weight change over Time), we need to include an interaction term in model: (i.e. + Weight*time_visit).

summary (gee.model2)

# Individual Wald test and confidence intervals for each covariate
predictors2 <- coef(summary(gee.model2))
CI2 <- with(as.data.frame(predictors2), cbind(lwr=Estimate-1.96*Std.err, est=Estimate, upr=Estimate+1.96*Std.err))
rownames(CI2) <- rownames(predictors2)
CI2

==Appendix==

SEM References

*http://socserv.mcmaster.ca/jfox/Misc/sem/SEM-paper.pdf

GEE References

*https://cran.r-project.org/web/packages/geepack/geepack.pdf

*http://www.jstatsoft.org/v15/i02/paper

===Footnotes===

* 3 http://www.jstatsoft.org/v15/i02/

* 4 https://books.google.com/books?id=mdEqBgAAQBAJ

==See also==
* [[SMHS_BigDataBigSci| Back to Model-based Analytics]]
* [[SMHS_BigDataBigSci_SEM| Structural Equation Modeling (SEM)]]
* [[SMHS_BigDataBigSci_GEE| Next Section: Generalized Estimating Equation (GEE) Modeling]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_BigDataBigSci_GCM}}

SMHS BigDataBigSci GCM

2016-05-23T13:43:31Z

Imoubara: /* Respiratory Illness GEE R example */

==[[SMHS_BigDataBigSci| Model-based Analytics]] - Growth Curve Models==

Latent growth curve models may be used to analyze longitudinal or temporal data where the outcome measure is assessed on multiple occasions, and we examine its change over time, e.g., the trajectory over time can be
modeled as a linear or quadratic function. Random effects are used to capture individual differences by conveniently representing (continuous) latent variables, aka growth factors. To fit a linear growth model we may specify a model with two latent variables: a random intercept, and a random slope:

#load data 05_PPMI_top_UPDRS_Integrated_LongFormat.csv ( dim(myData) 661 71), wide
# setwd("/dir/")
myData <- read.csv("https://umich.instructure.com/files/330395/download?download_frd=1&verifier=v6jBvV4x94ka3EYcGKuXXg5BZNaOLBVp0xkJih0H",header=TRUE)
attach(myData)

# dichotomize the "ResearchGroup" variable
table(myData$\$$ResearchGroup)
myData$\$$ResearchGroup <- ifelse(myData$\$$ResearchGroup == "Control", 1, 0)

# linear growth model with 4 timepoints
# intercept (i) and slope (s) with fixed coefficients
# i =~ 1*t1 + 1*t2 + 1*t3 + 1*t4 (intercept/constant)
# s =~ 0*t1 + 1*t2 + 2*t3 + 3*t4 (slope/linear term)
# ??? =~ 0*t1 + 1*t2 + 2*t3 + 3*t4 (quadratic term)

In this model, we have fixed all the coefficients of the linear growth functions:

model4 <-
'
i =~ 1*UPDRS_Part_I_Summary_Score_Baseline + 1*UPDRS_Part_I_Summary_Score_Month_03 +
1*UPDRS_Part_I_Summary_Score_Month_06 + 1*UPDRS_Part_I_Summary_Score_Month_09 +
1*UPDRS_Part_I_Summary_Score_Month_12 + 1*UPDRS_Part_I_Summary_Score_Month_18 +
1*UPDRS_Part_I_Summary_Score_Month_24 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Baseline +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_03 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_06 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_09 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_12 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_18 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_24 +
1*UPDRS_Part_III_Summary_Score_Baseline + 1*UPDRS_Part_III_Summary_Score_Month_03 +
1*UPDRS_Part_III_Summary_Score_Month_06 + 1*UPDRS_Part_III_Summary_Score_Month_09 +
1*UPDRS_Part_III_Summary_Score_Month_12 + 1*UPDRS_Part_III_Summary_Score_Month_18 +
1*UPDRS_Part_III_Summary_Score_Month_24 +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Baseline +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_06 +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_12 +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_24 +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Baseline +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_06 +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_12 +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_24
s =~ 0*UPDRS_Part_I_Summary_Score_Baseline + 1*UPDRS_Part_I_Summary_Score_Month_03 +
2*UPDRS_Part_I_Summary_Score_Month_06 + 3*UPDRS_Part_I_Summary_Score_Month_09 +
4*UPDRS_Part_I_Summary_Score_Month_12 + 5*UPDRS_Part_I_Summary_Score_Month_18 +
6*UPDRS_Part_I_Summary_Score_Month_24 +
0*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Baseline +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_03 +
2*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_06 +
3*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_09 +
4*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_12 +
5*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_18 +
6*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_24 +
0*UPDRS_Part_III_Summary_Score_Baseline + 1*UPDRS_Part_III_Summary_Score_Month_03 +
2*UPDRS_Part_III_Summary_Score_Month_06 + 3*UPDRS_Part_III_Summary_Score_Month_09 +
4*UPDRS_Part_III_Summary_Score_Month_12 + 5*UPDRS_Part_III_Summary_Score_Month_18 +
6*UPDRS_Part_III_Summary_Score_Month_24 +
0*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Baseline +
2*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_06 +
4*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_12 +
6*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_24 +
0*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Baseline +
2*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_06 +
4*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_12 +
6*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_24
'

fit4 <- growth(model4, data=myData)
summary(fit4)
parameterEstimates(fit4) # extracts the values of the estimated parameters, the standard errors,
# the z-values, the standardized parameter values, and returns a data frame
fitted(fit4) # return the model-implied (fitted) covariance matrix (and mean vector) of a fitted model

# resid() function return (unstandardized) residuals of a fitted model including the difference between
# the observed and implied covariance matrix and mean vector
resid(fit4)

==Measures of model quality (Comparative Fit Index (CFI), Root Mean Square Error of Approximation (RMSEA))==

# report the fit measures as a signature vector: Comparative Fit Index (CFI), Root Mean Square Error of
# Approximation (RMSEA)
fitMeasures(fit4, c("cfi", "rmsea", "srmr"))

====Comparative Fit Index====

(CFI) is an incremental measure directly based on the non-centrality measure. If d = χ2(df) where df are the degrees of freedom of the model, the Comparative Fit Index is:
\begin{equation}
\frac{(Null Model)-d(Proposed Model)}{d(Null Model)}.
\end{equation}

$0≤CFI≤1$ (by definition). It is interpreted as:

*$CFI<0.9$ - model fitting is poor.

*$0.9≤CFI≤0.95$ is considered marginal,

*$CFI>0.95$ is good.

CFI is a relative index of model fit – it compare the fit of your model to the fit of (the worst) fitting null model.

====Root Mean Square Error of Approximation====
(RMSEA) - “Ramsey”

An absolute measure of fit based on the non-centrality parameter:

$\sqrt{\frac{X^2-df}{df×(N - 1)}}$,

where N the sample size and df the degrees of freedom of the model. If χ2 < df, then the RMSEA∶=0. It has a penalty for complexity via the chi square to df ratio. The RMSEA is a popular measure of model fit.

*RMSEA < 0.01, excellent,

*RMSEA < 0.05, good

*RMSEA > 0.10 cutoff for poor fitting models

====Standardized Root Mean Square Residual====
(SRMR) is an absolute measure of fit defined as the standardized difference between the observed correlation and the predicted correlation. A value of zero indicates perfect fit. The SRMR has no penalty for model complexity. SRMR <0.08 is considered a good fit.

# inspect the model results (report parameter table)
inspect(fit4)

#install.packages("semTools")
# library("semTools")

A Simpler Model (fit5)

model5 <- '
# intercept and slope with fixed coefficients
i =~ UPDRS_Part_I_Summary_Score_Baseline + UPDRS_Part_I_Summary_Score_Month_03 + UPDRS_Part_I_Summary_Score_Month_24
s =~ 0*UPDRS_Part_I_Summary_Score_Baseline + 1*UPDRS_Part_I_Summary_Score_Month_03 + 6*UPDRS_Part_I_Summary_Score_Month_24
# regressions
i ~ R_fusiform_gyrus_Volume + Weight + ResearchGroup + Age + chr12_rs34637584_GT
s ~ R_fusiform_gyrus_Volume + Weight + ResearchGroup + Age + chr12_rs34637584_GT
# time-varying covariates
UPDRS_Part_I_Summary_Score_Baseline ~ Weight
UPDRS_Part_I_Summary_Score_Month_03 ~ ResearchGroup
UPDRS_Part_I_Summary_Score_Month_24 ~ Age
'

fit5 <- growth(model5, data=myData)
summary(fit5); fitMeasures(fit5, c("cfi", "rmsea", "srmr"))
parameterEstimates(fit5) # extracts the values of the estimated parameters, the standard errors,
# the z-values, the standardized parameter values, and returns a data frame

lavaan (0.5-18) converged normally after 99 iterations
Number of observations 661
Estimator ML
Minimum Function Test Statistic 3.703
Degrees of freedom 1
P-value (Chi-square) 0.054
Parameter estimates:
Information Expected
Standard Errors Standard
Estimate Std.err Z-value P(>|z|)
Latent variables:
i =~
UPDRS_P_I_S_S 1.000
UPDRS_P_I_S_S 1.074
UPDRS_P_I_S_S 1.172
s =~
UPDRS_P_I_S_S 0.000
UPDRS_P_I_S_S 1.000
UPDRS_P_I_S_S 6.000

Regressions:
i ~
R_fsfrm_gyr_V 0.000
Weight 0.003
ResearchGroup -0.880
Age -0.009
c12_34637584_ -0.907
s ~
R_fsfrm_gyr_V -0.000
Weight -0.000
ResearchGroup -0.084
Age 0.002
c12_34637584_ -0.047
UPDRS_Part_I_Summary_Score_Baseline ~
Weight -0.000
UPDRS_Part_I_Summary_Score_Month_03 ~
ResearchGroup 0.693
UPDRS_Part_I_Summary_Score_Month_24 ~
Age -0.002

Covariances:
i ~~
s 0.074

Intercepts:
UPDRS_P_I_S_S 0.000
UPDRS_P_I_S_S 0.000
UPDRS_P_I_S_S 0.000
i 1.633
s -0.023

Variances:
UPDRS_P_I_S_S 1.017
UPDRS_P_I_S_S 1.093
UPDRS_P_I_S_S 2.993
i 1.019
s -0.025

cfi rmsea srmr
0.996 0.064 0.008

fitted(fit5) # return the model-implied (fitted) covariance matrix (and mean vector) of a fitted model
# write.table(fitted(fit5), file="C:\\Users\\Dinov\\Desktop\\test1.txt")

# resid() function return (unstandardized) residuals of a fitted model including the difference between
# the observed and implied covariance matrix and mean vector
resid(fit5)

# report the fit measures as a signature vector
fitMeasures(fit5, c("cfi", "rmsea", "srmr")) # comparative fit index (CFI)

# inspect the model results (report parameter table)
inspect(fit5)

Note: See discussion of SEM modeling pros/cons 2.

==Generalized Estimating Equation (GEE) Modeling==

Generalized Estimating Equations (GEE) modeling3 is used for analyzing data with the following characteristics:
(1) the observations within a group may be correlated, (2) observations in separate clusters are independent, (3) a monotone transformation of the expectation is linearly related to the explanatory variables, and (4) the variance is a function of the expectation. The expectation (#3) and the variance (# 4) are conditional given group-level or individual-level covariates.

GEE is applied to handle correlated discrete and continuous outcome variables. For the outcome variables, it only requires specification of the first 2 moments and correlation among them. The goal is to estimate fixed parameters without specifying their joint distribution. The correlation is specified by one of these 4 alternatives (which is specified in the R call: geeglm(outcome ~ center + treat + sex + baseline + age, data = respiratory, family = "binomial", id = id, corstr = " exchangeable", scale.fix = TRUE):

<center>[[Image:SMHS_BigDataBigSci8.png|300px]]</center>

===Respiratory Illness GEE R example===

This example is based on a data set on respiratory illness 4 and the geepack package. The data is from a clinical study of the treatment effects on patients with respiratory illness. N=111 patients from 2 clinical centers randomized to receive either placebo or active treatments. 4 temporal examinations assessed the respiratory state of patients as good (=1) or poor (=0). Explanatory variables characterizing a patient were: center (1,2), treatment (A=active, P=placebo), sex (M=male, F=female), age (in years) at baseline. The values of the covariates were constant for the repeated elementary observations on each patient.

Table 1 shows the number of patients for the response patterns across the 4 visits split by baseline-status and treatment. Baseline respiratory status = 0 appear to have either low or high number of positive responses. Baseline respiratory status = 1 tend to respond positively. Table 2 describes the distribution of the number of positive responses per patient for sex and center.

# library("geepack")

Table 1: Distribution of patients for different response patterns classified by baseline-respiratory response and treatment. The patterns are ordered according to increasing numbers of positive responses.

<center>
{| class="wikitable" style="text-align:center; width:75%" border="1"
|-
! ||Visit|| colspan="15"| All Possible Response Patterns (2*2*2*2=16 permutation patterns)||
|-
|||1||0||1||0||0||0||1||1||1||0||0||1||1||1||0||1||
|-
|||2||0||0||1||0||0||1||0||0||1||0||1||1||0||1||1||
|-
|||3||0||0||0||1||0||0||1||0||1||1||1||0||1||1||1||
|-
|||4||0||0||0||0||1||0||0||1||0||1||0||1||1||1||1||
|-
!Baseline||Treatment||||||||||||||||||||||||||||||||Sum
|-
| rowspan="2"|0||A||7||2||2||2||1||0||1||0||1||0||1||2||0||4||7||30
|-
|P||18||1||0||2||1||2||0||0||1||0||0||1||2||0||3||31
|-
|rowspan="2"|1||A||0||0||0||0||0||0||1||1||0||0||4||0||1||0||17||24
|-
|P||1||4||1||0||0||0||0||1||1||3||1||1||2||1||10||26
|-
|Sum||||26||7||3||4||2||2||2||2||3||3||6||4||5||5||37||111
|}
</center>

Table 2: Distribution of patients for the number of positive responses across the 4 visits for Sex and Center.

<center>
{| class="wikitable" style="text-align:center; width:75%" border="1"
|-
! colspan="2" rowspan="2"| ||colspan="5"|Number of positive responses
|-
| 0||1||2||3||4
|-
|rowspan="2"|Sex || F||7||3||3||3||7
|-
|M||19||13||9||17||30
|-
|rowspan="2"|Center|| 1||18||9||6||11||12
|-
|2||8||7||6||9||25
|}
</center>

Figure 1 shows a plot of age against the proportion of positive responses for each patient. It indicates a quadratic relationship between the proportions and the age. Fitting a logistic model to the data (which would be appropriate if there were no time effects and no spread in the response probabilities for patients with the same covariate values).

# install.packages("geepack")
library("geepack")

# data include a clinical trial of 111 patients with respiratory illness from two different clinics were randomized to receive either
# placebo (P) or an active (A) treatment. Patients were examined at baseline and at four visits during treatment.
# At each examination, respiratory status (categorized as 1 = good, 0 = poor)
data("respiratory")
head(respiratory)
myData <- respiratory

<center>head(myData)
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Center||ID||Treat||Sex||Age||Baseline||Visit||Outcome
|-
|1 ||1||1||P||M||46||0||1||0
|-
|2 ||1||1||P||M||46||0||2||0
|-
|3 ||1||1||P||M||46||0||3||0
|-
|4 ||1||1||P||M||46||0||4||0
|-
|5||1||2||P||M||28||0||1||0
|-
|6||1||2||P||M||28||0||2||0
|}
</center>

# Get proportions of positive responses
responses <- factor(myData$\$$outcome, labels = c("OutcomePositive", "OutcomeNegative"))
data.frame <- data.frame(responses, myData$\$$age)
head(data.frame)
tab <- prop.table(table(data.frame), 1); tab # compute proportions
sum(tab[1,]) # check proportions (sums to 1.0)?
prop <- tab[1,] # save the proportions of positive responses for each patient
plot(as.numeric(dimnames(tab)$\$$myData.age), tab[1,], xlab = "Age", ylab = "Proportion of Positive Outcomes")
# dimnames(tab) # to see/inspect positive/negative outcomes

[[Image:SMHS_BigDataBigSci9.png|500px]]

x <- as.numeric(dimnames(tab)$\$$myData.age)
poly <- loess( prop ~ x) # fit a Local Polynomial Regression Fitting
plot(x, prop)
lines(predict(poly), col='red', lwd=2)

smoothingSpline <- smooth.spline(x, prop, spar=0.6)
plot(x, prop)
lines(smoothingSpline, col='red', lwd=1.5)
smoothPolySpline <- smooth.spline(x, predict(poly), spar=0.6)
lines(smoothPolySpline, col='blue', lwd=2)
legend("topright", inset=.05, title="Polynomial regression models", c("Raw Poly","Smooth Poly"), fill=c('red', 'blue'), horiz=TRUE)

[[Image:SMHS_BigDataBigSci10.png|500px]]

model.glm <- glm(outcome ~ baseline + center + sex + treat + age + I(age^2), data = respiratory, family = binomial)

summary(model.glm)

<center>Deviance Residuals:
{| class="wikitable" style="text-align:center; " border="1"
|-
|Min||1Q||Median||3Q||Max
|-
| -2.5951||-0.9108||0.4034||0.8336||2.0951
|}
</center>

<center>Coefficients:
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Estimate||Std. Error||z value||$Pr( \gt |z|)$
|-
|(Intercept)||3.3579727||1.0285292||3.265||0.0011 **
|-
|baseline||1.8850421||0.2482959||7.592||3.15e-14 ***
|-
|center||0.5099244||0.2453982||2.078||0.0377 *
|-
|sexM||-0.4510595||0.3166570||-1.424||0.1543
|-
|Treatp||-1.3231587||0.2431603||-5.442||5.28e-08 ***
|-
|age||-0.2072815||0.0472538||-4.387||1.15e-05 ***
|-
|I(age^2)||0.0025650||0.0006324||4.056||4.99e-05 ***
|}
</center>

Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

Null deviance: 609.41 on 443 degrees of freedom

Residual deviance: 468.62 on 437 degrees of freedom

AIC: 482.62

The correlation matrix of the of the outcome measures across visits is shown in Table 3.

attach(myData)
mat1 <- matrix(c(outcome[visit==1], outcome [visit==2], outcome [visit==3],
outcome[visit==4]), ncol = 4)
cor(mat1)

Table 3: Correlation matrix for the outcome measurements at different visits.

<center>Coefficients:
{| class="wikitable" style="text-align:center; " border="1"
|-
|||[,1]||[,2]||[,3]||[,4]
|-
|[,1]||1.0000000||0.5087944||0.4431438||0.5139016
|-
|[,2]||0.5087944||1.0000000||0.5821877||0.5301611
|-
|[,3]||0.4431438||0.5821877||1.0000000||0.5871276
|-
|[,4]||0.5139016||0.5301611||0.5871276||1.0000000
|}
</center>

# We can also examine for multicollinearity problem, using the correlation matrix for X
cor(model.matrix(model.glm)[,-1])

# GEE modeling: R function arguments/options

*corstr= for defining the correlation structure within groups in a GEE model

*id= is used to identify the grouping variable in a GEE model

*scale.fix= when TRUE causes the scale parameter to be fixed (by default at 1) rather than estimated

*waves= names a positive integer-valued variable that is used to identify the order and spacing of observations within groups in a GEE model. This argument is crucial when there are missing values and gaps in the data

gee.model1 <- geeglm(outcome ~ center + treat + sex + baseline + age, data = respiratory, family = "binomial", id = id, corstr = "exchangeable", scale.fix = TRUE)

# The column labeled Wald in the summary table is the square of the z-statistic. The reported p-values are the
# upper tailed probabilities from a chisq1 distribution and test whether the true parameter value ≠0.
summary(gee.model1)

# To test the effect of ''treatment'' using anova()
gee.model1 <- geeglm(outcome ~ center + treat + sex + baseline + age, data = respiratory, family=binomial(link="logit"), id = id, corstr = "exchangeable", std.err="san.se")
gee.model2 <- geeglm(outcome ~ center + sex + baseline + age, data = respiratory, family=binomial(link="logit"), id=id, corstr = "exchangeable", std.err="san.se")
anova(gee.model1, gee.model2)

# To test whether a categorical predictor with more than two levels should be retained in a GEE model we need
# to test the entire set of dummy variables simultaneously as a single construct.
# The geepack package provides a method for the anova function for a multivariate Wald test
# When the anova function is applied to a single geeglm object it returns sequential Wald tests for
# individual predictors with the tests carried out in the order the predictors are listed in the model formula.
anova(gee.model1)

===PD GEE example===

This example used the PPMI/PD data to show GEE analysis.

# 05_PPMI_top_UPDRS_Integrated_LongFormat1.csv
longData <- read.csv("https://umich.instructure.com/files/330397/download?download_frd=1",header=TRUE)

# library("geepack")

# Data Elements: FID_IID L_insular_cortex_ComputeArea L_insular_cortex_Volume R_insular_cortex_ComputeArea R_insular_cortex_Volume L_cingulate_gyrus_ComputeArea L_cingulate_gyrus_Volume R_cingulate_gyrus_ComputeArea R_cingulate_gyrus_Volume L_caudate_ComputeArea L_caudate_Volume R_caudate_ComputeArea R_caudate_Volume L_putamen_ComputeArea L_putamen_Volume R_putamen_ComputeArea R_putamen_Volume Sex Weight ResearchGroup Age chr12_rs34637584_GT chr17_rs11868035_GT chr17_rs11012_GT chr17_rs393152_GT chr17_rs12185268_GT chr17_rs199533_GT UPDRS_part_I UPDRS_part_II UPDRS_part_III time_visit

dim(longData)

data1 = na.omit(longData)
attach(data1)
ControlGroup <- ifelse(ResearchGroup == "Control", 1, 0)

# these calculations take a long time!!!
# if you get “Error in geese.fit(xx, yy, id, offset, soffset, w, waves = waves, zsca, :
# nrow(zsca) and length(y) not match” – this indicates some of the variables are of different lengths
# if you get “glm.fit: algorithm did not converge” – see this discussion: http://goo.gl/lrjBjB

gee.model0 <- geeglm(ControlGroup ~ L_insular_cortex_ComputeArea+L_insular_cortex_Volume+ Sex + Weight + Age + chr17_rs11012_GT + chr17_rs199533_GT + UPDRS_part_I + UPDRS_part_II + time_visit, data = data1, family=binomial(link="logit"), id = FID_IID, corstr = "unstructured", std.err="san.se")

gee.model1 <- geeglm(ControlGroup ~ L_insular_cortex_ComputeArea+L_insular_cortex_Volume+ R_putamen_ComputeArea + R_putamen_Volume + Sex + Weight + Age + chr17_rs11012_GT + chr17_rs199533_GT + UPDRS_part_I + UPDRS_part_II + time_visit, data = data1, family=binomial(link="logit"), id = FID_IID, corstr = "unstructured", std.err="san.se")

# compare 2 gee models
# anova(gee.model0,gee.model1)

# you can try the “family = poisson(link = "log")” model for the ResearchGroup response, as well

gee.model2 <- geeglm(ControlGroup
~ L_insular_cortex_ComputeArea+L_insular_cortex_Volume+R_insular_cortex_ComputeArea+ R_insular_cortex_Volume +L_cingulate_gyrus_ComputeArea + L_cingulate_gyrus_Volume + R_cingulate_gyrus_ComputeArea + R_cingulate_gyrus_Volume + L_caudate_ComputeArea + L_caudate_Volume + R_caudate_ComputeArea + R_caudate_Volume + L_putamen_ComputeArea + L_putamen_Volume + R_putamen_ComputeArea + R_putamen_Volume + Sex + Weight + Age + chr12_rs34637584_GT + chr17_rs11868035_GT + chr17_rs11012_GT + chr17_rs393152_GT + chr17_rs12185268_GT + chr17_rs199533_GT + UPDRS_part_I + UPDRS_part_II + time_visit, data = data1, family=binomial(link="logit"), id = FID_IID, corstr = "unstructured", std.err="san.se")

Remember that we do not interpret GEE coefficients as relating to individuals – GEE models are marginal models and the conclusions drawn are interpreted as population-based. Also, the time element in the model (time_visit) is just another controlling factor. The effect-sizes (betas) associated with each variable/predictor represent the slopes associated with the corresponding covariate, while holding time constant. If we need to examine interactions (e.g., Weight change over Time), we need to include an interaction term in model: (i.e. + Weight*time_visit).

summary (gee.model2)

# Individual Wald test and confidence intervals for each covariate
predictors2 <- coef(summary(gee.model2))
CI2 <- with(as.data.frame(predictors2), cbind(lwr=Estimate-1.96*Std.err, est=Estimate, upr=Estimate+1.96*Std.err))
rownames(CI2) <- rownames(predictors2)
CI2

==Appendix==

SEM References

<li>http://socserv.mcmaster.ca/jfox/Misc/sem/SEM-paper.pdf </li>

GEE References

<li>https://cran.r-project.org/web/packages/geepack/geepack.pdf</li>

<li>http://www.jstatsoft.org/v15/i02/paper</li>

===Footnotes===

* 3 http://www.jstatsoft.org/v15/i02/

* 4 https://books.google.com/books?id=mdEqBgAAQBAJ

==See also==
* [[SMHS_BigDataBigSci| Back to Model-based Analytics]]
* [[SMHS_BigDataBigSci_SEM| Structural Equation Modeling (SEM)]]
* [[SMHS_BigDataBigSci_GEE| Next Section: Generalized Estimating Equation (GEE) Modeling]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_BigDataBigSci_GCM}}

SMHS BigDataBigSci GCM

2016-05-23T13:42:45Z

Imoubara: /* Root Mean Square Error of Approximation */

==[[SMHS_BigDataBigSci| Model-based Analytics]] - Growth Curve Models==

Latent growth curve models may be used to analyze longitudinal or temporal data where the outcome measure is assessed on multiple occasions, and we examine its change over time, e.g., the trajectory over time can be
modeled as a linear or quadratic function. Random effects are used to capture individual differences by conveniently representing (continuous) latent variables, aka growth factors. To fit a linear growth model we may specify a model with two latent variables: a random intercept, and a random slope:

#load data 05_PPMI_top_UPDRS_Integrated_LongFormat.csv ( dim(myData) 661 71), wide
# setwd("/dir/")
myData <- read.csv("https://umich.instructure.com/files/330395/download?download_frd=1&verifier=v6jBvV4x94ka3EYcGKuXXg5BZNaOLBVp0xkJih0H",header=TRUE)
attach(myData)

# dichotomize the "ResearchGroup" variable
table(myData$\$$ResearchGroup)
myData$\$$ResearchGroup <- ifelse(myData$\$$ResearchGroup == "Control", 1, 0)

# linear growth model with 4 timepoints
# intercept (i) and slope (s) with fixed coefficients
# i =~ 1*t1 + 1*t2 + 1*t3 + 1*t4 (intercept/constant)
# s =~ 0*t1 + 1*t2 + 2*t3 + 3*t4 (slope/linear term)
# ??? =~ 0*t1 + 1*t2 + 2*t3 + 3*t4 (quadratic term)

In this model, we have fixed all the coefficients of the linear growth functions:

model4 <-
'
i =~ 1*UPDRS_Part_I_Summary_Score_Baseline + 1*UPDRS_Part_I_Summary_Score_Month_03 +
1*UPDRS_Part_I_Summary_Score_Month_06 + 1*UPDRS_Part_I_Summary_Score_Month_09 +
1*UPDRS_Part_I_Summary_Score_Month_12 + 1*UPDRS_Part_I_Summary_Score_Month_18 +
1*UPDRS_Part_I_Summary_Score_Month_24 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Baseline +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_03 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_06 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_09 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_12 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_18 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_24 +
1*UPDRS_Part_III_Summary_Score_Baseline + 1*UPDRS_Part_III_Summary_Score_Month_03 +
1*UPDRS_Part_III_Summary_Score_Month_06 + 1*UPDRS_Part_III_Summary_Score_Month_09 +
1*UPDRS_Part_III_Summary_Score_Month_12 + 1*UPDRS_Part_III_Summary_Score_Month_18 +
1*UPDRS_Part_III_Summary_Score_Month_24 +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Baseline +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_06 +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_12 +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_24 +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Baseline +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_06 +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_12 +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_24
s =~ 0*UPDRS_Part_I_Summary_Score_Baseline + 1*UPDRS_Part_I_Summary_Score_Month_03 +
2*UPDRS_Part_I_Summary_Score_Month_06 + 3*UPDRS_Part_I_Summary_Score_Month_09 +
4*UPDRS_Part_I_Summary_Score_Month_12 + 5*UPDRS_Part_I_Summary_Score_Month_18 +
6*UPDRS_Part_I_Summary_Score_Month_24 +
0*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Baseline +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_03 +
2*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_06 +
3*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_09 +
4*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_12 +
5*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_18 +
6*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_24 +
0*UPDRS_Part_III_Summary_Score_Baseline + 1*UPDRS_Part_III_Summary_Score_Month_03 +
2*UPDRS_Part_III_Summary_Score_Month_06 + 3*UPDRS_Part_III_Summary_Score_Month_09 +
4*UPDRS_Part_III_Summary_Score_Month_12 + 5*UPDRS_Part_III_Summary_Score_Month_18 +
6*UPDRS_Part_III_Summary_Score_Month_24 +
0*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Baseline +
2*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_06 +
4*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_12 +
6*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_24 +
0*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Baseline +
2*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_06 +
4*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_12 +
6*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_24
'

fit4 <- growth(model4, data=myData)
summary(fit4)
parameterEstimates(fit4) # extracts the values of the estimated parameters, the standard errors,
# the z-values, the standardized parameter values, and returns a data frame
fitted(fit4) # return the model-implied (fitted) covariance matrix (and mean vector) of a fitted model

# resid() function return (unstandardized) residuals of a fitted model including the difference between
# the observed and implied covariance matrix and mean vector
resid(fit4)

==Measures of model quality (Comparative Fit Index (CFI), Root Mean Square Error of Approximation (RMSEA))==

# report the fit measures as a signature vector: Comparative Fit Index (CFI), Root Mean Square Error of
# Approximation (RMSEA)
fitMeasures(fit4, c("cfi", "rmsea", "srmr"))

====Comparative Fit Index====

(CFI) is an incremental measure directly based on the non-centrality measure. If d = χ2(df) where df are the degrees of freedom of the model, the Comparative Fit Index is:
\begin{equation}
\frac{(Null Model)-d(Proposed Model)}{d(Null Model)}.
\end{equation}

$0≤CFI≤1$ (by definition). It is interpreted as:

*$CFI<0.9$ - model fitting is poor.

*$0.9≤CFI≤0.95$ is considered marginal,

*$CFI>0.95$ is good.

CFI is a relative index of model fit – it compare the fit of your model to the fit of (the worst) fitting null model.

====Root Mean Square Error of Approximation====
(RMSEA) - “Ramsey”

An absolute measure of fit based on the non-centrality parameter:

$\sqrt{\frac{X^2-df}{df×(N - 1)}}$,

where N the sample size and df the degrees of freedom of the model. If χ2 < df, then the RMSEA∶=0. It has a penalty for complexity via the chi square to df ratio. The RMSEA is a popular measure of model fit.

*RMSEA < 0.01, excellent,

*RMSEA < 0.05, good

*RMSEA > 0.10 cutoff for poor fitting models

====Standardized Root Mean Square Residual====
(SRMR) is an absolute measure of fit defined as the standardized difference between the observed correlation and the predicted correlation. A value of zero indicates perfect fit. The SRMR has no penalty for model complexity. SRMR <0.08 is considered a good fit.

# inspect the model results (report parameter table)
inspect(fit4)

#install.packages("semTools")
# library("semTools")

A Simpler Model (fit5)

model5 <- '
# intercept and slope with fixed coefficients
i =~ UPDRS_Part_I_Summary_Score_Baseline + UPDRS_Part_I_Summary_Score_Month_03 + UPDRS_Part_I_Summary_Score_Month_24
s =~ 0*UPDRS_Part_I_Summary_Score_Baseline + 1*UPDRS_Part_I_Summary_Score_Month_03 + 6*UPDRS_Part_I_Summary_Score_Month_24
# regressions
i ~ R_fusiform_gyrus_Volume + Weight + ResearchGroup + Age + chr12_rs34637584_GT
s ~ R_fusiform_gyrus_Volume + Weight + ResearchGroup + Age + chr12_rs34637584_GT
# time-varying covariates
UPDRS_Part_I_Summary_Score_Baseline ~ Weight
UPDRS_Part_I_Summary_Score_Month_03 ~ ResearchGroup
UPDRS_Part_I_Summary_Score_Month_24 ~ Age
'

fit5 <- growth(model5, data=myData)
summary(fit5); fitMeasures(fit5, c("cfi", "rmsea", "srmr"))
parameterEstimates(fit5) # extracts the values of the estimated parameters, the standard errors,
# the z-values, the standardized parameter values, and returns a data frame

lavaan (0.5-18) converged normally after 99 iterations
Number of observations 661
Estimator ML
Minimum Function Test Statistic 3.703
Degrees of freedom 1
P-value (Chi-square) 0.054
Parameter estimates:
Information Expected
Standard Errors Standard
Estimate Std.err Z-value P(>|z|)
Latent variables:
i =~
UPDRS_P_I_S_S 1.000
UPDRS_P_I_S_S 1.074
UPDRS_P_I_S_S 1.172
s =~
UPDRS_P_I_S_S 0.000
UPDRS_P_I_S_S 1.000
UPDRS_P_I_S_S 6.000

Regressions:
i ~
R_fsfrm_gyr_V 0.000
Weight 0.003
ResearchGroup -0.880
Age -0.009
c12_34637584_ -0.907
s ~
R_fsfrm_gyr_V -0.000
Weight -0.000
ResearchGroup -0.084
Age 0.002
c12_34637584_ -0.047
UPDRS_Part_I_Summary_Score_Baseline ~
Weight -0.000
UPDRS_Part_I_Summary_Score_Month_03 ~
ResearchGroup 0.693
UPDRS_Part_I_Summary_Score_Month_24 ~
Age -0.002

Covariances:
i ~~
s 0.074

Intercepts:
UPDRS_P_I_S_S 0.000
UPDRS_P_I_S_S 0.000
UPDRS_P_I_S_S 0.000
i 1.633
s -0.023

Variances:
UPDRS_P_I_S_S 1.017
UPDRS_P_I_S_S 1.093
UPDRS_P_I_S_S 2.993
i 1.019
s -0.025

cfi rmsea srmr
0.996 0.064 0.008

fitted(fit5) # return the model-implied (fitted) covariance matrix (and mean vector) of a fitted model
# write.table(fitted(fit5), file="C:\\Users\\Dinov\\Desktop\\test1.txt")

# resid() function return (unstandardized) residuals of a fitted model including the difference between
# the observed and implied covariance matrix and mean vector
resid(fit5)

# report the fit measures as a signature vector
fitMeasures(fit5, c("cfi", "rmsea", "srmr")) # comparative fit index (CFI)

# inspect the model results (report parameter table)
inspect(fit5)

Note: See discussion of SEM modeling pros/cons 2.

==Generalized Estimating Equation (GEE) Modeling==

Generalized Estimating Equations (GEE) modeling3 is used for analyzing data with the following characteristics:
(1) the observations within a group may be correlated, (2) observations in separate clusters are independent, (3) a monotone transformation of the expectation is linearly related to the explanatory variables, and (4) the variance is a function of the expectation. The expectation (#3) and the variance (# 4) are conditional given group-level or individual-level covariates.

GEE is applied to handle correlated discrete and continuous outcome variables. For the outcome variables, it only requires specification of the first 2 moments and correlation among them. The goal is to estimate fixed parameters without specifying their joint distribution. The correlation is specified by one of these 4 alternatives (which is specified in the R call: geeglm(outcome ~ center + treat + sex + baseline + age, data = respiratory, family = "binomial", id = id, corstr = " exchangeable", scale.fix = TRUE):

<center>[[Image:SMHS_BigDataBigSci8.png|300px]]</center>

===Respiratory Illness GEE R example===

This example is based on a data set on respiratory illness 4 and the geepack package. The data is from a clinical study of the treatment effects on patients with respiratory illness. N=111 patients from 2 clinical centers randomized to receive either placebo or active treatments. 4 temporal examinations assessed the respiratory state of patients as good (=1) or poor (=0). Explanatory variables characterizing a patient were: center (1,2), treatment (A=active, P=placebo), sex (M=male, F=female), age (in years) at baseline. The values of the covariates were constant for the repeated elementary observations on each patient.

Table 1 shows the number of patients for the response patterns across the 4 visits split by baseline-status and treatment. Baseline respiratory status = 0 appear to have either low or high number of positive responses. Baseline respiratory status = 1 tend to respond positively. Table 2 describes the distribution of the number of positive responses per patient for sex and center.

# library("geepack")

Table 1: Distribution of patients for different response patterns classified by baseline-respiratory response and treatment. The patterns are ordered according to increasing numbers of positive responses.

<center>
{| class="wikitable" style="text-align:center; width:75%" border="1"
|-
! ||Visit|| colspan="15"| All Possible Response Patterns (2*2*2*2=16 permutation patterns)||
|-
|||1||0||1||0||0||0||1||1||1||0||0||1||1||1||0||1||
|-
|||2||0||0||1||0||0||1||0||0||1||0||1||1||0||1||1||
|-
|||3||0||0||0||1||0||0||1||0||1||1||1||0||1||1||1||
|-
|||4||0||0||0||0||1||0||0||1||0||1||0||1||1||1||1||
|-
!Baseline||Treatment||||||||||||||||||||||||||||||||Sum
|-
| rowspan="2"|0||A||7||2||2||2||1||0||1||0||1||0||1||2||0||4||7||30
|-
|P||18||1||0||2||1||2||0||0||1||0||0||1||2||0||3||31
|-
|rowspan="2"|1||A||0||0||0||0||0||0||1||1||0||0||4||0||1||0||17||24
|-
|P||1||4||1||0||0||0||0||1||1||3||1||1||2||1||10||26
|-
|Sum||||26||7||3||4||2||2||2||2||3||3||6||4||5||5||37||111
|}
</center>

Table 2: Distribution of patients for the number of positive responses across the 4 visits for Sex and Center.

<center>
{| class="wikitable" style="text-align:center; width:75%" border="1"
|-
! colspan="2" rowspan="2"| ||colspan="5"|Number of positive responses
|-
| 0||1||2||3||4
|-
|rowspan="2"|Sex || F||7||3||3||3||7
|-
|M||19||13||9||17||30
|-
|rowspan="2"|Center|| 1||18||9||6||11||12
|-
|2||8||7||6||9||25
|}
</center>

Figure 1 shows a plot of age against the proportion of positive responses for each patient. It indicates a quadratic relationship between the proportions and the age. Fitting a logistic model to the data (which would be appropriate if there were no time effects and no spread in the response probabilities for patients with the same covariate values).

# install.packages("geepack")
library("geepack")

# data include a clinical trial of 111 patients with respiratory illness from two different clinics were randomized to receive either
# placebo (P) or an active (A) treatment. Patients were examined at baseline and at four visits during treatment.
# At each examination, respiratory status (categorized as 1 = good, 0 = poor)
data("respiratory")
head(respiratory)
myData <- respiratory

<center>head(myData)
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Center||ID||Treat||Sex||Age||Baseline||Visit||Outcome
|-
|1 ||1||1||P||M||46||0||1||0
|-
|2 ||1||1||P||M||46||0||2||0
|-
|3 ||1||1||P||M||46||0||3||0
|-
|4 ||1||1||P||M||46||0||4||0
|-
|5||1||2||P||M||28||0||1||0
|-
|6||1||2||P||M||28||0||2||0
|}
</center>

# Get proportions of positive responses
responses <- factor(myData$\$$outcome, labels = c("OutcomePositive", "OutcomeNegative"))
data.frame <- data.frame(responses, myData$\$$age)
head(data.frame)
tab <- prop.table(table(data.frame), 1); tab # compute proportions
sum(tab[1,]) # check proportions (sums to 1.0)?
prop <- tab[1,] # save the proportions of positive responses for each patient
plot(as.numeric(dimnames(tab)$\$$myData.age), tab[1,], xlab = "Age", ylab = "Proportion of Positive Outcomes")
# dimnames(tab) # to see/inspect positive/negative outcomes

[[Image:SMHS_BigDataBigSci9.png|500px]]

x <- as.numeric(dimnames(tab)$\$$myData.age)
poly <- loess( prop ~ x) # fit a Local Polynomial Regression Fitting
plot(x, prop)
lines(predict(poly), col='red', lwd=2)

smoothingSpline <- smooth.spline(x, prop, spar=0.6)
plot(x, prop)
lines(smoothingSpline, col='red', lwd=1.5)
smoothPolySpline <- smooth.spline(x, predict(poly), spar=0.6)
lines(smoothPolySpline, col='blue', lwd=2)
legend("topright", inset=.05, title="Polynomial regression models", c("Raw Poly","Smooth Poly"), fill=c('red', 'blue'), horiz=TRUE)

[[Image:SMHS_BigDataBigSci10.png|500px]]

model.glm <- glm(outcome ~ baseline + center + sex + treat + age + I(age^2), data = respiratory, family = binomial)

summary(model.glm)

<center>Deviance Residuals:
{| class="wikitable" style="text-align:center; " border="1"
|-
|Min||1Q||Median||3Q||Max
|-
| -2.5951||-0.9108||0.4034||0.8336||2.0951
|}
</center>

<center>Coefficients:
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Estimate||Std. Error||z value||$Pr( \gt |z|)$
|-
|(Intercept)||3.3579727||1.0285292||3.265||0.0011 **
|-
|baseline||1.8850421||0.2482959||7.592||3.15e-14 ***
|-
|center||0.5099244||0.2453982||2.078||0.0377 *
|-
|sexM||-0.4510595||0.3166570||-1.424||0.1543
|-
|Treatp||-1.3231587||0.2431603||-5.442||5.28e-08 ***
|-
|age||-0.2072815||0.0472538||-4.387||1.15e-05 ***
|-
|I(age^2)||0.0025650||0.0006324||4.056||4.99e-05 ***
|}
</center>

Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

Null deviance: 609.41 on 443 degrees of freedom

Residual deviance: 468.62 on 437 degrees of freedom

AIC: 482.62

The correlation matrix of the of the outcome measures across visits is shown in Table 3.

attach(myData)
mat1 <- matrix(c(outcome[visit==1], outcome [visit==2], outcome [visit==3],
outcome[visit==4]), ncol = 4)
cor(mat1)

Table 3: Correlation matrix for the outcome measurements at different visits.

<center>Coefficients:
{| class="wikitable" style="text-align:center; " border="1"
|-
|||[,1]||[,2]||[,3]||[,4]
|-
|[,1]||1.0000000||0.5087944||0.4431438||0.5139016
|-
|[,2]||0.5087944||1.0000000||0.5821877||0.5301611
|-
|[,3]||0.4431438||0.5821877||1.0000000||0.5871276
|-
|[,4]||0.5139016||0.5301611||0.5871276||1.0000000
|}
</center>

# We can also examine for multicollinearity problem, using the correlation matrix for X
cor(model.matrix(model.glm)[,-1])

# GEE modeling: R function arguments/options

<li>corstr= for defining the correlation structure within groups in a GEE model</li>

<li>id= is used to identify the grouping variable in a GEE model</li>

<li>scale.fix= when TRUE causes the scale parameter to be fixed (by default at 1) rather than estimated</li>

<li>waves= names a positive integer-valued variable that is used to identify the order and spacing of observations within groups in a GEE model. This argument is crucial when there are missing values and gaps in the data</li>

gee.model1 <- geeglm(outcome ~ center + treat + sex + baseline + age, data = respiratory, family = "binomial", id = id, corstr = "exchangeable", scale.fix = TRUE)

# The column labeled Wald in the summary table is the square of the z-statistic. The reported p-values are the
# upper tailed probabilities from a chisq1 distribution and test whether the true parameter value ≠0.
summary(gee.model1)

# To test the effect of ''treatment'' using anova()
gee.model1 <- geeglm(outcome ~ center + treat + sex + baseline + age, data = respiratory, family=binomial(link="logit"), id = id, corstr = "exchangeable", std.err="san.se")
gee.model2 <- geeglm(outcome ~ center + sex + baseline + age, data = respiratory, family=binomial(link="logit"), id=id, corstr = "exchangeable", std.err="san.se")
anova(gee.model1, gee.model2)

# To test whether a categorical predictor with more than two levels should be retained in a GEE model we need
# to test the entire set of dummy variables simultaneously as a single construct.
# The geepack package provides a method for the anova function for a multivariate Wald test
# When the anova function is applied to a single geeglm object it returns sequential Wald tests for
# individual predictors with the tests carried out in the order the predictors are listed in the model formula.
anova(gee.model1)

===PD GEE example===

This example used the PPMI/PD data to show GEE analysis.

# 05_PPMI_top_UPDRS_Integrated_LongFormat1.csv
longData <- read.csv("https://umich.instructure.com/files/330397/download?download_frd=1",header=TRUE)

# library("geepack")

# Data Elements: FID_IID L_insular_cortex_ComputeArea L_insular_cortex_Volume R_insular_cortex_ComputeArea R_insular_cortex_Volume L_cingulate_gyrus_ComputeArea L_cingulate_gyrus_Volume R_cingulate_gyrus_ComputeArea R_cingulate_gyrus_Volume L_caudate_ComputeArea L_caudate_Volume R_caudate_ComputeArea R_caudate_Volume L_putamen_ComputeArea L_putamen_Volume R_putamen_ComputeArea R_putamen_Volume Sex Weight ResearchGroup Age chr12_rs34637584_GT chr17_rs11868035_GT chr17_rs11012_GT chr17_rs393152_GT chr17_rs12185268_GT chr17_rs199533_GT UPDRS_part_I UPDRS_part_II UPDRS_part_III time_visit

dim(longData)

data1 = na.omit(longData)
attach(data1)
ControlGroup <- ifelse(ResearchGroup == "Control", 1, 0)

# these calculations take a long time!!!
# if you get “Error in geese.fit(xx, yy, id, offset, soffset, w, waves = waves, zsca, :
# nrow(zsca) and length(y) not match” – this indicates some of the variables are of different lengths
# if you get “glm.fit: algorithm did not converge” – see this discussion: http://goo.gl/lrjBjB

gee.model0 <- geeglm(ControlGroup ~ L_insular_cortex_ComputeArea+L_insular_cortex_Volume+ Sex + Weight + Age + chr17_rs11012_GT + chr17_rs199533_GT + UPDRS_part_I + UPDRS_part_II + time_visit, data = data1, family=binomial(link="logit"), id = FID_IID, corstr = "unstructured", std.err="san.se")

gee.model1 <- geeglm(ControlGroup ~ L_insular_cortex_ComputeArea+L_insular_cortex_Volume+ R_putamen_ComputeArea + R_putamen_Volume + Sex + Weight + Age + chr17_rs11012_GT + chr17_rs199533_GT + UPDRS_part_I + UPDRS_part_II + time_visit, data = data1, family=binomial(link="logit"), id = FID_IID, corstr = "unstructured", std.err="san.se")

# compare 2 gee models
# anova(gee.model0,gee.model1)

# you can try the “family = poisson(link = "log")” model for the ResearchGroup response, as well

gee.model2 <- geeglm(ControlGroup
~ L_insular_cortex_ComputeArea+L_insular_cortex_Volume+R_insular_cortex_ComputeArea+ R_insular_cortex_Volume +L_cingulate_gyrus_ComputeArea + L_cingulate_gyrus_Volume + R_cingulate_gyrus_ComputeArea + R_cingulate_gyrus_Volume + L_caudate_ComputeArea + L_caudate_Volume + R_caudate_ComputeArea + R_caudate_Volume + L_putamen_ComputeArea + L_putamen_Volume + R_putamen_ComputeArea + R_putamen_Volume + Sex + Weight + Age + chr12_rs34637584_GT + chr17_rs11868035_GT + chr17_rs11012_GT + chr17_rs393152_GT + chr17_rs12185268_GT + chr17_rs199533_GT + UPDRS_part_I + UPDRS_part_II + time_visit, data = data1, family=binomial(link="logit"), id = FID_IID, corstr = "unstructured", std.err="san.se")

Remember that we do not interpret GEE coefficients as relating to individuals – GEE models are marginal models and the conclusions drawn are interpreted as population-based. Also, the time element in the model (time_visit) is just another controlling factor. The effect-sizes (betas) associated with each variable/predictor represent the slopes associated with the corresponding covariate, while holding time constant. If we need to examine interactions (e.g., Weight change over Time), we need to include an interaction term in model: (i.e. + Weight*time_visit).

summary (gee.model2)

# Individual Wald test and confidence intervals for each covariate
predictors2 <- coef(summary(gee.model2))
CI2 <- with(as.data.frame(predictors2), cbind(lwr=Estimate-1.96*Std.err, est=Estimate, upr=Estimate+1.96*Std.err))
rownames(CI2) <- rownames(predictors2)
CI2

==Appendix==

SEM References

<li>http://socserv.mcmaster.ca/jfox/Misc/sem/SEM-paper.pdf </li>

GEE References

<li>https://cran.r-project.org/web/packages/geepack/geepack.pdf</li>

<li>http://www.jstatsoft.org/v15/i02/paper</li>

===Footnotes===

* 3 http://www.jstatsoft.org/v15/i02/

* 4 https://books.google.com/books?id=mdEqBgAAQBAJ

==See also==
* [[SMHS_BigDataBigSci| Back to Model-based Analytics]]
* [[SMHS_BigDataBigSci_SEM| Structural Equation Modeling (SEM)]]
* [[SMHS_BigDataBigSci_GEE| Next Section: Generalized Estimating Equation (GEE) Modeling]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_BigDataBigSci_GCM}}

SMHS BigDataBigSci GCM

2016-05-23T13:42:13Z

Imoubara: /* Comparative Fit Index */

==[[SMHS_BigDataBigSci| Model-based Analytics]] - Growth Curve Models==

Latent growth curve models may be used to analyze longitudinal or temporal data where the outcome measure is assessed on multiple occasions, and we examine its change over time, e.g., the trajectory over time can be
modeled as a linear or quadratic function. Random effects are used to capture individual differences by conveniently representing (continuous) latent variables, aka growth factors. To fit a linear growth model we may specify a model with two latent variables: a random intercept, and a random slope:

#load data 05_PPMI_top_UPDRS_Integrated_LongFormat.csv ( dim(myData) 661 71), wide
# setwd("/dir/")
myData <- read.csv("https://umich.instructure.com/files/330395/download?download_frd=1&verifier=v6jBvV4x94ka3EYcGKuXXg5BZNaOLBVp0xkJih0H",header=TRUE)
attach(myData)

# dichotomize the "ResearchGroup" variable
table(myData$\$$ResearchGroup)
myData$\$$ResearchGroup <- ifelse(myData$\$$ResearchGroup == "Control", 1, 0)

# linear growth model with 4 timepoints
# intercept (i) and slope (s) with fixed coefficients
# i =~ 1*t1 + 1*t2 + 1*t3 + 1*t4 (intercept/constant)
# s =~ 0*t1 + 1*t2 + 2*t3 + 3*t4 (slope/linear term)
# ??? =~ 0*t1 + 1*t2 + 2*t3 + 3*t4 (quadratic term)

In this model, we have fixed all the coefficients of the linear growth functions:

model4 <-
'
i =~ 1*UPDRS_Part_I_Summary_Score_Baseline + 1*UPDRS_Part_I_Summary_Score_Month_03 +
1*UPDRS_Part_I_Summary_Score_Month_06 + 1*UPDRS_Part_I_Summary_Score_Month_09 +
1*UPDRS_Part_I_Summary_Score_Month_12 + 1*UPDRS_Part_I_Summary_Score_Month_18 +
1*UPDRS_Part_I_Summary_Score_Month_24 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Baseline +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_03 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_06 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_09 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_12 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_18 +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_24 +
1*UPDRS_Part_III_Summary_Score_Baseline + 1*UPDRS_Part_III_Summary_Score_Month_03 +
1*UPDRS_Part_III_Summary_Score_Month_06 + 1*UPDRS_Part_III_Summary_Score_Month_09 +
1*UPDRS_Part_III_Summary_Score_Month_12 + 1*UPDRS_Part_III_Summary_Score_Month_18 +
1*UPDRS_Part_III_Summary_Score_Month_24 +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Baseline +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_06 +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_12 +
1*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_24 +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Baseline +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_06 +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_12 +
1*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_24
s =~ 0*UPDRS_Part_I_Summary_Score_Baseline + 1*UPDRS_Part_I_Summary_Score_Month_03 +
2*UPDRS_Part_I_Summary_Score_Month_06 + 3*UPDRS_Part_I_Summary_Score_Month_09 +
4*UPDRS_Part_I_Summary_Score_Month_12 + 5*UPDRS_Part_I_Summary_Score_Month_18 +
6*UPDRS_Part_I_Summary_Score_Month_24 +
0*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Baseline +
1*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_03 +
2*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_06 +
3*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_09 +
4*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_12 +
5*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_18 +
6*UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_24 +
0*UPDRS_Part_III_Summary_Score_Baseline + 1*UPDRS_Part_III_Summary_Score_Month_03 +
2*UPDRS_Part_III_Summary_Score_Month_06 + 3*UPDRS_Part_III_Summary_Score_Month_09 +
4*UPDRS_Part_III_Summary_Score_Month_12 + 5*UPDRS_Part_III_Summary_Score_Month_18 +
6*UPDRS_Part_III_Summary_Score_Month_24 +
0*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Baseline +
2*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_06 +
4*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_12 +
6*X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_24 +
0*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Baseline +
2*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_06 +
4*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_12 +
6*X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_24
'

fit4 <- growth(model4, data=myData)
summary(fit4)
parameterEstimates(fit4) # extracts the values of the estimated parameters, the standard errors,
# the z-values, the standardized parameter values, and returns a data frame
fitted(fit4) # return the model-implied (fitted) covariance matrix (and mean vector) of a fitted model

# resid() function return (unstandardized) residuals of a fitted model including the difference between
# the observed and implied covariance matrix and mean vector
resid(fit4)

==Measures of model quality (Comparative Fit Index (CFI), Root Mean Square Error of Approximation (RMSEA))==

# report the fit measures as a signature vector: Comparative Fit Index (CFI), Root Mean Square Error of
# Approximation (RMSEA)
fitMeasures(fit4, c("cfi", "rmsea", "srmr"))

====Comparative Fit Index====

(CFI) is an incremental measure directly based on the non-centrality measure. If d = χ2(df) where df are the degrees of freedom of the model, the Comparative Fit Index is:
\begin{equation}
\frac{(Null Model)-d(Proposed Model)}{d(Null Model)}.
\end{equation}

$0≤CFI≤1$ (by definition). It is interpreted as:

*$CFI<0.9$ - model fitting is poor.

*$0.9≤CFI≤0.95$ is considered marginal,

*$CFI>0.95$ is good.

CFI is a relative index of model fit – it compare the fit of your model to the fit of (the worst) fitting null model.

====Root Mean Square Error of Approximation====
(RMSEA) - “Ramsey”

An absolute measure of fit based on the non-centrality parameter:

$\sqrt{\frac{X^2-df}{df×(N - 1)}}$,

where N the sample size and df the degrees of freedom of the model. If χ2 < df, then the RMSEA∶=0. It has a penalty for complexity via the chi square to df ratio. The RMSEA is a popular measure of model fit.

<li>RMSEA < 0.01, excellent, </li>

<li>RMSEA < 0.05, good </li>

<li>RMSEA > 0.10 cutoff for poor fitting models</li>

====Standardized Root Mean Square Residual====
(SRMR) is an absolute measure of fit defined as the standardized difference between the observed correlation and the predicted correlation. A value of zero indicates perfect fit. The SRMR has no penalty for model complexity. SRMR <0.08 is considered a good fit.

# inspect the model results (report parameter table)
inspect(fit4)

#install.packages("semTools")
# library("semTools")

A Simpler Model (fit5)

model5 <- '
# intercept and slope with fixed coefficients
i =~ UPDRS_Part_I_Summary_Score_Baseline + UPDRS_Part_I_Summary_Score_Month_03 + UPDRS_Part_I_Summary_Score_Month_24
s =~ 0*UPDRS_Part_I_Summary_Score_Baseline + 1*UPDRS_Part_I_Summary_Score_Month_03 + 6*UPDRS_Part_I_Summary_Score_Month_24
# regressions
i ~ R_fusiform_gyrus_Volume + Weight + ResearchGroup + Age + chr12_rs34637584_GT
s ~ R_fusiform_gyrus_Volume + Weight + ResearchGroup + Age + chr12_rs34637584_GT
# time-varying covariates
UPDRS_Part_I_Summary_Score_Baseline ~ Weight
UPDRS_Part_I_Summary_Score_Month_03 ~ ResearchGroup
UPDRS_Part_I_Summary_Score_Month_24 ~ Age
'

fit5 <- growth(model5, data=myData)
summary(fit5); fitMeasures(fit5, c("cfi", "rmsea", "srmr"))
parameterEstimates(fit5) # extracts the values of the estimated parameters, the standard errors,
# the z-values, the standardized parameter values, and returns a data frame

lavaan (0.5-18) converged normally after 99 iterations
Number of observations 661
Estimator ML
Minimum Function Test Statistic 3.703
Degrees of freedom 1
P-value (Chi-square) 0.054
Parameter estimates:
Information Expected
Standard Errors Standard
Estimate Std.err Z-value P(>|z|)
Latent variables:
i =~
UPDRS_P_I_S_S 1.000
UPDRS_P_I_S_S 1.074
UPDRS_P_I_S_S 1.172
s =~
UPDRS_P_I_S_S 0.000
UPDRS_P_I_S_S 1.000
UPDRS_P_I_S_S 6.000

Regressions:
i ~
R_fsfrm_gyr_V 0.000
Weight 0.003
ResearchGroup -0.880
Age -0.009
c12_34637584_ -0.907
s ~
R_fsfrm_gyr_V -0.000
Weight -0.000
ResearchGroup -0.084
Age 0.002
c12_34637584_ -0.047
UPDRS_Part_I_Summary_Score_Baseline ~
Weight -0.000
UPDRS_Part_I_Summary_Score_Month_03 ~
ResearchGroup 0.693
UPDRS_Part_I_Summary_Score_Month_24 ~
Age -0.002

Covariances:
i ~~
s 0.074

Intercepts:
UPDRS_P_I_S_S 0.000
UPDRS_P_I_S_S 0.000
UPDRS_P_I_S_S 0.000
i 1.633
s -0.023

Variances:
UPDRS_P_I_S_S 1.017
UPDRS_P_I_S_S 1.093
UPDRS_P_I_S_S 2.993
i 1.019
s -0.025

cfi rmsea srmr
0.996 0.064 0.008

fitted(fit5) # return the model-implied (fitted) covariance matrix (and mean vector) of a fitted model
# write.table(fitted(fit5), file="C:\\Users\\Dinov\\Desktop\\test1.txt")

# resid() function return (unstandardized) residuals of a fitted model including the difference between
# the observed and implied covariance matrix and mean vector
resid(fit5)

# report the fit measures as a signature vector
fitMeasures(fit5, c("cfi", "rmsea", "srmr")) # comparative fit index (CFI)

# inspect the model results (report parameter table)
inspect(fit5)

Note: See discussion of SEM modeling pros/cons 2.

==Generalized Estimating Equation (GEE) Modeling==

Generalized Estimating Equations (GEE) modeling3 is used for analyzing data with the following characteristics:
(1) the observations within a group may be correlated, (2) observations in separate clusters are independent, (3) a monotone transformation of the expectation is linearly related to the explanatory variables, and (4) the variance is a function of the expectation. The expectation (#3) and the variance (# 4) are conditional given group-level or individual-level covariates.

GEE is applied to handle correlated discrete and continuous outcome variables. For the outcome variables, it only requires specification of the first 2 moments and correlation among them. The goal is to estimate fixed parameters without specifying their joint distribution. The correlation is specified by one of these 4 alternatives (which is specified in the R call: geeglm(outcome ~ center + treat + sex + baseline + age, data = respiratory, family = "binomial", id = id, corstr = " exchangeable", scale.fix = TRUE):

<center>[[Image:SMHS_BigDataBigSci8.png|300px]]</center>

===Respiratory Illness GEE R example===

This example is based on a data set on respiratory illness 4 and the geepack package. The data is from a clinical study of the treatment effects on patients with respiratory illness. N=111 patients from 2 clinical centers randomized to receive either placebo or active treatments. 4 temporal examinations assessed the respiratory state of patients as good (=1) or poor (=0). Explanatory variables characterizing a patient were: center (1,2), treatment (A=active, P=placebo), sex (M=male, F=female), age (in years) at baseline. The values of the covariates were constant for the repeated elementary observations on each patient.

Table 1 shows the number of patients for the response patterns across the 4 visits split by baseline-status and treatment. Baseline respiratory status = 0 appear to have either low or high number of positive responses. Baseline respiratory status = 1 tend to respond positively. Table 2 describes the distribution of the number of positive responses per patient for sex and center.

# library("geepack")

Table 1: Distribution of patients for different response patterns classified by baseline-respiratory response and treatment. The patterns are ordered according to increasing numbers of positive responses.

<center>
{| class="wikitable" style="text-align:center; width:75%" border="1"
|-
! ||Visit|| colspan="15"| All Possible Response Patterns (2*2*2*2=16 permutation patterns)||
|-
|||1||0||1||0||0||0||1||1||1||0||0||1||1||1||0||1||
|-
|||2||0||0||1||0||0||1||0||0||1||0||1||1||0||1||1||
|-
|||3||0||0||0||1||0||0||1||0||1||1||1||0||1||1||1||
|-
|||4||0||0||0||0||1||0||0||1||0||1||0||1||1||1||1||
|-
!Baseline||Treatment||||||||||||||||||||||||||||||||Sum
|-
| rowspan="2"|0||A||7||2||2||2||1||0||1||0||1||0||1||2||0||4||7||30
|-
|P||18||1||0||2||1||2||0||0||1||0||0||1||2||0||3||31
|-
|rowspan="2"|1||A||0||0||0||0||0||0||1||1||0||0||4||0||1||0||17||24
|-
|P||1||4||1||0||0||0||0||1||1||3||1||1||2||1||10||26
|-
|Sum||||26||7||3||4||2||2||2||2||3||3||6||4||5||5||37||111
|}
</center>

Table 2: Distribution of patients for the number of positive responses across the 4 visits for Sex and Center.

<center>
{| class="wikitable" style="text-align:center; width:75%" border="1"
|-
! colspan="2" rowspan="2"| ||colspan="5"|Number of positive responses
|-
| 0||1||2||3||4
|-
|rowspan="2"|Sex || F||7||3||3||3||7
|-
|M||19||13||9||17||30
|-
|rowspan="2"|Center|| 1||18||9||6||11||12
|-
|2||8||7||6||9||25
|}
</center>

Figure 1 shows a plot of age against the proportion of positive responses for each patient. It indicates a quadratic relationship between the proportions and the age. Fitting a logistic model to the data (which would be appropriate if there were no time effects and no spread in the response probabilities for patients with the same covariate values).

# install.packages("geepack")
library("geepack")

# data include a clinical trial of 111 patients with respiratory illness from two different clinics were randomized to receive either
# placebo (P) or an active (A) treatment. Patients were examined at baseline and at four visits during treatment.
# At each examination, respiratory status (categorized as 1 = good, 0 = poor)
data("respiratory")
head(respiratory)
myData <- respiratory

<center>head(myData)
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Center||ID||Treat||Sex||Age||Baseline||Visit||Outcome
|-
|1 ||1||1||P||M||46||0||1||0
|-
|2 ||1||1||P||M||46||0||2||0
|-
|3 ||1||1||P||M||46||0||3||0
|-
|4 ||1||1||P||M||46||0||4||0
|-
|5||1||2||P||M||28||0||1||0
|-
|6||1||2||P||M||28||0||2||0
|}
</center>

# Get proportions of positive responses
responses <- factor(myData$\$$outcome, labels = c("OutcomePositive", "OutcomeNegative"))
data.frame <- data.frame(responses, myData$\$$age)
head(data.frame)
tab <- prop.table(table(data.frame), 1); tab # compute proportions
sum(tab[1,]) # check proportions (sums to 1.0)?
prop <- tab[1,] # save the proportions of positive responses for each patient
plot(as.numeric(dimnames(tab)$\$$myData.age), tab[1,], xlab = "Age", ylab = "Proportion of Positive Outcomes")
# dimnames(tab) # to see/inspect positive/negative outcomes

[[Image:SMHS_BigDataBigSci9.png|500px]]

x <- as.numeric(dimnames(tab)$\$$myData.age)
poly <- loess( prop ~ x) # fit a Local Polynomial Regression Fitting
plot(x, prop)
lines(predict(poly), col='red', lwd=2)

smoothingSpline <- smooth.spline(x, prop, spar=0.6)
plot(x, prop)
lines(smoothingSpline, col='red', lwd=1.5)
smoothPolySpline <- smooth.spline(x, predict(poly), spar=0.6)
lines(smoothPolySpline, col='blue', lwd=2)
legend("topright", inset=.05, title="Polynomial regression models", c("Raw Poly","Smooth Poly"), fill=c('red', 'blue'), horiz=TRUE)

[[Image:SMHS_BigDataBigSci10.png|500px]]

model.glm <- glm(outcome ~ baseline + center + sex + treat + age + I(age^2), data = respiratory, family = binomial)

summary(model.glm)

<center>Deviance Residuals:
{| class="wikitable" style="text-align:center; " border="1"
|-
|Min||1Q||Median||3Q||Max
|-
| -2.5951||-0.9108||0.4034||0.8336||2.0951
|}
</center>

<center>Coefficients:
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Estimate||Std. Error||z value||$Pr( \gt |z|)$
|-
|(Intercept)||3.3579727||1.0285292||3.265||0.0011 **
|-
|baseline||1.8850421||0.2482959||7.592||3.15e-14 ***
|-
|center||0.5099244||0.2453982||2.078||0.0377 *
|-
|sexM||-0.4510595||0.3166570||-1.424||0.1543
|-
|Treatp||-1.3231587||0.2431603||-5.442||5.28e-08 ***
|-
|age||-0.2072815||0.0472538||-4.387||1.15e-05 ***
|-
|I(age^2)||0.0025650||0.0006324||4.056||4.99e-05 ***
|}
</center>

Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

Null deviance: 609.41 on 443 degrees of freedom

Residual deviance: 468.62 on 437 degrees of freedom

AIC: 482.62

The correlation matrix of the of the outcome measures across visits is shown in Table 3.

attach(myData)
mat1 <- matrix(c(outcome[visit==1], outcome [visit==2], outcome [visit==3],
outcome[visit==4]), ncol = 4)
cor(mat1)

Table 3: Correlation matrix for the outcome measurements at different visits.

<center>Coefficients:
{| class="wikitable" style="text-align:center; " border="1"
|-
|||[,1]||[,2]||[,3]||[,4]
|-
|[,1]||1.0000000||0.5087944||0.4431438||0.5139016
|-
|[,2]||0.5087944||1.0000000||0.5821877||0.5301611
|-
|[,3]||0.4431438||0.5821877||1.0000000||0.5871276
|-
|[,4]||0.5139016||0.5301611||0.5871276||1.0000000
|}
</center>

# We can also examine for multicollinearity problem, using the correlation matrix for X
cor(model.matrix(model.glm)[,-1])

# GEE modeling: R function arguments/options

<li>corstr= for defining the correlation structure within groups in a GEE model</li>

<li>id= is used to identify the grouping variable in a GEE model</li>

<li>scale.fix= when TRUE causes the scale parameter to be fixed (by default at 1) rather than estimated</li>

<li>waves= names a positive integer-valued variable that is used to identify the order and spacing of observations within groups in a GEE model. This argument is crucial when there are missing values and gaps in the data</li>

gee.model1 <- geeglm(outcome ~ center + treat + sex + baseline + age, data = respiratory, family = "binomial", id = id, corstr = "exchangeable", scale.fix = TRUE)

# The column labeled Wald in the summary table is the square of the z-statistic. The reported p-values are the
# upper tailed probabilities from a chisq1 distribution and test whether the true parameter value ≠0.
summary(gee.model1)

# To test the effect of ''treatment'' using anova()
gee.model1 <- geeglm(outcome ~ center + treat + sex + baseline + age, data = respiratory, family=binomial(link="logit"), id = id, corstr = "exchangeable", std.err="san.se")
gee.model2 <- geeglm(outcome ~ center + sex + baseline + age, data = respiratory, family=binomial(link="logit"), id=id, corstr = "exchangeable", std.err="san.se")
anova(gee.model1, gee.model2)

# To test whether a categorical predictor with more than two levels should be retained in a GEE model we need
# to test the entire set of dummy variables simultaneously as a single construct.
# The geepack package provides a method for the anova function for a multivariate Wald test
# When the anova function is applied to a single geeglm object it returns sequential Wald tests for
# individual predictors with the tests carried out in the order the predictors are listed in the model formula.
anova(gee.model1)

===PD GEE example===

This example used the PPMI/PD data to show GEE analysis.

# 05_PPMI_top_UPDRS_Integrated_LongFormat1.csv
longData <- read.csv("https://umich.instructure.com/files/330397/download?download_frd=1",header=TRUE)

# library("geepack")

# Data Elements: FID_IID L_insular_cortex_ComputeArea L_insular_cortex_Volume R_insular_cortex_ComputeArea R_insular_cortex_Volume L_cingulate_gyrus_ComputeArea L_cingulate_gyrus_Volume R_cingulate_gyrus_ComputeArea R_cingulate_gyrus_Volume L_caudate_ComputeArea L_caudate_Volume R_caudate_ComputeArea R_caudate_Volume L_putamen_ComputeArea L_putamen_Volume R_putamen_ComputeArea R_putamen_Volume Sex Weight ResearchGroup Age chr12_rs34637584_GT chr17_rs11868035_GT chr17_rs11012_GT chr17_rs393152_GT chr17_rs12185268_GT chr17_rs199533_GT UPDRS_part_I UPDRS_part_II UPDRS_part_III time_visit

dim(longData)

data1 = na.omit(longData)
attach(data1)
ControlGroup <- ifelse(ResearchGroup == "Control", 1, 0)

# these calculations take a long time!!!
# if you get “Error in geese.fit(xx, yy, id, offset, soffset, w, waves = waves, zsca, :
# nrow(zsca) and length(y) not match” – this indicates some of the variables are of different lengths
# if you get “glm.fit: algorithm did not converge” – see this discussion: http://goo.gl/lrjBjB

gee.model0 <- geeglm(ControlGroup ~ L_insular_cortex_ComputeArea+L_insular_cortex_Volume+ Sex + Weight + Age + chr17_rs11012_GT + chr17_rs199533_GT + UPDRS_part_I + UPDRS_part_II + time_visit, data = data1, family=binomial(link="logit"), id = FID_IID, corstr = "unstructured", std.err="san.se")

gee.model1 <- geeglm(ControlGroup ~ L_insular_cortex_ComputeArea+L_insular_cortex_Volume+ R_putamen_ComputeArea + R_putamen_Volume + Sex + Weight + Age + chr17_rs11012_GT + chr17_rs199533_GT + UPDRS_part_I + UPDRS_part_II + time_visit, data = data1, family=binomial(link="logit"), id = FID_IID, corstr = "unstructured", std.err="san.se")

# compare 2 gee models
# anova(gee.model0,gee.model1)

# you can try the “family = poisson(link = "log")” model for the ResearchGroup response, as well

gee.model2 <- geeglm(ControlGroup
~ L_insular_cortex_ComputeArea+L_insular_cortex_Volume+R_insular_cortex_ComputeArea+ R_insular_cortex_Volume +L_cingulate_gyrus_ComputeArea + L_cingulate_gyrus_Volume + R_cingulate_gyrus_ComputeArea + R_cingulate_gyrus_Volume + L_caudate_ComputeArea + L_caudate_Volume + R_caudate_ComputeArea + R_caudate_Volume + L_putamen_ComputeArea + L_putamen_Volume + R_putamen_ComputeArea + R_putamen_Volume + Sex + Weight + Age + chr12_rs34637584_GT + chr17_rs11868035_GT + chr17_rs11012_GT + chr17_rs393152_GT + chr17_rs12185268_GT + chr17_rs199533_GT + UPDRS_part_I + UPDRS_part_II + time_visit, data = data1, family=binomial(link="logit"), id = FID_IID, corstr = "unstructured", std.err="san.se")

Remember that we do not interpret GEE coefficients as relating to individuals – GEE models are marginal models and the conclusions drawn are interpreted as population-based. Also, the time element in the model (time_visit) is just another controlling factor. The effect-sizes (betas) associated with each variable/predictor represent the slopes associated with the corresponding covariate, while holding time constant. If we need to examine interactions (e.g., Weight change over Time), we need to include an interaction term in model: (i.e. + Weight*time_visit).

summary (gee.model2)

# Individual Wald test and confidence intervals for each covariate
predictors2 <- coef(summary(gee.model2))
CI2 <- with(as.data.frame(predictors2), cbind(lwr=Estimate-1.96*Std.err, est=Estimate, upr=Estimate+1.96*Std.err))
rownames(CI2) <- rownames(predictors2)
CI2

==Appendix==

SEM References

<li>http://socserv.mcmaster.ca/jfox/Misc/sem/SEM-paper.pdf </li>

GEE References

<li>https://cran.r-project.org/web/packages/geepack/geepack.pdf</li>

<li>http://www.jstatsoft.org/v15/i02/paper</li>

===Footnotes===

* 3 http://www.jstatsoft.org/v15/i02/

* 4 https://books.google.com/books?id=mdEqBgAAQBAJ

==See also==
* [[SMHS_BigDataBigSci| Back to Model-based Analytics]]
* [[SMHS_BigDataBigSci_SEM| Structural Equation Modeling (SEM)]]
* [[SMHS_BigDataBigSci_GEE| Next Section: Generalized Estimating Equation (GEE) Modeling]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_BigDataBigSci_GCM}}

SMHS BigDataBigSci SEM Ex2

2016-05-23T13:41:07Z

Imoubara: /* Output */

==[[SMHS_BigDataBigSci_SEM| Structural Equation Modeling (SEM)]] - Hands-on Example 2 (Parkinson’s Disease data) ==

# Data: PPMI Integrated imaging, demographics, genetics, clinical and cognitive (UPDRS) data.
# Dinov et al., 2016

<center>
{| class="wikitable" style="text-align:center; width:75%" border="1"
|-
!Index||FID_IID||L_cingulate_gyrus_ComputeArea||L_cingulate_gyrus_Volume||R_cingulate_gyrus_ComputeArea||R_cingulate_gyrus_Volume||L_caudate_ComputeArea||L_caudate_Volume||R_caudate_ComputeArea||R_caudate_Volume||L_putamen_ComputeArea||L_putamen_Volume||R_putamen_ComputeArea||R_putamen_Volume||L_hippocampus_ComputeArea||L_hippocampus_Volume||R_hippocampus_ComputeArea||R_hippocampus_Volume||cerebellum_ComputeArea||cerebellum_Volume||L_fusiform_gyrus_ComputeArea||L_fusiform_gyrus_Volume||R_fusiform_gyrus_ComputeArea||R_fusiform_gyrus_Volume||Sex||Weight||ResearchGroup||Age||chr12_rs34637584_GT||chr17_rs11868035_GT||chr17_rs11012_GT||chr17_rs393152_GT||chr17_rs12185268_GT||UPDRS_part_I||UPDRS_part_II||UPDRS_part_III||UPDRS_part_IV||time_visit
|-
|2||3001||4381.93||11205.13||4610.447||12246.55||621.5344||821.8991||1302.146||2526.248||1029.175||1543.017||1680.197||3792.201||1769.672||4737.038||1578.946||3817.621||20909.58||185742.6||4534.707||15830.32||3945.037||14471.84||1||74.2||PD||65.1808||0||1||1||1||1||0||2||12||NA||0
|-
|2||3001||4381.93||11205.13||4610.447||12246.55||621.5344||821.8991||1302.146||2526.248||1029.175||1543.017||1680.197||3792.201||1769.672||4737.038||1578.946||3817.621||20909.58||185742.6||4534.707||15830.32||3945.037||14471.84||1||74.2||PD||65.1808||0||1||1||1||1||0||2||18||NA||42
|-
|2||3001||4381.93||11205.13||4610.447||12246.55||621.5344||821.8991||1302.146||2526.248||1029.175||1543.017||1680.197||3792.201||1769.672||4737.038||1578.946||3817.621||20909.58||185742.6||4534.707||15830.32||3945.037||14471.84||1||74.2||PD||65.1808||0||1||1||1||1||0||3||23||NA||24
|-
|2||3001||4381.93||11205.13||4610.447||12246.55||621.5344||821.8991||1302.146||2526.248||1029.175||1543.017||1680.197||3792.201||1769.672||4737.038||1578.946||3817.621||20909.58||185742.6||4534.707||15830.32||3945.037||14471.84||1||74.2||PD||65.1808||0||1||1||1||1||1||3||19||NA||9
|-
|2||3001||4381.93||11205.13||4610.447||12246.55||621.5344||821.8991||1302.146||2526.248||1029.175||1543.017||1680.197||3792.201||1769.672||4737.038||1578.946||3817.621||20909.58||185742.6||4534.707||15830.32||3945.037||14471.84||1||74.2||PD||65.1808||0||1||1||1||1||4||3||20||NA||0
|-
|2||3001||4381.93||11205.13||4610.447||12246.55||621.5344||821.8991||1302.146||2526.248||1029.175||1543.017||1680.197||3792.201||1769.672||4737.038||1578.946||3817.621||20909.58||185742.6||4534.707||15830.32||3945.037||14471.84||1||74.2||PD||65.1808||0||1||1||1||1||1||4||29||NA||42
|-
|2||3001||4381.93||11205.13||4610.447||12246.55||621.5344||821.8991||1302.146||2526.248||1029.175||1543.017||1680.197||3792.201||1769.672||4737.038||1578.946||3817.621||20909.58||185742.6||4534.707||15830.32||3945.037||14471.84||1||74.2||PD||65.1808||0||1||1||1||1||0||2||39||NA||24
|-
|2||3001||4381.93||11205.13||4610.447||12246.55||621.5344||821.8991||1302.146||2526.248||1029.175||1543.017||1680.197||3792.201||1769.672||4737.038||1578.946||3817.621||20909.58||185742.6||4534.707||15830.32||3945.037||14471.84||1||74.2||PD||65.1808||0||1||1||1||1||0||5||25||NA||9
|-
|2||3001||4381.93||11205.13||4610.447||12246.55||621.5344||821.8991||1302.146||2526.248||1029.175||1543.017||1680.197||3792.201||1769.672||4737.038||1578.946||3817.621||20909.58||185742.6||4534.707||15830.32||3945.037||14471.84||1||74.2||PD||65.1808||0||1||1||1||1||1||6||34||NA||0
|-
|2||3001||4381.93||11205.13||4610.447||12246.55||621.5344||821.8991||1302.146||2526.248||1029.175||1543.017||1680.197||3792.201||1769.672||4737.038||1578.946||3817.621||20909.58||185742.6||4534.707||15830.32||3945.037||14471.84||1||74.2||PD||65.1808||0||1||1||1||1||1||11||42||0||42
|-
|2||3001||4381.93||11205.13||4610.447||12246.55||621.5344||821.8991||1302.146||2526.248||1029.175||1543.017||1680.197||3792.201||1769.672||4737.038||1578.946||3817.621||20909.58||185742.6||4534.707||15830.32||3945.037||14471.84||1||74.2||PD||65.1808||0||1||1||1||1||1||5||39||0||24
|-
|2||3001||4381.93||11205.13||4610.447||12246.55||621.5344||821.8991||1302.146||2526.248||1029.175||1543.017||1680.197||3792.201||1769.672||4737.038||1578.946||3817.621||20909.58||185742.6||4534.707||15830.32||3945.037||14471.84||1||74.2||PD||65.1808||0||1||1||1||1||NA||NA||NA||NA||9
|-
|3||3002||3221.54||7439.645||3194.348||7264.683||876.9414||1364.86||1056.22||1965.206||1275.905||2696.695||1375.725||2966.682||1529.759||3736.04||1799.439||4665.168||17627.01||155632.3||4013.385||12677.99||3551.876||11263.23||2||70.6||PD||67.6247||0||1||0||0||0||3||15||17||NA||3
|-
|3||3002||3221.54||7439.645||3194.348||7264.683||876.9414||1364.86||1056.22||1965.206||1275.905||2696.695||1375.725||2966.682||1529.759||3736.04||1799.439||4665.168||17627.01||155632.3||4013.385||12677.99||3551.876||11263.23||2||70.6||PD||67.6247||0||1||0||0||0||2||10||22||NA||48
|-
|3||3002||3221.54||7439.645||3194.348||7264.683||876.9414||1364.86||1056.22||1965.206||1275.905||2696.695||1375.725||2966.682||1529.759||3736.04||1799.439||4665.168||17627.01||155632.3||4013.385||12677.99||3551.876||11263.23||2||70.6||PD||67.6247||0||1||0||0||0||NA||NA||NA||NA||30
|-
|3||3002||3221.54||7439.645||3194.348||7264.683||876.9414||1364.86||1056.22||1965.206||1275.905||2696.695||1375.725||2966.682||1529.759||3736.04||1799.439||4665.168||17627.01||155632.3||4013.385||12677.99||3551.876||11263.23||2||70.6||PD||67.6247||0||1||0||0||0||1||16||20||NA||12
|-
|3||3002||3221.54||7439.645||3194.348||7264.683||876.9414||1364.86||1056.22||1965.206||1275.905||2696.695||1375.725||2966.682||1529.759||3736.04||1799.439||4665.168||17627.01||155632.3||4013.385||12677.99||3551.876||11263.23||2||70.6||PD||67.6247||0||1||0||0||0||3||15||27||0||3
|-
|3||3002||3221.54||7439.645||3194.348||7264.683||876.9414||1364.86||1056.22||1965.206||1275.905||2696.695||1375.725||2966.682||1529.759||3736.04||1799.439||4665.168||17627.01||155632.3||4013.385||12677.99||3551.876||11263.23||2||70.6||PD||67.6247||0||1||0||0||0||4||16||22||0||48
|-
|3||3002||3221.54||7439.645||3194.348||7264.683||876.9414||1364.86||1056.22||1965.206||1275.905||2696.695||1375.725||2966.682||1529.759||3736.04||1799.439||4665.168||17627.01||155632.3||4013.385||12677.99||3551.876||11263.23||2||70.6||PD||67.6247||0||1||0||0||0||8||14||22||0||30
|-
|3||3002||3221.54||7439.645||3194.348||7264.683||876.9414||1364.86||1056.22||1965.206||1275.905||2696.695||1375.725||2966.682||1529.759||3736.04||1799.439||4665.168||17627.01||155632.3||4013.385||12677.99||3551.876||11263.23||2||70.6||PD||67.6247||0||1||0||0||0||4||13||24||1||12
|-
|3||3002||3221.54||7439.645||3194.348||7264.683||876.9414||1364.86||1056.22||1965.206||1275.905||2696.695||1375.725||2966.682||1529.759||3736.04||1799.439||4665.168||17627.01||155632.3||4013.385||12677.99||3551.876||11263.23||2||70.6||PD||67.6247||0||1||0||0||0||4||16||31||4||3
|-
|3||3002||3221.54||7439.645||3194.348||7264.683||876.9414||1364.86||1056.22||1965.206||1275.905||2696.695||1375.725||2966.682||1529.759||3736.04||1799.439||4665.168||17627.01||155632.3||4013.385||12677.99||3551.876||11263.23||2||70.6||PD||67.6247||0||1||0||0||0||6||14||19||4||48
|-
|3||3002||3221.54||7439.645||3194.348||7264.683||876.9414||1364.86||1056.22||1965.206||1275.905||2696.695||1375.725||2966.682||1529.759||3736.04||1799.439||4665.168||17627.01||155632.3||4013.385||12677.99||3551.876||11263.23||2||70.6||PD||67.6247||0||1||0||0||0||5||18||29||3||30
|}
</center>

# install.packages("lavaan")
library(lavaan)
#load data 05_PPMI_top_UPDRS_Integrated_LongFormat1.csv ( dim(myData) 1764 31 )
# setwd("/dir/")
myData <- read.csv("https://umich.instructure.com/files/330397/download?download_frd=1&verifier=3bYRT9FXgBGMCQv8MNxsclWnMgodiJRYo3ODFtDq",header=TRUE)

# dichotomize the "ResearchGroup" variable
myData$\$$ResearchGroup <- ifelse(myData$\$$ResearchGroup == "Control", 1, 0)

# Data elements: Index FID_IID L_cingulate_gyrus_ComputeArea L_cingulate_gyrus_Volume
R_cingulate_gyrus_ComputeArea R_cingulate_gyrus_Volume L_caudate_ComputeArea
L_caudate_Volume R_caudate_ComputeArea R_caudate_Volume
L_putamen_ComputeArea L_putamen_Volume R_putamen_ComputeArea
R_putamen_Volume L_hippocampus_ComputeArea L_hippocampus_Volume R_hippocampus_ComputeArea
R_hippocampus_Volume cerebellum_ComputeArea
cerebellum_Volume L_fusiform_gyrus_ComputeArea L_fusiform_gyrus_Volume R_fusiform_gyrus_ComputeArea
R_fusiform_gyrus_Volume Sex Weight ResearchGroup Age chr12_rs34637584_GT chr17_rs11868035_GT chr17_rs11012_GT chr17_rs393152_GT
chr17_rs12185268_GT UPDRS_Part_I_Summary_Score_Baseline
UPDRS_Part_I_Summary_Score_Month_03 UPDRS_Part_I_Summary_Score_Month_06 UPDRS_Part_I_Summary_Score_Month_09 UPDRS_Part_I_Summary_Score_Month_12 UPDRS_Part_I_Summary_Score_Month_18 UPDRS_Part_I_Summary_Score_Month_24 UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Baseline UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_03 UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_06 UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_09 UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_12 UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_18 UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_24 UPDRS_Part_III_Summary_Score_Baseline UPDRS_Part_III_Summary_Score_Month_03 UPDRS_Part_III_Summary_Score_Month_06 UPDRS_Part_III_Summary_Score_Month_09 UPDRS_Part_III_Summary_Score_Month_12 UPDRS_Part_III_Summary_Score_Month_18 UPDRS_Part_III_Summary_Score_Month_24 X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Baseline X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_06 X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_12 X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_24 X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Baseline X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_06 X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_12 X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_24

====Validation of the measurement model====

myData<-within(myData, {
L_cingulate_gyrus_ComputeArea <- lm(L_cingulate_gyrus_ComputeArea ~ L_cingulate_gyrus_Volume+R_cingulate_gyrus_ComputeArea+R_cingulate_gyrus_Volume+L_caudate_ComputeArea+L_caudate_Volume+R_caudate_ComputeArea+R_caudate_Volume+L_putamen_ComputeArea+L_putamen_Volume+R_putamen_ComputeArea+R_putamen_Volum e+L_hippocampus_ComputeArea+L_hippocampus_Volume+R_hippocampus_ComputeArea+R_hippocampus_Volume+cerebellum_ComputeArea+cerebellum_Volume+L_fusiform_gyrus_ComputeArea+L_fusiform_gyrus_Volume+R_fusiform_gyrus_ComputeArea+R_fusiform_gyru s_Volume, data=myData)$\$$residuals
Weight <- lm(Weight ~ Sex+ResearchGroup+Age+chr12_rs34637584_GT+chr17_rs11868035_GT+chr17_rs11012_GT+chr17_rs393152_GT+chr17_rs12185268_GT, data=myData)$\$$residuals
UPDRS_Part_I_Summary_Score_Baseline <- lm(UPDRS_Part_I_Summary_Score_Baseline ~ UPDRS_Part_I_Summary_Score_Month_03+UPDRS_Part_I_Summary_Score_Month_06+UPDRS_Part_I_Summary_Score_Month_09+UPDRS_Part_I_Summary_Score_Month_12+UPDRS_Part_I_Summary_Score_Month_18+UPDRS_Part_I_Summary_Score_Month_24+UPDRS_Part_II_Pati ent_Questionnaire_Summary_Score_Baseline+UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_03+UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_06+UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_09+UPDRS_Part_II_Pa tient_Questionnaire_Summary_Score_Month_12+UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_18+UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_24+UPDRS_Part_III_Summary_Score_Baseline+UPDRS_Part_III_Summary_Score_Month_ 03+UPDRS_Part_III_Summary_Score_Month_06+UPDRS_Part_III_Summary_Score_Month_09+UPDRS_Part_III_Summary_Score_Month_12+UPDRS_Part_III_Summary_Score_Month_18+UPDRS_Part_III_Summary_Score_Month_24+X_Assessment_Non.Motor_Epworth_Sleepiness _Scale_Summary_Score_Baseline+X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_06+X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_12+X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_ Month_24+X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Baseline+X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_06+X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short _Summary_Score_Month_12+X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_24, data=myData)$\$$residuals })

====Structural Model====

# Next, proceed with the structural model including the residuals from data to account for effects of site.

Lavaan model specification:

formula type operator mnemonic
latent variable definition =~ is measured by
regression ~ is regressed on
(residual) (co)variance ~~ is correlated with
Intercept ~ 1 Intercept

For example,
myModel <-
# regressions
y1 + y2 ~ f1 + f2 + x1 + x2
f1 ~ f2 + f3
f2 ~ f3 + x1 + x2

# latent variable definitions
f1 =~ y1 + y2 + y3
f2 =~ y4 + y5 + y6
f3 =~ y7 + y8 + y9 + y10

# variances and covariances
y1 ~~ y1
y1 ~~ y2
f1 ~~ f2

# intercepts
y1 ~ 1
f1 ~ 1
model1 <-
'
# latent variable definitions - defining how the latent variables are “manifested by” a set of observed
# (or manifest) variables, aka “indicators”
# (1) Measurement Model
Imaging =~ L_cingulate_gyrus_ComputeArea+L_cingulate_gyrus_Volume
DemoGeno =~ Weight+Sex+Age
UPDRS =~ UPDRS_Part_I_Summary_Score_Baseline+UPDRS_Part_I_Summary_Score_Month_03

# (2) Regressions
ResearchGroup ~ Imaging + DemoGeno + UPDRS
'
model2 <-
'
# latent variable definitions - defining how the latent variables are “manifested by” a set of observed
# (or manifest) variables, aka “indicators”
# (1) Measurement Model
Imaging =~ L_cingulate_gyrus_ComputeArea+L_cingulate_gyrus_Volume+R_cingulate_gyrus_ComputeArea+R_cingulate_gyrus_Volume+L_caudate_ComputeArea+L_caudate_Volume+R_caudate_ComputeArea+R_caudate_Volume+L_putamen_ComputeArea+L_putamen_Volume+R_putam en_ComputeArea+R_putamen_Volume+L_hippocampus_ComputeArea+L_hippocampus_Volume+R_hippocampus_ComputeArea+R_hippocampus_Volume+cerebellum_ComputeArea+cerebellum_Volume+L_fusiform_gyrus_ComputeArea+L_fusiform_gyrus_Volume+R_fusiform_gyr us_ComputeArea+R_fusiform_gyrus_Volume
DemoGeno =~ Weight+Sex+Age+chr12_rs34637584_GT+chr17_rs11868035_GT+chr17_rs11012_GT+chr17_rs393152_GT+chr17_rs12185268_GT
UPDRS =~ UPDRS_Part_I_Summary_Score_Baseline+UPDRS_Part_I_Summary_Score_Month_03+UPDRS_Part_I_Summary_Score_Month_06+UPDRS_Part_I_Summary_Score_Month_09+UPDRS_Part_I_Summary_Score_Month_12+UPDRS_Part_I_Summary_Score_Month_18+UPDRS_Part_I_Summa ry_Score_Month_24+UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Baseline+UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_03+UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_06+UPDRS_Part_II_Patient_Questionnaire_Sum mary_Score_Month_09+UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_12+UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_18+UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_24+UPDRS_Part_III_Summary_Score_Baseline +UPDRS_Part_III_Summary_Score_Month_03+UPDRS_Part_III_Summary_Score_Month_06+UPDRS_Part_III_Summary_Score_Month_09+UPDRS_Part_III_Summary_Score_Month_12+UPDRS_Part_III_Summary_Score_Month_18+UPDRS_Part_III_Summary_Score_Month_24+X_Ass essment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Baseline+X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_06+X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_12+X_Assessment_Non.Motor_Epw orth_Sleepiness_Scale_Summary_Score_Month_24+X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Baseline+X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_06+X_Assessment_Non.Motor_ Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_12+X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_24

# (2) Regressions
# ResearchGroup ~ Imaging + DemoGeno + UPDRS
# transform cat variable to numeric:
# myData$\$$ResearchGroup <- ifelse(myData$\$$ResearchGroup == "Control", 0,
# ifelse(myData$\$$ResearchGroup == "PD", 2, 1))
RG_ranked ~ Imaging + DemoGeno + UPDRS

# (3) Residual Variances
L_insular_cortex_ComputeArea ~~ L_insular_cortex_ComputeArea
L_insular_cortex_Volume ~~ L_insular_cortex_Volume
R_insular_cortex_ComputeArea ~~ R_insular_cortex_ComputeArea
R_insular_cortex_Volume ~~ R_insular_cortex_Volume
L_cingulate_gyrus_ComputeArea ~~ L_cingulate_gyrus_ComputeArea
L_cingulate_gyrus_Volume ~~ L_cingulate_gyrus_Volume
R_cingulate_gyrus_ComputeArea ~~ R_cingulate_gyrus_ComputeArea
R_cingulate_gyrus_Volume ~~ R_cingulate_gyrus_Volume
L_caudate_ComputeArea ~~ L_caudate_ComputeArea
L_caudate_Volume ~~ L_caudate_Volume
R_caudate_ComputeArea ~~ R_caudate_ComputeArea
R_caudate_Volume ~~ R_caudate_Volume
L_putamen_ComputeArea ~~ L_putamen_ComputeArea
L_putamen_Volume ~~ L_putamen_Volume
R_putamen_ComputeArea ~~ R_putamen_ComputeArea
R_putamen_Volume ~~ R_putamen_Volume
L_hippocampus_ComputeArea ~~ L_hippocampus_ComputeArea
L_hippocampus_Volume ~~ L_hippocampus_Volume
R_hippocampus_ComputeArea ~~ R_hippocampus_ComputeArea
R_hippocampus_Volume ~~ R_hippocampus_Volume
cerebellum_ComputeArea ~~ cerebellum_ComputeArea
cerebellum_Volume ~~ cerebellum_Volume
L_fusiform_gyrus_ComputeArea ~~ L_fusiform_gyrus_ComputeArea
L_fusiform_gyrus_Volume ~~ L_fusiform_gyrus_Volume
R_fusiform_gyrus_ComputeArea ~~ R_fusiform_gyrus_ComputeArea
R_fusiform_gyrus_Volume ~~ R_fusiform_gyrus_Volume
R_fusiform_gyrus_ShapeIndex ~~ R_fusiform_gyrus_ShapeIndex
R_fusiform_gyrus_Curvedness ~~ R_fusiform_gyrus_Curvedness
Sex ~~ Sex
Weight ~~ Weight
ResearchGroup ~~ ResearchGroup
VisitID ~~ VisitID
Age ~~ Age
chr12_rs34637584_GT ~~ chr12_rs34637584_GT
chr17_rs11868035_GT ~~ chr17_rs11868035_GT
chr17_rs11012_GT ~~ chr17_rs11012_GT
chr17_rs393152_GT ~~ chr17_rs393152_GT
chr17_rs12185268_GT ~~ chr17_rs12185268_GT
chr17_rs199533_GT ~~ chr17_rs199533_GT
UPDRS_Part_I_Summary_Score_Baseline ~~ UPDRS_Part_I_Summary_Score_Baseline
UPDRS_Part_I_Summary_Score_Month_03 ~~ UPDRS_Part_I_Summary_Score_Month_03
UPDRS_Part_I_Summary_Score_Month_06 ~~ UPDRS_Part_I_Summary_Score_Month_06
UPDRS_Part_I_Summary_Score_Month_09 ~~ UPDRS_Part_I_Summary_Score_Month_09
UPDRS_Part_I_Summary_Score_Month_12 ~~ UPDRS_Part_I_Summary_Score_Month_12
UPDRS_Part_I_Summary_Score_Month_18 ~~ UPDRS_Part_I_Summary_Score_Month_18
UPDRS_Part_I_Summary_Score_Month_24 ~~ UPDRS_Part_I_Summary_Score_Month_24
UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Baseline ~~ UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Baseline
UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_03 ~~ UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_03
UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_06 ~~ UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_06
UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_09 ~~ UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_09
UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_12 ~~ UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_12
UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_18 ~~ UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_18
UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_24 ~~ UPDRS_Part_II_Patient_Questionnaire_Summary_Score_Month_24
UPDRS_Part_III_Summary_Score_Baseline ~~ UPDRS_Part_III_Summary_Score_Baseline
UPDRS_Part_III_Summary_Score_Month_03 ~~ UPDRS_Part_III_Summary_Score_Month_03
UPDRS_Part_III_Summary_Score_Month_06 ~~ UPDRS_Part_III_Summary_Score_Month_06
UPDRS_Part_III_Summary_Score_Month_09 ~~ UPDRS_Part_III_Summary_Score_Month_09
UPDRS_Part_III_Summary_Score_Month_12 ~~ UPDRS_Part_III_Summary_Score_Month_12
UPDRS_Part_III_Summary_Score_Month_18 ~~ UPDRS_Part_III_Summary_Score_Month_18
UPDRS_Part_III_Summary_Score_Month_24 ~~ UPDRS_Part_III_Summary_Score_Month_24
X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Baseline ~~ X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Baseline
X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_06 ~~ X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_06
X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_12 ~~ X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_12
X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_24 ~~ X_Assessment_Non.Motor_Epworth_Sleepiness_Scale_Summary_Score_Month_24
X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Baseline ~~ X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Baseline
X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_06 ~~ X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_06
X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_12 ~~ X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_12
X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_24 ~~ X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Month_24

# (4) Residual Covariances
Sex ~~ Weight
'
# confirmatory factor analysis (CFA)
# The baseline is a null model constraining the observed variables to covary with no other variables.
# That is, the covariances are fixed to 0 and only individual variances are estimated. This is represents
# a “reasonable worst-possible fitting model”, against which the new fitted model is compared
# to calculate appropriate model-quality indices (e.g., CFA).

# standardize all variable to avoid huge variations between variable distributions
library("MASS")
# myData <- read.csv("https://umich.instructure.com/files/330397/download?download_frd=1&verifier=3bYRT9FXgBGMCQv8MNxsclWnMgodiJRYo3ODFtDq",header=TRUE)

summary(myData)
myData2<-scale(myData); summary(myData2)

myDF <- data.frame(myData2)
# myDF3 <- subset(myDF, select=c("L_cingulate_gyrus_ComputeArea", "cerebellum_Volume", "Weight", "Sex", "Age", " UPDRS_part_I", "UPDRS_part_II", "UPDRS_part_III", "ResearchGroup"))

myDF3 <- subset(myDF, select=c("R_insular_cortex_ComputeArea", "R_insular_cortex_Volume", "Sex", "Weight", "ResearchGroup", "Age", "chr12_rs34637584_GT", "chr17_rs11868035_GT", "chr17_rs11012_GT"))

model3 <-
'
# latent variable definitions - defining how the latent variables are “manifested by” a set of observed
# (or manifest) variables, aka “indicators”
# (1) Measurement Model
# Imaging =~ L_cingulate_gyrus_ComputeArea + cerebellum_Volume
Imaging =~ R_insular_cortex_ComputeArea + R_insular_cortex_Volume
DemoGeno =~ Weight+Sex+Age
# UPDRS =~ UPDRS_Part_I_Summary_Score_Baseline+X_Assessment_Non.Motor_Geriatric_Depression_Scale_GDS_Short_Summary_Score_Baseline
UPDRS =~ UPDRS_part_I +UPDRS_part_II + UPDRS_part_III
# (2) Regressions
ResearchGroup ~ Imaging + DemoGeno + UPDRS

fit3 <- cfa(model3, data= myData2, missing='FIML') # deal with missing values (missing='FIML')
summary(fit3, fit.measures=TRUE)
lavaan (0.5-18) converged normally after 2044 iterations
Number of observations    1764
Number of missing patterns    3
Estimator    ML
Minimum Function Test Statistic    455.923
Degrees of freedom    15
P-value (Chi-square)    0.000
Model test baseline model:
Minimum Function Test Statistic    2625.020
Degrees of freedom    28
P-value    0.000
User model versus baseline model:
Comparative Fit Index (CFI)    0.830
Tucker-Lewis Index (TLI)    0.683
Loglikelihood and Information Criteria:
Loglikelihood user model (H0)    -51499.484
Loglikelihood unrestricted model (H1)    -51271.522
Number of free parameters    29
Akaike (AIC)    103056.967
Bayesian (BIC)    103215.752
Sample-size adjusted Bayesian (BIC)    103123.621
Root Mean Square Error of Approximation:
RMSEA    0.129
90 Percent Confidence Interval    0.119 0.139
P-value RMSEA <= 0.05    0.000
Standardized Root Mean Square Residual:
SRMR    0.062
Parameter estimates:
Information    Observed
Standard Errors    Standard

Estimate Std.err Z-value P(>|z|)

Latent variables:
Imaging =~
R_cnglt_gyr_V    1.000
L_cadt_CmptAr    493.058
DemoGeno =~
Weight    1.000
Sex    24.158
Age    0.094
UPDRS =~
UPDRS_part_I    1.000
UPDRS_part_II    7.389
Regressions:
ResearchGroup ~
Imaging    -0.000
DemoGeno    0.002
UPDRS    -0.323
Covariances:
Imaging ~~
DemoGeno    0.001
UPDRS    0.002
DemoGeno ~~
UPDRS    0.000
Intercepts:
R_cnglt_gyr_V    7895.658
L_cadt_CmptAr    635.570
Weight    82.048
Sex    1.340
Age    61.073
UPDRS_part_I    1.126
UPDRS_part_II    4.905
ResearchGroup    0.290
Imaging    0.000
DemoGeno    0.000
UPDRS    0.000
Variances:
R_cnglt_gyr_V    17070159.189
L_cadt_CmptAr    -536243845.090
Weight    274.912
Sex    96.664
Age    105.347
UPDRS_part_I    2.442
UPDRS_part_II    -0.256
ResearchGroup    0.149
Imaging    2206.397
DemoGeno    -0.165
UPDRS    0.550
'

====Output====
3 parts of the Lavaan SEM output
*First six lines are called the header contains the following information:
*lavaan version number
*lavaan converge info (normal or not), and # iterations needed
*the number of observations that were effectively used in the analysis
*the estimator that was used to obtain the parameter values (here: ML)
*the model test statistic, the degrees of freedom, and a corresponding p-value

# Next, is the Model test baseline model and the value for the SRMR
# The last section contains the parameter estimates, standard errors (if the information matrix is expected or observed, and if the standard errors are standard, robust, or based on the bootstrap). Then, it tabulates all free (and fixed) parameters that were included in the model. Typically, first the latent variables are shown, followed by covariances and (residual) variances. The first column (Estimate) contains the (estimated or fixed) parameter value for each model parameter; the second column (Std.err) contains the standard error for each estimated parameter; the third column (Z-value) contains the Wald statistic (which is simply obtained by dividing the parameter value by its standard error), and the last column contains the p-value for testing the null hypothesis that the parameter equals zero in the population.

Note: You can get this type of error “…system is computationally singular: reciprocal condition…”, which indicates that the design matrix is not invertible. Thus, it can't be used to develop a regression model. This is due to linearly dependent columns, i.e. strongly correlated variables. Resolve pairwise covariances (or correlations) of your variables to investigate if there are any variables that can potentially be removed. You're looking for covariances (or correlations) >> 0. We can also automate this variable selection by using a forward stepwise regression.

# Graphical fit model visualization
library(semPlot)
semPaths(fit3)

<center>[[Image:SMHS_BigDataBigSci4.png|500px]]</center>

semPaths(fit3, "std", ask = FALSE, as.expression = "edges", mar = c(3, 1, 5, 1))

<center>[[Image:SMHS_BigDataBigSci5.png|500px]]</center>

==See also==
* [[SMHS_BigDataBigSci_SEM_sem_vs_cfa| Next See: Differences and Similarities between '''sem'''() and '''cfa'''() ]]
* [[SMHS_BigDataBigSci_SEM| Back to Structural Equation Modeling (SEM)]]
* [[SMHS_BigDataBigSci_SEM_Ex1| Back to SEM Example 1: School Kids Mental Abilities]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_BigDataBigSci_SEM_Ex2}}

SMHS BigDataBigSci SEM Ex1

2016-05-23T13:40:14Z

Imoubara: /* Structural Equation Modeling (SEM) - Hands-on Example 1 (School Kids Mental Abilities) */

==[[SMHS_BigDataBigSci_SEM| Structural Equation Modeling (SEM)]] - Hands-on Example 1 (School Kids Mental Abilities) ==

These data (Holzinger & Swineford 1939) include mental ability test scores of 7 & 8 grade children from two schools (Pasteur and Grant-White). This version of the dataset includes only 9 (out of the 26) tests. We can build and test a confirmatory factor analysis (CFA) SEM model for 3 correlated latent variables (or factors), each with three indicators:

*'''visual''' factor measured by 3 variables: x1, x2 and x3,
*'''textual''' factor measured by 3 variables: x4, x5 and x6,
*'''speed''' factor measured by 3 variables: x7, x8 and x9.

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|id||lhs||op||rhs||user||free||ustart
|-
|1 ||Visual||=~||x1||1||0||1
|-
|2 ||Visual||=~||x2||1||1||NA
|-
|3 ||Visual||=~||x3||1||2||NA
|-
|4 ||Textual||=~||x4||1||0||1
|-
|5||Textual||=~||x5||1||3||NA
|-
|6||Textual||=~||x6||1||4||NA
|-
|7 ||Speed||=~||x7||1||0||1
|-
|8 ||Speed||=~||x8||1||5||NA
|-
|9 ||Speed||=~||x9||1||6||NA
|-
|10 ||x1||~~||x1||0||7||NA
|-
|11||x2||~~||x2||0||8||NA
|-
|12||x3||~~||x3||0||9||NA
|-
|13||x4||~~||x4||0||10||NA
|-
|14||x5||~~||x5||0||11||NA
|-
|15||x6||~~||x6||0||12||NA
|-
|16||x7||~~||x7||0||13||NA
|-
|17||x8||~~||x8||0||14||NA
|-
|18||x9||~~||x9||0||15||47.8
|-
|19||Visual||~~||Visual||0||16||NA
|-
|20||Textual||~~||Textual||0||17||NA
|-
|21||Speed||~~||Speed||boy||18||NA
|-
|22||Visual||~~||Textual||girl||19||NA
|-
|23||Visual||~~||Speed||girl||20||NA
|-
|24||Textual||~~||Speed||boy||21||NA
|}
</center>

There are 3 latent variables (factors) in this model, each with 3 indicators, resulting in 9 factor loadings that need to be estimated. There are also 3 covariances among the latent variables {another three parameters}.

These 12 parameters are represented in the path diagram as single-headed and double-headed arrows, respectively. We also need to estimate the residual variances of the 9 observed variables and the variances of the 3 latent variables, resulting in 12 additional free parameters. In total, we have 24 parameters.

<center>[[Image:SMHS_BigDataBigSci2.png|200px]]</center>

To fully identify the model we need to set the metric of the latent variables. There are 2 ways to do this:
*for each latent variable, fix the factor loading of one of the indicators (typically the first) to a constant (e.g., 1.0), or
*standardize the variances of the 3 latent variables.

Either way, we fix 3 of these 24 parameters, and 21 parameters remain free.

The parTable(fit) method, generates this table output.

The `rhs', `op' and `lhs' columns define the parameters of the model.
All parameters with the `=~' operator are factor loadings, whereas all parameters with the `~~' operator are variances or covariances. Nonzero elements in the `free' column are the free parameters of the model. Zero elements in the `free' column correspond to fixed parameters, whose value is found in the `start' column.

Lavaan’s user-friendly model-specification approach is implemented in the fitting functions: cfa() and sem().

Since these data contain 3 latent variables, and no regressions, the minimalist syntax is:

data.model <- 'visual =~ x1 + x2 + x3
textual =~ x4 + x5 + x6
speed =~ x7 + x8 + x9'

Fit the CFA model:

fit.1 <- cfa(data.model, data = HolzingerSwineford1939)

The `user' column (parTabale) shows which parameters were explicitly contained in the user-specified model syntax (= 1), and which parameters were added by the cfa() function (= 0).
parTable(fit.1)

If we prefer not to fix the factor loadings of the first indicator, but instead want to fix the variances of the latent variances, the model syntax would be changed to:
fit.2 <- 'visual =~ NA*x1 + x2 + x3
textual =~ NA*x4 + x5 + x6
speed =~ NA*x7 + x8 + x9
visual ~~ 1*visual
textual ~~ 1*textual
speed ~~ 1*speed'

More complex model specifications can be made using the full '''lavaan''' model syntax:

fit.full <- ' # latent variables
visual =~ 1*x1 + x2 + x3
textual =~ 1*x4 + x5 + x6
speed =~ 1*x7 + x8 + x9
# residual variances observed variables
x1 ~~ x1
x2 ~~ x2
x3 ~~ x3
x4 ~~ x4
x5 ~~ x5
x6 ~~ x6
x7 ~~ x7
x8 ~~ x8
x9 ~~ x9
# factor variances
visual ~~ visual
textual ~~ textual
speed ~~ speed
# factor covariances
visual ~~ textual + speed
textual ~~ speed'
fit.3 <- lavaan(fit.full, data = HolzingerSwineford1939)

We can specify the model where the first factor loadings are explicitly fixed to one, and the covariances among the factors are added manually.

fit.mixed <- ' # latent variables
visual =~ 1*x1 + x2 + x3
textual =~ 1*x4 + x5 + x6
speed =~ 1*x7 + x8 + x9
# factor covariances
visual ~~ textual + speed
textual ~~ speed'
fit <- lavaan(fit.mixed, data = HolzingerSwineford1939, auto.var = TRUE)

The best method to view results from a SEM fitted with lavaan is summary(), which can be called with optional arguments like fit.measures, standardized, and rsquare.

===Core Lavaan Methods===
*summary() print a long summary of the model results
*show() print a short summary of the model results
*coef() returns the estimates of the free parameters in the model as a named numeric vector
*fitted() returns the implied moments (covariance matrix and mean vector) of the model
*resid() returns the raw, normalized or standardized residuals (difference between implied and observed moments)
*vcov() returns the covariance matrix of the estimated parameters
*predict() compute factor scores
*logLik() returns the log-likelihood of the fitted model (if maximum likelihood estimation was used)
*AIC(), BIC() compute information criteria (if maximum likelihood estimation is used)
*update() update a fitted lavaan object
*inspect() peek into the internal representation of the model; by default, it returns a list of model matrices counting the free parameters in the model; can also be used to extract starting values, gradient values, and much more

If these args are set to TRUE, the output includes additional fit measures, standardized estimates, and R2 values for the dependent variables, respectively

fit.model <- 'visual =~ x1 + x2 + x3
textual =~ x4 + x5 + x6
speed =~ x7 + x8 + x9'
fit <- cfa(fit.model, data = HolzingerSwineford1939)
summary(fit, fit.measures = TRUE)

fit <- cfa(fit.model, data=HolzingerSwineford1939, estimator="GLS", group="sex")
fit.4 <- cfa(fit.model, data=HolzingerSwineford1939, estimator="GLD", group="sex", group.equal="regressions")
anova(fit, fit.4)

===Output===
The output consists of three sections.

*The first section (first 6 lines) contains the package version number, an indication whether the model has converged (and in how many iterations), and the effective number of observations used in the analysis.

*The second section contains the model χ^2 test statistic, degrees of freedom, and a p value are printed. If fit.measures = TRUE, it also prints the test statistic of the baseline model (where all observed variables are assumed to be uncorrelated) and several popular fit indices. If maximum likelihood estimation is used, this section will also contain information about the log-likelihood, the AIC, and the BIC.

*The third section provides an overview of the parameter estimates, including the type of standard errors used and whether the observed or expected information matrix was used to compute standard errors. Then, for each model parameter, the estimate and the standard error are displayed, and if appropriate, a z value based on the Wald test and a corresponding two-sided p value are also shown. To ease the reading of the parameter estimates, they are grouped into three blocks:
*factor loadings,
*factor covariances, and
*residual variances of both observed variables and factors.</li>

The summary() method provides a nice summary of the model results for visualization purposes. The parameterEstimates() method returns the actual parameter estimates as a data.frame, which can be processed further.

<center>parameterEstimates(fit)
{| class="wikitable" style="text-align:center; " border="1"
|-
|Index||lhs||op||rhs||est||se||z||pvalue||ci.lower||ci.upper
|-
|1||visual||=~||x1||1||0||NA||NA||1||1
|-
|2||visual||=~||x2||0.553||0.1||5.554||0||0.358||0.749
|-
|3||visual||=~||x3||0.729||0.109||6.685||0||0.516||0.943
|-
|4||textual||=~||x4||1||0||NA||NA||1||1
|-
|5||textual||=~||x5||1.113||0.065||17.014||0||0.985||1.241
|-
|6||textual||=~||x6||0.926||0.055||16.703||0||0.817||1.035
|-
|7||speed||=~||x7||1||0||NA||NA||1||1
|-
|8||speed||=~||x8||1.18||0.165||7.152||0||0.857||1.503
|-
|9||speed||=~||x9||1.082||0.151||7.155||0||0.785||1.378
|-
|10||x1||~~||x1||0.549||0.114||4.833||0||0.326||0.772
|-
|11||x2||~~||x2||1.134||0.102||11.146||0||0.934||1.333
|-
|12||x3||~~||x3||0.844||0.091||9.317||0||0.667||1.022
|-
|13||x4||~~||x4||0.371||0.048||7.779||0||0.278||0.465
|-
|14||x5||~~||x5||0.446||0.058||7.642||0||0.332||0.561
|-
|15||x6||~~||x6||0.356||0.043||8.277||0||0.272||0.441
|-
|16||x7||~~||x7||0.799||0.081||9.823||0||0.64||0.959
|-
|17||x8||~~||x8||0.488||0.074||6.573||0||0.342||0.633
|-
|18||x9||~~||x9||0.566||0.071||8.003||0||0.427||0.705
|-
|19||visual||~~||visual||0.809||0.145||5.564||0||0.524||1.094
|-
|20||textual||~~||textual||0.979||0.112||8.737||0||0.76||1.199
|-
|21||speed||~~||speed||0.384||0.086||4.451||0||0.215||0.553
|-
|22||visual||~~||textual||0.408||0.074||5.552||0||0.264||0.552
|-
|23||visual||~~||speed||0.262||0.056||4.66||0||0.152||0.373
|-
|24||textual||~~||speed||0.173||0.049||3.518||0||0.077||0.27
|}
</center>

The confidence level can be changed by setting the level argument. To obtain several standardized versions of the estimates, we can use standardized = TRUE:

<center>est <- parameterEstimates(fit, ci = FALSE, standardized = TRUE)
subset(est, op == "=~") 

{| class="wikitable" style="text-align:center; " border="1"
|-
|Index||lhs||op||rhs||est||se||z||pvalue||std.lv||std.all||std.nox
|-
|1||visual||=~||x1||1||0||NA||NA||0.9||0.772||0.772
|-
|2||visual||=~||x2||0.553||0.1||5.554||0||0.498||0.424||0.424
|-
|3||visual||=~||x3||0.729||0.109||6.685||0||0.656||0.581||0.581
|-
|4||textual||=~||x4||1||0||NA||NA||0.99||0.852||0.852
|-
|5||textual||=~||x5||1.113||0.065||17.014||0||1.102||0.855||0.855
|-
|6||textual||=~||x6||0.926||0.055||16.703||0||0.917||0.838||0.838
|-
|7||speed||=~||x7||1||0||NA||NA||0.619||0.57||0.57
|-
|8||speed||=~||x8||1.18||0.165||7.152||0||0.731||0.723||0.723
|-
|9||speed||=~||x9||1.082||0.151||7.155||0||0.67||0.665||0.665
|}
</center>

This only shows the factor loadings are shown but 3 additional columns with standardized values are added.
<li>In the first column (std.lv), only the latent variables have been standardized; </li>
<li>In the second column (std.all), both the latent and the observed variables have been standardized; </li>
<li> In the third column (std.nox), both the latent and the observed variables have been standardized, except for the exogenous observed variables. This option may be useful if the standardization of exogenous observed variables has little meaning (for example, binary covariates). Since there are no exogenous covariates in this model, the last two columns are identical in this output.</li>

library("semPlot")
# semPaths(fit, "std", "show")
semPaths(fit, "std", curvePivot = TRUE, edge.label.cex = 1.0)
# get the margines right:
# semPaths(fit, "std", curvePivot = TRUE, edge.label.cex = 1.0, mar = c(10, 3, 10, 3))
# semPaths(fit, "std", curvePivot = TRUE, edge.label.cex = 1.0, mar = c(10, 3, 10, 3), as.expression = c("nodes",
# "edges"), sizeMan = 3, sizeInt = 1, sizeLat = 4)

[[Image:SMHS_BigDataBigSci3.png|500px]]

==See also==
* [[SMHS_BigDataBigSci_SEM| Back to Structural Equation Modeling (SEM)]]
* [[SMHS_BigDataBigSci_SEM_Ex2| Next Section: SEM Example 2: Parkinson’s Disease data]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_BigDataBigSci_SEM_Ex1}}

SMHS BigDataBigSci SEM Ex1

2016-05-23T13:39:33Z

Imoubara:

==[[SMHS_BigDataBigSci_SEM| Structural Equation Modeling (SEM)]] - Hands-on Example 1 (School Kids Mental Abilities) ==

These data (Holzinger & Swineford 1939) include mental ability test scores of 7 & 8 grade children from two schools (Pasteur and Grant-White). This version of the dataset includes only 9 (out of the 26) tests. We can build and test a confirmatory factor analysis (CFA) SEM model for 3 correlated latent variables (or factors), each with three indicators:

*'''visual''' factor measured by 3 variables: x1, x2 and x3,
*'''textual''' factor measured by 3 variables: x4, x5 and x6,
*'''speed''' factor measured by 3 variables: x7, x8 and x9.

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|id||lhs||op||rhs||user||free||ustart
|-
|1 ||Visual||=~||x1||1||0||1
|-
|2 ||Visual||=~||x2||1||1||NA
|-
|3 ||Visual||=~||x3||1||2||NA
|-
|4 ||Textual||=~||x4||1||0||1
|-
|5||Textual||=~||x5||1||3||NA
|-
|6||Textual||=~||x6||1||4||NA
|-
|7 ||Speed||=~||x7||1||0||1
|-
|8 ||Speed||=~||x8||1||5||NA
|-
|9 ||Speed||=~||x9||1||6||NA
|-
|10 ||x1||~~||x1||0||7||NA
|-
|11||x2||~~||x2||0||8||NA
|-
|12||x3||~~||x3||0||9||NA
|-
|13||x4||~~||x4||0||10||NA
|-
|14||x5||~~||x5||0||11||NA
|-
|15||x6||~~||x6||0||12||NA
|-
|16||x7||~~||x7||0||13||NA
|-
|17||x8||~~||x8||0||14||NA
|-
|18||x9||~~||x9||0||15||47.8
|-
|19||Visual||~~||Visual||0||16||NA
|-
|20||Textual||~~||Textual||0||17||NA
|-
|21||Speed||~~||Speed||boy||18||NA
|-
|22||Visual||~~||Textual||girl||19||NA
|-
|23||Visual||~~||Speed||girl||20||NA
|-
|24||Textual||~~||Speed||boy||21||NA
|}
</center>

There are 3 latent variables (factors) in this model, each with 3 indicators, resulting in 9 factor loadings that need to be estimated. There are also 3 covariances among the latent variables {another three parameters}.

These 12 parameters are represented in the path diagram as single-headed and double-headed arrows, respectively. We also need to estimate the residual variances of the 9 observed variables and the variances of the 3 latent variables, resulting in 12 additional free parameters. In total, we have 24 parameters.

<center>[[Image:SMHS_BigDataBigSci2.png|200px]]</center>

To fully identify the model we need to set the metric of the latent variables. There are 2 ways to do this:
<li>for each latent variable, fix the factor loading of one of the indicators (typically the first) to a constant (e.g., 1.0), or </li>
<li> standardize the variances of the 3 latent variables. </li>

Either way, we fix 3 of these 24 parameters, and 21 parameters remain free.

The parTable(fit) method, generates this table output.

The `rhs', `op' and `lhs' columns define the parameters of the model.
All parameters with the `=~' operator are factor loadings, whereas all parameters with the `~~' operator are variances or covariances. Nonzero elements in the `free' column are the free parameters of the model. Zero elements in the `free' column correspond to fixed parameters, whose value is found in the `start' column.

Lavaan’s user-friendly model-specification approach is implemented in the fitting functions: cfa() and sem().

Since these data contain 3 latent variables, and no regressions, the minimalist syntax is:

data.model <- 'visual =~ x1 + x2 + x3
textual =~ x4 + x5 + x6
speed =~ x7 + x8 + x9'

Fit the CFA model:

fit.1 <- cfa(data.model, data = HolzingerSwineford1939)

The `user' column (parTabale) shows which parameters were explicitly contained in the user-specified model syntax (= 1), and which parameters were added by the cfa() function (= 0).
parTable(fit.1)

If we prefer not to fix the factor loadings of the first indicator, but instead want to fix the variances of the latent variances, the model syntax would be changed to:
fit.2 <- 'visual =~ NA*x1 + x2 + x3
textual =~ NA*x4 + x5 + x6
speed =~ NA*x7 + x8 + x9
visual ~~ 1*visual
textual ~~ 1*textual
speed ~~ 1*speed'

More complex model specifications can be made using the full '''lavaan''' model syntax:

fit.full <- ' # latent variables
visual =~ 1*x1 + x2 + x3
textual =~ 1*x4 + x5 + x6
speed =~ 1*x7 + x8 + x9
# residual variances observed variables
x1 ~~ x1
x2 ~~ x2
x3 ~~ x3
x4 ~~ x4
x5 ~~ x5
x6 ~~ x6
x7 ~~ x7
x8 ~~ x8
x9 ~~ x9
# factor variances
visual ~~ visual
textual ~~ textual
speed ~~ speed
# factor covariances
visual ~~ textual + speed
textual ~~ speed'
fit.3 <- lavaan(fit.full, data = HolzingerSwineford1939)

We can specify the model where the first factor loadings are explicitly fixed to one, and the covariances among the factors are added manually.

fit.mixed <- ' # latent variables
visual =~ 1*x1 + x2 + x3
textual =~ 1*x4 + x5 + x6
speed =~ 1*x7 + x8 + x9
# factor covariances
visual ~~ textual + speed
textual ~~ speed'
fit <- lavaan(fit.mixed, data = HolzingerSwineford1939, auto.var = TRUE)

The best method to view results from a SEM fitted with lavaan is summary(), which can be called with optional arguments like fit.measures, standardized, and rsquare.

===Core Lavaan Methods===
*summary() print a long summary of the model results
*show() print a short summary of the model results
*coef() returns the estimates of the free parameters in the model as a named numeric vector
*fitted() returns the implied moments (covariance matrix and mean vector) of the model
*resid() returns the raw, normalized or standardized residuals (difference between implied and observed moments)
*vcov() returns the covariance matrix of the estimated parameters
*predict() compute factor scores
*logLik() returns the log-likelihood of the fitted model (if maximum likelihood estimation was used)
*AIC(), BIC() compute information criteria (if maximum likelihood estimation is used)
*update() update a fitted lavaan object
*inspect() peek into the internal representation of the model; by default, it returns a list of model matrices counting the free parameters in the model; can also be used to extract starting values, gradient values, and much more

If these args are set to TRUE, the output includes additional fit measures, standardized estimates, and R2 values for the dependent variables, respectively

fit.model <- 'visual =~ x1 + x2 + x3
textual =~ x4 + x5 + x6
speed =~ x7 + x8 + x9'
fit <- cfa(fit.model, data = HolzingerSwineford1939)
summary(fit, fit.measures = TRUE)

fit <- cfa(fit.model, data=HolzingerSwineford1939, estimator="GLS", group="sex")
fit.4 <- cfa(fit.model, data=HolzingerSwineford1939, estimator="GLD", group="sex", group.equal="regressions")
anova(fit, fit.4)

===Output===
The output consists of three sections.

*The first section (first 6 lines) contains the package version number, an indication whether the model has converged (and in how many iterations), and the effective number of observations used in the analysis.

*The second section contains the model χ^2 test statistic, degrees of freedom, and a p value are printed. If fit.measures = TRUE, it also prints the test statistic of the baseline model (where all observed variables are assumed to be uncorrelated) and several popular fit indices. If maximum likelihood estimation is used, this section will also contain information about the log-likelihood, the AIC, and the BIC.

*The third section provides an overview of the parameter estimates, including the type of standard errors used and whether the observed or expected information matrix was used to compute standard errors. Then, for each model parameter, the estimate and the standard error are displayed, and if appropriate, a z value based on the Wald test and a corresponding two-sided p value are also shown. To ease the reading of the parameter estimates, they are grouped into three blocks:
*factor loadings,
*factor covariances, and
*residual variances of both observed variables and factors.</li>

The summary() method provides a nice summary of the model results for visualization purposes. The parameterEstimates() method returns the actual parameter estimates as a data.frame, which can be processed further.

<center>parameterEstimates(fit)
{| class="wikitable" style="text-align:center; " border="1"
|-
|Index||lhs||op||rhs||est||se||z||pvalue||ci.lower||ci.upper
|-
|1||visual||=~||x1||1||0||NA||NA||1||1
|-
|2||visual||=~||x2||0.553||0.1||5.554||0||0.358||0.749
|-
|3||visual||=~||x3||0.729||0.109||6.685||0||0.516||0.943
|-
|4||textual||=~||x4||1||0||NA||NA||1||1
|-
|5||textual||=~||x5||1.113||0.065||17.014||0||0.985||1.241
|-
|6||textual||=~||x6||0.926||0.055||16.703||0||0.817||1.035
|-
|7||speed||=~||x7||1||0||NA||NA||1||1
|-
|8||speed||=~||x8||1.18||0.165||7.152||0||0.857||1.503
|-
|9||speed||=~||x9||1.082||0.151||7.155||0||0.785||1.378
|-
|10||x1||~~||x1||0.549||0.114||4.833||0||0.326||0.772
|-
|11||x2||~~||x2||1.134||0.102||11.146||0||0.934||1.333
|-
|12||x3||~~||x3||0.844||0.091||9.317||0||0.667||1.022
|-
|13||x4||~~||x4||0.371||0.048||7.779||0||0.278||0.465
|-
|14||x5||~~||x5||0.446||0.058||7.642||0||0.332||0.561
|-
|15||x6||~~||x6||0.356||0.043||8.277||0||0.272||0.441
|-
|16||x7||~~||x7||0.799||0.081||9.823||0||0.64||0.959
|-
|17||x8||~~||x8||0.488||0.074||6.573||0||0.342||0.633
|-
|18||x9||~~||x9||0.566||0.071||8.003||0||0.427||0.705
|-
|19||visual||~~||visual||0.809||0.145||5.564||0||0.524||1.094
|-
|20||textual||~~||textual||0.979||0.112||8.737||0||0.76||1.199
|-
|21||speed||~~||speed||0.384||0.086||4.451||0||0.215||0.553
|-
|22||visual||~~||textual||0.408||0.074||5.552||0||0.264||0.552
|-
|23||visual||~~||speed||0.262||0.056||4.66||0||0.152||0.373
|-
|24||textual||~~||speed||0.173||0.049||3.518||0||0.077||0.27
|}
</center>

The confidence level can be changed by setting the level argument. To obtain several standardized versions of the estimates, we can use standardized = TRUE:

<center>est <- parameterEstimates(fit, ci = FALSE, standardized = TRUE)
subset(est, op == "=~") 

{| class="wikitable" style="text-align:center; " border="1"
|-
|Index||lhs||op||rhs||est||se||z||pvalue||std.lv||std.all||std.nox
|-
|1||visual||=~||x1||1||0||NA||NA||0.9||0.772||0.772
|-
|2||visual||=~||x2||0.553||0.1||5.554||0||0.498||0.424||0.424
|-
|3||visual||=~||x3||0.729||0.109||6.685||0||0.656||0.581||0.581
|-
|4||textual||=~||x4||1||0||NA||NA||0.99||0.852||0.852
|-
|5||textual||=~||x5||1.113||0.065||17.014||0||1.102||0.855||0.855
|-
|6||textual||=~||x6||0.926||0.055||16.703||0||0.917||0.838||0.838
|-
|7||speed||=~||x7||1||0||NA||NA||0.619||0.57||0.57
|-
|8||speed||=~||x8||1.18||0.165||7.152||0||0.731||0.723||0.723
|-
|9||speed||=~||x9||1.082||0.151||7.155||0||0.67||0.665||0.665
|}
</center>

This only shows the factor loadings are shown but 3 additional columns with standardized values are added.
<li>In the first column (std.lv), only the latent variables have been standardized; </li>
<li>In the second column (std.all), both the latent and the observed variables have been standardized; </li>
<li> In the third column (std.nox), both the latent and the observed variables have been standardized, except for the exogenous observed variables. This option may be useful if the standardization of exogenous observed variables has little meaning (for example, binary covariates). Since there are no exogenous covariates in this model, the last two columns are identical in this output.</li>

library("semPlot")
# semPaths(fit, "std", "show")
semPaths(fit, "std", curvePivot = TRUE, edge.label.cex = 1.0)
# get the margines right:
# semPaths(fit, "std", curvePivot = TRUE, edge.label.cex = 1.0, mar = c(10, 3, 10, 3))
# semPaths(fit, "std", curvePivot = TRUE, edge.label.cex = 1.0, mar = c(10, 3, 10, 3), as.expression = c("nodes",
# "edges"), sizeMan = 3, sizeInt = 1, sizeLat = 4)

[[Image:SMHS_BigDataBigSci3.png|500px]]

==See also==
* [[SMHS_BigDataBigSci_SEM| Back to Structural Equation Modeling (SEM)]]
* [[SMHS_BigDataBigSci_SEM_Ex2| Next Section: SEM Example 2: Parkinson’s Disease data]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_BigDataBigSci_SEM_Ex1}}

SMHS BigDataBigSci

2016-05-23T13:36:25Z

Imoubara:

==[[SMHS| Scientific Methods for Health Sciences]] - Model-based Analyses ==

Structural Equation Modeling (SEM), Growth Curve Models (GCM), and Generalized Estimating Equation (GEE) Modeling

==Questions ==

*How to represent dependencies in linear models and examine causal effects?
*Is there a way to study population average effects of a covariate against specific individual effects?

==Overview==

SEM allow re-parameterization of random-effects to specify latent variables that may affect measures at different time points using structural equations. SEM show variables having predictive (possibly causal) effects on other variables (denoted by arrows) where coefficients index the strength and direction of predictive relations. SEM does not offer much more than what classical regression methods do, but it does allow simultaneous estimation of multiple equations modeling complementary relations.

Growth Curve (or latent growth) modeling is a statistical technique employed in SEM for estimating growth trajectories for longitudinal data (over time). It represent repeated measures of dependent variables as functions of time and other covariates. When subjects or units are observed repeatedly over known time points latent growth curve models reveal the trend of an individual as a function of an underlying growth process where the growth curve parameters can be estimated for each subject/unit.

GEE is a marginal longitudinal method that directly assesses the mean relations of interest (i.e., how the mean dependent variable changes over time), accounting for covariances among the observations within subjects, and getting a better estimate and valid significance tests of the relations. Thus, GEE estimates two different equations, (1) for the mean relations, and (2) for the covariance structure. An advantage of GEE over random-effect models is that it does not require the dependent variable to be normally distributed. However, a disadvantage of GEE is that it is less flexible and versatile – commonly employed algorithms for it require a small-to-moderate number of time points evenly (or approximately evenly) spaced, and similarly spaced across subjects. Nevertheless, it is a little more flexible than repeated-measure ANOVA because it permits some missing values and has an easy way to test for and model away the specific form of autocorrelation within subjects.

GEE is mostly used when the study is focused on uncovering the population average effect of a covariate vs. the individual specific effect. These two things are only equivalent for linear models, but not in non-linear models.

For instance, suppose $Y_{i,j}$ is the random effects logistic model of the $j^{th}$, observation of the $i^{th}$ subject, then
$
log\Bigg(\frac{p_{i,j}}{1-p_{i,j}} \Bigg)=μ+ν_i,
$
where $ν_i \sim N(0,σ^2)$ is a random effect for subject i and $p_{i,j}=P(Y_{i,j}=1|ν_i).$

(1) When using a random effects model on such data, the estimate of μ accounts for the fact that a mean zero normally distributed perturbation was applied to each individual, making it ''individual-specific''.

(2) When using a GEE model on the same data, we estimate the population average log odds,

\begin{equation}
δ=log\Bigg(\frac{E_v(\frac{1}{1+e^{-μ+v}i})}{1-E_v(\frac{1}{1+e^{-μ+v}i})}
\Bigg),
\end{equation}

in general $μ≠δ$.

If $μ=1$ and $σ^2=1$, then $δ≈.83$.

empirically:

m <- 1; s <- 1; v<-rnorm(1000, 0,s); v2 <- 1/(1+exp(-m+v)); v_mean <- mean(v2)

d <- log(v_mean/(1-v_mean)); d

Note that the random effects have mean zero on the transformed, linked, scale, but their effect is not mean zero on the original scale of the data. We can also simulate data from a mixed effects logistic regression model and compare the population level average with the inverse-logit of the intercept to see that they are not equal. This leads to a difference of the interpretation of the coefficients between GEE and random effects models, or SEM.

That is, there will be a difference between the GEE population average coefficients and the individual specific coefficients (random effects models).

# theoretically, if it can be computed:

$E(Y)=μ=1$ (in this specific case), but the expectation of the population average log odds
$δ=log\Bigg[\frac{P(Y_{i,j}=1|v_i)}{1-P(Y_{i,j}=1|v_i)}\Bigg]$ would be $< 1$ 1.
Note that this is kind of related to the fact that a grand-total average need not be equal to an average of partial averages.

The mean of the $i^{th}$ person in the $j^{th}$ observation (e.g., location, time, etc.) can be expressed by:

$E(Yij | Xij,α_j)= g[μ(Xij|β)+Uij(α_j,Xij)]$,

Where $μ(X_{ij}|β)$ is the average “response” of a person with the same covariates $X_{ij}$, $β$ a set of fixed effect coefficients, and $Uij(α_j,Xij)$ is an error term that is a function of the (time, space) random effects, $α_j$, and also a function of the covariates $X_{ij}$, and $g$ is the '''link function''' which specifies the regression type -- e.g.,

*linear:''' $g^{-1} (u)=u,$

*log:''' $g^{-1} (u)= log(u),$

*logistic:''' $g^{-1} (u)=log(\frac{u}{1-u})$

*$E(Uij(α_j,Xij)|Xij)=0.$

The link function, $g(u)$, provides the relationship between the linear predictor and the mean of the distribution function. For practical applications there are many commonly used link functions. It makes sense to try to match the domain of the link function to the range of the distribution function's mean.

<center>Common distributions with typical uses and canonical link functions</center>
<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|Distribution ||Support of distribution||Typical uses||Link name||Link function||Mean function
|-
|Normal||real: $(-∞, +∞)$||Linear-response data||Identity||$X\beta=\mu$||$\mu=X\beta$
|-
|Exponential, Gamma||real:$(0, +∞)$||Exponential-response data, scale parameters||Inverse||$X\beta=-\mu^{-1}$||$\mu=-(X\beta)^{-1}$
|-
|Inverse Gaussian||real:$(0, +∞)$|| ||Inverse squared||$X\beta=-\mu^{-2}$||$\mu=(-X\beta)^{-1/2}$
|}
</center>

==Model-based Analytics==

===[[SMHS_BigDataBigSci_SEM| Structural Equation Modeling (SEM)]]===

===[[SMHS_BigDataBigSci_GCM| Growth Curve Modeling (GCM)]]===

===[[SMHS_BigDataBigSci_GEE| Generalized Estimating Equation (GEE) Modeling]]===

===[[SMHS_BigDataBigSci_CrossVal|Internal Validation - Statistical n-fold cross-validaiton]]===

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_BigDataBigSci}}

SMHS SciVisualization NetworkViz

2016-05-23T13:35:15Z

Imoubara: /* Circos Connectogram/Table visualization */

==[[SMHS_SciVisualization| SMHS Scientific Visualization]] - Complex Network Visualization ==

===Background===
[[SMHS_SciVisualization_SOCR_Excel_R_Charts|First see the SOCR, Excel and R charts section]].

# Install package
# install.packages("igraph")
library("igraph")

# build a simple graph
g <- graph( c(1,2, 1,3, 2,3, 3,4), n=10)
plot(g)

summary(g); g; is.igraph(g); is.directed(g); vcount(g); ecount(g)

<center>[[Image:SMHS_SciVisualization38.png|300px]] </center>

<center>[[Image:SMHS_SciVisualization39.png|300px]] </center>

plot(g, layout=layout.circle)

plot(g, layout=layout.fruchterman.reingold)
plot(g, layout=layout.graphopt)
plot(g, layout=layout.kamada.kawai, vertex.color="cyan")

# Interactive
tkplot(g, layout=layout.kamada.kawai)
# 3D plot
rglplot(g, layout=layout.kamada.kawai(g))

Dataset 1: Coappearance network in the novel “les miserablese”.

D. E. Knuth, The Stanford GraphBase: A Platform for Combinatorial Computing, Addison-Wesley, Reading, MA (1993).

The data contains the weighted network of coappearances of characters in Victor Hugo's novel "Les Miserables".

Nodes represent characters as indicated by the labels and edges connect any pair of characters that appear in the same chapter of the book. The values on the edges are the number of such coappearances.

Alternatively, we can use a directed, weighted network representing the neural network of the nematode

C. Elegans. D. Watts and S. Strogatz, Nature 393, 440-442 (1998).

The file celegansneural.gml describes a weighted, directed network where the nodes have been renumbered to be consecutive.

Edge weights are the weights given by Watts.

install.packages("rgl")
library("igraph")

g<-read.graph("C:\\Users\\Dinov\\Desktop\\celegansneural.gml",format=c("gml"))
g
plot(g, layout=layout.graphopt)

data_g <- read.table("https://umich.instructure.com/files/330389/download?download_frd=1&verifier=u1jqCGS8AAU0MsO5ffLCyvVFYXXAflpdLtg8RXhk", sep=" ", header = FALSE)

data_g_mat <- as.matrix(data_g, byrow=TRUE, nc=2)
g_miserab <- graph.edgelist(data_g_mat, dir=FALSE)
summary(g_miserab)
plot(g_miserab, layout=layout.graphopt)
# rglplot(g_miserab, layout=layout.kamada.kawai(g_miserab))

# to name the vertices and and plot the graph of the first 10 vertices
V(g_miserab)$\$$name
g_miserab.1 <- graph.ring(10)
V(g_miserab.1)$\$$name <- sample(letters, vcount(g_miserab.1))
plot(g_miserab.1, layout=layout.graphopt)

# compute the node adjacency matrix
g <- g_miserab; as_adjacency_matrix(g)
E(g)$\$$weight <- runif(ecount(g))
W <- get.adjacency(g, attr="weight")
W

===Social Network Analysis Example===

# free memory
# rm(list = ls())
# gc()

# load termDocMatrix dataset
# These data include Twitter text data of @RDataMining representing a general social network analysis
# example. The terms represent people and the tweets represent LinkedIn groups.
# The term-document matrix can be viewed as the group membership of people.
# We may want to build a network of terms based on their co-occurrence in the same tweets,
# similarly to a network of people based on their group membership.
# https://umich.instructure.com/files/541336/download?download_frd=1

load("E:\\Ivo.dir\\Research\\UMichigan\\Education_Teaching_Curricula\\2015_2016\\HS_853_Fall_2015\\Modules_docx\\data\\03_GraphNetwork_TermDocMatrix.rdata")

<center>Labeled graph [[Image:SMHS_SciVisualization40.png|300px]] </center>

<center>Adjacency matrix [[Image:SMHS_SciVisualization41.png|300px]] Coordinates are 1-6.</center>

# inspect part of the matrix
termDocMatrix [5:10,1:20]
# change it to a Boolean matrix == incidence matrix
termDocMatrix [termDocMatrix >=1] <- 1

# transform into a term-term adjacency matrix (n×n), where (i,j)th entries correspond to the number of edges
# node from xi to node xj.
# Matrix Multiplication in R: http://www.statmethods.net/advstats/matrix.html, dim(t(termDocMatrix))
termMatrix <- termDocMatrix %*% t(termDocMatrix)

# A graph has no loops, when all entries of the adjacency matrix on the main diagonal of are zeroes
# http://mathonline.wikidot.com/adjacency-matrices
diag(termMatrix)

# The matrix product of incidence matrix (B) and it’s transpose B×B^T represents the degrees of all nodes!
# inspect terms numbered 5 to 10
termMatrix[5:10,5:10]

# library("igraph")
# build a graph from the adjacency matrix
g <- graph.adjacency(termMatrix, weighted=T, mode="undirected")
plot(g)

# remove loops
g <- simplify(g); plot(g)

# set labels and degrees of V(g)
V(g)$\$$label <- V(g)$\$$name
V(g)$\$$degree <- degree(g)

# set seed to make the layout reproducible
set.seed(1953)
layout1 <- layout.fruchterman.reingold(g) # Fruchterman-Reingold layout
plot(g, layout=layout1)

# plot(g, layout=layout.kamada.kawai)
# tkplot(g, layout=layout.kamada.kawai)

<center>[[Image:SMHS_SciVisualization42.png|400px]] </center>

# Finesse the graph appearance – vertices and edges
V(g)$\$$label.cex <- 2.2 * V(g)$\$$degree / max(V(g)$\$$degree)+ .2
V(g)$\$$label.color <- rgb(0, 0, .2, .8)
V(g)$\$$frame.color <- rgb(0,0,1)
egam <- (log(E(g)$\$$weight)+.4) / max(log(E(g)$\$$weight)+.4)
E(g)$\$$color <- rgb(.5, .5, 0, egam) # Graph Edges, E(g)
E(g)$\$$width <- egam
# plot the graph in layout1
plot(g, layout=layout1)

V(g)$\$$label <- V(g)$\$$name
V(g)$\$$label.color <- rgb(0, 0, 0, 0.5)
V(g)$\$$label.dist <- 1.0 # relative distance of labels from node center
V(g)$\$$label.angle<- 3/8 #in radians
V(g)$\$$label.cex <- 1.4*V(g)$\$$degree/max(V(g)$\$$degree) + 1
V(g)$\$$color <- rgb(1, 0, 0, .4)
V(g)$\$$size <- 22 * V(g)$\$$degree / max(V(g)$\$$degree)+ 2
V(g)$\$$shape <- "rectangle"
# V(g)$\$$.size=10*(strwidth(V(g)$\$$label) + strwidth("oo")) * 10
# V(g)$\$$.size2=strheight("I") * 10
V(g)$\$$frame.color <- NA
# set vertex labels and their colors and sizes
# set edge width and color
E(g)$\$$width <- .3
E(g)$\$$color <- rgb(.5, .5, 0, .3)

set.seed(1234)
plot(g, layout=layout.fruchterman.reingold)

<center>[[Image:SMHS_SciVisualization43.png|400px]] </center>

===Hands-on activity (oncological primary doctor and a second-opinion)===

We use some of the Stanford Real Graph Data (http://snap.stanford.edu/data/) or this graph data on cancer patients seen by a primary doctor and a second-opinion doctor, stage of the disease, and diagnostic agreement between primary and secondary oncologist: Primary, Secondary, Stage, DxAgreement

# 03_GraphData_Health.txt
healthGraphTable <- read.table("https://umich.instructure.com/files/554234/download?download_frd=1", sep='\t', dec=',', header=T)
#specify the path, separator(tab, comma, ...), decimal point symbol, etc.

<center>head(healthGraphTable)
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Primary||Secondary||Stage||DxAgreement
|-
|1||AA||DD||3||Y
|-
|2||AB||DD||3||R
|-
|3||AF||BA||3||Q
|-
|4||DD||DA||3||Q
|-
|5||CD||EC||3||X
|-
|6||DD||CE||3||Y

|}
</center>

# Transform the table into the required graph format:
healthGraph.network<-graph.data.frame(healthGraphTable, directed=F)
# the 'directed' attribute specifies whether the edges are directed
# or equivalent irrespective of the position (1st vs 2nd column). For directed graphs use 'directed=T'

# Inspect the data:
V(healthGraph.network) <blockquote># prints the list of vertices (physicians/oncologists)</blockquote>
E(healthGraph.network) <blockquote># prints the list of edges (primary-secondary relationships)</blockquote>
degree(healthGraph.network) <blockquote># print the number of edges (relationships) per node (physician)</blockquote>

# first plot of graph
plot(healthGraph.network)

#Subset the data. If we want to exclude only physicians who are mostly outside of the network
# i.e., participate only tangentially (with 1 or 2 relationships only)
# we can exclude nodes by subsetting the graph on the basis of the node/physician’s 'degree':
healthGraph.out.network <- V(healthGraph.network)[degree(healthGraph.network)<=2]
#identify those vertices part of less than or equal to 2 connections (edges)
healthGraph.in.network <- delete.vertices(healthGraph.network, healthGraph.out.network)
#exclude them from the graph

# Plot the data by specifying certain details about the graph, e.g., separate some nodes (people) by color:
V(healthGraph.in.network)$\$$color <- ifelse(V(healthGraph.in.network)$\$$name=='CA', 'blue', 'red')
#useful for highlighting certain people. Works by matching the name attribute of the vertex to the one specified in the 'ifelse' expression
# We can also color the connecting edges differently depending on the 'Stage':
E(healthGraph.in.network)$\$$color<-ifelse(E(healthGraph.in.network)$\$$Stage>3, "red", "grey")
# or depending on the different diagnostic agreement labels ('DxAgreement'):
E(healthGraph.in.network)$\$$color<-ifelse(E(healthGraph.in.network)$\$$DxAgreement =='X', "red", ifelse(E(healthGraph.in.network)$\$$DxAgreement=='Y', "blue", "grey"))

# Note: the example uses nested ifelse expressions which can be improved
# Additional attributes like size can be further specified in an analogous manner:
V(healthGraph.in.network)$\$$size<-degree(healthGraph.in.network)/10
#here the size of the vertices is specified by the degree of the vertex, so that people supervising more have get proportionally bigger dots. Getting the right scale gets some playing around with the parameters of the scale function (from the 'base' package)

# Note that if the same attribute is specified beforehand and inside the function, the former will be overridden.
# And finally the plot itself:
par(mai=c(0,0,1,0))
#this specifies the size of the margins, default settings leave too much free space on all sides
plot(healthGraph.in.network, #the graph to be plotted
layout=layout.fruchterman.reingold, # the layout method. see the igraph documentation for details
main='Onco Physician Network Example', #specifies the title
vertex.label.dist=0.5, #puts the name labels slightly off the dots
vertex.frame.color='blue', #the color of the border of the dots
vertex.label.color='black', #the color of the name labels
vertex.label.font=2, #the font of the name labels
vertex.label=V(healthGraph.in.network)$\$$name, #specifies the labels of the vertices
vertex.label.cex=1 #specifies the size of the font of the labels
)

# Save or export the plot as a metafile to the clipboard, a pdf or png (and other formats).
png(filename="org_network.png", height=1900, width=1200) #call the png writer
# alternatively print to high-res PDF file # pdf(file="org_network.pdf")

#run the plot

dev.off() #don’t forget to close the device

==Pathway analysis==

Pathway analysis is a technique that reduces complexity and increased explanatory power in studies examining underlying biological structure of differentially expressed genes and proteins.

# install package
# install.packages("dendsort") – contains the “” dataset
# Data: Sample data matrix from the integrated pathway analysis of gastric cancer from the
# Cancer Genome Atlas (TCGA) study. A multivariate table obtained from the integrated pathway analysis
# of gastric cancer from the Cancer Genome Atlas (TCGA) study. Each column represents a pathway
# consisting of a set of genes and each row represents a cohort of samples based on specific clinical
# or genetic features. For each pair of a pathway and a feature, a continuous value of between
# 1 and -1 is assigned to score positive or negative association, respectively.
# A data frame with 215 rows and 117 variables

library("dendsort")
data(sample_tcga)
dataTable <- t(sample_tcga)
head(dataTable)
write.csv(dataTable, "E:\\Ivo.dir\\Research\\UMichigan\\Education_Teaching_Curricula\\2015_2016\\HS_853_Fall_2015\\Modules_docx\\data\\03_TCGA_Data_117x215.csv")
# data.new <- read.csv("https://umich.instructure.com/files/330393/download?download_frd=1")

# install SPIA package: http://bioconductor.org/packages/2.6/bioc/html/SPIA.html
# source("http://bioconductor.org/biocLite.R")
# biocLite("SPIA")
library("SPIA")

# “top” Colorectal cancer dataset provided by SPIA package.
data(Vessels)
head(top)
# pathway analysis based on combined evidence;
# use nB=2000 or more for more accurate results
res<-spia(de=DE_Vessels,all=ALL_Vessels,organism="hsa",nB=500,plots=FALSE,beta=NULL,verbose=FALSE)
#make the output fit this screen
res$\$$Name=substr(res$\$$Name,1,10)
#show first 15 pathways, omitting KEGG links
res[1:15,-12]

==GIS/Distortion mapping==

# install the R GISTools package
# install.packages("GISTools")
library("GISTools")
data(georgia)
…

Java Applet: http://www.socr.ucla.edu/htmls/SOCR_Cartograhy.html
Activities: http://wiki.stat.ucla.edu/socr/index.php/SOCR_Cartography_Project

==Circos Connectogram/Table visualization==

Circular chord/ribbon diagrams present a mechanism to visualize numeric tables containing information of directional relations. This type of chart visualizes tables in a circular way. Sectors of the plot is union(rownames(mat), colnames(mat)). When there is no rowname or colname, the chart assigns names for it (rows could be auto-named as "R1", "R2", ... and columns may be named as "C1", "C2").

*Circos: http://circos.ca

*R circlize: http://cran.r-project.org/web/packages/circlize/circlize.pdf

===Example Early-Onset Alzheimer’s Disease===

Recent studies examined the Interactions between imaging (Structural Brain Change) and genetics (SNP) biomarkers in Early-Onset Alzheimer's Disease Subjects. Circular representation of the significant SNP-Neuroimaging interactions. The left and right parts of the graph contain the 15-ROI imaging markers and the 20-SNP genotypes, respectively. The strength of the connection between each SNP-ROI pair is presented as a ribbon, whose size, color and location are proportional to -log (p). Clearly, there are a lot of spurious effects (skinny red lines on background) and several significantly strong associations (thicker purple ribbons on foreground), e.g., purple association between SNP_5 (rs7718456) and ROI_10 (L_hippocampus, Volume). SNP: single nucleotide polymorphism, ROI: region of interest.

<center>[[Image:SMHS_SciVisualization44.png|400px]] </center>

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|SNPROI||ROI_1||ROI_2||ROI_3||ROI_4||ROI_5||ROI_6||ROI_7||ROI_8||ROI_9||ROI_10||ROI_11||ROI_12||ROI_13||ROI_14||ROI_15
|-
|rs17029131||10||10||10||10||10||10||10||10||10||10||188||10||10||10||10
|-
|rs1822144||10||10||10||10||10||200||10||10||10||10||188||10||10||10||10
|-
|rs6446443||10||10||10||126||113||10||10||113||10||10||10||10||10||10||10
|-
|rs12506164||10||10||10||10||10||167||10||10||10||10||10||10||10||10||10
|-
|rs7718456||10||202||144||206||10||10||10||169||225||321||10||10||290||10||10
|-
|rs9377090||10||145||10||10||10||10||10||153||10||10||10||10||10||10||10
|-
|rs2776932||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs4933672||10||10||113||10||10||10||10||10||10||10||10||232||10||10||10
|-
|rs11193270||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs11193272||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs11193274||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs12218153||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs1338956||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs1338025||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs12101936||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs16964473||10||10||10||10||10||10||10||10||10||10||112||10||10||10||10
|-
|rs12972537||10||10||10||10||10||10||125||10||10||10||126||10||10||10||10
|-
|rs2212356||10||10||10||10||10||10||10||10||10||10||10||129||10||10||10
|-
|rs2831165||10||10||10||10||10||10||10||10||10||10||10||10||10||10||169
|-
|rs1266320||10||120||10||10||10||10||10||10||10||145||10||10||10||10||129
|}
</center>

# install.packages("circlize")
library("circlize")

# 03_CircularTable_EOAD_Data.csv
EOAD_data <- read.csv("https://umich.instructure.com/files/330388/download?download_frd=1", sep=",", row.names=1, header = TRUE)

rownames(EOAD_data)
colnames(EOAD_data)
EOAD_matrix <- as.matrix(EOAD_data)

### graphics settings
# par(mfrow = c(3, 2))
# par(mar = c(1, 1, 1, 1))
chordDiagram(EOAD_matrix)

circos.clear()
circos.par(gap.degree = c(rep(2, nrow(EOAD_matrix)-1), 10, rep(2, ncol(EOAD_matrix)-1), 10))
chordDiagram(EOAD_matrix)

circos.clear()
circos.par(start.degree = 90)
chordDiagram(EOAD_matrix)

circos.clear()
# chordDiagram(EOAD_matrix, order = c("ROI_1", "ROI_2", "ROI_3", "ROI_4", "ROI_5", "ROI_6", "ROI_7", "ROI_8", "ROI_9", "ROI_10", "ROI_11", "ROI_12", "ROI_13", "ROI_14", "ROI_15"))
chordDiagram(EOAD_matrix, directional = TRUE)
chordDiagram(EOAD_matrix, directional = TRUE, diffHeight = 0.06)

circos.clear()

### colors settings
rand_color = function(n, alpha = 1) {
return(rgb(runif(n), runif(n), runif(n), alpha = alpha))
}

par(mfrow = c(2, 2))
par(mar = c(1, 1, 1, 1))
grid.col = NULL

# random grid/sector and ribbon/chord colors
col_mat = rand_color(length(EOAD_matrix), alpha = 0.5)
grid_col = rand_color(length(rownames(EOAD_matrix)) + length(colnames(EOAD_matrix)), alpha = 0.5)
dim(col_mat) = dim(EOAD_matrix)
chordDiagram(EOAD_matrix, grid.col = grid_col, col = col_mat)

# grid/sector and ribbon/chord colors according to cell values
# Generate quantile values for the color mapping relative to table cell-values
seqs <- seq(0.92, 1, 0.008)

chordDiagram(EOAD_matrix, grid.col = grid_col, col = colorRamp2(quantile(EOAD_matrix, seqs), rev(heat.colors(11))), transparency = 0.5)
circos.clear()

<center>[[Image:SMHS_SciVisualization46.png|500px]] </center>

===Practice===

Repeat these charts using the 03_NIPS_Baby_VitK_Shot_DataSummaryAnalysis_March2012_Short.csv dataset (Appendix), https://umich.instructure.com/files/330392/download?download_frd=1

==Graphical Workflow Protocol Visualization==

(1) Brain Imaging & Genetics Data:

a. ADNI: http://adni.loni.usc.edu/

b. PPMI: http://ppmi-info.org/

c. XNAT Central: https://central.xnat.org/

d. Pipeline Data (see client library)

e. Cloud Services (AWS/Box/Drive)

(2) Pipeline Environment

a. http://pipeline.loni.usc.edu/

b. Web-Java Client: http://pipeline.loni.usc.edu/products-services/pws/

c. Videos: http://pipeline.loni.usc.edu/learn/basic-videos/

d. Publications: http://pipeline.loni.usc.edu/get-started/acknowledgmentscredits/

(3) End-to-end Computational workflows

a. Navigator: http://pipeline.loni.usc.edu/explore/library-navigator/

b. Detailed Descriptions: http://wiki.loni.usc.edu/twiki/bin/view/CCB/PipelineWorkflows

<center>[[Image:SMHS_SciVisualization47.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization48.png|500px]] </center>

==Appendix==

===Neonate Infant Pain Score (NIPS) Data (Vitamin K shots) Dataset===

<center>A short version of the Neonate Infant Pain Score (NIPS) Data (Vitamin K shots) dataset, http://wiki.socr.umich.edu/index.php/SOCR_Data_NIPS_InfantVitK_ShotData
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|Index||Immediate||30_Sec||60_Sec||120_Sec||TotalCryTime
|-
|1||6||7||6||2||63
|-
|2||5||1||2||0||0
|-
|3||7||6||6||7||54
|-
|4||3||7||3||0||27
|-
|5||7||5||6||0||19
|-
|6||6||6||6||2||2
|-
|7||7||7||6||0||46
|-
|8||6||7||0||0||33
|-
|9||5||0||4||0||56
|-
|10||7||7||7||6||63
|-
|105||6||0||0||0||11
|-
|106||7||6||0||0||59
|-
|107||7||4||4||0||28
|-
|108||7||7||7||1||64
|-
|109||7||0||0||0||8
|-
|110||5||0||1||3||64
|-
|111||7||5||7||7||72
|-
|112||4||2||0||2||50
|-
|113||7||6||7||0||44
|-
|114||7||1||0||0||11
|}
</center>

==See Next==
* [[SMHS_SciVisualization| Back to the Scientific Visualization section]]
* [[SMHS| Back to the Scientific Methods for Health Sciences EBook ToC]]

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_SciVisualization_SOCR_Excel_R_Charts}}

SMHS SciVisualization SOCR Excel R Charts

2016-05-23T13:30:49Z

Imoubara: /* Hyperbolic Visualization */

==[[SMHS_SciVisualization| SMHS Scientific Visualization]] - SOCR, Excel and R charts ==

==SOCR Charts==

*URL: http://socr.umich.edu/html/cha/ (Java applet)

*About/List: http://wiki.stat.ucla.edu/socr/index.php/About_pages_for_SOCR_Chart_List

*Activities: http://wiki.stat.ucla.edu/socr/index.php/SOCR_EduMaterials_ChartsActivities

*Data: http://wiki.socr.umich.edu/index.php/SOCR_Data

<center>[[Image:SMHS_SciVisualization2.png|500px]] </center>

==Excel Charts==

MS Excel provides a large number of charts that can be used to quickly and effectively render complex multivariate data. For instance, the table below contains the principal component analysis (PCA) of 50 derived neuroimaging biomarkers (region of interest (ROI) by shape morphometry metric). The loadings of these 50 variables on the top 5 (most significant) principal component directions are shown in the table. Experiment with effective visualizations of these data.

<center>
{| class="wikitable" style="text-align:center; width:99%" border="1"
!Hemi||ROI||measure||ROI_Measure||Dim.1||Dim.2||Dim.3||Dim.4||Dim.5
|-
|L||insular||AvgMeanCurvature||L_insular_cortex_AvgMeanCurvature||0.72||0||0.06||0.06||0
|-
|L||insular||ComputeArea||L_insular_cortex_ComputeArea||0.77||0.06||0.04||0.01||0
|-
|L||insular||Volume||L_insular_cortex_Volume||0.72||0.09||0.04||0.03||0.01
|-
|L||insular||ShapeIndex||L_insular_cortex_ShapeIndex||0.46||0.06||0.01||0.02||0.01
|-
|L||insular||Curvedness||L_insular_cortex_Curvedness||0.78||0||0.05||0.03||0.01
|-
|R||insular||AvgMeanCurvature||R_insular_cortex_AvgMeanCurvature||0.79||0||0.03||0.08||0
|-
|R||insular||ComputeArea||R_insular_cortex_ComputeArea||0.79||0.09||0.03||0.01||0
|-
|R||insular||Volume||R_insular_cortex_Volume||0.73||0.11||0.03||0.03||0
|-
|R||insular||ShapeIndex||R_insular_cortex_ShapeIndex||0.27||0.17||0||0.07||0
|-
|R||insular||Curvedness||R_insular_cortex_Curvedness||0.84||0.02||0.03||0.01||0
|-
|L||cingulate||AvgMeanCurvature||L_cingulate_gyrus_AvgMeanCurvature||0.72||0||0.05||0.02||0.02
|-
|L||cingulate||ComputeArea||L_cingulate_gyrus_ComputeArea||0.74||0.05||0.06||0.04||0.01
|-
|L||cingulate||Volume||L_cingulate_gyrus_Volume||0.69||0.08||0.05||0.05||0.01
|-
|L||cingulate||ShapeIndex||L_cingulate_gyrus_ShapeIndex||0.53||0||0.05||0||0.03
|-
|L||cingulate||Curvedness||L_cingulate_gyrus_Curvedness||0.7||0.01||0.05||0.04||0.03
|-
|R||cingulate||AvgMeanCurvature||R_cingulate_gyrus_AvgMeanCurvature||0.6||0||0.02||0.03||0.01
|-
|R||cingulate||ComputeArea||R_cingulate_gyrus_ComputeArea||0.73||0.06||0.04||0.03||0.01
|-
|R||cingulate||Volume||R_cingulate_gyrus_Volume||0.68||0.09||0.04||0.04||0.01
|-
|R||cingulate||ShapeIndex||R_cingulate_gyrus_ShapeIndex||0.56||0.01||0.05||0||0.01
|-
|R||cingulate||Curvedness||R_cingulate_gyrus_Curvedness||0.25||0||0.01||0.04||0
|-
|L||caudate||AvgMeanCurvature||L_caudate_AvgMeanCurvature||0.52||0||0.05||0||0.01
|-
|L||caudate||ComputeArea||L_caudate_ComputeArea||0.51||0.09||0.03||0.04||0.02
|-
|L||caudate||Volume||L_caudate_Volume||0.44||0.09||0.03||0.06||0.03
|-
|L||caudate||ShapeIndex||L_caudate_ShapeIndex||0.2||0.03||0.04||0.04||0
|-
|L||caudate||Curvedness||L_caudate_Curvedness||0.51||0.12||0.02||0.01||0.01
|-
|R||caudate||AvgMeanCurvature||R_caudate_AvgMeanCurvature||0.68||0.04||0.04||0.02||0
|-
|R||caudate||ComputeArea||R_caudate_ComputeArea||0.67||0.17||0.03||0.02||0.01
|-
|R||caudate||Volume||R_caudate_Volume||0.61||0.16||0.02||0.03||0.01
|-
|R||caudate||ShapeIndex||R_caudate_ShapeIndex||0.18||0.02||0.03||0.11||0
|-
|R||caudate||Curvedness||R_caudate_Curvedness||0.65||0.19||0.01||0||0
|-
|L||putamen||AvgMeanCurvature||L_putamen_AvgMeanCurvature||0.62||0||0.04||0.03||0.02
|-
|L||putamen||ComputeArea||L_putamen_ComputeArea||0.56||0.05||0.04||0.03||0.05
|-
|L||putamen||Volume||L_putamen_Volume||0.52||0.07||0.04||0.05||0.05
|-
|L||putamen||ShapeIndex||L_putamen_ShapeIndex||0.06||0.13||0||0.15||0
|-
|L||putamen||Curvedness||L_putamen_Curvedness||0.64||0.11||0.03||0.01||0.03
|-
|R||putamen||AvgMeanCurvature||R_putamen_AvgMeanCurvature||0.62||0||0.07||0.04||0.01
|-
|R||putamen||ComputeArea||R_putamen_ComputeArea||0.66||0.08||0.03||0.01||0.03
|-
|R||putamen||Volume||R_putamen_Volume||0.64||0.12||0.03||0.02||0.03
|-
|R||putamen||ShapeIndex||R_putamen_ShapeIndex||0.15||0.24||0||0.08||0.03
|-
|R||putamen||Curvedness||R_putamen_Curvedness||0.65||0.05||0.05||0||0.02
|-
|L||hippocampus||AvgMeanCurvature||L_hippocampus_AvgMeanCurvature||0.78||0||0.01||0.04||0
|-
|L||hippocampus||ComputeArea||L_hippocampus_ComputeArea||0.75||0.07||0.01||0||0.02
|-
|L||hippocampus||Volume||L_hippocampus_Volume||0.72||0.09||0.01||0.01||0.01
|-
|L||hippocampus||ShapeIndex||L_hippocampus_ShapeIndex||0.45||0.17||0||0.04||0.02
|-
|L||hippocampus||Curvedness||L_hippocampus_Curvedness||0.79||0.03||0.01||0||0.02
|-
|R||hippocampus||AvgMeanCurvature||R_hippocampus_AvgMeanCurvature||0.72||0||0||0.1||0.01
|-
|R||hippocampus||ComputeArea||R_hippocampus_ComputeArea||0.71||0.09||0||0||0.05
|-
|R||hippocampus||Volume||R_hippocampus_Volume||0.68||0.1||0||0||0.04
|-
|R||hippocampus||ShapeIndex||R_hippocampus_ShapeIndex||0.37||0.18||0||0.02||0.03
|-
|R||hippocampus||Curvedness||R_hippocampus_Curvedness||0.77||0.03||0||0.02||0.04
|}
</center>

<center>[[Image:SMHS_SciVisualization3.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization4.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization5.png|500px]] </center>

==R-Charts==

There are 100’s of packages and 1,000 of different charts, plots and graphs that can be generated using R. Such interactive visualizations enable deeper exploration of data, models and results. JavaScript libraries, e.g., D3, provide advantages for data visualization as these involve HTML5 and are easily shareable online. The R community is developing R interfaces to some popular JavaScript libraries to allow users to create interactive visualizations without detailed knowledge of JavaScript.

===Examples of powerful R interactive visualization packages===

*ggplot2 – http://ggplot2.org

*ggvis – interactive plots extending the static ggplot2 charts, http://ggvis.rstudio.com

*rCharts – R interface to multiple JavaScript charting libraries, http://rcharts.io

*plotly – transforming ggplot2 charts into interactive plots, https://plot.ly/r

*googleVis – Google Charts using R, http://cran.r-project.org/web/packages/googleVis/vignettes/googleVis_examples.html

*HTMLWidgets
** leaflet – library for creating dynamic maps, supports panning and zooming, annotations, markers, polygons, etc. http://www.htmlwidgets.org/showcase_leaflet.html
** dygraphs – provides mechanism for charting time-series data, supports interactive navigation features including series/point highlighting, zooming, and panning, http://www.htmlwidgets.org/showcase_dygraphs.html
** networkD3 – library for creating D3 network graphs including force directed networks, Sankey diagrams, and Reingold-Tilford tree networks, http://www.htmlwidgets.org/showcase_networkD3.html
** DataTables – displays R matrices or data frames as interactive HTML tables that support filtering, pagination, and sorting, http://www.htmlwidgets.org/showcase_datatables.html
** Rthreejs – features 3D scatterplots and globes based on WebGL, http://www.htmlwidgets.org/showcase_threejs.html

*Other R graphic examples
** To write out plots out to file use:
# pdf() command all graphs are redirected to test.pdf. Also works with other common formats: jpeg, png, ps, tiff.
pdf("C:\\Users\\Dinov\\Desktop\\test.pdf"); plot(1:100, 1:100); dev.off()
# Generates Scalable Vector Graphics (SVG) that can be edited by vector graphics software
svg("test.svg"); plot(1:100, 1:100); dev.off()

===Paired ScatterPlots===

set.seed(100)
x <- matrix(runif(50), ncol=5, dimnames=list(letters[1:10], LETTERS[1:5]))
describe(x) # library("Hmisc")
plot(x[,1], x[,2], pch=20, col="red", main="Symbols and Labels")
text(x[,1]+0.03, x[,2], rownames(x))

<center>[[Image:SMHS_SciVisualization6.png|500px]] </center>

pairs(x)

<center>[[Image:SMHS_SciVisualization7.png|500px]] </center>

Another way to generate scatterplots is by using ggplot:

# library(ggplot2)
x <- sample(1:20, 20); y <- sample(1:20, 20); cat <- rep(c("A", "B", "C", "D"), 5)
#vs. cat <- rep(c("A", "B", "C", "D"), each=5)
plot.1 <- qplot(x, y, geom="point", size=5*x, color=cat, main="GGplot with Relative Dot Size and Color") + theme(legend.position = "topleft")
print(plot.1)

# Use Case-Studies: https://umich.instructure.com/courses/38100/files/folder/Case_Studies
# Case_03_MentalHealthServicesSurvey
# data1 <- read.table('https://umich.instructure.com/files/399128/download?download_frd=1&verifier=AG2e9QUKUm1jvDBpkX7D9jbEjKNc4irA0ECk0f7p', header=T)
head(data1)
attach(data1)
# library("Hmisc")
describe(data1)

plot(data1[,3], data1[,4], pch=20, col="red", main="Symbols and Labels")
# text(data1 [,3]+0.03, data1 [,4], rownames(data1))
plot.1 <- qplot(x, y, geom="point", size=5*x, color=cat, main="GGplot with Relative Dot Size and Color") + theme(legend.position = "topleft")
print(plot.1)

# redo plots using majorfundtype FacilityType Ownership Focus
# pairs(data1, na.action=na.omit)

<center>[[Image:SMHS_SciVisualization8.png|500px]] </center>

# Scatterplot with regression line. Use the “diamonds” dataset, which is a data frame with
# 53,940 rows and 10 variables ()
# describe(diamonds)

# Use Case-Studies: https://umich.instructure.com/courses/38100/files/folder/Case_Studies
# CaseStudy01_Divorce_YoungAdults
# data1 <- read.csv('https://umich.instructure.com/files/399118/download?download_frd=1&verifier=ESACv31KcyiHbkPZPuT8Oo4V7XzPtgTTbs6PQLTv', header=T)
attach(data1)
# plot variables: DIVYEAR momint dadint momclose depression livewithmom gethitched

set.seed(110)
# par(mfrow=c(1,2))
data.2 <- diamonds[sample(nrow(diamonds), 500), ]
plot.2 <- qplot(price, depth, data = data.2, geom = c("point", "smooth"), method = "lm")
plot.3 <- qplot(carat, price, data=data.2, geom=c("point", "smooth"), span=0.4)
print(plot.2); print(plot.3)

<center>[[Image:SMHS_SciVisualization9.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization10.png|500px]] </center>

===Barplots===

x <- matrix(runif(50), ncol=5, dimnames=list(letters[1:10], LETTERS[1:5]))
barplot(x[1:4,], ylim=c(0, max(x[1:4,])+0.3), beside=TRUE, legend.text = letters[1:4],
args.legend = list(x = "topleft"))
text(labels=round(as.vector(as.matrix(x[1:4,])),2), x=seq(1.5, 21, by=1) + sort(rep(c(0,1,2,3,4), 4)), y=as.vector(as.matrix(x[1:4,]))+0.1)

<center>[[Image:SMHS_SciVisualization11.png|500px]] </center>

# to put error bars on barplot:

# 10 rows (a, b, c, …):
bar <- barplot(m <- rowMeans(x) * 10, ylim=c(0, 10))
stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

# Case_04_ChildTrauma
# data1 <- read.table('https://umich.instructure.com/files/399129/download?download_frd=1&verifier=Hmv0YW2Kie5ZTV9CKBUNArSHR66f3GWSmVzZDBxc', header=T)
attach(data1)
head(x)
head(data1)
# plot data
data2 <- data1[,-5] # remove the 5th columns text
data1 <- data2[,-5] # remove the 6th columns text
# or data1 <- data1[,c(-5,-6)]

data2 <- as.data.frame(data1)
Blacks <- data2[which(data2$\$$race=="black"),]
Other <- data2[which(data2$\$$race=="other"),]
Hispanic <- data2[which(data2$\$$race=="hispanic"),]
White <- data2[which(data2$\$$race=="white"),]

A <- c(mean(Blacks$\$$age), mean(Blacks$\$$service))
#colnames(A) <- c("age "," service ")
B <- c(mean(Other$\$$age), mean(Other$\$$service))
C <- c(mean(Hispanic$\$$age), mean(Hispanic$\$$service))
D <- c(mean(White$\$$age), mean(White$\$$service))

x <- cbind(A, B, C, D)

bar <- barplot(x[1:2,], ylim=c(0, max(x[1:2,])+2.0), beside=TRUE,
legend.text = c("age","service") , args.legend = list(x = "right"))
text(labels=round(as.vector(as.matrix(x[1:2,])),2), x=seq(1.4, 21, by=1.5), #y=as.vector(as.matrix(x[1:2,]))+0.3)
y=11.5)

m <- x; stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

barplot(as.matrix(data1[1:4,]), ylim=c(0, max(data1[1:4,])+0.3), beside=TRUE, legend.text = data1[1:4,1], args.legend = list(x = "topleft"))
text(labels=round(as.vector(as.matrix(data1[1:4,])),2), x=seq(1.5, 21, by=1), y=as.vector(as.matrix(data1[1:4,]))+0.1)

<center>[[Image:SMHS_SciVisualization12.png|500px]] </center>

# Columns (A, B, C, D, E):
bar <- barplot(m <- colMeans(x) * 5, ylim=c(0, 5))
stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

<center>[[Image:SMHS_SciVisualization13.png|500px]] </center>

===Histograms and Density Plots===

hist(x, freq=TRUE, breaks=10)

<center>[[Image:SMHS_SciVisualization14.png|500px]] </center>

plot(density(x), lwd = 10, col="green")

<center>[[Image:SMHS_SciVisualization15.png|500px]] </center>

===Pie Chart===

# first , “A”, and second, “B”, columns
par (mfrow=c(1,2))
pie(x[,1], col=rainbow(length(x[,1]), start=0.1, end=0.8), clockwise=TRUE)

pie(x[,1], col=rainbow(length(x[,1]), start=0.1, end=0.8), clockwise=TRUE)

pie(x[,2], col=rainbow(length(x[,2]), start=0.1, end=0.8), clockwise=TRUE)
legend("topleft", legend=row.names(x), cex=1.3, bty="n", pch=15, pt.cex=1.8, col=rainbow(length(x[,2]), start=0.1, end=0.8), ncol=1)

<center>[[Image:SMHS_SciVisualization16.png|500px]] </center>

You can export the data:
write.table(x, " ", "data.txt")
# copy-paste it in SOCR Pie chart to generate another Pie view of data

===Line Plots Using ggplot===

head(diamonds)

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||Carat||Cut||Color||Clarity||Depth||Table||Price||X||Y||Z
|-
|1||0.23||Ideal||E||SI2||61.5||55||326||3.95||3.98||2.43
|-
|2||0.21||Premium||E||SI1||59.8||61||326||3.89||3.84||2.31
|-
|3||0.23||Good||E||VS1||56.9||65||237||4.05||4.07||2.31
|-
|4||0.29||Premium||I||VS2||62.4||58||334||4.2||4.23||2.63
|-
|5||0.31||Good||J||SI2||63.3||58||335||4.34||4.35||4.75
|-
|6||0.24||VeryGood||J||VVS2||62.8||57||336||3.94||3.96||2.48
|}
</center>

plot.2 <- ggplot(diamonds, aes(carat, price, group=cut, color=cut)) + geom_line()
print(plot.2)

<center>[[Image:SMHS_SciVisualization17.png|500px]] </center>

plot.2 <- ggplot(data1, aes(age, service, group=race, color=race)) + geom_line()
print(plot.2)

# Faceting plot (geometrically, faceting (or facetting) is the process of removing parts of a polygon, polyhedron or polytope, without creating any new vertices)
plot.3 <- ggplot(diamonds, aes(carat, price)) + geom_line(aes(color=cut), size=1) +
facet_wrap(~cut, ncol=1)
print(plot.3)

<center>[[Image:SMHS_SciVisualization18.png|500px]] </center>

===Barplots with ggplot===

plot.4 <- ggplot(diamonds, aes(cut, fill=cut)) + geom_bar() + facet_grid(. ~ clarity)
print(plot.4)

<center>[[Image:SMHS_SciVisualization19.png|500px]] </center>

New_var <- service+rnorm(1000, 0,1)
data1$\$$New_var <- int(New_var)
plot.4 <- ggplot(data1, aes(race, fill= traumatype)) + geom_bar() + facet_grid(. ~ New_var)
print(plot.4)

plot.4a <- ggplot(diamonds, aes(color, price/carat, fill=color)) + geom_boxplot()
print(plot.4a)

<center>[[Image:SMHS_SciVisualization20.png|500px]] </center>

===Jitter plot===

plot.5 <- ggplot(diamonds, aes(color, price/carat)) + geom_jitter(alpha = I(1 / 2), aes(color=color))
print(plot.5)

<center>[[Image:SMHS_SciVisualization21.png|500px]] </center>

===Density Plots===

plot.6 <- ggplot(diamonds, aes(carat, size=2)) + geom_density(aes(color = cut))
print(plot.6)

<center>[[Image:SMHS_SciVisualization22.png|500px]] </center>

plot.6 <- ggplot(data1, aes(age, size=2)) + geom_density(aes(color = traumatype))
print(plot.6)

plot.7 <- ggplot(diamonds, aes(carat, size=2)) + geom_density(aes(fill = color))
print(plot.7)

<center>[[Image:SMHS_SciVisualization23.png|500px]] </center>

plot.8 <- ggplot(diamonds, aes(x=carat, size=1)) + geom_histogram(aes(y = price), binwidth=0.2) + geom_density()
print(plot.8)

<center>[[Image:SMHS_SciVisualization24.png|500px]] </center>

plot.8a <- ggplot(diamonds, aes(x=carat, size=1)) + geom_histogram(aes(y = price), stat="identity") + geom_density()
print(plot.8a)

<center>[[Image:SMHS_SciVisualization25.png|500px]] </center>

===Heatmaps===

# Generating Dendogram Association Heatmap Plot (Genotype vs. Imaging phenotype)
# http://stat.ethz.ch/R-manual/R-patched/library/stats/html/heatmap.html
# http://www.ncbi.nlm.nih.gov/pmc/articles/PMC4005931/

AD_Associations_Data <- read.table("https://umich.instructure.com/files/330387/download?download_frd=1&verifier=gLk2ADgrLhXGeknI6mqIeJugi2ODr8RARsQlBUMe", header=TRUE, row.names=1, sep=",", dec=".")

MCI_Associations_Data <- read.table("https://umich.instructure.com/files/330390/download?download_frd=1&verifier=FczlJD6ISRPZhu69xvHuoZHx2c7gXX9YEvvPCTBG", header=TRUE, row.names=1, sep=",", dec=".")

NC_Associations_Data <- read.table("https://umich.instructure.com/files/330391/download?download_frd=1&verifier=i2BEtSpmpbrzQUPoA2ST06IzzcaenyVEHRepHSF3", header=TRUE, row.names=1, sep=",", dec=".")

require(graphics)
require(grDevices)
library(gplots)

AD_Data <- AD_Associations_Data
MCI_Data <- MCI_Associations_Data
NC_Data <- NC_Associations_Data

AD_mat <- as.matrix(AD_Data); class(AD_mat) <- "numeric"
MCI_mat <- as.matrix(MCI_Data); class(MCI_mat) <- "numeric"
NC_mat <- as.matrix(NC_Data); class(NC_mat) <- "numeric"

# set up the rol (rc) and column (cc) colors for each cohort
rcAD <- rainbow(nrow(AD_mat), start = 0, end = 1.0); ccAD<-rainbow(ncol(AD_mat), start = 0, end = 1.0)
rcMCI <- rainbow(nrow(MCI_mat), start = 0, end=1.0); ccMCI<-rainbow(ncol(MCI_mat),start=0,end=1.0)
rcNC <- rainbow(nrow(NC_mat), start = 0, end = 1.0); ccNC<-rainbow(ncol(NC_mat), start = 0, end = 1.0)

# set up 1x3 graph display - par (mfrow=c(1,3)) – does not work with ‘heatmap’
hvAD <- heatmap(AD_mat, col = cm.colors(256), scale = "column", RowSideColors = rcAD, ColSideColors = ccAD, margins = c(2,2), main="AD Cohort SNP-ROI_volume Association (p_values)")
hvMCI <- heatmap(MCI_mat, col = cm.colors(256), scale = "column", RowSideColors = rcMCI, ColSideColors = ccMCI, margins = c(2,2), main="MCI Cohort SNP-ROI_volume Association (p_values)")
hvNC <- heatmap(NC_mat, col = cm.colors(256), scale = "column", RowSideColors = rcNC, ColSideColors = ccNC, margins = c(2,2), main="NC Cohort SNP-ROI_volume Association (p_values)")

<center>[[Image:SMHS_SciVisualization26.png|500px]] </center>

# Alternatively, we can use the R package gplots
install.packages("gplots")
library(gplots)
## col dendrogram plotted and col reordering done.
# heatmap.2(AD_mat, keysize=2)
## A more decorative heatmap, with z-score scaling along columns
heatmap.2(AD_mat, col=cm.colors(255), scale="column", RowSideColors=rcAD, ColSideColors=ccAD, margin=c(8, 7), xlab="Imaging Biomarkers (ROI volume)", ylab= "Genetics Biomarkers (SNPs)", main="AD Associations Heatmap (SNP-Imaging)", tracecol="green", density="density")

<center>[[Image:SMHS_SciVisualization27.png|500px]] </center>

===Correlation Plots===

The corrplot package is a graphical display of a correlation matrix and confidence intervals, with some tools for matrix reordering. There are seven visualization methods (parameter method) in corrplot package, named "circle", "square", "ellipse", "number", "shade", "color", "pie".
# install.packages("corrplot")
library(corrplot)
NC_Associations_Data <- read.table("https://umich.instructure.com/files/330391/download?download_frd=1&verifier=i2BEtSpmpbrzQUPoA2ST06IzzcaenyVEHRepHSF3", header=TRUE, row.names=1, sep=",", dec=".")
M <- cor(NC_Associations_Data)

<center>[[Image:SMHS_SciVisualization28.png|500px]] </center>

===Hyperbolic Visualization===

*URL: http://socr.umich.edu/html/Navigators.html

*Tools:
** Java/Jar applet: http://socr.umich.edu/html/navigators/HW/jars/SOCR_HW_Viewer.jar
** JavaScript: http://socr.umich.edu/html/navigators/D3/SOCR_D3_Viewer.html (JSON)

*Data Format
** XML data: http://socr.umich.edu/html/navigators/HW/SOCR_HyperTree.xml
** JSON data: http://socr.umich.edu/html/navigators/D3/xml/SOCR_HyperTree.json

*D3 Visualization
** E:\Ivo.dir\Research\UMichigan\Education_Teaching_Curricula\2015_2016\HS_853_Fall_2015\Modules_docx\Tools\TreeViewer_JS
** treeJS.json
** flareD3.json

<center>[[Image:SMHS_SciVisualization29.png|400px]] </center>

<center>[[Image:SMHS_SciVisualization30.png|400px]] </center>

*URL: https://github.com/mbostock/d3/wiki/Gallery

*Source code: https://github.com/mbostock/d3

<center>[[Image:SMHS_SciVisualization31.png|400px]] </center>

===Motion Charts===

*Video: http://www.socr.ucla.edu/SOCR_MotionCharts/SOCR_HTML5_MotionChart_Video2.gif

*Java: http://www.socr.ucla.edu/SOCR_MotionCharts/

*HTML5: http://socr.umich.edu/HTML5/MotionChart/

*Activities: http://wiki.socr.umich.edu/index.php/SOCR_MotionCharts

<center>[[Image:SMHS_SciVisualization32.png|500px]] </center>

===1D/2D/3D signal/area/volume/surface/model/atlas visualization===

*1D: (See R/SOCR Visualization tools above)

*2D: http://imagej.nih.gov/ij/

*3D: http://socr.umich.edu/HTML5/BrainViewer/

Supported File Formats:
Volumes (.nii / .nii.gz / .img&.hdr / .mgh / .mgz / .nrrd)
Shapes (.dx / .vtk / .stl / FreeSurfer)
Fibers (.trk)

<center>[[Image:SMHS_SciVisualization33.png|500px]] </center>

===Trees and Graphs===

*Trees/Hierarchies and general Graphs

# Install and load the APE package, needed for the phylogenetic tree rendering (as.phylo)
# install.packages("ape")
library("ape")

Load data

# Data: 02_Nof1_Data.csv
data.1 <- read.table("https://umich.instructure.com/files/330385/download?download_frd=1&verifier=DwJUGSd6t24dvK7uYmzA2aDyzlmsohyaK6P7jK0Q ", sep=",", header = TRUE)
head(data.1)

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
mydata1
|-
|||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0

|}
</center>

Clustering

hc = hclust(dist(data.1), 'ave')
# the agglomeration method can be specified "ward.D", "ward.D2", "single","complete", "average" (= UPGMA), "mcquitty" (= WPGMA),"median" (= WPGMC) or "centroid" (= UPGMC)

# (3) Plot clustering diagram
par (mfrow=c(1,1))
# very simple dendrogram
plot(hc)

<center>[[Image:SMHS_SciVisualization34.png|500px]] </center>

require(graphics)
(x <- identify(hc)) ## Terminate with 2nd mouse button !!
identify(hc, function(k) print(table(data.1[k,5])))

You can now cut the tree into branches. You can split the tree into 2 groups, by setting the number of cuts with the k=2 parameter, or by specifying height to cut the tree at (?cutree):

k- an integer scalar or vector with the desired number of groups

h- numeric scalar or vector with heights where the tree should be cut

cutree(hc, k = 2)
# alternatively specify the height, which is, the value of the criterion associated with the clustering method
# for the particular agglomeration.
cutree(hc, h= 50) # cut at h=50
table(cutree(hc, h= 50)) # cluster distribution
# To identify the number of cases for varying number of clusters we can combine calls to cutree and table
# in a call to sapply -- to see the sizes of the clusters for 2≤ k≤10 cluster-solutions:
# numbClusters=5;
myClusters = sapply(2:10,function(numbClusters)table(cutree(hc, numbClusters)))
names(myClusters) <- paste("Number of Clusters=", 2:10, sep = "")
myClusters
#To see which SubjectIDs are in which clusters:
groups.10 <- cutree(hc, k = 10)
sapply(unique(groups.10),function(g)data.1$\$$ID[groups.10 == g])
#To see which Treatments (Tx) are in which clusters:
groups.2 <- cutree(hc, k = 2)
sapply(unique(groups.2),function(g)data.1$\$$Tx[groups.2 == g])
# drill down deeper
table(groups.2, data.1$\$$Tx)
# For a small number of observations, we can often interpret the cluster solution directly by looking
# at the labels of the observations that are in each cluster.
# This is hard for larger data sets. To characterize clusters we can look at cluster summary statistics,
# like the median, of the variables that were used to perform the cluster analysis broken down
# by the groups that the cluster analysis identified.

The aggregate function will compute stats (e.g., median) on many variables simultaneously.

To look at the median values for the variables we've used in the cluster analysis, broken up by the cluster groups:

aggregate(data.1, list(groups.10),median) # may have to shrink data.1 prior to clustering!
# data.2 <- data.1[,-c(1,3)] # Remove ID and Tx variables?
aggregate(data.2, list(groups.2),median) # for only 2 clusters

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Group||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||14||16||0||20||-5||-0.040||2.995||3.275||0.275||41
|-
|2||2||16||15||1||25||0||0.025||3.280||3.360||0.360||104

|}
</center>

table(groups.2, data.1$\$$PhyAct)

# library("Hmisc")

describe(data.1$\$$PhyAct)

# It’s useful to add the numbers of observations in each group (aggregate returns a data frame,
# that can be manipulated)

df.2 <- aggregate(data.1, list(groups.2),median)

data.frame(Cluster= df.2[,1], Freq=as.vector(table(groups.2)), df.2[,-1])

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Cluster||Freq||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||570||14||16||0||20||-5||-0.040||2.995||3.275||0.275||41
|-
|2||2||330||16||15||1||25||0||0.025||3.280||3.360||0.360||104

|}
</center>

===Publications===

*This paper examines nasal and bronchial tissue cultures as appropriate in vitro models for the assessment of smoking-induced adverse effects in the respiratory system (doi: 10.1177/1091581814551647), using “hclust” package. No data.

*This paper classified subtypes of gastric cancer based on epidemiologic and histologic and gene expression data. These new classifications of gastric cancer have implications for improving our understanding of disease biology and identification of unique molecular drivers for each gastric cancer subtype (doi: 10.1158/1078-0432.CCR-10-2203).

Repeat the clustering

# using centroids and squared Euclidean distance
# cut the tree into 10 clusters and reconstruct the upper part of the tree from the cluster centers.
hc <- hclust(dist(data.1), "cen")
mem <- cutree(hc, k = 10)
cent <- NULL
for(k in 1:10){
cent <- rbind(cent, colMeans(data.1[mem == k, , drop = FALSE]))
}

hc1 <- hclust(dist(cent), method = "cen", members = table(mem))

opar <- par(mfrow = c(1, 2))
plot(hc, labels = FALSE, hang = -1, main = "Original Tree")
plot(hc1, hang = -1, main = "Re-start from 10 clusters")
par(opar)

<center>[[Image:SMHS_SciVisualization35.png|500px]] </center>

Identify subjects within each of the 10 classes

rect.hclust(hc, h=10)

# To save the cluster numbers to a new variable in the dataset, use the cutree function.
# data.1$\$$clusterID <- cutree(hc, 10)
data.1$\$$clusterID <- cutree(hc, 10)
head(data.1)

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct||CluserID
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53||1
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73||1
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23||2
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36||2
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21||2
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0||2

|}
</center>

Phylogenetic tree diagram

# library("ape")
plot(as.phylo(hc1), use.edge.length = TRUE, type = "fan")
plot(as.phylo(hc), use.edge.length = TRUE, type = "fan", tip.color = hsv(runif(15, 0.65, 0.95), 1, 1, 0.7), label.offset = 1, cex = log(data.1$\$$ID, 10), col = "red")

<center>[[Image:SMHS_SciVisualization36.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization37.png|500px]] </center>

===Hands-on Activity (Health Behavior Risks)===

# load data CaseStudy09_HealthBehaviorRisks_Data
data.2 <- read.csv("https://umich.instructure.com/files/399182/download?download_frd=1 ", sep=",", header = TRUE)

# Classify the cases using these variables: "AGE_G" "SEX" "RACEGR3" "IMPEDUC" "IMPMRTL"
# "EMPLOY1" "INCOMG" "CVDINFR4" "CVDCRHD4" "CVDSTRK3" "DIABETE3" "RFSMOK3"
# "FRTLT1" "VEGLT1"
data.raw <- data.2[,-c(1,14,17)]

# Does the classification match either of these:
# TOTINDA (Leisure time physical activities per month, 1=Yes, 2=No, 9=Don’t know/Refused/Missing)
# RFDRHV4 (Heavy alcohol consumption, 1=No, 2=Yes, 9=Don’t know/Refused/Missing)

hc = hclust(dist(data.raw), 'ave')
# the agglomeration method can be specified "ward.D", "ward.D2", "single", "complete", "average" (= UPGMA), "mcquitty" (= WPGMA), "median" (= WPGMC) or "centroid" (= UPGMC)

# (3) Plot clustering diagram
par (mfrow=c(1,1))
# very simple dendrogram
plot(hc)

summary(data.2$\$$TOTINDA); summary(data.2$\$$RFDRHV4)

cutree(hc, k = 2)
# alternatively specify the height, which is, the value of the criterion associated with the
# clustering method for the particular agglomeration -- cutree(hc, h= 10)

table(cutree(hc, h= 10)) # cluster distribution

# To identify the number of cases for varying number of clusters we can combine calls to cutree and table
# in a call to sapply -- to see the sizes of the clusters for 2≤ k≤10 cluster-solutions:
# numbClusters=4;
myClusters = sapply(2:5,function(numbClusters)table(cutree(hc, numbClusters)))
names(myClusters) <- paste("Number of Clusters=", 2:5, sep = "")
myClusters

#To see which SubjectIDs are in which clusters:
table(cutree(hc, k=2))
groups.k.2 <- cutree(hc, k = 2)
sapply(unique(groups.k.2),function(g)data.2$\$$ID[groups.k.2 == g])

#To see which TOTINDA (Leisure time physical activities per month, 1=Yes, 2=No, 9=Don’t
# know/Refused/Missing) & whch RFDRHV4 are in which clusters:
groups.k.3 <- cutree(hc, k = 3)
sapply(unique(groups.k.3),function(g)data.2$\$$TOTINDA [groups.k.3 == g])
sapply(unique(groups.k.3),function(g)data.2$\$$RFDRHV4[groups.k.3 == g])

# Perhaps there are intrinsically 3 groups here e.g., 1, 2 and 9 …
groups.k.3 <- cutree(hc, k = 3)
sapply(unique(groups.k.3),function(g)data.2$\$$TOTINDA [groups.k.3 == g])
sapply(unique(groups.k.3),function(g)data.2$\$$RFDRHV4 [groups.k.3 == g])

# Note that there is quite a dependence between the outcome variables …
plot(data.2$\$$RFDRHV4, data.2$\$$TOTINDA)

# drill down deeper
table(groups.k.3, data.2$\$$RFDRHV4)

# To characterize clusters we can look at cluster summary statistics,
# like the median, of the variables that were used to perform the cluster analysis broken down
# by the groups that the cluster analysis identified. The aggregate function will compute stats
# (e.g., median) on many variables simultaneously. To look at the median values for the variables
# we've used in the cluster analysis, broken up by the cluster groups:
aggregate(data.2, list(groups.k.3),median)

==See Next==
*[[SMHS_SciVisualization_NetworkViz|Next See the Complex Network Visualization section]]
*[[SMHS| Back to the Scientific Methods for Health Sciences EBook ToC]]

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_SciVisualization_SOCR_Excel_R_Charts}}

SMHS SciVisualization SOCR Excel R Charts

2016-05-23T13:30:23Z

Imoubara: /* Examples of powerful R interactive visualization packages */

==[[SMHS_SciVisualization| SMHS Scientific Visualization]] - SOCR, Excel and R charts ==

==SOCR Charts==

*URL: http://socr.umich.edu/html/cha/ (Java applet)

*About/List: http://wiki.stat.ucla.edu/socr/index.php/About_pages_for_SOCR_Chart_List

*Activities: http://wiki.stat.ucla.edu/socr/index.php/SOCR_EduMaterials_ChartsActivities

*Data: http://wiki.socr.umich.edu/index.php/SOCR_Data

<center>[[Image:SMHS_SciVisualization2.png|500px]] </center>

==Excel Charts==

MS Excel provides a large number of charts that can be used to quickly and effectively render complex multivariate data. For instance, the table below contains the principal component analysis (PCA) of 50 derived neuroimaging biomarkers (region of interest (ROI) by shape morphometry metric). The loadings of these 50 variables on the top 5 (most significant) principal component directions are shown in the table. Experiment with effective visualizations of these data.

<center>
{| class="wikitable" style="text-align:center; width:99%" border="1"
!Hemi||ROI||measure||ROI_Measure||Dim.1||Dim.2||Dim.3||Dim.4||Dim.5
|-
|L||insular||AvgMeanCurvature||L_insular_cortex_AvgMeanCurvature||0.72||0||0.06||0.06||0
|-
|L||insular||ComputeArea||L_insular_cortex_ComputeArea||0.77||0.06||0.04||0.01||0
|-
|L||insular||Volume||L_insular_cortex_Volume||0.72||0.09||0.04||0.03||0.01
|-
|L||insular||ShapeIndex||L_insular_cortex_ShapeIndex||0.46||0.06||0.01||0.02||0.01
|-
|L||insular||Curvedness||L_insular_cortex_Curvedness||0.78||0||0.05||0.03||0.01
|-
|R||insular||AvgMeanCurvature||R_insular_cortex_AvgMeanCurvature||0.79||0||0.03||0.08||0
|-
|R||insular||ComputeArea||R_insular_cortex_ComputeArea||0.79||0.09||0.03||0.01||0
|-
|R||insular||Volume||R_insular_cortex_Volume||0.73||0.11||0.03||0.03||0
|-
|R||insular||ShapeIndex||R_insular_cortex_ShapeIndex||0.27||0.17||0||0.07||0
|-
|R||insular||Curvedness||R_insular_cortex_Curvedness||0.84||0.02||0.03||0.01||0
|-
|L||cingulate||AvgMeanCurvature||L_cingulate_gyrus_AvgMeanCurvature||0.72||0||0.05||0.02||0.02
|-
|L||cingulate||ComputeArea||L_cingulate_gyrus_ComputeArea||0.74||0.05||0.06||0.04||0.01
|-
|L||cingulate||Volume||L_cingulate_gyrus_Volume||0.69||0.08||0.05||0.05||0.01
|-
|L||cingulate||ShapeIndex||L_cingulate_gyrus_ShapeIndex||0.53||0||0.05||0||0.03
|-
|L||cingulate||Curvedness||L_cingulate_gyrus_Curvedness||0.7||0.01||0.05||0.04||0.03
|-
|R||cingulate||AvgMeanCurvature||R_cingulate_gyrus_AvgMeanCurvature||0.6||0||0.02||0.03||0.01
|-
|R||cingulate||ComputeArea||R_cingulate_gyrus_ComputeArea||0.73||0.06||0.04||0.03||0.01
|-
|R||cingulate||Volume||R_cingulate_gyrus_Volume||0.68||0.09||0.04||0.04||0.01
|-
|R||cingulate||ShapeIndex||R_cingulate_gyrus_ShapeIndex||0.56||0.01||0.05||0||0.01
|-
|R||cingulate||Curvedness||R_cingulate_gyrus_Curvedness||0.25||0||0.01||0.04||0
|-
|L||caudate||AvgMeanCurvature||L_caudate_AvgMeanCurvature||0.52||0||0.05||0||0.01
|-
|L||caudate||ComputeArea||L_caudate_ComputeArea||0.51||0.09||0.03||0.04||0.02
|-
|L||caudate||Volume||L_caudate_Volume||0.44||0.09||0.03||0.06||0.03
|-
|L||caudate||ShapeIndex||L_caudate_ShapeIndex||0.2||0.03||0.04||0.04||0
|-
|L||caudate||Curvedness||L_caudate_Curvedness||0.51||0.12||0.02||0.01||0.01
|-
|R||caudate||AvgMeanCurvature||R_caudate_AvgMeanCurvature||0.68||0.04||0.04||0.02||0
|-
|R||caudate||ComputeArea||R_caudate_ComputeArea||0.67||0.17||0.03||0.02||0.01
|-
|R||caudate||Volume||R_caudate_Volume||0.61||0.16||0.02||0.03||0.01
|-
|R||caudate||ShapeIndex||R_caudate_ShapeIndex||0.18||0.02||0.03||0.11||0
|-
|R||caudate||Curvedness||R_caudate_Curvedness||0.65||0.19||0.01||0||0
|-
|L||putamen||AvgMeanCurvature||L_putamen_AvgMeanCurvature||0.62||0||0.04||0.03||0.02
|-
|L||putamen||ComputeArea||L_putamen_ComputeArea||0.56||0.05||0.04||0.03||0.05
|-
|L||putamen||Volume||L_putamen_Volume||0.52||0.07||0.04||0.05||0.05
|-
|L||putamen||ShapeIndex||L_putamen_ShapeIndex||0.06||0.13||0||0.15||0
|-
|L||putamen||Curvedness||L_putamen_Curvedness||0.64||0.11||0.03||0.01||0.03
|-
|R||putamen||AvgMeanCurvature||R_putamen_AvgMeanCurvature||0.62||0||0.07||0.04||0.01
|-
|R||putamen||ComputeArea||R_putamen_ComputeArea||0.66||0.08||0.03||0.01||0.03
|-
|R||putamen||Volume||R_putamen_Volume||0.64||0.12||0.03||0.02||0.03
|-
|R||putamen||ShapeIndex||R_putamen_ShapeIndex||0.15||0.24||0||0.08||0.03
|-
|R||putamen||Curvedness||R_putamen_Curvedness||0.65||0.05||0.05||0||0.02
|-
|L||hippocampus||AvgMeanCurvature||L_hippocampus_AvgMeanCurvature||0.78||0||0.01||0.04||0
|-
|L||hippocampus||ComputeArea||L_hippocampus_ComputeArea||0.75||0.07||0.01||0||0.02
|-
|L||hippocampus||Volume||L_hippocampus_Volume||0.72||0.09||0.01||0.01||0.01
|-
|L||hippocampus||ShapeIndex||L_hippocampus_ShapeIndex||0.45||0.17||0||0.04||0.02
|-
|L||hippocampus||Curvedness||L_hippocampus_Curvedness||0.79||0.03||0.01||0||0.02
|-
|R||hippocampus||AvgMeanCurvature||R_hippocampus_AvgMeanCurvature||0.72||0||0||0.1||0.01
|-
|R||hippocampus||ComputeArea||R_hippocampus_ComputeArea||0.71||0.09||0||0||0.05
|-
|R||hippocampus||Volume||R_hippocampus_Volume||0.68||0.1||0||0||0.04
|-
|R||hippocampus||ShapeIndex||R_hippocampus_ShapeIndex||0.37||0.18||0||0.02||0.03
|-
|R||hippocampus||Curvedness||R_hippocampus_Curvedness||0.77||0.03||0||0.02||0.04
|}
</center>

<center>[[Image:SMHS_SciVisualization3.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization4.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization5.png|500px]] </center>

==R-Charts==

There are 100’s of packages and 1,000 of different charts, plots and graphs that can be generated using R. Such interactive visualizations enable deeper exploration of data, models and results. JavaScript libraries, e.g., D3, provide advantages for data visualization as these involve HTML5 and are easily shareable online. The R community is developing R interfaces to some popular JavaScript libraries to allow users to create interactive visualizations without detailed knowledge of JavaScript.

===Examples of powerful R interactive visualization packages===

*ggplot2 – http://ggplot2.org

*ggvis – interactive plots extending the static ggplot2 charts, http://ggvis.rstudio.com

*rCharts – R interface to multiple JavaScript charting libraries, http://rcharts.io

*plotly – transforming ggplot2 charts into interactive plots, https://plot.ly/r

*googleVis – Google Charts using R, http://cran.r-project.org/web/packages/googleVis/vignettes/googleVis_examples.html

*HTMLWidgets
** leaflet – library for creating dynamic maps, supports panning and zooming, annotations, markers, polygons, etc. http://www.htmlwidgets.org/showcase_leaflet.html
** dygraphs – provides mechanism for charting time-series data, supports interactive navigation features including series/point highlighting, zooming, and panning, http://www.htmlwidgets.org/showcase_dygraphs.html
** networkD3 – library for creating D3 network graphs including force directed networks, Sankey diagrams, and Reingold-Tilford tree networks, http://www.htmlwidgets.org/showcase_networkD3.html
** DataTables – displays R matrices or data frames as interactive HTML tables that support filtering, pagination, and sorting, http://www.htmlwidgets.org/showcase_datatables.html
** Rthreejs – features 3D scatterplots and globes based on WebGL, http://www.htmlwidgets.org/showcase_threejs.html

*Other R graphic examples
** To write out plots out to file use:
# pdf() command all graphs are redirected to test.pdf. Also works with other common formats: jpeg, png, ps, tiff.
pdf("C:\\Users\\Dinov\\Desktop\\test.pdf"); plot(1:100, 1:100); dev.off()
# Generates Scalable Vector Graphics (SVG) that can be edited by vector graphics software
svg("test.svg"); plot(1:100, 1:100); dev.off()

===Paired ScatterPlots===

set.seed(100)
x <- matrix(runif(50), ncol=5, dimnames=list(letters[1:10], LETTERS[1:5]))
describe(x) # library("Hmisc")
plot(x[,1], x[,2], pch=20, col="red", main="Symbols and Labels")
text(x[,1]+0.03, x[,2], rownames(x))

<center>[[Image:SMHS_SciVisualization6.png|500px]] </center>

pairs(x)

<center>[[Image:SMHS_SciVisualization7.png|500px]] </center>

Another way to generate scatterplots is by using ggplot:

# library(ggplot2)
x <- sample(1:20, 20); y <- sample(1:20, 20); cat <- rep(c("A", "B", "C", "D"), 5)
#vs. cat <- rep(c("A", "B", "C", "D"), each=5)
plot.1 <- qplot(x, y, geom="point", size=5*x, color=cat, main="GGplot with Relative Dot Size and Color") + theme(legend.position = "topleft")
print(plot.1)

# Use Case-Studies: https://umich.instructure.com/courses/38100/files/folder/Case_Studies
# Case_03_MentalHealthServicesSurvey
# data1 <- read.table('https://umich.instructure.com/files/399128/download?download_frd=1&verifier=AG2e9QUKUm1jvDBpkX7D9jbEjKNc4irA0ECk0f7p', header=T)
head(data1)
attach(data1)
# library("Hmisc")
describe(data1)

plot(data1[,3], data1[,4], pch=20, col="red", main="Symbols and Labels")
# text(data1 [,3]+0.03, data1 [,4], rownames(data1))
plot.1 <- qplot(x, y, geom="point", size=5*x, color=cat, main="GGplot with Relative Dot Size and Color") + theme(legend.position = "topleft")
print(plot.1)

# redo plots using majorfundtype FacilityType Ownership Focus
# pairs(data1, na.action=na.omit)

<center>[[Image:SMHS_SciVisualization8.png|500px]] </center>

# Scatterplot with regression line. Use the “diamonds” dataset, which is a data frame with
# 53,940 rows and 10 variables ()
# describe(diamonds)

# Use Case-Studies: https://umich.instructure.com/courses/38100/files/folder/Case_Studies
# CaseStudy01_Divorce_YoungAdults
# data1 <- read.csv('https://umich.instructure.com/files/399118/download?download_frd=1&verifier=ESACv31KcyiHbkPZPuT8Oo4V7XzPtgTTbs6PQLTv', header=T)
attach(data1)
# plot variables: DIVYEAR momint dadint momclose depression livewithmom gethitched

set.seed(110)
# par(mfrow=c(1,2))
data.2 <- diamonds[sample(nrow(diamonds), 500), ]
plot.2 <- qplot(price, depth, data = data.2, geom = c("point", "smooth"), method = "lm")
plot.3 <- qplot(carat, price, data=data.2, geom=c("point", "smooth"), span=0.4)
print(plot.2); print(plot.3)

<center>[[Image:SMHS_SciVisualization9.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization10.png|500px]] </center>

===Barplots===

x <- matrix(runif(50), ncol=5, dimnames=list(letters[1:10], LETTERS[1:5]))
barplot(x[1:4,], ylim=c(0, max(x[1:4,])+0.3), beside=TRUE, legend.text = letters[1:4],
args.legend = list(x = "topleft"))
text(labels=round(as.vector(as.matrix(x[1:4,])),2), x=seq(1.5, 21, by=1) + sort(rep(c(0,1,2,3,4), 4)), y=as.vector(as.matrix(x[1:4,]))+0.1)

<center>[[Image:SMHS_SciVisualization11.png|500px]] </center>

# to put error bars on barplot:

# 10 rows (a, b, c, …):
bar <- barplot(m <- rowMeans(x) * 10, ylim=c(0, 10))
stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

# Case_04_ChildTrauma
# data1 <- read.table('https://umich.instructure.com/files/399129/download?download_frd=1&verifier=Hmv0YW2Kie5ZTV9CKBUNArSHR66f3GWSmVzZDBxc', header=T)
attach(data1)
head(x)
head(data1)
# plot data
data2 <- data1[,-5] # remove the 5th columns text
data1 <- data2[,-5] # remove the 6th columns text
# or data1 <- data1[,c(-5,-6)]

data2 <- as.data.frame(data1)
Blacks <- data2[which(data2$\$$race=="black"),]
Other <- data2[which(data2$\$$race=="other"),]
Hispanic <- data2[which(data2$\$$race=="hispanic"),]
White <- data2[which(data2$\$$race=="white"),]

A <- c(mean(Blacks$\$$age), mean(Blacks$\$$service))
#colnames(A) <- c("age "," service ")
B <- c(mean(Other$\$$age), mean(Other$\$$service))
C <- c(mean(Hispanic$\$$age), mean(Hispanic$\$$service))
D <- c(mean(White$\$$age), mean(White$\$$service))

x <- cbind(A, B, C, D)

bar <- barplot(x[1:2,], ylim=c(0, max(x[1:2,])+2.0), beside=TRUE,
legend.text = c("age","service") , args.legend = list(x = "right"))
text(labels=round(as.vector(as.matrix(x[1:2,])),2), x=seq(1.4, 21, by=1.5), #y=as.vector(as.matrix(x[1:2,]))+0.3)
y=11.5)

m <- x; stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

barplot(as.matrix(data1[1:4,]), ylim=c(0, max(data1[1:4,])+0.3), beside=TRUE, legend.text = data1[1:4,1], args.legend = list(x = "topleft"))
text(labels=round(as.vector(as.matrix(data1[1:4,])),2), x=seq(1.5, 21, by=1), y=as.vector(as.matrix(data1[1:4,]))+0.1)

<center>[[Image:SMHS_SciVisualization12.png|500px]] </center>

# Columns (A, B, C, D, E):
bar <- barplot(m <- colMeans(x) * 5, ylim=c(0, 5))
stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

<center>[[Image:SMHS_SciVisualization13.png|500px]] </center>

===Histograms and Density Plots===

hist(x, freq=TRUE, breaks=10)

<center>[[Image:SMHS_SciVisualization14.png|500px]] </center>

plot(density(x), lwd = 10, col="green")

<center>[[Image:SMHS_SciVisualization15.png|500px]] </center>

===Pie Chart===

# first , “A”, and second, “B”, columns
par (mfrow=c(1,2))
pie(x[,1], col=rainbow(length(x[,1]), start=0.1, end=0.8), clockwise=TRUE)

pie(x[,1], col=rainbow(length(x[,1]), start=0.1, end=0.8), clockwise=TRUE)

pie(x[,2], col=rainbow(length(x[,2]), start=0.1, end=0.8), clockwise=TRUE)
legend("topleft", legend=row.names(x), cex=1.3, bty="n", pch=15, pt.cex=1.8, col=rainbow(length(x[,2]), start=0.1, end=0.8), ncol=1)

<center>[[Image:SMHS_SciVisualization16.png|500px]] </center>

You can export the data:
write.table(x, " ", "data.txt")
# copy-paste it in SOCR Pie chart to generate another Pie view of data

===Line Plots Using ggplot===

head(diamonds)

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||Carat||Cut||Color||Clarity||Depth||Table||Price||X||Y||Z
|-
|1||0.23||Ideal||E||SI2||61.5||55||326||3.95||3.98||2.43
|-
|2||0.21||Premium||E||SI1||59.8||61||326||3.89||3.84||2.31
|-
|3||0.23||Good||E||VS1||56.9||65||237||4.05||4.07||2.31
|-
|4||0.29||Premium||I||VS2||62.4||58||334||4.2||4.23||2.63
|-
|5||0.31||Good||J||SI2||63.3||58||335||4.34||4.35||4.75
|-
|6||0.24||VeryGood||J||VVS2||62.8||57||336||3.94||3.96||2.48
|}
</center>

plot.2 <- ggplot(diamonds, aes(carat, price, group=cut, color=cut)) + geom_line()
print(plot.2)

<center>[[Image:SMHS_SciVisualization17.png|500px]] </center>

plot.2 <- ggplot(data1, aes(age, service, group=race, color=race)) + geom_line()
print(plot.2)

# Faceting plot (geometrically, faceting (or facetting) is the process of removing parts of a polygon, polyhedron or polytope, without creating any new vertices)
plot.3 <- ggplot(diamonds, aes(carat, price)) + geom_line(aes(color=cut), size=1) +
facet_wrap(~cut, ncol=1)
print(plot.3)

<center>[[Image:SMHS_SciVisualization18.png|500px]] </center>

===Barplots with ggplot===

plot.4 <- ggplot(diamonds, aes(cut, fill=cut)) + geom_bar() + facet_grid(. ~ clarity)
print(plot.4)

<center>[[Image:SMHS_SciVisualization19.png|500px]] </center>

New_var <- service+rnorm(1000, 0,1)
data1$\$$New_var <- int(New_var)
plot.4 <- ggplot(data1, aes(race, fill= traumatype)) + geom_bar() + facet_grid(. ~ New_var)
print(plot.4)

plot.4a <- ggplot(diamonds, aes(color, price/carat, fill=color)) + geom_boxplot()
print(plot.4a)

<center>[[Image:SMHS_SciVisualization20.png|500px]] </center>

===Jitter plot===

plot.5 <- ggplot(diamonds, aes(color, price/carat)) + geom_jitter(alpha = I(1 / 2), aes(color=color))
print(plot.5)

<center>[[Image:SMHS_SciVisualization21.png|500px]] </center>

===Density Plots===

plot.6 <- ggplot(diamonds, aes(carat, size=2)) + geom_density(aes(color = cut))
print(plot.6)

<center>[[Image:SMHS_SciVisualization22.png|500px]] </center>

plot.6 <- ggplot(data1, aes(age, size=2)) + geom_density(aes(color = traumatype))
print(plot.6)

plot.7 <- ggplot(diamonds, aes(carat, size=2)) + geom_density(aes(fill = color))
print(plot.7)

<center>[[Image:SMHS_SciVisualization23.png|500px]] </center>

plot.8 <- ggplot(diamonds, aes(x=carat, size=1)) + geom_histogram(aes(y = price), binwidth=0.2) + geom_density()
print(plot.8)

<center>[[Image:SMHS_SciVisualization24.png|500px]] </center>

plot.8a <- ggplot(diamonds, aes(x=carat, size=1)) + geom_histogram(aes(y = price), stat="identity") + geom_density()
print(plot.8a)

<center>[[Image:SMHS_SciVisualization25.png|500px]] </center>

===Heatmaps===

# Generating Dendogram Association Heatmap Plot (Genotype vs. Imaging phenotype)
# http://stat.ethz.ch/R-manual/R-patched/library/stats/html/heatmap.html
# http://www.ncbi.nlm.nih.gov/pmc/articles/PMC4005931/

AD_Associations_Data <- read.table("https://umich.instructure.com/files/330387/download?download_frd=1&verifier=gLk2ADgrLhXGeknI6mqIeJugi2ODr8RARsQlBUMe", header=TRUE, row.names=1, sep=",", dec=".")

MCI_Associations_Data <- read.table("https://umich.instructure.com/files/330390/download?download_frd=1&verifier=FczlJD6ISRPZhu69xvHuoZHx2c7gXX9YEvvPCTBG", header=TRUE, row.names=1, sep=",", dec=".")

NC_Associations_Data <- read.table("https://umich.instructure.com/files/330391/download?download_frd=1&verifier=i2BEtSpmpbrzQUPoA2ST06IzzcaenyVEHRepHSF3", header=TRUE, row.names=1, sep=",", dec=".")

require(graphics)
require(grDevices)
library(gplots)

AD_Data <- AD_Associations_Data
MCI_Data <- MCI_Associations_Data
NC_Data <- NC_Associations_Data

AD_mat <- as.matrix(AD_Data); class(AD_mat) <- "numeric"
MCI_mat <- as.matrix(MCI_Data); class(MCI_mat) <- "numeric"
NC_mat <- as.matrix(NC_Data); class(NC_mat) <- "numeric"

# set up the rol (rc) and column (cc) colors for each cohort
rcAD <- rainbow(nrow(AD_mat), start = 0, end = 1.0); ccAD<-rainbow(ncol(AD_mat), start = 0, end = 1.0)
rcMCI <- rainbow(nrow(MCI_mat), start = 0, end=1.0); ccMCI<-rainbow(ncol(MCI_mat),start=0,end=1.0)
rcNC <- rainbow(nrow(NC_mat), start = 0, end = 1.0); ccNC<-rainbow(ncol(NC_mat), start = 0, end = 1.0)

# set up 1x3 graph display - par (mfrow=c(1,3)) – does not work with ‘heatmap’
hvAD <- heatmap(AD_mat, col = cm.colors(256), scale = "column", RowSideColors = rcAD, ColSideColors = ccAD, margins = c(2,2), main="AD Cohort SNP-ROI_volume Association (p_values)")
hvMCI <- heatmap(MCI_mat, col = cm.colors(256), scale = "column", RowSideColors = rcMCI, ColSideColors = ccMCI, margins = c(2,2), main="MCI Cohort SNP-ROI_volume Association (p_values)")
hvNC <- heatmap(NC_mat, col = cm.colors(256), scale = "column", RowSideColors = rcNC, ColSideColors = ccNC, margins = c(2,2), main="NC Cohort SNP-ROI_volume Association (p_values)")

<center>[[Image:SMHS_SciVisualization26.png|500px]] </center>

# Alternatively, we can use the R package gplots
install.packages("gplots")
library(gplots)
## col dendrogram plotted and col reordering done.
# heatmap.2(AD_mat, keysize=2)
## A more decorative heatmap, with z-score scaling along columns
heatmap.2(AD_mat, col=cm.colors(255), scale="column", RowSideColors=rcAD, ColSideColors=ccAD, margin=c(8, 7), xlab="Imaging Biomarkers (ROI volume)", ylab= "Genetics Biomarkers (SNPs)", main="AD Associations Heatmap (SNP-Imaging)", tracecol="green", density="density")

<center>[[Image:SMHS_SciVisualization27.png|500px]] </center>

===Correlation Plots===

The corrplot package is a graphical display of a correlation matrix and confidence intervals, with some tools for matrix reordering. There are seven visualization methods (parameter method) in corrplot package, named "circle", "square", "ellipse", "number", "shade", "color", "pie".
# install.packages("corrplot")
library(corrplot)
NC_Associations_Data <- read.table("https://umich.instructure.com/files/330391/download?download_frd=1&verifier=i2BEtSpmpbrzQUPoA2ST06IzzcaenyVEHRepHSF3", header=TRUE, row.names=1, sep=",", dec=".")
M <- cor(NC_Associations_Data)

<center>[[Image:SMHS_SciVisualization28.png|500px]] </center>

===Hyperbolic Visualization===

*URL: http://socr.umich.edu/html/Navigators.html

*Tools:

** Java/Jar applet: http://socr.umich.edu/html/navigators/HW/jars/SOCR_HW_Viewer.jar

** JavaScript: http://socr.umich.edu/html/navigators/D3/SOCR_D3_Viewer.html (JSON)

*Data Format

** XML data: http://socr.umich.edu/html/navigators/HW/SOCR_HyperTree.xml

** JSON data: http://socr.umich.edu/html/navigators/D3/xml/SOCR_HyperTree.json

*D3 Visualization

** E:\Ivo.dir\Research\UMichigan\Education_Teaching_Curricula\2015_2016\HS_853_Fall_2015\Modules_docx\Tools\TreeViewer_JS

** treeJS.json

** flareD3.json

<center>[[Image:SMHS_SciVisualization29.png|400px]] </center>

<center>[[Image:SMHS_SciVisualization30.png|400px]] </center>

*URL: https://github.com/mbostock/d3/wiki/Gallery

*Source code: https://github.com/mbostock/d3

<center>[[Image:SMHS_SciVisualization31.png|400px]] </center>

===Motion Charts===

*Video: http://www.socr.ucla.edu/SOCR_MotionCharts/SOCR_HTML5_MotionChart_Video2.gif

*Java: http://www.socr.ucla.edu/SOCR_MotionCharts/

*HTML5: http://socr.umich.edu/HTML5/MotionChart/

*Activities: http://wiki.socr.umich.edu/index.php/SOCR_MotionCharts

<center>[[Image:SMHS_SciVisualization32.png|500px]] </center>

===1D/2D/3D signal/area/volume/surface/model/atlas visualization===

*1D: (See R/SOCR Visualization tools above)

*2D: http://imagej.nih.gov/ij/

*3D: http://socr.umich.edu/HTML5/BrainViewer/

Supported File Formats:
Volumes (.nii / .nii.gz / .img&.hdr / .mgh / .mgz / .nrrd)
Shapes (.dx / .vtk / .stl / FreeSurfer)
Fibers (.trk)

<center>[[Image:SMHS_SciVisualization33.png|500px]] </center>

===Trees and Graphs===

*Trees/Hierarchies and general Graphs

# Install and load the APE package, needed for the phylogenetic tree rendering (as.phylo)
# install.packages("ape")
library("ape")

Load data

# Data: 02_Nof1_Data.csv
data.1 <- read.table("https://umich.instructure.com/files/330385/download?download_frd=1&verifier=DwJUGSd6t24dvK7uYmzA2aDyzlmsohyaK6P7jK0Q ", sep=",", header = TRUE)
head(data.1)

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
mydata1
|-
|||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0

|}
</center>

Clustering

hc = hclust(dist(data.1), 'ave')
# the agglomeration method can be specified "ward.D", "ward.D2", "single","complete", "average" (= UPGMA), "mcquitty" (= WPGMA),"median" (= WPGMC) or "centroid" (= UPGMC)

# (3) Plot clustering diagram
par (mfrow=c(1,1))
# very simple dendrogram
plot(hc)

<center>[[Image:SMHS_SciVisualization34.png|500px]] </center>

require(graphics)
(x <- identify(hc)) ## Terminate with 2nd mouse button !!
identify(hc, function(k) print(table(data.1[k,5])))

You can now cut the tree into branches. You can split the tree into 2 groups, by setting the number of cuts with the k=2 parameter, or by specifying height to cut the tree at (?cutree):

k- an integer scalar or vector with the desired number of groups

h- numeric scalar or vector with heights where the tree should be cut

cutree(hc, k = 2)
# alternatively specify the height, which is, the value of the criterion associated with the clustering method
# for the particular agglomeration.
cutree(hc, h= 50) # cut at h=50
table(cutree(hc, h= 50)) # cluster distribution
# To identify the number of cases for varying number of clusters we can combine calls to cutree and table
# in a call to sapply -- to see the sizes of the clusters for 2≤ k≤10 cluster-solutions:
# numbClusters=5;
myClusters = sapply(2:10,function(numbClusters)table(cutree(hc, numbClusters)))
names(myClusters) <- paste("Number of Clusters=", 2:10, sep = "")
myClusters
#To see which SubjectIDs are in which clusters:
groups.10 <- cutree(hc, k = 10)
sapply(unique(groups.10),function(g)data.1$\$$ID[groups.10 == g])
#To see which Treatments (Tx) are in which clusters:
groups.2 <- cutree(hc, k = 2)
sapply(unique(groups.2),function(g)data.1$\$$Tx[groups.2 == g])
# drill down deeper
table(groups.2, data.1$\$$Tx)
# For a small number of observations, we can often interpret the cluster solution directly by looking
# at the labels of the observations that are in each cluster.
# This is hard for larger data sets. To characterize clusters we can look at cluster summary statistics,
# like the median, of the variables that were used to perform the cluster analysis broken down
# by the groups that the cluster analysis identified.

The aggregate function will compute stats (e.g., median) on many variables simultaneously.

To look at the median values for the variables we've used in the cluster analysis, broken up by the cluster groups:

aggregate(data.1, list(groups.10),median) # may have to shrink data.1 prior to clustering!
# data.2 <- data.1[,-c(1,3)] # Remove ID and Tx variables?
aggregate(data.2, list(groups.2),median) # for only 2 clusters

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Group||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||14||16||0||20||-5||-0.040||2.995||3.275||0.275||41
|-
|2||2||16||15||1||25||0||0.025||3.280||3.360||0.360||104

|}
</center>

table(groups.2, data.1$\$$PhyAct)

# library("Hmisc")

describe(data.1$\$$PhyAct)

# It’s useful to add the numbers of observations in each group (aggregate returns a data frame,
# that can be manipulated)

df.2 <- aggregate(data.1, list(groups.2),median)

data.frame(Cluster= df.2[,1], Freq=as.vector(table(groups.2)), df.2[,-1])

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Cluster||Freq||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||570||14||16||0||20||-5||-0.040||2.995||3.275||0.275||41
|-
|2||2||330||16||15||1||25||0||0.025||3.280||3.360||0.360||104

|}
</center>

===Publications===

*This paper examines nasal and bronchial tissue cultures as appropriate in vitro models for the assessment of smoking-induced adverse effects in the respiratory system (doi: 10.1177/1091581814551647), using “hclust” package. No data.

*This paper classified subtypes of gastric cancer based on epidemiologic and histologic and gene expression data. These new classifications of gastric cancer have implications for improving our understanding of disease biology and identification of unique molecular drivers for each gastric cancer subtype (doi: 10.1158/1078-0432.CCR-10-2203).

Repeat the clustering

# using centroids and squared Euclidean distance
# cut the tree into 10 clusters and reconstruct the upper part of the tree from the cluster centers.
hc <- hclust(dist(data.1), "cen")
mem <- cutree(hc, k = 10)
cent <- NULL
for(k in 1:10){
cent <- rbind(cent, colMeans(data.1[mem == k, , drop = FALSE]))
}

hc1 <- hclust(dist(cent), method = "cen", members = table(mem))

opar <- par(mfrow = c(1, 2))
plot(hc, labels = FALSE, hang = -1, main = "Original Tree")
plot(hc1, hang = -1, main = "Re-start from 10 clusters")
par(opar)

<center>[[Image:SMHS_SciVisualization35.png|500px]] </center>

Identify subjects within each of the 10 classes

rect.hclust(hc, h=10)

# To save the cluster numbers to a new variable in the dataset, use the cutree function.
# data.1$\$$clusterID <- cutree(hc, 10)
data.1$\$$clusterID <- cutree(hc, 10)
head(data.1)

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct||CluserID
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53||1
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73||1
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23||2
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36||2
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21||2
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0||2

|}
</center>

Phylogenetic tree diagram

# library("ape")
plot(as.phylo(hc1), use.edge.length = TRUE, type = "fan")
plot(as.phylo(hc), use.edge.length = TRUE, type = "fan", tip.color = hsv(runif(15, 0.65, 0.95), 1, 1, 0.7), label.offset = 1, cex = log(data.1$\$$ID, 10), col = "red")

<center>[[Image:SMHS_SciVisualization36.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization37.png|500px]] </center>

===Hands-on Activity (Health Behavior Risks)===

# load data CaseStudy09_HealthBehaviorRisks_Data
data.2 <- read.csv("https://umich.instructure.com/files/399182/download?download_frd=1 ", sep=",", header = TRUE)

# Classify the cases using these variables: "AGE_G" "SEX" "RACEGR3" "IMPEDUC" "IMPMRTL"
# "EMPLOY1" "INCOMG" "CVDINFR4" "CVDCRHD4" "CVDSTRK3" "DIABETE3" "RFSMOK3"
# "FRTLT1" "VEGLT1"
data.raw <- data.2[,-c(1,14,17)]

# Does the classification match either of these:
# TOTINDA (Leisure time physical activities per month, 1=Yes, 2=No, 9=Don’t know/Refused/Missing)
# RFDRHV4 (Heavy alcohol consumption, 1=No, 2=Yes, 9=Don’t know/Refused/Missing)

hc = hclust(dist(data.raw), 'ave')
# the agglomeration method can be specified "ward.D", "ward.D2", "single", "complete", "average" (= UPGMA), "mcquitty" (= WPGMA), "median" (= WPGMC) or "centroid" (= UPGMC)

# (3) Plot clustering diagram
par (mfrow=c(1,1))
# very simple dendrogram
plot(hc)

summary(data.2$\$$TOTINDA); summary(data.2$\$$RFDRHV4)

cutree(hc, k = 2)
# alternatively specify the height, which is, the value of the criterion associated with the
# clustering method for the particular agglomeration -- cutree(hc, h= 10)

table(cutree(hc, h= 10)) # cluster distribution

# To identify the number of cases for varying number of clusters we can combine calls to cutree and table
# in a call to sapply -- to see the sizes of the clusters for 2≤ k≤10 cluster-solutions:
# numbClusters=4;
myClusters = sapply(2:5,function(numbClusters)table(cutree(hc, numbClusters)))
names(myClusters) <- paste("Number of Clusters=", 2:5, sep = "")
myClusters

#To see which SubjectIDs are in which clusters:
table(cutree(hc, k=2))
groups.k.2 <- cutree(hc, k = 2)
sapply(unique(groups.k.2),function(g)data.2$\$$ID[groups.k.2 == g])

#To see which TOTINDA (Leisure time physical activities per month, 1=Yes, 2=No, 9=Don’t
# know/Refused/Missing) & whch RFDRHV4 are in which clusters:
groups.k.3 <- cutree(hc, k = 3)
sapply(unique(groups.k.3),function(g)data.2$\$$TOTINDA [groups.k.3 == g])
sapply(unique(groups.k.3),function(g)data.2$\$$RFDRHV4[groups.k.3 == g])

# Perhaps there are intrinsically 3 groups here e.g., 1, 2 and 9 …
groups.k.3 <- cutree(hc, k = 3)
sapply(unique(groups.k.3),function(g)data.2$\$$TOTINDA [groups.k.3 == g])
sapply(unique(groups.k.3),function(g)data.2$\$$RFDRHV4 [groups.k.3 == g])

# Note that there is quite a dependence between the outcome variables …
plot(data.2$\$$RFDRHV4, data.2$\$$TOTINDA)

# drill down deeper
table(groups.k.3, data.2$\$$RFDRHV4)

# To characterize clusters we can look at cluster summary statistics,
# like the median, of the variables that were used to perform the cluster analysis broken down
# by the groups that the cluster analysis identified. The aggregate function will compute stats
# (e.g., median) on many variables simultaneously. To look at the median values for the variables
# we've used in the cluster analysis, broken up by the cluster groups:
aggregate(data.2, list(groups.k.3),median)

==See Next==
*[[SMHS_SciVisualization_NetworkViz|Next See the Complex Network Visualization section]]
*[[SMHS| Back to the Scientific Methods for Health Sciences EBook ToC]]

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_SciVisualization_SOCR_Excel_R_Charts}}

SMHS SciVisualization SOCR Excel R Charts

2016-05-23T13:29:51Z

Imoubara:

==[[SMHS_SciVisualization| SMHS Scientific Visualization]] - SOCR, Excel and R charts ==

==SOCR Charts==

*URL: http://socr.umich.edu/html/cha/ (Java applet)

*About/List: http://wiki.stat.ucla.edu/socr/index.php/About_pages_for_SOCR_Chart_List

*Activities: http://wiki.stat.ucla.edu/socr/index.php/SOCR_EduMaterials_ChartsActivities

*Data: http://wiki.socr.umich.edu/index.php/SOCR_Data

<center>[[Image:SMHS_SciVisualization2.png|500px]] </center>

==Excel Charts==

MS Excel provides a large number of charts that can be used to quickly and effectively render complex multivariate data. For instance, the table below contains the principal component analysis (PCA) of 50 derived neuroimaging biomarkers (region of interest (ROI) by shape morphometry metric). The loadings of these 50 variables on the top 5 (most significant) principal component directions are shown in the table. Experiment with effective visualizations of these data.

<center>
{| class="wikitable" style="text-align:center; width:99%" border="1"
!Hemi||ROI||measure||ROI_Measure||Dim.1||Dim.2||Dim.3||Dim.4||Dim.5
|-
|L||insular||AvgMeanCurvature||L_insular_cortex_AvgMeanCurvature||0.72||0||0.06||0.06||0
|-
|L||insular||ComputeArea||L_insular_cortex_ComputeArea||0.77||0.06||0.04||0.01||0
|-
|L||insular||Volume||L_insular_cortex_Volume||0.72||0.09||0.04||0.03||0.01
|-
|L||insular||ShapeIndex||L_insular_cortex_ShapeIndex||0.46||0.06||0.01||0.02||0.01
|-
|L||insular||Curvedness||L_insular_cortex_Curvedness||0.78||0||0.05||0.03||0.01
|-
|R||insular||AvgMeanCurvature||R_insular_cortex_AvgMeanCurvature||0.79||0||0.03||0.08||0
|-
|R||insular||ComputeArea||R_insular_cortex_ComputeArea||0.79||0.09||0.03||0.01||0
|-
|R||insular||Volume||R_insular_cortex_Volume||0.73||0.11||0.03||0.03||0
|-
|R||insular||ShapeIndex||R_insular_cortex_ShapeIndex||0.27||0.17||0||0.07||0
|-
|R||insular||Curvedness||R_insular_cortex_Curvedness||0.84||0.02||0.03||0.01||0
|-
|L||cingulate||AvgMeanCurvature||L_cingulate_gyrus_AvgMeanCurvature||0.72||0||0.05||0.02||0.02
|-
|L||cingulate||ComputeArea||L_cingulate_gyrus_ComputeArea||0.74||0.05||0.06||0.04||0.01
|-
|L||cingulate||Volume||L_cingulate_gyrus_Volume||0.69||0.08||0.05||0.05||0.01
|-
|L||cingulate||ShapeIndex||L_cingulate_gyrus_ShapeIndex||0.53||0||0.05||0||0.03
|-
|L||cingulate||Curvedness||L_cingulate_gyrus_Curvedness||0.7||0.01||0.05||0.04||0.03
|-
|R||cingulate||AvgMeanCurvature||R_cingulate_gyrus_AvgMeanCurvature||0.6||0||0.02||0.03||0.01
|-
|R||cingulate||ComputeArea||R_cingulate_gyrus_ComputeArea||0.73||0.06||0.04||0.03||0.01
|-
|R||cingulate||Volume||R_cingulate_gyrus_Volume||0.68||0.09||0.04||0.04||0.01
|-
|R||cingulate||ShapeIndex||R_cingulate_gyrus_ShapeIndex||0.56||0.01||0.05||0||0.01
|-
|R||cingulate||Curvedness||R_cingulate_gyrus_Curvedness||0.25||0||0.01||0.04||0
|-
|L||caudate||AvgMeanCurvature||L_caudate_AvgMeanCurvature||0.52||0||0.05||0||0.01
|-
|L||caudate||ComputeArea||L_caudate_ComputeArea||0.51||0.09||0.03||0.04||0.02
|-
|L||caudate||Volume||L_caudate_Volume||0.44||0.09||0.03||0.06||0.03
|-
|L||caudate||ShapeIndex||L_caudate_ShapeIndex||0.2||0.03||0.04||0.04||0
|-
|L||caudate||Curvedness||L_caudate_Curvedness||0.51||0.12||0.02||0.01||0.01
|-
|R||caudate||AvgMeanCurvature||R_caudate_AvgMeanCurvature||0.68||0.04||0.04||0.02||0
|-
|R||caudate||ComputeArea||R_caudate_ComputeArea||0.67||0.17||0.03||0.02||0.01
|-
|R||caudate||Volume||R_caudate_Volume||0.61||0.16||0.02||0.03||0.01
|-
|R||caudate||ShapeIndex||R_caudate_ShapeIndex||0.18||0.02||0.03||0.11||0
|-
|R||caudate||Curvedness||R_caudate_Curvedness||0.65||0.19||0.01||0||0
|-
|L||putamen||AvgMeanCurvature||L_putamen_AvgMeanCurvature||0.62||0||0.04||0.03||0.02
|-
|L||putamen||ComputeArea||L_putamen_ComputeArea||0.56||0.05||0.04||0.03||0.05
|-
|L||putamen||Volume||L_putamen_Volume||0.52||0.07||0.04||0.05||0.05
|-
|L||putamen||ShapeIndex||L_putamen_ShapeIndex||0.06||0.13||0||0.15||0
|-
|L||putamen||Curvedness||L_putamen_Curvedness||0.64||0.11||0.03||0.01||0.03
|-
|R||putamen||AvgMeanCurvature||R_putamen_AvgMeanCurvature||0.62||0||0.07||0.04||0.01
|-
|R||putamen||ComputeArea||R_putamen_ComputeArea||0.66||0.08||0.03||0.01||0.03
|-
|R||putamen||Volume||R_putamen_Volume||0.64||0.12||0.03||0.02||0.03
|-
|R||putamen||ShapeIndex||R_putamen_ShapeIndex||0.15||0.24||0||0.08||0.03
|-
|R||putamen||Curvedness||R_putamen_Curvedness||0.65||0.05||0.05||0||0.02
|-
|L||hippocampus||AvgMeanCurvature||L_hippocampus_AvgMeanCurvature||0.78||0||0.01||0.04||0
|-
|L||hippocampus||ComputeArea||L_hippocampus_ComputeArea||0.75||0.07||0.01||0||0.02
|-
|L||hippocampus||Volume||L_hippocampus_Volume||0.72||0.09||0.01||0.01||0.01
|-
|L||hippocampus||ShapeIndex||L_hippocampus_ShapeIndex||0.45||0.17||0||0.04||0.02
|-
|L||hippocampus||Curvedness||L_hippocampus_Curvedness||0.79||0.03||0.01||0||0.02
|-
|R||hippocampus||AvgMeanCurvature||R_hippocampus_AvgMeanCurvature||0.72||0||0||0.1||0.01
|-
|R||hippocampus||ComputeArea||R_hippocampus_ComputeArea||0.71||0.09||0||0||0.05
|-
|R||hippocampus||Volume||R_hippocampus_Volume||0.68||0.1||0||0||0.04
|-
|R||hippocampus||ShapeIndex||R_hippocampus_ShapeIndex||0.37||0.18||0||0.02||0.03
|-
|R||hippocampus||Curvedness||R_hippocampus_Curvedness||0.77||0.03||0||0.02||0.04
|}
</center>

<center>[[Image:SMHS_SciVisualization3.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization4.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization5.png|500px]] </center>

==R-Charts==

There are 100’s of packages and 1,000 of different charts, plots and graphs that can be generated using R. Such interactive visualizations enable deeper exploration of data, models and results. JavaScript libraries, e.g., D3, provide advantages for data visualization as these involve HTML5 and are easily shareable online. The R community is developing R interfaces to some popular JavaScript libraries to allow users to create interactive visualizations without detailed knowledge of JavaScript.

===Examples of powerful R interactive visualization packages===

*ggplot2 – http://ggplot2.org

*ggvis – interactive plots extending the static ggplot2 charts, http://ggvis.rstudio.com

*rCharts – R interface to multiple JavaScript charting libraries, http://rcharts.io

*plotly – transforming ggplot2 charts into interactive plots, https://plot.ly/r

*googleVis – Google Charts using R, http://cran.r-project.org/web/packages/googleVis/vignettes/googleVis_examples.html

*HTMLWidgets

** leaflet – library for creating dynamic maps, supports panning and zooming, annotations, markers, polygons, etc. http://www.htmlwidgets.org/showcase_leaflet.html

** dygraphs – provides mechanism for charting time-series data, supports interactive navigation features including series/point highlighting, zooming, and panning, http://www.htmlwidgets.org/showcase_dygraphs.html

** networkD3 – library for creating D3 network graphs including force directed networks, Sankey diagrams, and Reingold-Tilford tree networks, http://www.htmlwidgets.org/showcase_networkD3.html

** DataTables – displays R matrices or data frames as interactive HTML tables that support filtering, pagination, and sorting, http://www.htmlwidgets.org/showcase_datatables.html

** Rthreejs – features 3D scatterplots and globes based on WebGL, http://www.htmlwidgets.org/showcase_threejs.html

*Other R graphic examples
** To write out plots out to file use:
# pdf() command all graphs are redirected to test.pdf. Also works with other common formats: jpeg, png, ps, tiff.
pdf("C:\\Users\\Dinov\\Desktop\\test.pdf"); plot(1:100, 1:100); dev.off()
# Generates Scalable Vector Graphics (SVG) that can be edited by vector graphics software
svg("test.svg"); plot(1:100, 1:100); dev.off()

===Paired ScatterPlots===

set.seed(100)
x <- matrix(runif(50), ncol=5, dimnames=list(letters[1:10], LETTERS[1:5]))
describe(x) # library("Hmisc")
plot(x[,1], x[,2], pch=20, col="red", main="Symbols and Labels")
text(x[,1]+0.03, x[,2], rownames(x))

<center>[[Image:SMHS_SciVisualization6.png|500px]] </center>

pairs(x)

<center>[[Image:SMHS_SciVisualization7.png|500px]] </center>

Another way to generate scatterplots is by using ggplot:

# library(ggplot2)
x <- sample(1:20, 20); y <- sample(1:20, 20); cat <- rep(c("A", "B", "C", "D"), 5)
#vs. cat <- rep(c("A", "B", "C", "D"), each=5)
plot.1 <- qplot(x, y, geom="point", size=5*x, color=cat, main="GGplot with Relative Dot Size and Color") + theme(legend.position = "topleft")
print(plot.1)

# Use Case-Studies: https://umich.instructure.com/courses/38100/files/folder/Case_Studies
# Case_03_MentalHealthServicesSurvey
# data1 <- read.table('https://umich.instructure.com/files/399128/download?download_frd=1&verifier=AG2e9QUKUm1jvDBpkX7D9jbEjKNc4irA0ECk0f7p', header=T)
head(data1)
attach(data1)
# library("Hmisc")
describe(data1)

plot(data1[,3], data1[,4], pch=20, col="red", main="Symbols and Labels")
# text(data1 [,3]+0.03, data1 [,4], rownames(data1))
plot.1 <- qplot(x, y, geom="point", size=5*x, color=cat, main="GGplot with Relative Dot Size and Color") + theme(legend.position = "topleft")
print(plot.1)

# redo plots using majorfundtype FacilityType Ownership Focus
# pairs(data1, na.action=na.omit)

<center>[[Image:SMHS_SciVisualization8.png|500px]] </center>

# Scatterplot with regression line. Use the “diamonds” dataset, which is a data frame with
# 53,940 rows and 10 variables ()
# describe(diamonds)

# Use Case-Studies: https://umich.instructure.com/courses/38100/files/folder/Case_Studies
# CaseStudy01_Divorce_YoungAdults
# data1 <- read.csv('https://umich.instructure.com/files/399118/download?download_frd=1&verifier=ESACv31KcyiHbkPZPuT8Oo4V7XzPtgTTbs6PQLTv', header=T)
attach(data1)
# plot variables: DIVYEAR momint dadint momclose depression livewithmom gethitched

set.seed(110)
# par(mfrow=c(1,2))
data.2 <- diamonds[sample(nrow(diamonds), 500), ]
plot.2 <- qplot(price, depth, data = data.2, geom = c("point", "smooth"), method = "lm")
plot.3 <- qplot(carat, price, data=data.2, geom=c("point", "smooth"), span=0.4)
print(plot.2); print(plot.3)

<center>[[Image:SMHS_SciVisualization9.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization10.png|500px]] </center>

===Barplots===

x <- matrix(runif(50), ncol=5, dimnames=list(letters[1:10], LETTERS[1:5]))
barplot(x[1:4,], ylim=c(0, max(x[1:4,])+0.3), beside=TRUE, legend.text = letters[1:4],
args.legend = list(x = "topleft"))
text(labels=round(as.vector(as.matrix(x[1:4,])),2), x=seq(1.5, 21, by=1) + sort(rep(c(0,1,2,3,4), 4)), y=as.vector(as.matrix(x[1:4,]))+0.1)

<center>[[Image:SMHS_SciVisualization11.png|500px]] </center>

# to put error bars on barplot:

# 10 rows (a, b, c, …):
bar <- barplot(m <- rowMeans(x) * 10, ylim=c(0, 10))
stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

# Case_04_ChildTrauma
# data1 <- read.table('https://umich.instructure.com/files/399129/download?download_frd=1&verifier=Hmv0YW2Kie5ZTV9CKBUNArSHR66f3GWSmVzZDBxc', header=T)
attach(data1)
head(x)
head(data1)
# plot data
data2 <- data1[,-5] # remove the 5th columns text
data1 <- data2[,-5] # remove the 6th columns text
# or data1 <- data1[,c(-5,-6)]

data2 <- as.data.frame(data1)
Blacks <- data2[which(data2$\$$race=="black"),]
Other <- data2[which(data2$\$$race=="other"),]
Hispanic <- data2[which(data2$\$$race=="hispanic"),]
White <- data2[which(data2$\$$race=="white"),]

A <- c(mean(Blacks$\$$age), mean(Blacks$\$$service))
#colnames(A) <- c("age "," service ")
B <- c(mean(Other$\$$age), mean(Other$\$$service))
C <- c(mean(Hispanic$\$$age), mean(Hispanic$\$$service))
D <- c(mean(White$\$$age), mean(White$\$$service))

x <- cbind(A, B, C, D)

bar <- barplot(x[1:2,], ylim=c(0, max(x[1:2,])+2.0), beside=TRUE,
legend.text = c("age","service") , args.legend = list(x = "right"))
text(labels=round(as.vector(as.matrix(x[1:2,])),2), x=seq(1.4, 21, by=1.5), #y=as.vector(as.matrix(x[1:2,]))+0.3)
y=11.5)

m <- x; stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

barplot(as.matrix(data1[1:4,]), ylim=c(0, max(data1[1:4,])+0.3), beside=TRUE, legend.text = data1[1:4,1], args.legend = list(x = "topleft"))
text(labels=round(as.vector(as.matrix(data1[1:4,])),2), x=seq(1.5, 21, by=1), y=as.vector(as.matrix(data1[1:4,]))+0.1)

<center>[[Image:SMHS_SciVisualization12.png|500px]] </center>

# Columns (A, B, C, D, E):
bar <- barplot(m <- colMeans(x) * 5, ylim=c(0, 5))
stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

<center>[[Image:SMHS_SciVisualization13.png|500px]] </center>

===Histograms and Density Plots===

hist(x, freq=TRUE, breaks=10)

<center>[[Image:SMHS_SciVisualization14.png|500px]] </center>

plot(density(x), lwd = 10, col="green")

<center>[[Image:SMHS_SciVisualization15.png|500px]] </center>

===Pie Chart===

# first , “A”, and second, “B”, columns
par (mfrow=c(1,2))
pie(x[,1], col=rainbow(length(x[,1]), start=0.1, end=0.8), clockwise=TRUE)

pie(x[,1], col=rainbow(length(x[,1]), start=0.1, end=0.8), clockwise=TRUE)

pie(x[,2], col=rainbow(length(x[,2]), start=0.1, end=0.8), clockwise=TRUE)
legend("topleft", legend=row.names(x), cex=1.3, bty="n", pch=15, pt.cex=1.8, col=rainbow(length(x[,2]), start=0.1, end=0.8), ncol=1)

<center>[[Image:SMHS_SciVisualization16.png|500px]] </center>

You can export the data:
write.table(x, " ", "data.txt")
# copy-paste it in SOCR Pie chart to generate another Pie view of data

===Line Plots Using ggplot===

head(diamonds)

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||Carat||Cut||Color||Clarity||Depth||Table||Price||X||Y||Z
|-
|1||0.23||Ideal||E||SI2||61.5||55||326||3.95||3.98||2.43
|-
|2||0.21||Premium||E||SI1||59.8||61||326||3.89||3.84||2.31
|-
|3||0.23||Good||E||VS1||56.9||65||237||4.05||4.07||2.31
|-
|4||0.29||Premium||I||VS2||62.4||58||334||4.2||4.23||2.63
|-
|5||0.31||Good||J||SI2||63.3||58||335||4.34||4.35||4.75
|-
|6||0.24||VeryGood||J||VVS2||62.8||57||336||3.94||3.96||2.48
|}
</center>

plot.2 <- ggplot(diamonds, aes(carat, price, group=cut, color=cut)) + geom_line()
print(plot.2)

<center>[[Image:SMHS_SciVisualization17.png|500px]] </center>

plot.2 <- ggplot(data1, aes(age, service, group=race, color=race)) + geom_line()
print(plot.2)

# Faceting plot (geometrically, faceting (or facetting) is the process of removing parts of a polygon, polyhedron or polytope, without creating any new vertices)
plot.3 <- ggplot(diamonds, aes(carat, price)) + geom_line(aes(color=cut), size=1) +
facet_wrap(~cut, ncol=1)
print(plot.3)

<center>[[Image:SMHS_SciVisualization18.png|500px]] </center>

===Barplots with ggplot===

plot.4 <- ggplot(diamonds, aes(cut, fill=cut)) + geom_bar() + facet_grid(. ~ clarity)
print(plot.4)

<center>[[Image:SMHS_SciVisualization19.png|500px]] </center>

New_var <- service+rnorm(1000, 0,1)
data1$\$$New_var <- int(New_var)
plot.4 <- ggplot(data1, aes(race, fill= traumatype)) + geom_bar() + facet_grid(. ~ New_var)
print(plot.4)

plot.4a <- ggplot(diamonds, aes(color, price/carat, fill=color)) + geom_boxplot()
print(plot.4a)

<center>[[Image:SMHS_SciVisualization20.png|500px]] </center>

===Jitter plot===

plot.5 <- ggplot(diamonds, aes(color, price/carat)) + geom_jitter(alpha = I(1 / 2), aes(color=color))
print(plot.5)

<center>[[Image:SMHS_SciVisualization21.png|500px]] </center>

===Density Plots===

plot.6 <- ggplot(diamonds, aes(carat, size=2)) + geom_density(aes(color = cut))
print(plot.6)

<center>[[Image:SMHS_SciVisualization22.png|500px]] </center>

plot.6 <- ggplot(data1, aes(age, size=2)) + geom_density(aes(color = traumatype))
print(plot.6)

plot.7 <- ggplot(diamonds, aes(carat, size=2)) + geom_density(aes(fill = color))
print(plot.7)

<center>[[Image:SMHS_SciVisualization23.png|500px]] </center>

plot.8 <- ggplot(diamonds, aes(x=carat, size=1)) + geom_histogram(aes(y = price), binwidth=0.2) + geom_density()
print(plot.8)

<center>[[Image:SMHS_SciVisualization24.png|500px]] </center>

plot.8a <- ggplot(diamonds, aes(x=carat, size=1)) + geom_histogram(aes(y = price), stat="identity") + geom_density()
print(plot.8a)

<center>[[Image:SMHS_SciVisualization25.png|500px]] </center>

===Heatmaps===

# Generating Dendogram Association Heatmap Plot (Genotype vs. Imaging phenotype)
# http://stat.ethz.ch/R-manual/R-patched/library/stats/html/heatmap.html
# http://www.ncbi.nlm.nih.gov/pmc/articles/PMC4005931/

AD_Associations_Data <- read.table("https://umich.instructure.com/files/330387/download?download_frd=1&verifier=gLk2ADgrLhXGeknI6mqIeJugi2ODr8RARsQlBUMe", header=TRUE, row.names=1, sep=",", dec=".")

MCI_Associations_Data <- read.table("https://umich.instructure.com/files/330390/download?download_frd=1&verifier=FczlJD6ISRPZhu69xvHuoZHx2c7gXX9YEvvPCTBG", header=TRUE, row.names=1, sep=",", dec=".")

NC_Associations_Data <- read.table("https://umich.instructure.com/files/330391/download?download_frd=1&verifier=i2BEtSpmpbrzQUPoA2ST06IzzcaenyVEHRepHSF3", header=TRUE, row.names=1, sep=",", dec=".")

require(graphics)
require(grDevices)
library(gplots)

AD_Data <- AD_Associations_Data
MCI_Data <- MCI_Associations_Data
NC_Data <- NC_Associations_Data

AD_mat <- as.matrix(AD_Data); class(AD_mat) <- "numeric"
MCI_mat <- as.matrix(MCI_Data); class(MCI_mat) <- "numeric"
NC_mat <- as.matrix(NC_Data); class(NC_mat) <- "numeric"

# set up the rol (rc) and column (cc) colors for each cohort
rcAD <- rainbow(nrow(AD_mat), start = 0, end = 1.0); ccAD<-rainbow(ncol(AD_mat), start = 0, end = 1.0)
rcMCI <- rainbow(nrow(MCI_mat), start = 0, end=1.0); ccMCI<-rainbow(ncol(MCI_mat),start=0,end=1.0)
rcNC <- rainbow(nrow(NC_mat), start = 0, end = 1.0); ccNC<-rainbow(ncol(NC_mat), start = 0, end = 1.0)

# set up 1x3 graph display - par (mfrow=c(1,3)) – does not work with ‘heatmap’
hvAD <- heatmap(AD_mat, col = cm.colors(256), scale = "column", RowSideColors = rcAD, ColSideColors = ccAD, margins = c(2,2), main="AD Cohort SNP-ROI_volume Association (p_values)")
hvMCI <- heatmap(MCI_mat, col = cm.colors(256), scale = "column", RowSideColors = rcMCI, ColSideColors = ccMCI, margins = c(2,2), main="MCI Cohort SNP-ROI_volume Association (p_values)")
hvNC <- heatmap(NC_mat, col = cm.colors(256), scale = "column", RowSideColors = rcNC, ColSideColors = ccNC, margins = c(2,2), main="NC Cohort SNP-ROI_volume Association (p_values)")

<center>[[Image:SMHS_SciVisualization26.png|500px]] </center>

# Alternatively, we can use the R package gplots
install.packages("gplots")
library(gplots)
## col dendrogram plotted and col reordering done.
# heatmap.2(AD_mat, keysize=2)
## A more decorative heatmap, with z-score scaling along columns
heatmap.2(AD_mat, col=cm.colors(255), scale="column", RowSideColors=rcAD, ColSideColors=ccAD, margin=c(8, 7), xlab="Imaging Biomarkers (ROI volume)", ylab= "Genetics Biomarkers (SNPs)", main="AD Associations Heatmap (SNP-Imaging)", tracecol="green", density="density")

<center>[[Image:SMHS_SciVisualization27.png|500px]] </center>

===Correlation Plots===

The corrplot package is a graphical display of a correlation matrix and confidence intervals, with some tools for matrix reordering. There are seven visualization methods (parameter method) in corrplot package, named "circle", "square", "ellipse", "number", "shade", "color", "pie".
# install.packages("corrplot")
library(corrplot)
NC_Associations_Data <- read.table("https://umich.instructure.com/files/330391/download?download_frd=1&verifier=i2BEtSpmpbrzQUPoA2ST06IzzcaenyVEHRepHSF3", header=TRUE, row.names=1, sep=",", dec=".")
M <- cor(NC_Associations_Data)

<center>[[Image:SMHS_SciVisualization28.png|500px]] </center>

===Hyperbolic Visualization===

*URL: http://socr.umich.edu/html/Navigators.html

*Tools:

** Java/Jar applet: http://socr.umich.edu/html/navigators/HW/jars/SOCR_HW_Viewer.jar

** JavaScript: http://socr.umich.edu/html/navigators/D3/SOCR_D3_Viewer.html (JSON)

*Data Format

** XML data: http://socr.umich.edu/html/navigators/HW/SOCR_HyperTree.xml

** JSON data: http://socr.umich.edu/html/navigators/D3/xml/SOCR_HyperTree.json

*D3 Visualization

** E:\Ivo.dir\Research\UMichigan\Education_Teaching_Curricula\2015_2016\HS_853_Fall_2015\Modules_docx\Tools\TreeViewer_JS

** treeJS.json

** flareD3.json

<center>[[Image:SMHS_SciVisualization29.png|400px]] </center>

<center>[[Image:SMHS_SciVisualization30.png|400px]] </center>

*URL: https://github.com/mbostock/d3/wiki/Gallery

*Source code: https://github.com/mbostock/d3

<center>[[Image:SMHS_SciVisualization31.png|400px]] </center>

===Motion Charts===

*Video: http://www.socr.ucla.edu/SOCR_MotionCharts/SOCR_HTML5_MotionChart_Video2.gif

*Java: http://www.socr.ucla.edu/SOCR_MotionCharts/

*HTML5: http://socr.umich.edu/HTML5/MotionChart/

*Activities: http://wiki.socr.umich.edu/index.php/SOCR_MotionCharts

<center>[[Image:SMHS_SciVisualization32.png|500px]] </center>

===1D/2D/3D signal/area/volume/surface/model/atlas visualization===

*1D: (See R/SOCR Visualization tools above)

*2D: http://imagej.nih.gov/ij/

*3D: http://socr.umich.edu/HTML5/BrainViewer/

Supported File Formats:
Volumes (.nii / .nii.gz / .img&.hdr / .mgh / .mgz / .nrrd)
Shapes (.dx / .vtk / .stl / FreeSurfer)
Fibers (.trk)

<center>[[Image:SMHS_SciVisualization33.png|500px]] </center>

===Trees and Graphs===

*Trees/Hierarchies and general Graphs

# Install and load the APE package, needed for the phylogenetic tree rendering (as.phylo)
# install.packages("ape")
library("ape")

Load data

# Data: 02_Nof1_Data.csv
data.1 <- read.table("https://umich.instructure.com/files/330385/download?download_frd=1&verifier=DwJUGSd6t24dvK7uYmzA2aDyzlmsohyaK6P7jK0Q ", sep=",", header = TRUE)
head(data.1)

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
mydata1
|-
|||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0

|}
</center>

Clustering

hc = hclust(dist(data.1), 'ave')
# the agglomeration method can be specified "ward.D", "ward.D2", "single","complete", "average" (= UPGMA), "mcquitty" (= WPGMA),"median" (= WPGMC) or "centroid" (= UPGMC)

# (3) Plot clustering diagram
par (mfrow=c(1,1))
# very simple dendrogram
plot(hc)

<center>[[Image:SMHS_SciVisualization34.png|500px]] </center>

require(graphics)
(x <- identify(hc)) ## Terminate with 2nd mouse button !!
identify(hc, function(k) print(table(data.1[k,5])))

You can now cut the tree into branches. You can split the tree into 2 groups, by setting the number of cuts with the k=2 parameter, or by specifying height to cut the tree at (?cutree):

k- an integer scalar or vector with the desired number of groups

h- numeric scalar or vector with heights where the tree should be cut

cutree(hc, k = 2)
# alternatively specify the height, which is, the value of the criterion associated with the clustering method
# for the particular agglomeration.
cutree(hc, h= 50) # cut at h=50
table(cutree(hc, h= 50)) # cluster distribution
# To identify the number of cases for varying number of clusters we can combine calls to cutree and table
# in a call to sapply -- to see the sizes of the clusters for 2≤ k≤10 cluster-solutions:
# numbClusters=5;
myClusters = sapply(2:10,function(numbClusters)table(cutree(hc, numbClusters)))
names(myClusters) <- paste("Number of Clusters=", 2:10, sep = "")
myClusters
#To see which SubjectIDs are in which clusters:
groups.10 <- cutree(hc, k = 10)
sapply(unique(groups.10),function(g)data.1$\$$ID[groups.10 == g])
#To see which Treatments (Tx) are in which clusters:
groups.2 <- cutree(hc, k = 2)
sapply(unique(groups.2),function(g)data.1$\$$Tx[groups.2 == g])
# drill down deeper
table(groups.2, data.1$\$$Tx)
# For a small number of observations, we can often interpret the cluster solution directly by looking
# at the labels of the observations that are in each cluster.
# This is hard for larger data sets. To characterize clusters we can look at cluster summary statistics,
# like the median, of the variables that were used to perform the cluster analysis broken down
# by the groups that the cluster analysis identified.

The aggregate function will compute stats (e.g., median) on many variables simultaneously.

To look at the median values for the variables we've used in the cluster analysis, broken up by the cluster groups:

aggregate(data.1, list(groups.10),median) # may have to shrink data.1 prior to clustering!
# data.2 <- data.1[,-c(1,3)] # Remove ID and Tx variables?
aggregate(data.2, list(groups.2),median) # for only 2 clusters

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Group||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||14||16||0||20||-5||-0.040||2.995||3.275||0.275||41
|-
|2||2||16||15||1||25||0||0.025||3.280||3.360||0.360||104

|}
</center>

table(groups.2, data.1$\$$PhyAct)

# library("Hmisc")

describe(data.1$\$$PhyAct)

# It’s useful to add the numbers of observations in each group (aggregate returns a data frame,
# that can be manipulated)

df.2 <- aggregate(data.1, list(groups.2),median)

data.frame(Cluster= df.2[,1], Freq=as.vector(table(groups.2)), df.2[,-1])

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Cluster||Freq||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||570||14||16||0||20||-5||-0.040||2.995||3.275||0.275||41
|-
|2||2||330||16||15||1||25||0||0.025||3.280||3.360||0.360||104

|}
</center>

===Publications===

*This paper examines nasal and bronchial tissue cultures as appropriate in vitro models for the assessment of smoking-induced adverse effects in the respiratory system (doi: 10.1177/1091581814551647), using “hclust” package. No data.

*This paper classified subtypes of gastric cancer based on epidemiologic and histologic and gene expression data. These new classifications of gastric cancer have implications for improving our understanding of disease biology and identification of unique molecular drivers for each gastric cancer subtype (doi: 10.1158/1078-0432.CCR-10-2203).

Repeat the clustering

# using centroids and squared Euclidean distance
# cut the tree into 10 clusters and reconstruct the upper part of the tree from the cluster centers.
hc <- hclust(dist(data.1), "cen")
mem <- cutree(hc, k = 10)
cent <- NULL
for(k in 1:10){
cent <- rbind(cent, colMeans(data.1[mem == k, , drop = FALSE]))
}

hc1 <- hclust(dist(cent), method = "cen", members = table(mem))

opar <- par(mfrow = c(1, 2))
plot(hc, labels = FALSE, hang = -1, main = "Original Tree")
plot(hc1, hang = -1, main = "Re-start from 10 clusters")
par(opar)

<center>[[Image:SMHS_SciVisualization35.png|500px]] </center>

Identify subjects within each of the 10 classes

rect.hclust(hc, h=10)

# To save the cluster numbers to a new variable in the dataset, use the cutree function.
# data.1$\$$clusterID <- cutree(hc, 10)
data.1$\$$clusterID <- cutree(hc, 10)
head(data.1)

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct||CluserID
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53||1
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73||1
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23||2
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36||2
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21||2
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0||2

|}
</center>

Phylogenetic tree diagram

# library("ape")
plot(as.phylo(hc1), use.edge.length = TRUE, type = "fan")
plot(as.phylo(hc), use.edge.length = TRUE, type = "fan", tip.color = hsv(runif(15, 0.65, 0.95), 1, 1, 0.7), label.offset = 1, cex = log(data.1$\$$ID, 10), col = "red")

<center>[[Image:SMHS_SciVisualization36.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization37.png|500px]] </center>

===Hands-on Activity (Health Behavior Risks)===

# load data CaseStudy09_HealthBehaviorRisks_Data
data.2 <- read.csv("https://umich.instructure.com/files/399182/download?download_frd=1 ", sep=",", header = TRUE)

# Classify the cases using these variables: "AGE_G" "SEX" "RACEGR3" "IMPEDUC" "IMPMRTL"
# "EMPLOY1" "INCOMG" "CVDINFR4" "CVDCRHD4" "CVDSTRK3" "DIABETE3" "RFSMOK3"
# "FRTLT1" "VEGLT1"
data.raw <- data.2[,-c(1,14,17)]

# Does the classification match either of these:
# TOTINDA (Leisure time physical activities per month, 1=Yes, 2=No, 9=Don’t know/Refused/Missing)
# RFDRHV4 (Heavy alcohol consumption, 1=No, 2=Yes, 9=Don’t know/Refused/Missing)

hc = hclust(dist(data.raw), 'ave')
# the agglomeration method can be specified "ward.D", "ward.D2", "single", "complete", "average" (= UPGMA), "mcquitty" (= WPGMA), "median" (= WPGMC) or "centroid" (= UPGMC)

# (3) Plot clustering diagram
par (mfrow=c(1,1))
# very simple dendrogram
plot(hc)

summary(data.2$\$$TOTINDA); summary(data.2$\$$RFDRHV4)

cutree(hc, k = 2)
# alternatively specify the height, which is, the value of the criterion associated with the
# clustering method for the particular agglomeration -- cutree(hc, h= 10)

table(cutree(hc, h= 10)) # cluster distribution

# To identify the number of cases for varying number of clusters we can combine calls to cutree and table
# in a call to sapply -- to see the sizes of the clusters for 2≤ k≤10 cluster-solutions:
# numbClusters=4;
myClusters = sapply(2:5,function(numbClusters)table(cutree(hc, numbClusters)))
names(myClusters) <- paste("Number of Clusters=", 2:5, sep = "")
myClusters

#To see which SubjectIDs are in which clusters:
table(cutree(hc, k=2))
groups.k.2 <- cutree(hc, k = 2)
sapply(unique(groups.k.2),function(g)data.2$\$$ID[groups.k.2 == g])

#To see which TOTINDA (Leisure time physical activities per month, 1=Yes, 2=No, 9=Don’t
# know/Refused/Missing) & whch RFDRHV4 are in which clusters:
groups.k.3 <- cutree(hc, k = 3)
sapply(unique(groups.k.3),function(g)data.2$\$$TOTINDA [groups.k.3 == g])
sapply(unique(groups.k.3),function(g)data.2$\$$RFDRHV4[groups.k.3 == g])

# Perhaps there are intrinsically 3 groups here e.g., 1, 2 and 9 …
groups.k.3 <- cutree(hc, k = 3)
sapply(unique(groups.k.3),function(g)data.2$\$$TOTINDA [groups.k.3 == g])
sapply(unique(groups.k.3),function(g)data.2$\$$RFDRHV4 [groups.k.3 == g])

# Note that there is quite a dependence between the outcome variables …
plot(data.2$\$$RFDRHV4, data.2$\$$TOTINDA)

# drill down deeper
table(groups.k.3, data.2$\$$RFDRHV4)

# To characterize clusters we can look at cluster summary statistics,
# like the median, of the variables that were used to perform the cluster analysis broken down
# by the groups that the cluster analysis identified. The aggregate function will compute stats
# (e.g., median) on many variables simultaneously. To look at the median values for the variables
# we've used in the cluster analysis, broken up by the cluster groups:
aggregate(data.2, list(groups.k.3),median)

==See Next==
*[[SMHS_SciVisualization_NetworkViz|Next See the Complex Network Visualization section]]
*[[SMHS| Back to the Scientific Methods for Health Sciences EBook ToC]]

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_SciVisualization_SOCR_Excel_R_Charts}}

SMHS SciVisualization

2016-05-23T13:26:04Z

Imoubara:

==[[SMHS| Scientific Methods for Health Sciences]] - Scientific Visualization ==

===Questions===

*How and why should we “look” at data?
*What data characteristics are important for exploratory data analytics (EDAs)?

Scientific Data-driven or Simulation-driven visualization methods may be classified in many alternative ways. Visualization techniques can be classified according to many criteria:

<center>[[Image:SMHS_SciVisualization1.png|500px]] </center>

*Data Type: structured/unstructured, small/large, complete/incomplete, time/space, ascii/binary, Euclidean/non-Euclidean, etc.

*Task type: Task type is one of the aspects considered in classification of visualization techniques, which provides means of interaction between the researcher, the data and the display software/platform

*Scalability: Visualization techniques are subject to some limitations, such as the amount of data that a particular technique can exhibit

*Dimensionality: Visualization techniques can also be classified according to the number of attributes

*Positioning and Attributes: the distribution of attributes on the chart may affect the interpretation of the display representation, e.g., correlation analysis, where the relative distance among the plotted attributes is relevant for observation

*Investigative Need: the specific scientific question or exploratory interest may also determine the type of visualization:
** Examining the composition of the data
** Exploring the distribution of the data
** Contrasting or comparing several data elements, relations, association
** Unsupervised exploratory data mining

http://www.socr.umich.edu/CSCD/html/Cores/Macore2/SciViz.html

==[[SMHS_SciVisualization_SOCR_Excel_R_Charts|SOCR, Excel and R Charts]]==

==[[SMHS_SciVisualization_NetworkViz|Complex Network Visualization]]==

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_SciVisualization}}

SMHS MethodsHeterogeneity CER

2016-05-23T13:24:50Z

Imoubara:

==[[SMHS_MethodsHeterogeneity| Methods for Studying Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research]] - Comparative Effectiveness Research (CER) ==

===Overview===

==Observational Studies: Tips for the CER Practitioners==

*Different study types can offer different understandings; neither should be discounted without closer examination.

*RCTs provide an accurate understanding of the effect of a particular intervention in a well-defined patient group under “controlled” circumstances.

*Observational studies provide an understanding of real-world care and its impact, but can be biased due to uncontrolled factors.

*Observational studies differ in the types of databases used. These databases may lack clinical detail and contain incomplete or inaccurate data.

*Before accepting the findings from an observational study, consider whether confounding factors may have influenced the results.

*In this scenario, subgroup analysis was vital in clarifying both study designs; what is true for the many (e.g., overall, estrogen appeared to be detrimental) may not be true for the few (e.g., that for the younger post-menopausal woman, the benefits were greater and the harms less frequent).

*Carefully examine the generalizability of the study. Do the study’s patients and intervention match those under consideration?

*Observational studies can identify associations but cannot prove cause-and-effect relationships.

===Case-Study 1: The Cetuximab Study===

What was done and what was found?

Cetuximab, an anti-epidermal growth factor receptor (EGFR) agent, has recently been added to the therapeutic armamentarium. Two important CRTs examined its impact in patients with mCRC (metastatic-stage Colorectal cancer). In the first one, 56 centers in 11 European countries investigated the outcomes associated with cetuximab therapy in 329 mCRC patients who experienced disease progression either on irinotecan therapy or within 3 months thereafter. The study reported that the group on a combination of irinotecan and cetuximab had a significantly higher rate of overall response to treatment (primary endpoint) than the group on cetuximab alone: 22.9% (95% CI, 17.5-29.1%) vs. 10.8% (95% CI, 5.7-18.1%) (P=0.007), respectively. Similarly, the median time to progression was significantly longer in the combination therapy group (4.1 vs. 1.5 months, P<0.001). As these patients had already progressed on irinotecan prior to the study, any response was viewed as positive. Safety between the two treatment arms was similar: approximately 80% of patients in each arm experienced a rash. Grade 3 or 4 (the more severe) toxic effects on the skin were slightly more frequent in the combination-therapy group compared to cetuximab monotherapy, observed in 9.4% and 5.2% of participants, respectively. Other side effects, such as diarrhea and neutropenia observed in the combination-therapy arm, were considered to be in the range expected for irinotecan alone. Data from this study demonstrated the efficacy and safety of cetuximab and were instrumental in the FDA’s 2004 approval.

A second CRT (2007) examined 572 patients and suggested efficacy of cetuximab in the treatment of mCRC. This study was a randomized, non-blinded, controlled trial that examined cetuximab monotherapy plus best supportive care compared to best supportive care alone in patients who had received and failed prior chemotherapy regimens. It reported that median overall survival (the primary endpoint) was significantly higher in patients receiving cetuximab plus best supportive care compared to best supportive care alone (6.1 vs. 4.6 months, respectively) (hazard ratio for death=0.77; 95% CI: 0.64- 0.92, P=0.005). This RCT described a greater incidence of adverse events in the cetuximab plus best supportive care group compared to best supportive care alone including (most significantly) rash, as well as edema, fatigue, nausea and vomiting.

Was this the right answer?

These RCTs had fairly broad enrollment criteria and the cetuximab benefits were modest. Emerging scientific theories raised the possibility that genetically defined population subsets might experience a greater-than-average treatment benefit. One such area of inquiry entailed examining “biomarkers,” or genetic indicators of a patient’s greater response to therapy. Even as the above RCTs were being conducted, data emerged showing the importance of the KRAS gene.

Emerging Data

Based on the emerging biochemical evidence that the epidermal growth factor receptor (EGFR) treatment mechanism (Cetuximab) was even more finely detailed than previously understood, the study authors of the 2007 RCT undertook a retrospective subgroup analysis using tumor tissue samples preserved from their initial study. Following laboratory analysis, all viable tissue samples were classified as having a wild-type (non-mutated) or a mutated KRAS gene. Instead of the previous two study arms (cetuximab plus best supportive care vs. best supportive care alone), there were 4 for this new analysis: each of the two original study arms was further divided by wild-type vs. mutated KRAS status. Laboratory evaluation determined that 40.9% and 42.3% of all patients in the RCT had a KRAS mutation in the cetuximab plus best supportive care group compared to the best supportive care group alone, respectively. The efficacy of cetuximab was found to be significantly correlated with KRAS status: in patients with wild-type (non-mutated). KRAS genes, cetuximab plus best supportive care compared to best supportive care alone improved overall survival (median 9.5 vs. 4.8 months, respectively; hazard ratio for death=0.55; 95% CI, 0.41-0.74, P<0.001), and progression-free survival (median 3.7 vs. 1.9 months, respectively; hazard ratio for progression or death=0.40; 95% CI, 0.30-0.54, P<0.001). Meanwhile, in patients with mutated KRAS tumors, the authors found no significant difference in outcome between cetuximab plus best supportive care vs. best supportive care alone.

What next?

Based on these and similar results from other studies, the FDA narrowed its product labeling in July 2009 to indicate that cetuximab is not recommended for mCRC patients with mutated KRAS tumors. This distinction reduces the relevant population by approximately 40%. Similarly, the American society of Clinical oncology released a provisional clinical recommendation that all mCRC patients have their tumors tested for KRAS status before receiving anti-EGFR therapy. The benefits of targeted treatment are many. Patients who previously underwent cetuximab therapy without knowing their genetic predisposition would no longer have to be exposed to the drug’s toxic effects if unnecessary, as the efficacy of cetuximab is markedly higher in the genetically defined appropriate patients. In a less-uncertain environment, clinicians can be more confident in advocating a course of action in their care of patients. And finally, knowledge that targeted therapy is possible suggests the potential for further innovation in treatment options. In fact, research continues to demonstrate options for targeted cetuximab treatment of mCRC at an even finer scale than seen with KRAS; and similar genetic targeting is being investigated, and advocated, in other cancer types.

Lessons Learned From this case Study

Although RCTs are generally viewed as the gold standard, results of one or even a series of trials may not accurately reflect the benefits experienced by an individual patient. This case-study suggests that cetuximab initially appeared to have rather modest clinical benefits. Albeit, new information that became available and subsequent genetic subgroup assessments led to very different conclusions. Clinicians should be aware that the current knowledge is likely to evolve and any decisions about patient care should be carefully considered with that sense of uncertainty in mind. As in this case study, subgroup analyses (e.g., genetic subtypes) need a theoretical rationale. Ideally, the analyses should be determined at the time of original RCT design and should not just occur as explorations of the subsequent data. When improperly employed, post hoc analyses may lead to incorrect patient care conclusions.

RCTs Tips for the CER Practitioners

*RCTs can determine whether an intervention can provide benefit in a very controlled environment.

*The controlled nature of an RCT may limit its generalizability to a broader population.

*No results are permanent; advances in scientific knowledge and understanding can influence how we view the effectiveness (or safety) of a therapeutic intervention.

*Targeted therapy illuminated by carefully thought out subgroup analyses can improve the efficacious and safe use of an intervention.

===Case-Study 2: The Rosiglitazone Study===

Meta-analysis

Often the results for the same intervention differ across clinical trials and it may not be clear whether one therapy provides more benefit than another. As CER increases and more studies are conducted, clinicians and policymakers are more likely to encounter this scenario. In a systematic review, a researcher identifies similar studies and displays their results in a table, enabling qualitative comparisons across the studies. With a meta-analysis, the data from included studies are statistically combined into a single “result.” Merging the data from a number of studies increases the effective sample size of the investigation, providing a statistically stronger conclusion about the body of research. By so doing, investigators may detect low frequency events and demonstrate more subtle distinctions between therapeutic alternatives.

When studies have been properly identified and combined, the meta-analysis produces a summary estimate of the findings and a confidence interval that can serve as a benchmark in medical opinion and practice. However, when done incorrectly, the quantitative and statistical analysis can create impressive “numbers” but biased results. The following are important criteria for properly conducted meta-analyses:

1. Carefully defining unbiased inclusion or exclusion criteria for study selection

2. Including only those studies that have similar design elements, such as patient population, drug regimen, outcomes being assessed, and time-frame

3. Applying correct statistical methods to combine and analyze the data

Reporting this information is essential for the reader to determine whether the data were suitable to combine, and if the meta-analysis draws unbiased conclusions. Meta-analyses of randomized clinical trials are considered to be the highest level of medical evidence as they are based upon a synthesis of rigorously controlled trials that systematically reduce bias and confounding. This technique is useful in summarizing available evidence and will likely become more common in the era of publicly funded comparative effectiveness research. The following case study will examine several key principles that will be useful as the reader encounters these publications.

Clinical Application

Heart disease is the leading cause of mortality in the United States, resulting in approximately 20% of all deaths. Diabetics are particularly susceptible to heart disease, with more than 65% of deaths attributable to it. The nonfatal complications of diabetes are wide-ranging and include kidney failure, nerve damage, amputation, stroke and blindness, among other outcomes. In 2007, the total estimated cost of diabetes in the United States was $174B; $116B was derived from direct medical expenditures and the rest from the indirect cost of lost productivity due to the disease. With such serious health effects and heavy direct and indirect costs tied to diabetes, proper disease management is critical. Historically, diabetes treatment has focused on strict blood sugar control, assuming that this goal not only targets diabetes but also reduces other serious comorbidities of the disease.

Anti-diabetic agents have long been associated with key questions as to their benefits/risks in the treatment of diabetes. The sulfonylurea tolbutamide, a first generation anti-diabetic drug, was found in a landmark study in the 1970s to significantly increase the CV mortality rate compared to patients not on this agent. Further analysis by external parties concluded that the methods employed in this trial were significantly flawed (e.g., use of an “arbitrary” definition of diabetes status, heterogeneous baseline characteristics of the populations studied, and incorrect statistical methods). Since these early studies, CV concerns continue to be an issue with selected oral hypoglycemic agents that have subsequently entered the marketplace.

A class of drugs, thiazolidinedione (TZD), was approved in the late 1990s, as a solution to the problems associated with the older generation of sulfonylureas. Rosiglitazone, a member of the TZD class, was approved by the FDA in 1999 and was widely prescribed for the treatment of type-2 diabetes. A number of RCTs supported the benefit of rosiglitazone as an important new oral antidiabetic agent. However, safety concerns developed as the FDA received reports of adverse cardiac events potentially associated with rosiglitazone. It was in this setting that a meta-analysis by Nissen and Wolski was published in the New England Journal of Medicine in June 2007.

What was done?

Nissen and Wolski conducted a meta-analysis examining the impact of rosiglitazone on cardiac events and mortality compared to alternative therapeutic approaches. The study began with a broad search to locate potential studies for review. The authors screened published phase II, III, and IV trials; the FDA website; and the drug manufacturer’s clinical-trial registry for applicable data relating to rosiglitazone use. When the initial search was complete, the studies were further categorized by pre-stated inclusion criteria. Meta-analysis inclusion criteria were simple: studies had to include rosiglitazone and a randomized comparator group treated with either another drug or placebo, study arms had to show similar length of treatment, and all groups had to have received more than 24 weeks of exposure to the study drugs. The studies had to contain outcome data of interest including the rate of myocardial infarction (MI) or death from all CV causes. Out of 116 studies surveyed by the authors, 42 met their inclusion criteria and were included in the meta-analysis. Of the studies they included, 23 had durations of 26 weeks or less, and only five studies followed patients for more than a year. Until this point, the study’s authors were following a path similar to that of any reviewer interested in CV outcomes, examining the results of these 42 studies and comparing them qualitatively. Quantitatively combining the data, however, required the authors to make choices about the studies they could merge and the statistical methods they should apply for analysis. Those decisions greatly influenced the results that were reported.

What was found?

When the studies were combined, the meta-analysis contained data from 15,565 patients in the rosiglitazone group and 12,282 patients as comparators. Analyzing their data, the authors chose one particular statistical method (the Peto odds ratio method, a fixed-effect statistical approach), which calculates the odds of events occurring where the outcomes of interest are rare and small in number. In comparing rosiglitazone with a “control” group that included other drugs or placebo, the authors reported odds ratios of 1.43 (95% CI, 1.03-1.98; P=0.03) and 1.64 (95% CI,
0.98-2.74; P=0.06) for MI and death from CV causes, respectively. In other words, the odds of an MI or death from a CV cause are higher for rosiglitazone patients than for patients on other therapies or placebo. The authors reported that rosiglitazone was significantly associated with an increase in the risk of MI and had borderline significance in increasing the risk of death from all CV causes. These findings appeared online on the same day that the FDA issued a safety alert regarding rosiglitazone. Discussion of the meta-analysis was immediately featured prominently in the news media. By December 2007, prescription claims for the drug at retail pharmacies had fallen by more than 50%.

As diabetic patients and their clinicians reacted to the news, a methodologic debate also ensued. This discussion included statistical issues pertaining to the conduct of the analysis, its implications for clinical care, and finally the FDA and drug manufacturer’s roles in overseeing and regulating rosiglitazone. The concern among patients with diabetes regarding treatment, continues in the medical community today.

Was this the right answer?

Should the studies have been combined? Commentators faulted the authors for including several studies that were not originally intended to investigate diabetes, and for combining both placebo and drug therapy data into one comparator arm. Some critics noted that despite the stated inclusion criteria, some data were derived from studies where the rosiglitazone arm was allowed a longer follow-up than the comparator arm. By failing to account for this longer follow-up period, commentators felt that the authors may have overestimated the effect of rosiglitazone on CV outcomes. Many reviewers were concerned that this meta-analysis excluded trials in which no patients suffered an MI or died from CV causes – the outcomes of greatest interest. Some reviewers also noted that the exclusion of zero-event trials from the pooled dataset not only gave an incomplete picture of the impact of rosiglitazone but could have increased the odds ratio estimate. In general, the pooled dataset was criticized by many for being a faulty microcosm of the information available regarding rosiglitazone.

It is essential that a meta-analysis be based on similarity in the data sources. If studies differ in important areas such as the patient populations, interventions, or outcomes, combining their data may not be suitable. The researchers accepted studies and populations that were clinically heterogeneous, yet pooled them as if they were not. The study reported that the results were combined from a number of trials that were not initially intended to investigate CV outcomes. Furthermore, the available data did not allow for time-to-event analysis, an essential tool in comparing the impact of alternative treatment options. Reviewers considered the data to be insufficiently homogeneous, and the line of cause and effect to be murkier than the authors described.

Were the statistical methods optimal?

The statistical methods for this meta-analysis also came under significant criticism. The critiques focused on the authors’ use of the Peto method as being an incorrect choice because data were pooled from both small and very large studies, resulting in a potential overestimation of treatment effect. Others reviewers pointed that the Peto method should not have been used, as a number of the underlying studies did not have patients assigned equally to rosiglitazone and comparator groups. Finally, critics suggested that the heterogeneity of the included studies required an altogether different set of analytic techniques.

Demonstrating the sensitivity of the authors’ initial analysis to the inclusion criteria and statistical tests used, a number of researchers reworked the data from this study. one researcher used the same studies but analyzed the data with a more commonly used statistical method (Mantel-Haenszel), and found no significant increase in the relative risk or common odds ratio with MI or CV death. When the pool of studies was expanded to include those originally eliminated because they had zero CV events, the odds ratios for MI and death from CV causes dropped from 1.43 to 1.26 (95% CI, 0.93-1.72) and from 1.64 to 1.14 (95% CI, 0.74-1.74), respectively. Neither of the recalculated odd ratios were significant for MI or CV death. Finally, several newer long-term studies have been published since the Nissen meta-analysis. Incorporating their results with the meta-analysis data showed that rosiglitazone is associated with an increased risk of MI but not of CV death. Thus, the findings from these meta-analyses varied with the methods employed, the studies included, and the addition of later trials.

Emerging Data

The controversy surrounding the rosiglitazone meta-analysis authored by Nissen and Wolski forced an unplanned interim analysis of a long-term, randomized trial investigating the CV effects of rosiglitazone among patients with type 2 diabetes. The authors of the RECORD trial noted that even though the follow-up at 3.75 years was shorter than expected, rosiglitazone, when added to standard glucose-lowering therapy, was found to be associated with an increase in the risk of heart failure but was not associated with any increase in death from CV or other causes. Data at the time were found to be insufficient to determine the effect of rosiglitazone on an increase in the risk of MI. the final report of that trial, published in June 2009, confirmed the elevated risk of heart failure in people with type 2 diabetes treated with rosiglitazone in addition to glucose-lowering drugs, but continued to show inconclusive results about the effect of the drug therapy on the risk of MI. Further, the RECORD trial clarified that rosiglitazone does not result in an increased risk of CV morbidity or mortality compared to standard glucose-lowering drugs. Other trials conducted since the publishing of the meta-analysis have corroborated these results, casting further doubt on the findings of the meta-analysis published by Nissen and Wolski.

Now what?

Some sources suggest that the original Nissen meta-analysis delivered more harm than benefit, and that a well-recognized medical journal may have erred in its process of peer review. Despite this criticism, it is important to note that subsequent publications support the risk of adverse CV events associated with rosiglitazone, although rosiglitazone use does not appear to increase deaths. These results and emerging data point to the need for further rigorous research to clarify the benefits and risks of rosiglitazone on a variety of outcomes, and the importance of directing the drug to the population that will maximally benefit from its use.

Lessons Learned From this Case Study

Results from initial randomized trials that seem definitive at one time may not be conclusive, as further trials may emerge to clarify, redirect, or negate previously accepted results. A meta-analysis of those trials can lead to varying results based upon the timing of the analysis and the choices made in its performance.

Meta-Analysis: Tips for CER Practitioners

*The results of a meta-analysis are highly dependent on the studies included (and excluded). Are these criteria properly defined and relevant to the purposes of the meta-analysis? Were the combined studies sufficiently similar? Can results from this cohort be generalized to other populations of interest?

*The statistical methodology can impact study results. Have there been reviews critiquing the methods used in the meta-analysis?

*A variety of statistical tests should be considered, and perhaps reported, in the analysis of results. Do the authors mention their rationale in choosing a statistical method? Do they show the stability of their results across a spectrum of analytical methods?

*Nothing is permanent. Emerging data may change the playing field, and meta- analysis results are only as good as the data and statistics from which they are derived.

===Case-Study 3: The Nurses’ Health Study===

An observational study

An observational study is a very common type of research design in which the effects of a treatment or condition are studied without formally randomizing patients in an experimental design. Such studies can be done prospectively, wherein data are collected about a group of patients going forward in time; or retrospectively, in which the researcher looks into the past, mining existing databases for data that have already been collected. Latter studies are frequently performed by using an electronic database that contains, for example, administrative, “billing,” or claims data. Less commonly, observational research uses electronic health records, which have greater clinical information that more closely resembles the data collected in an RCT. Observational studies often take place in “real- world” environments, which allow researchers to collect data for a wide array of outcomes. Patients are not randomized in these studies, but the findings can be used to generate hypotheses for investigation in a more constrained experimental setting. Perhaps the best known observational study is the “Framingham study,” which collected demographic and health data for a group of individuals over many years (and continues to do so) and has provided an understanding of the key risk factors for heart disease and stroke.

Observational studies present many advantages to the comparative effectiveness researcher. the study design can provide a unique glimpse of the use of a health care intervention in the “real world,” an essential step in gauging the gap between efficacy (can a treatment work in a controlled setting?) and effectiveness (does the treatment work in a real-life situation?). Furthermore, observational studies can be conducted at low cost, particularly if they involve the secondary analysis of existing data sources. CER often uses administrative databases, which are based upon the billing data submitted by providers during routine care. These databases typically have limited clinical information, may have errors in them, and generally do not undergo auditing.

The uncontrolled nature of observational studies allows them to be subject to bias and confounding. For example, doctors may prescribe a new medication only for the sickest patients. Comparing these outcomes (without careful statistical adjustment) with those from less ill patients receiving alternative treatment may lead to misleading results. Observational studies can identify important associations but cannot prove cause and effect. These studies can generate hypotheses that may require RCTs for fuller demonstration of those relationships. Secondary analysis can also be problematic if researchers overwork datasets by doing multiple exploratory analyses (e.g., data-dredging): the more we look, the more we find, even if those findings are merely statistical aberrations. Unfortunately, the growing need for CER and the wide availability of administrative databases may lead to selection of research of poor quality with inaccurate findings.

In comparative effectiveness research, observational studies are typically considered to be less conclusive than RCTs and meta-analyses. Nonetheless, they can be useful, especially because they examine typical care. Due to lower cost and improvements in health information, observational studies will become increasingly common. Critical assessment of whether the described results are helpful or biased (based upon how the study was performed) are necessary. This case will illustrate several characteristics of the types of studies that will assist in evaluating newly published work.

Clinical Applications

Cardiovascular diseases (CVD) are the leading cause of death in women older than the age of 50. Epidemiologic evidence suggests that estrogen is a key mediator in the development of CVD. Estrogen is an ovarian hormone whose production decreases as women approach menopause. The steep increase in CVD in women at menopause and older and in women who have had hysterectomies further supports a relationship between estrogen and CVD. Building on this evidence of biologic plausibility, epidemiological and observational studies suggested that estrogen replacement therapy (a form of hormone replacement therapy, or HRT) had positive effects on the risk of CVD in postmenopausal women, (albeit with some negative effects in its potential to increase the risk for breast cancer and stroke). Based on these findings, in the 1980s and 1990s HRT was routinely employed to treat menopausal symptoms and serve as prophylaxis against CVD.

What was done?

The Nurses’ Health Study (NHS) began collecting data in 1976. In the study, researchers intended to examine a broad range of health effects in women over a long period of time, and a key goal was to clarify the role of HRT in heart disease. The cohort (i.e., the group being followed) included married registered nurses aged 30-55 in 1976 who lived in the 11 most populous states. To collect data, the researchers mailed the study participants a survey every 2 years that asked questions about topics such as smoking, hormone use, menopausal status, and less frequently, diet. Data were collected for key end points that included MI, coronary-artery bypass grafting or angioplasty, stroke, total CVD mortality, and deaths from all causes.

What was found?

At a 10-year follow-up point, the NHS had a study pool of 48,470 women. The researchers found that estrogen use (alone, without progestin) in postmenopausal women was associated with a reduction in the incidence of CVD as well as in CVD mortality compared to non-users. Later, estrogen-progestin combination therapy was shown to be even more cardioprotective than estrogen monotherapy, and lower doses of estrogen replacement therapy were found to deliver equal cardioprotection and lower the risk for adverse events. NHS researchers were alert to the potential for bias in observational studies. Adjustment for risk factors such as age (a typical practice to eliminate confounding) did not change the reported findings.

Was this the right answer?

The NHS was not unique in reporting the benefits associated with HRT; other observational studies corroborated the NHS findings. A secondary retrospective data analysis of the UK primary care electronic medical record database, for example, also showed the protective effect associated with HRT use. Researchers were aware of the fundamental limitations of observational studies, particularly with regard to selection bias. They and practicing clinicians were also aware of the potential negative health effects of HRT, which had to be constantly weighed against the potential cardioprotective benefits in deciding a patient’s course of treatment. As a large section of the population could experience the health effects of HRT, researchers began planning RCTs to verify the promising observational study results. It was highly anticipated that those RCTs would corroborate the belief that estrogen replacement can reduce CVD risk.

Randomized Controlled Trial: The Women’s Health Initiative

The Women’s health Initiative (WHI) was a major study established by the National Institutes of health in 1992 to assess a broad range of health effects in postmenopausal women. The trial was intended to follow these women for 8 years, at a cost of millions of dollars in federal funding. Among its many facets, it included an RCT to confirm the results from the observational studies discussed above. To fully investigate earlier findings, the WHI had two subgroups. One subgroup consisted of women with prior hysterectomies; they received estrogen monotherapy. The second group consisted of women who had not undergone hysterectomy; they received estrogen in combination with progestin. The WHI enrolled 27,347 women in their HRT investigation: 10,739 in the estrogen-alone arm and 16,608 in the estrogen plus progestin arm. Within each arm, women were randomly assigned to receive either HRT or placebo. All women in the trial were postmenopausal and aged 50-79 years; the mean age was 63.6 years (a fact that would be important in later analysis). Some participants had experienced previous CV events. The primary outcome of both subgroups was coronary heart disease (CHD), as described by nonfatal MI or death due to CHD.

The estrogen-progestin arm of the WHI was halted after a mean follow-up of 5.2 years, 3 years earlier than expected, as the HRT users in this arm were found to be at increased risk for CHD compared to those who received placebo. The study also noted elevated rates of breast cancer and stroke, among other poor outcomes. The estrogen-alone arm continued for an average follow-up of 6.8 years before being similarly discontinued ahead of schedule. Although this part of the study did not find an increased risk of CHD, it also did not find any cardioprotective effect. Beyond failing to locate any clear CV benefits, the WHI also found real evidence of harm, including increased risk of blood clots, breast cancer and stroke. Initial WHI publications therefore recommended against HRT being prescribed for the secondary prevention of CVD.

What Next?

Scientists and the clinicians who relied on their data for guidance in treating patients, were faced with conflicting data: epidemiological and observational studies suggested that HRT was cardioprotective while the higher-quality evidence from RCTs strongly suggested the opposite. Clinicians primarily followed the WHI results, so prescriptions for HRT in postmenopausal women quickly declined. Meanwhile, researchers began to analyze the studies for potential discrepancies, and found that the women being followed in the NHS and the WHI differed in several important characteristics.

First, the WHI population was older than the NHS cohort, and many had entered menopause at least 10 years before they enrolled in the RCT. Thus, the WHI enrollees experienced a long duration from the onset of menopause to the commencement of HRT. At the same time, many in the NHS population were closer to the onset of menopause and were still displaying hormonal symptoms when they began HRT. Second, although the NHS researchers adjusted the data for various confounding effects, their results could still have been subject to bias. In general, the NHS cohort was more highly educated and of a higher socioeconomic status than the WHI participants, and therefore more likely to see a physician regularly. The NHS women were also leaner and generally healthier than their RCT counterparts, and had been selected for their evident lack of pre-existing CV conditions. This selection bias in the NHS enrollment may have led to a “healthy woman” effect that in turn led to an overestimation of the benefits of therapy in the observational study. Third, researchers noted that dosing differences between the two study types may have contributed to the divergent results. The NHS reported beneficial results following low-dose estrogen therapy. The WHL, meanwhile, used a higher estrogen dose, exposing women to a larger dosage of hormones and increasing their risk for adverse events. The increased risk profile of the WHI women (e.g., older, more comorbidities, higher estrogen dose) could have contributed to the evidence of harm seen in the WHI results.

Emerging Data
In addition to identifying the inherent differences between the two study populations, researchers began a secondary analysis of the NHS and WHI trials. NHS researchers reported that women who began HRT close to the onset of menopause had a significantly reduced risk of CHD. In the subgroups of women that were older and had a similar duration after menopause compared with the WHI women, they found no significant relationship between HRT and CHD. Also, the WHI study further stratified these results by age, and found that women who began HRT close to their onset of menopause experienced some cardioprotection, while women who were further from the onset of menopause had a slightly elevated risk for CHD.

Secondary analysis of both studies was therefore necessary to show that age and a short duration from the onset of menopause are crucial to HRT success as a cardioprotective agent. Neither study type provided “truth” or rather, both studies provided “truth” if viewed carefully (e.g., both produced valid and important results). The differences seen in the studies were rooted in the timing of HRT and the populations being studied.

Lessons Learned From this case Study

Although RCTs are given a higher evidence grade, observational studies provide important clinical insights. In this example, the study populations differed. For policymakers and clinicians, it is crucial to examine whether the CER was based upon patients similar to those being considered. Any study with a dissimilar population may provide non-relevant results. Thus, readers of CER need to carefully examine the generalizability of the findings being reported.

==Appendix==

General Classification and Regression Tree (CART) data analysis steps part of the R package rpart.

===Growing the Tree===

# To grow a tree, use
rpart(formula, data=, method=,control=), where
formula is in the format outcome ~ predictor1+predictor2+...
data= specifies the data frame
method= "class" for a classification tree, use "anova" for a regression tree
control= optional parameters for controlling tree growth. For example, control=rpart.control(minsplit=30, cp=0.001) requires that the minimum number of observations in a node be 30 before attempting a split and that a split must decrease the overall lack of fit by a factor of 0.001 (cost complexity factor) before being attempted.

===Examining Results===

# These functions help with examining the results.
printcp(fit) display complexity parameter (cp) table
plotcp(fit) plot cross-validation results
rsq.rpart(fit) plot approximate R-squared and relative error for different splits (2 plots). labels are only appropriate for the "anova" method.
print(fit) print results
summary(fit) detailed results including surrogate splits
plot(fit) plot decision tree
text(fit) label the decision tree plot
post(fit, file=) create postscript plot of decision tree
# In trees created by rpart(), move to the LEFT branch when the stated condition is true.

===Pruning Trees===

#In general, trees should be pruned back to avoid overfitting the data. The tree size should minimize the cross-#validated error – xerror column printed by printcp(). Pruning the tree is accomplished by:
prune(fit, cp= )
# use printcp( ) to examine the cross-validation error results, select the complexity parameter (CP) associated with minimum error, and insert the CP it into the prune() function. This (automatically selecting the complexity parameter associated with the smallest cross-validated error) can be done succinctly by:
fit$\$$cptable[which.min(fit$\$$cptable[,"xerror"]),"CP"]

===Compete Dataset for N-of-1 Example===
[[SMHS_MethodsHeterogeneity_CER_Nof1|This N-of-1 Dataset]] includes an example.

===[[SMHS_MethodsHeterogeneity|Back to the Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research section]]===

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php/SMHS_MethodsHeterogeneity_CER}}

SMHS MethodsHeterogeneity MetaAnalysis

2016-05-23T13:23:30Z

Imoubara:

==[[SMHS_MethodsHeterogeneity| Methods for Studying Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research]] - Meta-Analyses ==

==Meta-analysis==

===Overview===

Meta-analysis is an approach to combine treatment effects across trials or studies into an aggregated treatment effect with higher statistical power than observed in each individual trials. It may detect HTE by testing for differences in treatment effects across similar RCTs. It requires that the individual treatment effects are similar to ensure pooling is meaningful. In the presence of large clinical or methodological differences between the trials, it may be to avoid meta-analyses. The presence of HTE across studies in a meta-analysis may be due to differences in the design or execution of the individual trials (e.g., randomization methods, patient selection criteria). Cochran's Q is a methods for detection of heterogeneity, which is computed as the weighted sum of squared differences between each study's treatment effect and the pooled effects across the studies. It is a barometer of inter-trial differences impacting the observed study result. A possible source of error in a meta-analysis is publication bias. Trial size may introduce publication bias since larger trials are more likely to be published. Language and accessibility represent other potential confounding factors. When the heterogeneity is not due to poor study design, it may be useful to optimize the treatment benefits for different cohorts of participants.

Cochran's Q statistics is the weighted sum of squares on a standardized scale. The corresponding P value indicates the strength of the evidence of presence of heterogeneity. This test may have low power to detect heterogeneity sometimes and it is suggested to use a value of 0.10 as a cut-off for significance (Higgins et al., 2003). The Q statistics also may have too much power as a test of heterogeneity when the number of studies is large.

===Simulation Example 1===

# Install and Load library
install.packages("meta")
library(meta)

# Set number of studies
n.studies = 15

# number of treatments: case1, case2, control
n.trt = 3

# number of outcomes
n.event = 2

# simulate the (balanced) number of cases (case1 and case2) and controls in each study
ctl.group = rbinom(n = n.studies, size = 200, prob = 0.3)
case1.group = rbinom(n = n.studies, size = 200, prob = 0.3)
case2.group = rbinom(n = n.studies, size = 200, prob = 0.3)

# Simulate the number of outcome events (e.g., deaths) and no events in the control group
event.ctl.group = rbinom(n = n.studies, size = ctl.group, prob = rep(0.1, length(ctl.group)))
noevent.ctl.group = ctl.group - event.ctl.group

# Simulate the number of events and no events in the case1 group
event.case1.group = rbinom(n = n.studies, size = case1.group, prob = rep(0.5, length(case1.group)))
noevent.case1.group = case1.group - event.case1.group

# Simulate the number of events and no events in the case2 group
event.case2.group = rbinom(n = n.studies, size = case2.group, prob = rep(0.6, length(case2.group)))
noevent.case2.group = case2.group - event.case2.group

# Run the univariate meta-analysis using metabin(), Meta-analysis of binary outcome data –
# Calculation of fixed and random effects estimates (risk ratio, odds ratio, risk difference or arcsine
# difference) for meta-analyses with binary outcome data. Mantel-Haenszel (MH),
# inverse variance and Peto method are available for pooling.

# method = A character string indicating which method is to be used for pooling of studies.
# one of "MH" , "Inverse" , or "Cochran"
# sm = A character string indicating which summary measure (“OR”, "RR" "RD"=risk difference) is to be
# used for pooling of studies

# Control vs. Case1, n.e and n.c are numbers in experimental and control groups
meta.ctr_case1 <- metabin(event.e = event.case1.group, n.e = case1.group, event.c = event.ctl.group,
n.c = ctl.group, method = "MH", sm = "OR")
# in this case we use Odds Ratio, of the odds of death in the experimental and control studies
forest(meta.ctr_case1)

<center>[[Image:SMHS_Methods8.png|500px]] </center>

# Control vs. Case2
meta.ctr_case2 <- metabin(event.e = event.case2.group, n.e = case2.group, event.c = event.ctl.group,
n.c = ctl.group, method = "MH", sm = "OR")
forest(meta.ctr_case2)

<center>[[Image:SMHS_Methods9.png|500px]] </center>

# Case1 vs. Case2
meta.case1_case2 <- metabin(event.e = event.case1.group, n.e = case1.group, event.c = event.case2.group,
n.c = case2.group, method = "MH", sm = "OR")
forest(meta.case1_case2)
summary(meta.case1_case2)

Test of heterogeneity:
Q d.f. p-value
11.99 14 0.6071

<center>[[Image:SMHS_Methods10.png|500px]] </center>

The forest plot shows the I2 test indicates the evidence to reject the null hypothesis (no study heterogeneity and the fixed effects model should be used).

==Series of “N of 1” trials==

This technique combines (a “series of”) n-of-1 trial data to identify HTE. An n-of-1 trial is a repeated crossover trial for a single patient, which randomly assigns the patient to one treatment vs. another for a given time period, after which the patient is re-randomized to treatment for the next time period, usually repeated for 4-6 time periods. Such trials are most feasibly done in chronic conditions, where little or no washout period is needed between treatments and treatment effects are identifiable in the short-term, such as pain or reliable surrogate markers. Combining data from identical n-of-1 trials across a set of patients enables the statistical analysis controlling for patient fixed or random effects, covariates, centers, or sequence effects, see Figure below. These combined trials are often analyzed within a Bayesian context using shrinkage estimators that combine individual and group mean treatment effects to create a “posterior” individual mean treatment effect estimate which is a form of inverse variance-weighted average of the individual and group effects. Such trials are typically more expensive than standard RCTs on a per-patient basis, however, they require much smaller sample sizes, often less than 100 patients (due to the efficient individual-as-own-control design), and create individual treatment effect estimates that are not possible in a non-crossover design . For the individual patient, the treatment effect can be re-estimated after each time period, and the trial stopped at any point when the more effective treatment is identified with reasonable statistical certainty.

====Example====

A study involving 8 participants collected data across 30 days, in which 15 treatment days and 15 control days are randomly assigned within each participant. The treatment effect is represented as a binary variable (control day=0; treatment day=1). The outcome variable represents the response to the intervention within each of the 8 participants. Study employed a fixed-effects modeling. By creating N − 1 dummy-coded variables representing the N=8 participants, where the last (i=8) participant serves as the reference (i.e., as the model intercept). So, each dummy-coded variable represents the difference between each participant (i) and the 8th participant. Thus, all other patients' values will be relative to the values of the 8th (reference) subject. The overall differences across participants in fixed effects can be evaluated with multiple degree-of-freedom F-tests.

<center>[[Image:SMHS_Methods11.png|500px]] </center>

<center>

{| class="wikitable" style="text-align:center; " border="1"
|-
|ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||1||33||8||0.97||5.00||4.03||1.03||53
|-
|1||2||1||33||8||-0.17||3.87||4.03||1.03||73
|-
|1||3||0||33||8||0.81||4.84||4.03||1.03||23
|-
|1||4||0||33||8||-0.41||3.62||4.03||1.03||36
|-
|...||...||...||...||...||...||...||...||...||...

|}
</center> Complete data is available in the Appendix.

<center>Data Summary

{| class="wikitable" style="text-align:center; " border="1"
|-
|Intercept||Constant
|-
|Physical Activity||PhyAct
|-
|Intervention||Tx
|-
|WP Social Support||WPSS
|-
|PM Social Support (1-3)||PMss3
|-
|Self Efficacy||SelfEff25

|}
</center>

rm(list=ls())
Nof1 <-read.table("https://umich.instructure.com/files/330385/download?download_frd=1&verifier=DwJUGSd6t24dvK7uYmzA2aDyzlmsohyaK6P7jK0Q", sep=",", header = TRUE) # 02_Nof1_Data.csv
attach(Nof1)
head(Nof1)

<center>

{| class="wikitable" style="text-align:center; " border="1"
|-
| ||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0

|}
</center>

df.1 = data.frame(PhyAct, Tx, WPSS, PMss3, SelfEff25)

# library("lme4")

lm.1 = model.lmer <- lmer(PhyAct ~ Tx + SelfEff + Tx*SelfEff + (1|Day) + (1|ID) , data= df.1)
summary(lm.1)

Linear mixed model fit by REML ['lmerMod']
Formula: PhyAct ~ Tx + SelfEff + Tx * SelfEff + (1 | Day) + (1 | ID)
Data: df.1

REML criterion at convergence: 8820

<center> Scaled Residuals
{| class="wikitable" style="text-align:center; " border="1"
|-
| Min||1Q||Median||3Q||Max
|-
|-2.7012||-0.6833||-0.0333||0.6542||3.9612
|}
</center>

<center> Random Effects
{| class="wikitable" style="text-align:center; " border="1"
|-
| Groups ||Name||Variance ||Std.Dev.
|-
| Day||(Intercept) ||0.0 || 0.00
|-

|ID|| (Intercept)||601.5||24.53
|-

|Residual|| ||969.0 ||31.13
|}
Number of obs: 900, groups: Day, 30; ID, 30
</center>

<center> Fixed Effects
{| class="wikitable" style="text-align:center; " border="1"
|-
|Estimate||Std.||Error||t value
|-
|(Intercept)||38.3772||14.4738||2.651
|-
|Tx||4.0283||6.3745||0.632
|-
|SelfEff||0.5818||0.5942||0.979
|-
|Tx:SelfEff||0.9702||0.2617||3.708
|}
</center>

<center> Correlation of Fixed Effects
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||(Intr)||Tx ||SlfEff
|-
| Tx|| -0.220|| ||
|-
| SelfEff||-0.946 ||0.208 ||
|-
| Tx:SelfEff ||0.208 ||-0.946 ||-0.220
|}
</center>

# Model: PhyAct = Tx + WPSS + PMss3 + Tx*WPSS + Tx*PMss3 + SelfEff25 + Tx*SelfEff25 + ε
lm.2 = lm(PhyAct ~ Tx + WPSS + PMss3 + Tx*WPSS + Tx*PMss3 + SelfEff25 + Tx*SelfEff25, df.1)
summary(lm.2)

Call:
lm(formula = PhyAct ~ Tx + WPSS + PMss3 + Tx * WPSS + Tx * PMss3 +
SelfEff25 + Tx * SelfEff25, data = df.1)

<center> Residuals
{| class="wikitable" style="text-align:center; " border="1"
|-
|Min||1Q||Median||3Q||Max
|-
| -102.39||-28.24||-1.47||25.16||122.41

|}
</center>

<center>Coefficients
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||Estimate||Std. Error||t value||$Pr(>|t|)$
|-
|(Intercept)||52.0067||1.8080||28.764||< 2e-16 ***
|-
|Tx||27.7366||2.5569||10.848||< 2e-16 ***
|-
|WPSS||1.9631||2.4272||0.809||0.418853
|-
|PMss3||13.5110||2.7853||4.851||1.45e-06 ***
|-
|SelfEff25||0.6289||0.2205||2.852||0.004439 **
|-
|Tx:WPSS||9.9114||3.4320||2.888||0.003971 **
|-
|Tx:PMss3||8.8422||3.9390||2.245||0.025025 *
|-
|Tx:SelfEff25||1.0460||0.3118||3.354||0.000829 ***

|}
</center>

[Using SAS (StudyI_Analyses.sas, StudyIIab_Analyses.sas)]

<center> Type 3 Tests of Fixed Effects
{| class="wikitable" style="text-align:center; " border="1"
|-
|Effect||Num DF||Den DF||F Value||$Pr>F$
|-
|Tx||1||224||67.46||<.0001
|-
|ID||7||224||25.95||<.0001
|-
|Tx*ID||7||224||2.92||0.0060
|}
</center>

==Quantile Treatment Effect (QTE)==

QTE employs quantile regression estimation (QRE) to examine the central tendency and statistical dispersion of the treatment effect in a population. These may not be revealed by the conventional mean estimation in RCTs. For instance, patients with different comorbidity scores may respond differently to a treatment. Quantile regression has the ability to reveal HTE according to the ranking of patients’ comorbidity scores or some other relevant covariate by which patients may be ranked. Therefore, in an attempt to inform patient-centered care, quantile regression provides more information on the distribution of the treatment effect than typical conditional mean treatment effect estimation. QTE characterizes the heterogeneous treatment effect on individuals and groups across various positions in the distributions of different outcomes of interest. This unique feature has given quantile regression analysis substantial attention and has been employed across a wide range of applications, particularly when evaluating the economic effects of welfare reform.

One caveat of applying QRE in clinical trials for examining HTE is that the QTE doesn’t demonstrate the treatment effect for a given patient. Instead, it focuses on the treatment effect among subjects within the qth quantile, such as those who are exactly at the top 10th percent in terms of blood pressure or a depression score for some covariate of interest, for example, comorbidity score. It is not uncommon for the qth quantiles to be two different sets of patients before and after the treatment. For this reason, we have to assume that these two groups of patients are homogeneous if they were in the same quantiles.

Income-Food Expenditure Example: Let’s examine the Engel data (N=235) on the relationship between food expenditure (foodexp) and household income (income). We can plot the data and then explore the superposition of the six fitted quantile regression lines.

install.packages("quantreg")
library(quantreg)
data(engel)
attach(engel)

<center>head(engel)
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Income||Foodexp
|-
|1||420.1577||255.8394
|-
|2||541.4117||310.9587
|-
|3||901.1575||485.6800
|-
|4||639.0802||402.9974
|-
|5||750.8756||495.5608
|-
|6||945.7989||633.7978

|}
</center>

<center>summary(engel)
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Income||Foodexp
|-
|Min||377.1||242.3
|-
|1st Qu.||638.9||429.7
|-
|Median||884.0||582.5
|-
|Mean||982.5||624.2
|-
|3rd Qu.||1164.0||743.9
|-
|Max||4957.8||2032.7

|}
</center>

Note: If Y be a real valued random variable with cumulative distribution function FY(y)=P(Y≤ y), then the τ-quantile of Y is given by

<center> QY(τ)=FY-1(τ)=inf{ y:FY(y)≥τ} </center>

where 0≤τ≤1.

<center>[[Image:SMHS_Methods12.png|500px]] </center>

# (1) Graphics
plot(income, foodexp, cex=.25, type="n", xlab="Household Income", ylab="Food Expenditure")
points(income, foodexp, cex=.5, col="blue")

# tau - the quantile(s) to be estimated, in the range from 0 to 1. An object "rq.process" and an object "rqs"
# are returned containing the matrix of coefficient estimates at the specified quantiles.
abline( rq(foodexp ~ income, tau=.5), col="blue") # Quantile Regression Model

abline( lm(foodexp ~ income), lty=2, lwd=3, col="red") # linear model
taus <- c(0.05, 0.1, 0.25, 0.75, 0.90, 0.95)
colors <- rainbow(length(taus))

models <- vector(mode = "list", length = length(taus)) # define a vector of models to store QR for diff taus
model.names <- vector(mode = "list", length = length(taus)) # define a vector model names

for( i in 1:length(taus)){
models[[i]] <- rq(foodexp ~ income, tau=taus[i])
var <- taus[i]
model.names[[i]] <- paste("Model [", i , "]: tau=", var)
abline( models[[i]], lwd=2, col= colors[[i]])
}
legend(3000, 1100, model.names, col= colors, pch= taus, bty='n', cex=.75)

<center>[[Image:SMHS_Methods13.png|500px]] </center>

# (2) Inference about quantile regression coefficients. As an alternative to the rank-inversion confidence intervals, we can obtain a table of coefficients, standard errors, t-statistics, and p-values using the summary function:

summary(models[[3]], se = "nid")

Call: rq(formula = foodexp ~ income, tau = taus[i])

tau: [1] 0.25

<center>Coefficients
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Value||Std. Error||t Value||$Pr(>|t|)$
|-
|(Intercept)||95.48354||21.39237||4.46344||0.00001
|-
|Income||0.47410||0.02906||16.31729||0.00000

|}
</center>

# Alternatively, we can use summary.rq to compute bootstrapped standard errors.
summary.rq(models[[3]], se = "nid")

Call: rq(formula = foodexp ~ income, tau = taus[i])
tau: [1] 0.25

<center>Coefficients
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Value||Std. Error||t Value||$Pr(>|t|)$
|-
|(Intercept)||95.48354||21.39237||4.46344||0.00001
|-
|Income||0.47410||0.02906||16.31729||0.00000

|}
</center>

==Nonparametric Regression Methods ==

Nonparametric regression enables dealing with HTE in RCTs. Different nonparametric methods, such as kernel smoothing methods and series methods, can be used to generate test statistics for examining the presence of HTE. A kernel method is a weighting scheme based on a kernel function (e.g. uniform, Gaussian). When evaluating the treatment effect of a patient in RCTs, the kernel method assigns larger weights to those observations with similar covariates. This is done because it is assumed that patients with similar covariates provide more relevant data on predicted treatment response. Examining participants that have different backgrounds (e.g., demographic, clinical), kernel smoothing methods utilize information from highly divergent participants when estimating a particular subject’s treatment effect. Lower weights are assigned to very different subjects and the kernel methods require choosing a set of smoothing parameters to group patients according to their relative degree of similarities. A drawback is that the corresponding proposed test statistics may be sensitive to the chosen bandwidths, which inhibits the interpretation of the results. Series methods use approximating functions (splines or power series of the explanatory variables) to construct test statistics. Compared to kernel smoothing methods, series methods normally have the advantage of computational convenience; however, the precision of test statistics depends on the number of terms selected in the series.

Canadian Wage Data Example: Nonparametric regression extends the classical parametric regression (e.g., lm, lmer) involving one continuous dependent variable, y, and (1 or more) continuous explanatory variable(s), x. Let’s start with a popular parametric model of a wage equation that we can extend to a fully nonparametric regression model. First, we will compare and contrast the parametric and nonparametric approach towards univariate regression and then proceed to multivariate regression.

Let’s use the Canadian cross-section wage data (cps71) consisting of a random sample taken from the 1971 Canadian Census for male individuals having common education (High-School). N=205 observations, 2 variables, the logarithm of the individual’s wage (logwage) and their age (age). The classical wage equation model includes a quadratic term of age.

# install.packages("np")
library("np")
data("cps71")

# (1) Linear Model -> R2 = 0.2308
model.lin <- lm( logwage ~ age + I(age^2), data = cps71)
summary(model.lin)

Call:
lm(formula = logwage ~ age + I(age^2), data = cps71)

Residuals:
Min 1Q Median 3Q Max
-2.4041 -0.1711 0.0884 0.3182 1.3940

<center>Coefficients
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||Estimate||Std. Error||t Value||$Pr(>|t|)$
|-
|(Intercept)||10.0419773||0.4559986||22.022||< 2e-16 ***
|-
|Age||0.1731310||0.0238317|| 7.265||7.96e-12 ***
|-
|I(age^2)||-0.0019771||0.0002898||-6.822||1.02e-10 ***

|}
</center>

Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.5608 on 202 degrees of freedom
Multiple R-squared: 0.2308, Adjusted R-squared: 0.2232
F-statistic: 30.3 on 2 and 202 DF, p-value: 3.103e-12

# (2) Next, we consider the local linear nonparametric method employing cross-validated
# bandwidth selection and estimation in one step. Start with computing the least-squares
# cross-validated bandwidths for the local constant estimator (default).
# Note that R2 = 0.3108675
bandwidth <- npregbw(formula= logwage ~ age, data = cps71)
model.np <- npreg(bandwidth, regtype = "ll", bwmethod = "cv.aic", gradients = TRUE, data = cps71)
summary(model.np)

Regression Data: 205 training points, in 1 variable(s) age
Bandwidth(s): 1.892157
Kernel Regression Estimator: Local-Constant
Bandwidth Type: Fixed
Residual standard error: 0.5307943
R-squared: 0.3108675
Continuous Kernel Type: Second-Order Gaussian
No. Continuous Explanatory Vars.: 1

# NP model significance may be tested by
npsigtest(model.np)

Kernel Regression Significance Test
Type I Test with IID Bootstrap (399 replications, Pivot=TRUE, joint=FALSE)
Explanatory variables tested for significance: age (1)

age
Bandwidth(s): 1.892157

Individual Significance Tests
P Value:
age < 2.22e-16 ***

# So, as was the case for the linear parametric model, Age is significant in the local linear NP-model

# (3) Graphical comparison of parametric and nonparametric models.
plot(cps71$\$$age, cps71$\$$logwage, xlab = "age", ylab = "log(wage)", cex=.1)
lines(cps71$\$$age, fitted(model.lin), lty = 2, col = " red")
lines(cps71$\$$age, fitted(model.np), lty = 1, col = "blue")
legend("topright", c("Data", "Linear", "Non-linear"), col=c("Black", "Red", "Blue"), pch = c(1, 1, 1), bty='n', cex=.75)

<center>[[Image:SMHS_Methods14.png|500px]] </center>

# some additional plots resenting the parametric (quadratic, dashed line) and the nonparametric estimates
# (solid line) of the regression function for the cps71 data.
plot(model.np, plot.errors.method = "asymptotic")
plot(model.np, gradients = TRUE)
lines(cps71$\$$age, coef(model.lin)[2]+2*cps71$\$$age*coef(model.lin)[3], lty = 2, col = "red")
plot(model.np, gradients = TRUE, plot.errors.method = "asymptotic")

# (4) using the Lin and NL models to generate predictions based on the obtained appropriate
# bandwidths and estimated a nonparametric model. We need to create a set of explanatory
# variables for which to generate predictions. These can be part of the original dataset or be
# outside its scope. Typically, we don’t have the outcome for the evaluation data and need only
# provide the explanatory variables for which predicted values are generated by the models.
# Occasionally, splitting the dataset into two independent samples (training/testing), allows estimation
# of a model on one sample, and evaluation of its performance on another.

cps.eval.data <- data.frame(age = seq(10,70, by=10)) # simulate some explanatory X values (ages)
pred.lin <- predict(model.lin, newdata = cps.eval.data) # Linear Prediction of log(Wage)
pred.np <- predict(model.np, newdata = cps.eval.data) # non-Linear Prediction of log(Wage)
plot(pred.lin, pred.np)
abline(lm(pred.np ~ pred.lin))

<center>[[Image:SMHS_Methods15.png|500px]] </center>

.
.
.

==Predictive risk models ==

Predictive risk models represent a class of methods for identifying potential for HTE when the individual patient risk for disease-related events at baseline depends on observed factors. For instance, common measures are disease staging criteria, such as those used in COPD or heart failure, Framingham risk scores for cardiovascular event risk, or genetic variations, e.g., HER2 for breast cancer. Initial predictive risk modeling, aka risk function estimation, is often performed without accounting for treatment effects. Least squares or Cox proportional hazards regression methods are appropriate in many cases and provide relatively more interpretable risk functions, but rely on linearity assumptions and may not provide optimal predictive metrics. Partial least squares is an extension of least squares methods that can reduce the dimensionality of the predictor space by interposing latent variables, predicted by linear combinations of observable characteristics, as the intermediate predictors of one or more outcomes. Recursive partitioning, such as random forests, support vector machines, and neural networks represent latter methods with better predictive power than linear methods. Risk function estimation can range from highly exploratory analyses to near meta-analytic model validation, and may be useful at any stage of product development.

HIV Example: The “hmohiv” dataset represents a study of HIV positive patients examining whether there was a difference in survival times of HIV positive patients between a cohort using intravenous drugs (drug=1) and a cohort not using the IV drug (drug=0). The hmohiv data includes the following variables:

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|ID||Time||Age||Drug||Censor||Entdate||Enddate
|-
|1||5||46||0||1||5/15/1990||10/14/1990
|-
|2||6||35||1||0||9/19/1989||3/20/1990
|-
|3||8||30||1||1||4/21/1991||12/20/1991
|-
|4||3||30||1||1||1/3/1991||4/4/1991
|-
|5||22||36||0||1||9/18/1989||7/19/1991
|-
|6||1||32||1||0||3/18/1991||4/17/1991
|-
|...||...||...||...||...||...||...

|}
</center>

#cleaning up environment
rm(list=ls())

# load survival library
library(survival)

# load hmohiv data
hmohiv<-read.table("http://www.ats.ucla.edu/stat/r/examples/asa/hmohiv.csv", sep=",", header = TRUE)
attach(hmohiv)

# Fit Cox proportional hazards regression model
cox.model <- coxph( Surv(time, censor) ~ drug, method="breslow")
fit.1 <- survfit(cox.model, newdata=drug.new)

# construct a frame of the 2 cohorts IV_drug and no-IV-drug
drug.new<-data.frame(drug=c(0,1))

# plot results
plot(fit.1, xlab="Survival Time (Months)", ylab="Survival Probability")
points(fit.1$\$$time, fit.1$\$$surv[,1], pch=1)
points(fit.1$\$$time, fit.1$\$$surv[,2], pch=2)
legend(40, .8, c("Drug Absent", "Drug Present"), pch=c(1,2))

<center>[[Image:SMHS_Methods16.png|500px]] </center>

# to inslect the resulting Cox Proportional Hazard Model
cox.model
Call:
coxph(formula = Surv(time, censor) ~ drug, method = "breslow")

coef exp(coef) se(coef) z p
drug 0.779 2.18 0.242 3.22 0.0013

Likelihood ratio test=10.2 on 1 df, p=0.00141 n= 100, number of events= 80

.
.
.

==[[SMHS_MethodsHeterogeneity_CER|Next see: Comparative Effectiveness Research (CER)]]==

*[[SMHS_MethodsHeterogeneity|Back to the Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research section]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php/SMHS_MethodsHeterogeneity_MetaAnalysis}}

SMHS MethodsHeterogeneity HTE

2016-05-23T13:22:33Z

Imoubara: /* Latent growth and growth mixture modeling (LGM/GMM) */

==[[SMHS_MethodsHeterogeneity| Methods for Studying Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research]] - Methods and Approaches for HTE Analytics ==

===Overview===

Recursive partitioning is a data mining technique for exploring structure and patterns in complex data. It facilitates the visualization of decision rules for predicting categorical (classification tree) or continuous (regression tree) outcome variables. The R rpart package provides the tools for Classification and Regression Tree (CART) modeling, conditional inference trees, and random forests. Additional resources include an Introduction to Recursive Partitioning Using the RPART Routines . The Appendix includes description of the main CART analysis steps.

install.packages("rpart")
library("rpart")

===CART===
Classification and Regression Tree (CART) is a decision-tree based technique that considers how variation observed in a given response variable (continuous or categorical) can be understood through a systematic deconstruction of the overall study population into subgroups, using explanatory variables of interest. For HTE analysis, CART is best suited for early-stage, exploratory analyses. Its relative simplicity can be powerful in identifying basic relationships between variables of interest, and thus identify potential subgroups for more advanced analyses. The key to CART is its ‘systematic’ approach to the development of the subgroups, which are constructed sequentially through repeated, binary splits of the population of interest, one explanatory variable at a time. In other words, each ‘parent’ group is divided into two ‘child’ groups, with the objective of creating increasingly homogeneous subgroups. The process is repeated and the subgroups are then further split, until no additional variables are available for further subgroup development. The resulting tree structure is oftentimes overgrown, but additional techniques are used to ‘trim’ the tree to a point at which its predictive power is balanced against issues of over-fitting. Because the CART approach does not make assumptions regarding the distribution of the dependent variable, it can be used in situations where other multivariate modeling techniques often used for exploratory predictive risk modeling would not be appropriate – namely in situations where data are not normally distributed.

CART analyses are useful in situations where there is some evidence to suggest that HTE exists, but the subgroups defining the heterogeneous response are not well understood. CART allows for an exploration of response in a myriad of complex subpopulations, and more recently developed ensemble methods (such as Bayesian Additive Regression Trees) allow for more robust analyses through the combination of multiple CART analyses.

====Example Fifth Dutch growth study====

# Let’s use the Fifth Dutch growth study (2009) fdgs . Is it true that “the world’s tallest nation has stopped growing taller: the height of Dutch children from 1955 to 2009”?

#install.packages("mice")
library("mice")
?fdgs
head(fdgs)

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||ID ||Reg ||Age ||Sex ||HGT ||WGT ||HGT.Z ||WGT.Z
|-
|1 ||100001||West||13.09514||boy||175.5||75.0||1.751||2.410
|-
|2 ||100003||West||13.81793 ||boy||148.4||40.0||2.292||1.494
|-
|3 ||100004||West||13.97125||boy||159.9||46.5||0.743||0.783
|-
|4 ||100005||West||13.98220 ||girl||159.7||46.5 ||0.743 ||0.783
|-
|5||100006||West||13.52225||girl||160.3||47.8||0.414||0.355
|-
|6||100018||East||10.21492||boy||157.8||39.7||2.025||0.823
|}
</center>

summary(fdgs)
summary(fdgs)

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|ID ||Reg ||Age ||Sex ||HGT
|-
|Min.:100001||North:732||Min.:0.008214||boy:4829||Min.:46.0
|-
|1st Qu.:106353||East:2528||1st Qu.:1.618754||girl:5201||1st Qu.:83.8
|-
|Median:203855||South:2931||Median:8.084873|| ||Median:131.5
|-
|Mean:180091||West:2578||Mean:8.157936|| ||Mean:123.9
|-
|3rd Qu.210591||City:1261||3rd Qu.:13.547570|| ||3rd Qu.:162.3
|-
|Max:401955|| ||Max.:21.993155|| ||Max.:208.0
|-
| || || || ||NA's: 23
|}
</center>

(1) Classification Tree

Let's use the data frame fdgs to predict Region, from Age, Height, and Weight.
# grow tree
fit.1 <- rpart(reg ~ age + hgt + wgt, method="class", data= fdgs[,-1])

printcp(fit.1) # display the results
plotcp(fit.1) # visualize cross-validation results
summary(fit.1) # detailed summary of splits

# plot tree
par(oma=c(0,0,2,0))
plot(fit.1, uniform=TRUE, margin=0.3, main="Classification Tree for Region (FDGS Data)")
text(fit.1, use.n=TRUE, all=TRUE, cex=1.0)

<center>[[Image:SMHS_Methods2.png|500px]] </center>

# create a better plot of the classification tree
post(fit.1, title = "Classification Tree for Region (FDGS Data)", file = "")

<center>[[Image:SMHS_Methods3.png|500px]] </center>

(2) Pruning the tree

pruned.fit.1<- prune(fit.1, cp= fit.1$\$$cptable[which.min(fit.1$\$$\$$cptable[,"xerror"]),"CP"])

# plot the pruned tree
plot(pruned.fit.1, uniform=TRUE, main="Pruned Classification Tree for Region (FDGS Data)")
text(pruned.fit.1, use.n=TRUE, all=TRUE, cex=1.0)
post(pruned.fit.1, title = "Pruned Classification Tree for Region (FDGS Data)")

Not much change, as the initial tree is not complex!

===Random Forests ===
Random forests may improve predictive accuracy by generating a large number of bootstrapped trees (based on random samples of variables). It classifies cases using each tree in this new "forest", and decides the final predicted outcome by combining the results across all of the trees (an average in regression, a majority vote in classification). See the randomForest package.

library(randomForest)
fit.2 <- randomForest(reg ~ age + hgt + wgt, method="class", na.action = na.omit, data= fdgs[,-1])
print(fit.2) # view results
importance(fit.2) # importance of each predictor

Note on missing values/incomplete data: If the data have missing values, we have 3 choices:

1. Use a different tool (rpart handles missing values well)

2. Impute the missing values

3. For a small number of missing cases, we can use na.action = na.omit

===Latent growth and growth mixture modeling (LGM/GMM)===

LGM and GMM represent structural equation modeling techniques that capture inter-individual differences in longitudinal change corresponding to a particular treatment. For instance, patients’ different timing patterns of the treatment effects may represent the underlying sources of HTE. LGM distinguish if (yes/no) and how (fast/slow, temporary/lasting) patients respond to treatment. The heterogeneous individual growth trajectories are estimated from intra-individual changes over time by examining common population parameters, i.e., slopes, intercepts, and error variances. Suppose each individual has unique initial status (intercept) and response rate (slope) during a specific time interval. Then the variances of the individuals’ baseline measures (intercepts) and changes (slopes) in health outcomes will represent the degree of HTE. The LGM-identified HTE of individual growth curves can be attributed to observed predictors, including both fixed and time varying covariates.

LGM assumes that all individuals are from the same population (too restrictive in some cases). If the HTE is due to observed demographic variables, such as age, gender, and marital status, one may utilize multiple-group LGM. Despite its successful applications for modeling longitudinal change, there may be multiple subpopulations with unobserved heterogeneities. Growth mixture modeling (GMM) extends LGM to allow the identification and prediction of unobserved subpopulations in longitudinal data analysis. Each unobserved subpopulation may constitute its own latent class and behave differently than individuals in other latent classes. Within each latent class, there are also different trajectories across individuals; however, different latent classes don’t share common population parameters. Suppose we are interested in studying retirees’ psychological well-being change trajectory when multiple unknown subpopulations exist. We can add another layer (a latent class variable) on the LGM framework so that the unobserved latent classes can be inferred from the data. The covariates in GMM are designed to affect growth factors distinctly across different latent classes. Therefore, there are two types of HTE: 1) the latent class variable in GMM divides individuals into groups with different growth curves; and 2) coefficient estimates vary across latent classes.

Latent variables are not directly observed – they are inferred (via a model) from other actually observed and directly measured variables. Models that explain observed variables in terms of latent variables are called latent variable models. Then the latent (unobserved) variable is discrete, it’s referred to as latent class variable.

Breast Cancer Example: Recall the LMER package, earlier review discussions, where Linear Mixed Model (LMM) are used for longitudinal data to examine change over time of outcomes according relative to predictive covariates. LMM assumptions include:

(i) continuous longitudinal outcome

(ii) Gaussian random-effects and errors

(iii) linearity of the relationships with the outcome

(iv) homogeneous population

(v) missing at random data

The objectives of LGM/GMM models (see Latent Class Mixed Models, lcmm R package) are to extend the linear mixed model estimation to:

(i) heterogeneous populations (relax (iv) above). Use hlme for latent class linear mixed models (i.e. Gaussian continuous outcome)

(ii) other types of longitudinal outcomes : ordinal, (bounded) quantitative non-Gaussian outcomes (relax (i), (ii), (iii), (iv)). Use lcmm for general latent class mixed models with outcomes of different nature

(iii) joint analysis of a time-to-event (relax (iv), (v)). Use Jointlcmm for joint latent class models with a longitudinal outcome and a right-censored (left-truncated) time-to-event</blockquote>

Let’s use these data (http://www.ats.ucla.edu/stat/data/hdp.csv), representing cancer phenotypes and predictors (e.g., "IL6", "CRP", "LengthofStay", "Experience") and outcome measures (e.g., remission) collected on patients, nested within doctors (DID) and within hospitals (HID).

We can illustrate the latent class linear mixed models implemented in hlme through a study of the quadratic trajectories of the response (remission) with TumorSize, adjusting for CO2*Pain interaction and assuming correlated random-effects for the functions of SmokingHx and Sex. To estimate the corresponding standard linear mixed model using 1 latent class where CO2 interacts with Pain:

# install.packages("lcmm")
library("lcmm")

hdp <- read.csv("http://www.ats.ucla.edu/stat/data/hdp.csv")
hdp <- within(hdp, {
Married <- factor(Married, levels = 0:1, labels = c("no", "yes"))
DID <- factor(DID)
HID <- factor(HID)
})

add a new subject ID column (last column in the data, “ID”), this is necessary for the hmle call
hdp$\$$ID <- seq.int(nrow(hdp))

model.hlme <- hlme(remission ~ IL6 + CRP + LengthofStay + Experience + I(tumorsize^2) + co2*pain + I(tumorsize^2)*pain, random=~ SmokingHx + Sex, subject='ID', data=hdp, ng=1)
summary(model.hlme)

Heterogenous linear mixed model
fitted by maximum likelihood method

hlme(fixed = remission ~ IL6 + CRP + LengthofStay + Experience +
I(tumorsize^2) + co2 * pain + I(tumorsize^2) * pain, random = ~SmokingHx +
Sex, subject = "ID", ng = 1, data = hdp)

Statistical Model:
Dataset: hdp
Number of subjects: 8525
Number of observations: 8525
Number of latent classes: 1
Number of parameters: 21

Iteration process:
Convergence criteria satisfied
Number of iterations: 34
Convergence criteria: parameters= 1.2e-09
: likelihood= 8.3e-06
: second derivatives= 2.7e-05

Goodness-of-fit statistics:
maximum log-likelihood: -5223.9
AIC: 10489.79
BIC: 10637.86

Maximum Likelihood Estimates:

<center>Fixed effects in the Longitudinal Model:

{| class="wikitable" style="text-align:center; " border="1"
|-
| ||coef||Se||Wald||p-value
|-
|Intercept||0.28636||0.24314||1.178||0.23890
|-
|IL6||-0.01134||0.00183||-6.184||0.00000
|-
|CRP||-0.00674||0.00167||-4.043||0.00005
|-
|LengthofStay||-0.04834||0.00463||-10.436||0.00000
|-
|Experience||0.01695||0.00119||14.263||0.00000
|-
|I(tumorsize^2)||0.00000||0.00001||-0.076||0.93953
|-
|co2||-0.03549||0.16204||-0.219||0.82663
|-
|pain||0.03930||0.04278||0.919||0.35832
|-
|co2:pain||-0.01489||0.02871||-0.519||0.60395
|-
|I(tumorsize^2):pain||0.00000||0.00000||0.553||0.58045
|}
</center>

<center>Variance-covariance matrix of the random-effects

{| class="wikitable" style="text-align:center; " border="1"
|-
| ||intercept||SmokingHxformer||SmokingHxnever||Sexmale
|-
|intercept||0.19310943|| || ||
|-
|SmokingHxformer||-0.10617988||0.209155186|| ||
|-
|SmokingHxnever||-0.12388534||0.068342049||2.262655e-01||
|-
|Sexmale||-0.08130975||-0.007353491||-1.873934e-05||0.1730187

|}
</center>

Residual standard error:

coef: 0.1299767

se: 1.187426

Results interpretation:

(1) The first part of the summary provides information about the dataset, the number of subjects, observations, observations deleted (since by default, missing observations are deleted), number of latent classes and number of parameters.

(2) Next, details about the algorithm convergence is provided along with the number of iterations, the convergence criteria, and the information indicating if the model converged correctly: "convergence criteria satisfied".

(3) The maximum log-likelihood, Akaike criterion (AIC) and Bayesian Information criterion (BIC) are reported.

(4) Estimates of parameters, the estimated standard error, the Wald Test statistics (with Normal approximation) and the corresponding p-values are reported below.

(5) For the random-effect distribution, the estimated matrix of covariance of the random-effects is displayed.

(6) The standard error of the residuals is given along with its estimated standard error.

(7) The effect of TumorSize seems not associated with change over Pain of Remission. This may be formally assessed using a multivariate Wald test:

WaldMult(model.hlme, pos=c(6,8))
# pos - a vector containing the indices in model.hlme of the parameters to test
Wald Test p_value
I(tumorsize^2) = pain = 0 0.85562 0.65193

We may consider the model with an adjustment for CRP only on the intercept. Below we estimate the corresponding models for a varying number of latent classes (from 1 to 3) using the default initial values:

# Initial Model: model.hlme <- hlme(remission ~ IL6 + CRP + LengthofStay + Experience + I(tumorsize^2) + co2*pain + I(tumorsize^2)*pain, random=~ SmokingHx + Sex, subject='ID', data=hdp, ng=1)

model.hlme.1 <- hlme(tumorsize ~ IL6 + CRP + LengthofStay, subject='ID', data=hdp, ng=1)
model.hlme.2 <- hlme(tumorsize ~ IL6 + CRP + LengthofStay + SmokingHx, mixture=~ SmokingHx, subject='ID', data=hdp, ng=2)
model.hlme.3 <- hlme(tumorsize ~ IL6 + CRP + LengthofStay + SmokingHx, mixture=~ SmokingHx, subject='ID', data=hdp, ng=3)

The estimation process for a varying number of latent classes can be summarized with summarytable, which gives the log-likelihood, the number of parameters, the Bayesian Information Criterion, and the posterior proportion of each class:

summarytable(model.hlme.1, model.hlme.2, model.hlme.3)
G loglik npm BIC %class1 %class2 %class3
model.hlme.1 1 -33301.82 5 66648.89 100.000000
model.hlme.2 2 -31592.79 11 63285.15 99.214076 0.7859238
model.hlme.3 3 -31589.55 15 63314.86 6.357771 82.2991202 11.34311

The program took 404.65 seconds

In this example, the optimal number of latent classes according to the BIC is two (the smallest BIC). The posterior classification is described with:

postprob(model.hlme.2)

Posterior classification:
class1 class2
N 8458.00 67.00
% 99.21 0.79

Posterior classification table:
--> mean of posterior probabilities in each class
prob1 prob2
class1 0.8555 0.1445
class2 0.4362 0.5638

Posterior probabilities above a threshold (%):
class1 class2
prob>0.7 92.48 2.99
prob>0.8 77.38 0.00
prob>0.9 38.53 0.00

In this example, the first class includes a posteriori 8458 subjects (99%) while class 2 includes 67 (0.79%) subjects. Subjects were classified in class 1 with a mean posterior probability of 0.8555 %.

In class 1, 92.48% were classified with a posterior probability above 0.7 while 2.99% of the subjects were classified in class 2 with a posterior probability above 0.7. Goodness-of-fit of the model can be assessed by displaying the residuals as in figure and the mean predictions of the model as in figure, according to the time variable given in var.time:

plot(model.hlme.2)
# Figure (left panel)
plot(model.hlme.2, which="fit", var.time="Age", bty="l", ylab=" Remission ", xlab="Age", lwd=2)
# Figure (right panel)
plot(model.hlme.2, which="fit", var.time="Age", bty="l", ylab=" Remission ", xlab="Age", lwd=2, marg=FALSE)

<center>[[Image:SMHS_Methods4.png|500px]] </center>

<center>[[Image:SMHS_Methods5.png|500px]] </center>

<center>[[Image:SMHS_Methods6.png|500px]] </center>

The latent process mixed models implemented in lcmm are illustrated through the study of the linear trajectory of ntumors with Age adjusted for Sex and assuming correlated random-effects for the intercept and Age. Lines estimate the corresponding latent process mixed model with different link functions:

model.hlme.lin <- lcmm(ntumors ~ Age*Sex, random=~ Age ,subject='ID', data=hdp)
model.hlme.beta <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='beta')
model.hlme.spl <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='splines')
model.hlme.spl5q <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='5-quant-splines')

link function: An optional family of link functions. By default,

*"linear" option specifies a linear link function leading to a standard linear mixed model (homogeneous or heterogeneous as estimated in hlme).
*"beta" for estimating a link function from the family of Beta cumulative distribution functions, "thresholds" for using a threshold model to describe the correspondence between each level of an ordinal outcome and the underlying latent process, and
*"Splines" for approximating the link function by I-splines. For this latter case, the number of nodes and the nodes location should be also specified. The number of nodes is first entered followed by,
* -, then the location is specified with "equi", "quant" or "manual" for respectively equidistant nodes, nodes at quantiles of the marker distribution or interior nodes entered manually in argument
*intnodes. It is followed by - and finally "splines" is indicated. For example, "7-equi-splines" means I-splines with 7 equidistant nodes, "6-quant-splines" means I-splines with 6 nodes located at the quantiles of the marker distribution and "9-manual-splines" means I-splines with 9 nodes, the vector of 7 interior nodes being entered in the argument intnodes.

summary (model.hlme.lin)

General latent class mixed model fitted by maximum likelihood method

lcmm(fixed = ntumors ~ Age * Sex, random = ~Age, subject = "ID",data = hdp)

Statistical Model:
Dataset: hdp
Number of subjects: 8525
Number of observations: 8525
Number of latent classes: 1
Number of parameters: 8
Link function: linear

Iteration process:
Maximum number of iteration reached without convergence
Number of iterations: 100
Convergence criteria: parameters= 5.4e-10
: likelihood= 5.5e-10
: second derivatives= 1

Goodness-of-fit statistics:
maximum log-likelihood: -19915.24
AIC: 39846.49
BIC: 39902.89

Discrete posterior log-likelihood: 0
Discrete AIC: 16

Mean discrete AIC per subject: 9e-04
Mean UACV per subject: 0
Mean discrete LL per subject: 0

Maximum Likelihood Estimates:

Fixed effects in the longitudinal model:

coef Se Wald p-value
intercept (not estimated) 0.00000
Age 0.09491
Sexmale -0.66303
Age:Sexmale 0.01132

Variance-covariance matrix of the random-effects:
intercept Age
intercept 20.5013715
Age -0.2889814 0.007696382

Residual standard error (not estimated) = 1

Parameters of the link function:

coef Se Wald p-value
Linear 1 (intercept) -0.36768
Linear 2 (std err) 0.71432

Objects mlin, mbeta, mspl and mspl3eq are latent process mixed models that assume the exact same trajectory for the underlying latent process but respectively a linear, BetaCDF, I-splines with 5 equidistant knots (default with link=’splines’) and I-splines with 5 knots at percentiles. mlin reduces to a standard linear mixed model (link=’linear’ by default). The only difference with a hlme object is the parameterization for the intercept and the residual standard error that are considered as rescaling parameters.

col <- rainbow(4)
plot(model.hlme.lin, which="linkfunction", bty='l', ylab="Number-of-Tumors", col=col[1], lwd=2, xlab="underlying latent process")
plot(model.hlme.beta, which="linkfunction", add=T, col=col[2], lwd=2)
plot(model.hlme.spl, which="linkfunction", add=T, col=col[3], lwd=2)
plot(model.hlme.spl5q, which="linkfunction", add=T, col=col[4], lwd=2)
legend(x="topleft",legend=c("linear", "beta","splines (5equidistant)", "splines (5 at quantiles)"), lty=1,col=col,bty="n",lwd=2)

# to obtain confidence bands use function predictlink
link.lin <- predictlink(model.hlme.lin, ndraws=2000)

Error in predictlink.lcmm(model.hlme.spl, ndraws = 2000):
No confidence intervals can be produced since the program did not converge properly

model.hlme.lin$\$$conv # double-check the convergence of the algorithm[1] 2
# status of convergence:
# =1 if the convergence criteria were satisfied,
# =2 if the maximum number of iterations was reached,
# =4 or 5 if a problem occured during optimisation

model.hlme.lin <- lcmm(ntumors ~ Age*Sex, random=~ Age ,subject='ID', epsY = 0.5, convB = 1e-01, convL = 1e-01, convG = 1e-01, maxiter=200, data=hdp); model.hlme.lin$conv

# Now that we have convergence, we can obtain CI’s!!!
link.lin <- predictlink(model.hlme.lin, ndraws=2000)

# plot(model.hlme.lin, which="linkfunction", bty='l', ylab="Number-of-Tumors", col=col[1], lwd=2, xlab="underlying latent process")
plot(link.lin, add=TRUE, col=col[1], lty=2, lwd=2)
legend(x="left", legend=c("95% confidence bands", "for linear fit"), lty=c(2,NA), col=c(col[1],NA), bty="n", lwd=2)

<center>[[Image:SMHS_Methods7.png|500px]] </center>

# Repeat using the other link functions … model.hlme.beta, model.hlme.spl, …
model.hlme.beta <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='beta',
convB = 1e-01, convL = 1e-01, convG = 1e-01, maxiter=200); model.hlme.beta$\$$conv
link.beta <- predictlink(model.hlme.beta, ndraws=2000)
plot(link.beta, add=TRUE, col=col[2], lty=2, lwd=2)
legend(x="left", legend=c("95% confidence bands", "for BETA fit"), lty=c(3,NA), col=c(col[2],NA), bty="n", lwd=1)

===[[SMHS_MethodsHeterogeneity_MetaAnalysis|Next see: Meta-Analysis]]===
* [[SMHS_MethodsHeterogeneity|Back to the Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research section]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php/SMHS_MethodsHeterogeneity_HTE}}

SMHS MethodsHeterogeneity

2016-05-23T13:21:20Z

Imoubara:

==[[SMHS| Scientific Methods for Health Sciences]] - Methods for Studying Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research ==

==Methods and Approaches for HTE Analytics==

<center>
{| class="wikitable" style="text-align:center; width:99%" border="1"
! colspan="8" |Methods and Approaches for HTE Analytics ****
|-
|||Meta-analysis||CART*||N of 1 trials||LGM/GMM**||QTE***||Nonparametric||Predictive risk models
|-
|Intent of the Analysis||Exploratory and confirmatory||Exploratory||Exploratory and initial testing||"Exploratory, initial testing, and confirmatory"||"Exploratory, initial testing, & confirmatory"||Exploratory and confirmatory||Initial testing and confirmatory
|-
|Data Structure ||"Trial summary results, possibly with subgroup results"||Panel or cross-section||Repeated measures for a single patient: time series||Time series and panel||Panel and cross-sectional||"Panel, time series, and cross-sectional"||Panel or cross-sectional
|-
|Data Size Consideration ||Advantage of combining small sample sizes||Large sample sizes||Small sample sizes||LGM: small to large sample sizes; GMM: Large sample sizes ||Moderate to large sample sizes||Large sample sizes||Sample sizes depends on specific risk function
|-
|Key Strength(s)||Increase statistical power by pooling of results||Does not require assumptions around normality of distribution Can utilize different types of response variables; Possible to identify HTE across trials Possibility to measure and explain covariate's effect on treatment effect ||Patient is own control; Estimates patient-specific effects ||Accounting for unobserved characteristics Heterogeneous response across time||Robust to outcome outliers Heterogeneous response across quantiles||No functional form assumptions Flexible regressions||Multivariate approach to identifying risk factors or HTE
Estimates patient-specific effects
|-
|Key Limitation(s)||Included studies need to be similar enough to be meaningful Assumed distribution; Selection bias||Fairly sensitive to changes in underlying data May not fully identify additive impacts of multiple variables||Requires de novo study Not applicable to all conditions or treatments||Criteria for optimization solutions not clear||"Treatment effect designed for a quantile, not a specific patient"||Computationally demanding Smoothing parameters required for kernel methods||May be more or less interpretable or useful clinically
|}
</center>

* *CART: Classification and regression tree (CART) analysis
* LGM/GMM: Latent growth modeling/Growth mixture modeling.
* QTE: Quantile Treatment Effect.
* Standard meta-analysis like fixed and random effect models, and tests of heterogeneity, together with various plots and summaries, can be found in the [http://cran.r-project.org/web/packages/rmeta R-package rmeta]. Non-parametric R approaches are included in the [http://cran.r-project.org/web/packages/np/vignettes/np.pdf np package].

Additional details are provided in a paper entitled [http://dx.doi.org/10.1186/1471-2288-12-185 From concepts, theory, and evidence of heterogeneity of treatment effects to methodological approaches: a primer].

==[[SMHS_MethodsHeterogeneity_HTE |HTE Analytics, Latent growth and growth mixture modeling (LGM/GMM)]]==

==[[SMHS_MethodsHeterogeneity_MetaAnalysis |Meta-analysis]]==

==[[SMHS_MethodsHeterogeneity_CER| Comparative Effectiveness Research (CER)]]==

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php/SMHS_MethodsHeterogeneity_HTE}}

SMHS SciVisualization

2016-05-23T13:01:44Z

Imoubara:

==[[SMHS| Scientific Methods for Health Sciences]] - Scientific Visualization ==

===Questions===

*How and why should we “look” at data?
*What data characteristics are important for exploratory data analytics (EDAs)?

Scientific Data-driven or Simulation-driven visualization methods may be classified in many alternative ways. Visualization techniques can be classified according to many criteria:

<center>[[Image:SMHS_SciVisualization1.png|500px]] </center>

*Data Type: structured/unstructured, small/large, complete/incomplete, time/space, ascii/binary, Euclidean/non-Euclidean, etc.

*Task type: Task type is one of the aspects considered in classification of visualization techniques, which provides means of interaction between the researcher, the data and the display software/platform

*Scalability: Visualization techniques are subject to some limitations, such as the amount of data that a particular technique can exhibit

*Dimensionality: Visualization techniques can also be classified according to the number of attributes

*Positioning and Attributes: the distribution of attributes on the chart may affect the interpretation of the display representation, e.g., correlation analysis, where the relative distance among the plotted attributes is relevant for observation

*Investigative Need: the specific scientific question or exploratory interest may also determine the type of visualization:

**Examining the composition of the data

**Exploring the distribution of the data

**Contrasting or comparing several data elements, relations, association

**Unsupervised exploratory data mining

http://www.socr.umich.edu/CSCD/html/Cores/Macore2/SciViz.html

==[[SMHS_SciVisualization_SOCR_Excel_R_Charts|SOCR, Excel and R Charts]]==

==[[SMHS_SciVisualization_NetworkViz|Complex Network Visualization]]==

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_SciVisualization}}

SMHS SciVisualization

2016-05-23T12:58:50Z

Imoubara:

==[[SMHS| Scientific Methods for Health Sciences]] - Scientific Visualization ==

===Questions===

*How and why should we “look” at data?
*What data characteristics are important for exploratory data analytics (EDAs)?

Scientific Data-driven or Simulation-driven visualization methods may be classified in many alternative ways. Visualization techniques can be classified according to many criteria:

<center>[[Image:SMHS_SciVisualization1.png|500px]] </center>

*Data Type: structured/unstructured, small/large, complete/incomplete, time/space, ascii/binary, Euclidean/non-Euclidean, etc.

*Task type: Task type is one of the aspects considered in classification of visualization techniques, which provides means of interaction between the researcher, the data and the display software/platform

*Scalability: Visualization techniques are subject to some limitations, such as the amount of data that a particular technique can exhibit

*Dimensionality: Visualization techniques can also be classified according to the number of attributes

*Positioning and Attributes: the distribution of attributes on the chart may affect the interpretation of the display representation, e.g., correlation analysis, where the relative distance among the plotted attributes is relevant for observation

*Investigative Need: the specific scientific question or exploratory interest may also determine the type of visualization:

**Examining the composition of the data</blockquote>

**Exploring the distribution of the data</blockquote>

**Contrasting or comparing several data elements, relations, association</blockquote>

**Unsupervised exploratory data mining</blockquote>

http://www.socr.umich.edu/CSCD/html/Cores/Macore2/SciViz.html

==[[SMHS_SciVisualization_SOCR_Excel_R_Charts|SOCR, Excel and R Charts]]==

==[[SMHS_SciVisualization_NetworkViz|Complex Network Visualization]]==

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_SciVisualization}}

SMHS LinearModeling MachineLearning

2016-05-23T12:57:26Z

Imoubara:

==[[SMHS_LinearModeling|SMHS Linear Modeling]] - Machine Learning Algorithms==

Scientific inference based on fixed and random effect models, assumptions, and mixed effects logistic regression.

Questions:
*How can we tie human intuition and computer-generated results to obtain reliable, effective, and efficient decision-support system (that facilitates, forecasting)?
*Niels Born – “It is difficult to make predictions, especially about the future”
*Can we unsupervisely classify the data?
Prediction

For most of the machine learning algorithms (including first-order linear regression), we:
*ﬁrst generate the model using training data, and then
*predict values for test/new data.

Predictions are made using the R predict function. (type ?predict.name), where name is the function-name corresponding to the algorithm. The ﬁrst argument of predict often represents the variable storing the model, and the second argument is a matrix or data frame of test data that the model needs to be applied to. Calling predict can be done in 2 ways: type predict or type of predict.name.

Example:

#mydata <- read.table('https://umich.instructure.com/files/330381/download?download_frd=1&verifier=HpfmjfMFaMsk7rIpfPx0tmz960oTW7JA8ZonGvVC',as.is=T, header=T) # 01a_data.txt
# mydata <- read.table('data.txt',as.is=T, header=T)

# (1) First, there are different approaches to split the data (partition the data) into
# training and testing sets.
## TRAINING: 75% of the sample size
sample_size <- floor(0.75 * nrow(mydata))
## set the seed to make your partition reproductible
set.seed(1234)
train_ind <- sample(seq_len(nrow(mydata)), size = sample_size)
train <- mydata[train_ind, ]

# TESTING DATA
test <- mydata[-train_ind, ]

lin.mod <- lm(Weight ~ Height*Team, data=train)
predicted.values <- predict(lin.mod, newdata=test

Data Modeling/Training

Logistic Regression:
glm_model <-glm(ifelse(Weight > 200,1,0) ~ Height*Team, family=binomial(link="logit"), data=train)

K-Means Clustering
train.1 <- cbind(train$\$$Height, train$\$$Weight, train$\$$Age)
test.1 <- cbind(test$\$$Height, test$\$$Weight, test$\$$Age)
Weight.1 <- ifelse(train$\$$Weight > 200,1,0)

head(train.1)
kmeans_model <- kmeans(train.1, 3)
plot(train.1, col = kmeans_model$\$$cluster)
points(kmeans_model$\$$centers, col = 1:2, pch = 8, cex = 2)

K-Nearest Neighbor Classiﬁcation
# install.packages("class")
library("class")
knn_model <- knn(train=train.1, test=test.1, cl=as.factor(Weight.1), k=5)
plot(knn_model)
summary(knn_model)

Naïve Bayes Classifier
install.packages("e1071")
library("e1071")
nbc_model <- naiveBayes(Weight ~ Height*Age, data=train.1)

Decision Trees (CART)
#install.packages("e1071")
library("rpart")
cart_model <- rpart(Weight ~ Height+Age, data= as.data.frame(train.1), method="class")
plot(cart_model)
text(cart_model)

AdaBoost
install.packages("ada")
# X be the matrix of features, and labels be a vector of 0-1 class labels.
library("ada")
boost_model <- ada(x= cbind(train$\$$Height, train$\$$Weight, train$\$$Age), y= Weight.1)
plot(boost_model)
boost_model

Support Vector Machines (SVM)
#install.packages("e1071")
library("rpart")
svm_model <- svm(x= cbind(train$\$$Height, train$\$$Weight, train$\$$Age), y=as.factor(Weight.1),
kernel ="radial")
summary(svm_model)

==Appendix==

===Example 1: Simulation (subject, day, treatment, observation)===

Obs ~ Treatment + Day + Subject(Treatment)+ Day*Subject(Treatment)+ ε.

This model is accounts for: 
Response = Obs

Fixed effects: 
Treatment (fixed) 
Day (fixed) 
Treatment*Day interaction

Random Effects: 
Subject nested within Treatment (random) 
Day crossed with "Subject within Treatment" (random)

mydata <- data.frame(
Subject = c(13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 29, 30, 31, 32, 33,
34, 35, 36, 37, 38, 39, 40, 62, 63, 64, 65, 13, 14, 15, 16, 17, 18,
19, 20, 21, 22, 23, 24, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39,
40, 62, 63, 64, 65, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 62, 63, 64, 65),
Day = c(rep(c("Day1", "Day3", "Day6"), each=28)),
Treatment = c(rep(c("B", "A", "C", "B", "C", "A", "A", "B", "A", "C", "B", "C",
"A", "A", "B", "A", "C", "B", "C", "A", "A"), each = 4)),
Obs = c(6.472687, 7.017110, 6.200715, 6.613928, 6.829968, 7.387583, 7.367293,
8.018853, 7.527408, 6.746739, 7.296910, 6.983360, 6.816621, 6.571689,
5.911261, 6.954988, 7.624122, 7.669865, 7.676225, 7.263593, 7.704737,
7.328716, 7.295610, 5.964180, 6.880814, 6.926342, 6.926342, 7.562293,
6.677607, 7.023526, 6.441864, 7.020875, 7.478931, 7.495336, 7.427709,
7.633020, 7.382091, 7.359731, 7.285889, 7.496863, 6.632403, 6.171196,
6.306012, 7.253833, 7.594852, 6.915225, 7.220147, 7.298227, 7.573612,
7.366550, 7.560513, 7.289078, 7.287802, 7.155336, 7.394452, 7.465383,
6.976048, 7.222966, 6.584153, 7.013223, 7.569905, 7.459185, 7.504068,
7.801867, 7.598728, 7.475841, 7.511873, 7.518384, 6.618589, 5.854754,
6.125749, 6.962720, 7.540600, 7.379861, 7.344189, 7.362815, 7.805802,
7.764172, 7.789844, 7.616437, NA, NA, NA, NA))

install.packages("lme4")
library("lme4", lib.loc="~/R/win-library/3.1")
m1 <- lmer(Obs ~ Treatment * Day + (1 | Subject), mydata)
m1

Linear mixed model fit by REML ['lmerMod']

Formula: Obs ~ Treatment * Day + (1 | Subject)

Data: mydata

REML criterion at convergence: 56.8669

<center> Random Effects
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|Groups||Name||Std. Dev.
|-
|Subject||(Intercept)||0.2163
|-
|Residual|| ||0.2602

|}
Number of obs: 80, groups: Subject, 28 </center>

<center> Fixed Effects
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|(Intercept)||TreatmentB||TreatmentC
|-
|7.1827||-0.6129||0.1658
|-
|DayDay3||DayDay6 ||TreatmentB: DayDay3
|-
|0.2446||0.4507||-0.1235
|-
|TreatmentC: DayDay3||TreatmentB: DayDay6||TreatmentC: DayDay6
|-
|-0.2740||-0.3508||-0.3327

|}
</center>

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|Index||Subject||Day||Treatment||Obs
|-
|1||13||Day1||B||6.472687
|-
|2||14||Day1||B||7.01711
|-
|3||15||Day1||B||6.200715
|-
|4||16||Day1||B||6.613928
|-
|5||17||Day1||A||6.829968
|-
|6||18||Day1||A||7.387583
|-
|7||19||Day1||A||7.367293
|-
|8||20||Day1||A||8.018853
|-
|9||21||Day1||C||7.527408
|-
|10||22||Day1||C||6.746739
|-
|11||23||Day1||C||7.29691
|-
|12||24||Day1||C||6.98336
|-
|13||29||Day1||B||6.816621
|-
|14||30||Day1||B||6.571689
|-
|15||31||Day1||B||5.911261
|-
|16||32||Day1||B||6.954988
|-
|17||33||Day1||C||7.624122
|-
|18||34||Day1||C||7.669865
|-
|19||35||Day1||C||7.676225
|-
|20||36||Day1||C||7.263593
|-
|21||37||Day1||A||7.704737
|-
|22||38||Day1||A||7.328716
|-
|23||39||Day1||A||7.29561
|-
|24||40||Day1||A||5.96418
|-
|25||62||Day1||A||6.880814
|-
|26||63||Day1||A||6.926342
|-
|27||64||Day1||A||6.926342
|-
|28||65||Day1||A||7.562293
|-
|29||13||Day3||B||6.677607
|-
|30||14||Day3||B||7.023526
|-
|31||15||Day3||B||6.441864
|-
|32||16||Day3||B||7.020875
|-
|33||17||Day3||A||7.478931
|-
|34||18||Day3||A||7.495336
|-
|35||19||Day3||A||7.427709
|-
|36||20||Day3||A||7.63302
|-
|37||21||Day3||C||7.382091
|-
|38||22||Day3||C||7.359731
|-
|39||23||Day3||C||7.285889
|-
|40||24||Day3||C||7.496863
|-
|41||29||Day3||B||6.632403
|-
|42||30||Day3||B||6.171196
|-
|43||31||Day3||B||6.306012
|-
|44||32||Day3||B||7.253833
|-
|45||33||Day3||C||7.594852
|-
|46||34||Day3||C||6.915225
|-
|47||35||Day3||C||7.220147
|-
|48||36||Day3||C||7.298227
|-
|49||37||Day3||A||7.573612
|-
|50||38||Day3||A||7.36655
|-
|51||39||Day3||A||7.560513
|-
|52||40||Day3||A||7.289078
|-
|53||62||Day3||A||7.287802
|-
|54||63||Day3||A||7.155336
|-
|55||64||Day3||A||7.394452
|-
|56||65||Day3||A||7.465383
|-
|57||13||Day6||B||6.976048
|-
|58||14||Day6||B||7.222966
|-
|59||15||Day6||B||6.584153
|-
|60||16||Day6||B||7.013223
|-
|61||17||Day6||A||7.569905
|-
|62||18||Day6||A||7.459185
|-
|63||19||Day6||A||7.504068
|-
|64||20||Day6||A||7.801867
|-
|65||21||Day6||C||7.598728
|-
|66||22||Day6||C||7.475841
|-
|67||23||Day6||C||7.511873
|-
|68||24||Day6||C||7.518384
|-
|69||29||Day6||B||6.618589
|-
|70||30||Day6||B||5.854754
|-
|71||31||Day6||B||6.125749
|-
|72||32||Day6||B||6.96272
|-
|73||33||Day6||C||7.5406
|-
|74||34||Day6||C||7.379861
|-
|75||35||Day6||C||7.344189
|-
|76||36||Day6||C||7.362815
|-
|77||37||Day6||A||7.805802
|-
|78||38||Day6||A||7.764172
|-
|79||39||Day6||A||7.789844
|-
|80||40||Day6||A||7.616437
|-
|81||62||Day6||A||NA
|-
|82||63||Day6||A||NA
|-
|83||64||Day6||A||NA
|-
|84||65||Day6||A||NA

|}
</center>

===Example 2: Genotype-phenotype===

Save this data file as a tab-separated TXT file:

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|Genotype||Race||Subject||Weight
|-
|A||1||1||8
|-
|A||1||2||9
|-
|A||1||3||11
|-
|A||1||4||12
|-
|A||1||5||10
|-
|A||2||1||17
|-
|A||2||2||17
|-
|A||2||3||16
|-
|A||2||4||15
|-
|A||2||5||19
|-
|A||2||6||18
|-
|A||2||7||18
|-
|A||2||8||18
|-
|A||2||9||24
|-
|A||3||1||12
|-
|A||3||2||12
|-
|A||3||3||16
|-
|A||3||4||15
|-
|A||3||5||15
|-
|A||3||6||14
|-
|A||4||1||17
|-
|A||4||2||20
|-
|A||4||3||20
|-
|A||4||4||19
|-
|A||4||5||19
|-
|A||4||6||18
|-
|A||4||7||20
|-
|A||4||8||19
|-
|A||4||9||19
|-
|B||5||1||9
|-
|B||5||2||12
|-
|B||5||3||13
|-
|B||5||4||16
|-
|B||5||5||14
|-
|B||5||6||14
|-
|B||6||1||10
|-
|B||6||2||10
|-
|B||6||3||9
|-
|B||6||4||8
|-
|B||6||5||13
|-
|B||6||6||9
|-
|B||6||7||11
|-
|B||7||1||12
|-
|B||7||2||16
|-
|B||7||3||17
|-
|B||7||4||15
|-
|B||7||5||15
|-
|B||7||6||15
|-
|B||8||1||9
|-
|B||8||2||6
|-
|B||8||3||8
|-
|B||8||4||8
|-
|B||8||5||13
|-
|B||8||6||9
|-
|B||8||7||9
|-
|B||8||8||10

|}
</center>

# data <- read.table('C:\\Users\\Dinov\\Desktop\\data.txt',as.is=T, header=T)
data <- read.table('data.txt',as.is=T, header=T)
names(data)
attach(data)
table(Genotype, Race)
table(Race, Subject)

# for demonstration, construct a balanced data set
# 5 subjects for each race
data_balance <- data[data$\$$Subject <=5,]

# create factors
data_balance$\$$g <- as.factor(data_balance$\$$Genotype)
data_balance$\$$t <- as.factor(data_balance$\$$Race)
data_balance$\$$s <- as.factor(data_balance$\$$Subject)

# fit the ANOVA
anova.model <- lm(Weight ~ g+t, data= data_balance)
# get the ANOVA table
anova(anova.model)

# note that all F tests use MSE, subjects within race as denominator
# will need to hand-calculate test for genotypes

# Random effects modeling estimation using REML
library(lme4)

lme.model <- lmer(Weight~g+(1|t),data= data_balance)
summary(lme.model)
anova(lme.model)

# various extractor functions:
fixef(lme.model) # estimates of fixed effects
vcov(lme.model) # VC matrix for the fixed effects
VarCorr(lme.model) # estimated variance(-covariance) for random effects
ranef(lme.model) # predictions of random effects
coef(lme.model) # fixed effects + pred's of random effects
fitted(lme.model) # conditional means for each obs (X bhat + Z uhat)
resid(lme.model) # conditional residuals (Y - fitted)

# REML is the default method for estimating variance components.
# If want to use ML, can specify that
lmer(Weight~g+(1|t),REML=F, data= data_balance)

# Now, to get p-values for the effects, or construct a ci
# inference on Subject weight focus is the difference between the two genotypes
# which is Cb for C = [0, 1] using the default R parameterization
# following assumes lme4 library loaded, data frame is d
# uses full data set (unbalanced)
# also assumes g and t are factors identifying genotypes and trays

# fit the model
data$\$$g <- as.factor(data$\$$Genotype)
data$\$$t <- as.factor(data$\$$Race)
data$\$$s <- as.factor(data$\$$Subject)

# See R DATA TYPES: http://www.statmethods.net/input/datatypes.html

model.lmer <- lmer(Weight ~ g + (1|t), data= data)
# get a confidence interval for g
# slower, obvious programing
nsim <- 10
gdiff <- rep(NA, nsim)
for (i in 1:nsim) {
data$\$$y <- simulate(model.lmer) # param bootstrap data set
model.lmer.1 <- lmer(unlist(data$\$$y) ~ g + (1|t), data= data)
# we need to turn the list of simulated values (y) into an atomic vector with unlist()
# both data frames and models objects (e.g., produced by lm()) are lists
# http://adv-r.had.co.nz/Data-structures.html
gdiff[i] <- fixef(model.lmer.1)[2] # keep only the est diff
}
quantile(gdiff, c(0.025, 0.975))
# print 95% CI of the coefficient/effect-size of genotype(g)

# print model summary
summary(model.lmer)

# two ways to speed up CI construction and increase simulations to 1K
# use apply to avoid the for loop
# use refit() to avoid the setup time before fitting the LME

yall <- simulate(model.lmer, nsim=1000)
gdiff <- apply(yall, 2, function(y) {fixef(refit(model.lmer, y))[2]})
quantile(gdiff, c(0.025, 0.975))

# To get both the estimate and the SE
# which are in the fixed effect table returned by summary()
# use the extractor functions fixef() and vcov()

yall <- simulate(model.lmer, nsim=1000)
gdt <- apply(yall, 2, function(y) {
model.lmer.2 <- refit(model.lmer, y);
c(fixef(model.lmer.2)[2], sqrt(vcov(model.lmer.2)[2,2]) )
})
gdt <- t(gdt) # because result of apply is 2 rows, nsim cols

# Using gdt, we can obtain a parametric bootstrap-t interval

# Hypothesis testing: here we need to simulate under H0: g = 0
# To find the t statistic and the F statistic
# t statistic is in the @coefs table
# F statistic is a value in the anova() output
# if more than one test, need to subscript (unless you want all F's)
# need to reference as a list to avoid R issues

# Complete model with genotypes
model.lmer <- lmer(Weight ~ g + (1|t), data= data)

model.lmer.0 <- lmer(Weight ~ (1|t), data=data)
yall <- simulate(model.lmer.0, nsim=1000)
# NB: simulate data under model.lmer.0
gdt0 <- apply(yall, 2, function(y) {
model.lmer.2 <- refit(model.lmer, y); # but analyze under alt. model (model.lmer)
c(summary(model.lmer.2), anova(model.lmer.2)$\$$'F value' )
})
gdt0 <- t(gdt0)

# obs t = 1.438179, p-value using t statistic:
coef(summary(model.lmer))
mean(abs(gdt0[,1]$\$$sim_1$\$$residuals) >= 1.438179)
# p-value = 0.125

# obs F = 2.0684
anova(model.lmer)
mean(gdt0[,2]$\$$sim_2$\$$residuals >= 2.0684)
# p-value = 0.01785714

Baseball data

http://wiki.socr.umich.edu/index.php/SOCR_Data_MLB_HeightsWeights

data <- read.table('E:\\Ivo.dir\\Research\\UMichigan\\Education_Teaching_Curricula\\2015_2016\\HS_853_Fall_2015\\Modules_docx\\01a_data.txt',as.is=T, header=T)
boxplot(Weight ~ Position, data = data, xlab = "Position", ylab = "Weight",
main = "MLB Weight Distribution by Position")
boxplot(Weight ~ Team, data = data, xlab = "Team", ylab = "Weight",
main = "MLB Team Weight Distributions")

===References===

Bates, D.M., Maechler, M., & Bolker, B. (2012). lme4: Linear mixed-effects models using S4 classes. R package version 0.999999-0.

Baayen, R.H. (2008). Analyzing Linguistic Data: A Practical Introduction to Statistics Using R. Cambridge: Cambridge University Press.

Baayen, R.H., Davidson, D.J., Bates, D.M. (2008). Mixed-effects modeling with crossed random effects for subjects and items. Journal of Memory and Language, 59, 390-412.

Barr, D.J., Levy, R., Scheepers, C., & Tilly, H. J. (2013). Random effects structure for confirmatory hypothesis testing: Keep it maximal. Journal of Memory and Language, 68, 255–278.

Bolker, B. M., Brooks, M. E., Clark, C. J., Geange, S. W., Poulsen, J. R., Stevens, M. H. H., & White, J. S. S. (2009). Generalized linear mixed models: a practical guide for ecology and evolution. Trends in Ecology & Evolution, 24(3), 127-135.

Wike, E.L., & Church, J.D. (1976). Comments on Clark’s “The language-as-fixed-effect fallacy”. Journal of Verbal Learning & Verbal Behavior, 15, 249-255.

Winter, B. (2013). Linear models and linear mixed effects models in R with linguistic applications. arXiv:1308.5499. [http://arxiv.org/pdf/1308.5499.pdf]

....

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_LinearModeling_MachineLearning}}

SMHS LinearModeling LMM

2016-05-23T12:56:21Z

Imoubara:

==[[SMHS_LinearModeling| SMHS Linear Modeling]] - Linear Mixed Effects Analyses==

Scientific inference based on fixed and random effect models, assumptions, and mixed effects logistic regression.

Questions:
*What happens if data are not independent and identically distributed (IIDs)?
*How to model multiple observations for the case/subject (across time, conditions, etc.)?

===Fixed and Random Effects===

Linear models express relationships between data elements (variables) in terms of a (linear) function. For example, we can model weight as a function of height.

Weight ~ Height + ε

Here, “height” is a fixed effect, and ε is our “error term” representing the deviations between the model predictions and observations (of weight) due to “random” factors that we cannot control experimentally. This tem (ε) is the “probabilistic” or “stochastic” part of the model. Let’s try to unpack “ε” and add complexity to it. In mixed (fixed and random effect) models, everything in the “systematic” part of your model works just like with linear models. If we change the random aspect of our model this leaves the systematic part (height) unchanged.

Suppose we’re looking at the Baseball data and try to identify a relationship that looks like this:

Weight ~ position + ε

Position (player field position) is treated as a categorical factor with several levels (e.g., Catcher, First-Baseman, etc.) On top of that, we also have an additional fixed effect, Height, and so our bivariate linear model looks more like this:

Weight ~ Height + position + ε

This model expansion is nice, but it complicates a bit the data analytics and scientific inference. If the study design involved taking multiple measures per player, say across time/age, each player would yield multiple position, height and weight responses. According to the assumptions of the linear model, this would violate the independence assumption, as multiple responses from the same subject cannot be regarded as independent from one another. Every player has a slightly different weight, and this is going to be an idiosyncratic factor that affects all responses from the same player, thus rendering these different responses inter-dependent (within player) instead of independent, as required by the model assumptions.

A way to resolve this model assumption violation is to add a random effect for players. This allows us to account for inter-independences by assuming a different “baseline” weight value for each player. For example, player 1 may have a mean weight 200 pounds across different times, and player 2 may have a mean weight of 350 pounds. Here’s a visual depiction of how this looks like:

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|Team A_Player1||Team A_Playe2||Team A_Player3||Team A_Player4||Team A_Player5||Team B_Player1||Team B_Player2||Team B_Player 3
|-
|160||340||240||340||180||200||240||180
|-
|180||340||240||400||240||200||320||120
|-
|220||320||320||400||260||180||340||160
|-
|240||300||300||380||320||160||300||160
|-
|200||380||300||380||280||260||300||260
|-
|220||360||280||360||280||180||300||180
|-
|260||360||320||400||260||240||320||180
|-
|200||360||280||380||300||220||320||200
|-
|220||480||260||380||280||180||300||220
|}
</center>

<center>[[Image:SMHS_LinearModeling_Fig26.png|500px]]</center>

<center>[[Image:SMHS_LinearModeling_Fig27.png|500px]]</center>

SOCR Charts generated these plots (http://www.socr.umich.edu/html/cha/). The same data may similarly be plotted using R:

data <- read.table('C:\\Users\\Dinov\\Desktop\\01a_data.txt',as.is=T, header=T)
# data <- read.table('https://umich.instructure.com/files/330381/download?download_frd=1&verifier=HpfmjfMFaMsk7rIpfPx0tmz960oTW7JA8ZonGvVC',as.is=T, header=T)
attach(data)
boxplot(TeamA_Player1, TeamA_Player2, TeamA_Player3, TeamA_Player4, TeamA_Player5, TeamB_Player1, TeamB_Player2, TeamB_Player3, col=c("white","lightgray"))
boxplot(data, las = 2)
boxplot(data, las = 2, par(mar = c(8, 5, 4, 2)+ 0.1))

<center>[[Image:SMHS_LinearModeling_Fig28.png|500px]]</center>

We can model these individual differences by assuming different random intercepts for each player. In other words, each player will be assigned a different intercept value, and the mixed model estimates these intercept values.

The (fixed effects) linear models include several fixed effects and a general error term “ε”. Linear modeling segregates the world into things that we understand as systematic, i.e., fixed effects or the explanatory variables, and things that we cannot control for or poorly understand (error, ε). Statistical inference requires that the unsystematic part (ε) of the model does not have any interesting structure or pattern – it should represent random white noise with common (iid) across-the-board characteristics.

In mixed modeling, we add one or more terms to the fixed effects to account for random effects. These random effects essentially generalize the model (make it more applicable in situations when the error term does have structure) – that is, the random effect models pull out structure from the error term “ε”. For instance, in the baseball weights example, we add a random effect for “player”, and this characterizes idiosyncratic variation that is due to individual body build differences. The intertwining of fixed and random effects is what makes these models mixed-effect models.

Our updated formula looks like this:

M1: Weight ~ Height + position + ε1 
M2: Weight ~ Height + position + (1|player) + ε2

“(1|player)” is the R notation for random player effects. It assumes an intercept that’s different for each player”, and “1” stands for the constant-term or intercept. This formula explicitly states that the model should account for (inter-player dependencies) multiple responses per player (say over time) – i.e., account for different baselines for each player. This effectively resolves the conflict with weight-dependences within players that stem from multiple weight observations.

The mixed effect model still contains a general error term “ε”, because although it accounts for individual by-player variation, there are still going to be “random” differences between different body-size measurements (e.g., weight) from the same player (noise).

The player position represents an additional source of non-independence that may need to be accounted for. Similarly to the case of by-player variation, we may expect by-position variation. For instance, there might be some special body-size demands for different positions that may lead to overall higher/lower weight. The weight measurements for different players may be similarly affected by this random factor due to game-position-specific idiosyncrasies. Thus, the different responses to one position may not always be independent. There may be some similarities in multiple weight measurements for the same play-position – even if these come from different players. Disregarding these interdependencies, we may violate the linear model independence assumptions. Below is an exemplary visual representation of the by-position variability in weight.

data <- read.table('https://umich.instructure.com/files/330381/download?download_frd=1&verifier=HpfmjfMFaMsk7rIpfPx0tmz960oTW7JA8ZonGvVC',as.is=T, header=T)
library("reshape2")
# melting by "Position". `melt is from the reshape2 package.
# do ?melt for help
data.m <- melt(data[,-c(1:2)], id.var = "Position")
#
require(ggplot2)
ggplot(data = data.m, aes(x=variable, y=value)) + geom_boxplot(aes(fill=Position))

ggplot(data = data.m, aes(x=Position, y=value)) +
geom_boxplot() + facet_wrap(~variable,ncol = 4)

p <- ggplot(data = data.m, aes(x=variable, y=value))
p <- p + geom_boxplot(aes(fill = Position))
# to color the points replace group with color=Position
p <- p + geom_point(aes(y=value, group=Position), position = position_dodge(width=0.75))
p <- p + facet_wrap( ~ variable, scales="free")
p <- p + xlab("x-axis") + ylab("y-axis") + ggtitle("Title")
p <- p + guides(fill=guide_legend(title="Legend_Title"))
p

<center>[[Image:SMHS_LinearModeling_Fig29.png|500px]]</center>

The variation between positions may be different from the variation between players!

To add an additional random effect for position we expand the model:

Weight ~ Height + position + (1|player) + (1|position) + ε

Note that a similar argument may be made for “Team”, there could be error-term dependencies or patterns reflecting the between-team random effects on weight – some teams may be bulkier than others. This is really well documented in sports (e.g., top notch Serbian and Spanish water polo teams have a vastly different physiques).

data.m2 <- melt(data[,-c(1,3)], id.var = "Team")
# require(ggplot2)
p <- ggplot(data = data.m2, aes(x=variable, y=value)) + geom_boxplot(aes(fill=Team))
p + facet_wrap( ~ variable, scales="free")

<center>[[Image:SMHS_LinearModeling_Fig30.png|500px]]</center>

Thus, in addition to modeling different intercepts for different players, we may include, as necessary, different intercepts for different positions or teams. This “resolves” dependencies in the linear model, potentially accounting for multiple responses per player, position or team, and we correctly representing the model by-player and by-position variation in overall weight.

Prior to the advent of mixed linear models, researchers used the averages of all multiple records. For example, in nursing, researchers may average the vital signs (e.g., heart rates, temperatures, etc.) of their patients over time or condition for a patient-based analysis where each data point is assumed to be derived from one subject, assuring independence. Then researchers may also average over subjects for a diagnostic condition type analysis, where each data point comes from one condition. There are advantages and disadvantages of this averaging approach.
Whereas traditional analyses based on averaging are in principle correct, mixed models provide more flexibility and take the complete data into account. In a patient-based analysis (averaging over conditions/Dx), we basically disregard the by-condition variability. Conversely, in a condition-based analysis, we may disregard by-patient variation. A mixed-effect model would account for both sources of variation in a single analysis.

Let’s apply this understanding of the linear mixed effects modeling via R.

R commands for mixed-effect modeling
(See appendix for complete R script) Open RStudio9 and install the R package lme410 :

install.packages(“lme4”)
library(lme4)

This makes available the function lmer(), which is the mixed model equivalent of the function lm() in the fixed-effect model. Load some data in RStudio11,12 .
data = read.csv(file.choose( ))
attach(data)

You can also try the R QCC package (for quality control, see the first section of this tutorial):
install.packages("qcc")
library("qcc", lib.loc="~/R/win-library/3.1")
data(orangejuice)
attach(orangejuice)
qcc(D[trial], sizes=size[trial], type="p")

<center>[[Image:SMHS_LinearModeling_Fig31.png|500px]]</center>

Test the data-import and get a summary by using head(), tail(), summary(), str(), colnames(), or whatever commands you commonly use to get an overview of a dataset. Also, it is always good to check for missing values:

which(is.na(Team)==T)

If there are missing values, there are no problems for the mixed-effect modeling.

Using the MLB Baseball data13 we can explore relationship between variables (e.g., Height and Weight) by means of boxplots:

# data <- read.table('E:\\Ivo.dir\\Research\\UMichigan\\Education_Teaching_Curricula\\2015_2016\\HS_853_Fall_2015\\Modules_docx\\data\\01a_data.txt',as.is=T, header=T)
data <- read.table('data.txt',as.is=T, header=T)
boxplot(Weight ~ Height, col=c("white","lightgray"))
boxplot(Weight ~ Height*team, col=c("white","lightgray"))

<center>[[Image:SMHS_LinearModeling_Fig32.png|500px]]</center>

Is the thick median line in the middle of the boxplot lower for the light than the heavier players?

To construct the mixed model try the command below …

lmer(Weight ~ Height, data=data)

You will get an error that should look like this:
Error: No random effects terms specified in formula

This is because the model needs at least 1 random effect however we only specified a single fixed effect (Height). So, let’s add random intercepts for subjects and items (remember that items are called “scenarios” here):

model.lmer <- lmer(Weight ~ Height + (1|Team) + (1|Position), data= data)

This command creates a model that includes a fixed effect “Height” to predict Weight, controlling for by-team and by-position variability. The model is saved in an object model.lmer. To see the model type in model.lmer – this will print the output in the shell. Note that in the classical fixed effect model, lm(), we need to use summary() to get this output.

This is the full output:
summary(model.lmer)

Linear mixed model fit by REML ['lmerMod']
Formula: Weight ~ Height + (1 | Team) + (1 | Position)
Data: data

REML criterion at convergence: 8841.4

Scaled residuals:
Min 1Q Median 3Q Max
-2.9396 -0.6885 -0.0222 0.6010 4.1358

Random effects:
Groups Name Variance Std.Dev.
Team (Intercept) 1.285 1.133
Position (Intercept) 56.218 7.498
Residual 295.652 17.195
Number of obs: 1034, groups: Team, 30; Position, 9

Fixed effects:
Estimate Std. Error t value
(Intercept) -142.8215 19.0160 -7.511
Height 4.6973 0.2571 18.271

Correlation of Fixed Effects:
(Intr)
Height -0.991

The output starts with the user-specified model and data. Then, there’s the restricted maximum likelihood (ReML) criterion, summary of the model residuals (ε), followed by random and fixed effects.

The ''standard deviation column'' represents a measure of the variability for each random effect included in the model. “Team” has much less variability than Position. The Residual row represents the variability that’s not due to either Team or Position. This is the ε term – random deviations from the predicted values that are not due to Team or Position. This reflects the fact that body-size has some factors that affect Weight that are outside of the observations we have in this experiment. Similarly, to the fixed effect models, the fixed effects output in this mixed model output includes estimates, SE and T-statistic.

The coefficient of “Height” (4.6973) is the slope for this variable. Finally, the Correlation of the Fixed Effects (H vs. Intercept) is reported to be negative! The output under "''correlation of fixed effects''" has a different interpretation from the intuitive meaning. It is not about the correlation of the variables, but about the “expected correlation of the regression coefficients”. This may, or may not, be related to multicollinearity. In this case, ''corr(H,Intrc)''= -0.991 suggests that if we redo the experiment again a decrease of the Height coefficient will increase the intercept, and vice-versa, an increase of the Height coefficient is expected to drive down the intercept term (which is currently =-142.8215).

plot(Height, Weight, main="Scatterplot Height vs. Weight", xlab="Height ", ylab="Weight ", pch=19)
# Add fit lines
abline(lm(Weight~Height), col="red") # regression line (W~H)
lines(lowess(Height,Weight), col="blue") # lowess line (H,W), (locally weighted scatterplot smoothing)

<center>[[Image:SMHS_LinearModeling_Fig33.png|500px]]</center>

Inference on LMER coefficients: The Satterthwaite approximation, implemented in the lmerTest package, overloads the lmerM function, using exactly the same model, but the summary() will include approximate degrees of freedom and p-values for all predictors.

# install.packages("lmerTest")
library(lmerTest)

# re-fit model
model.lmer <- lmer(Weight ~ Height + (1|Team) + (1|Position), data= data, REML = FALSE)
coeffs <- data.frame(coef(summary(model.lmer)))

# get Satterthwaite-approximated degrees of freedom
coeffs$\$$df.Satt <- coef(summary(model.lmer))[, 3]
# get approximate p-values
coeffs$\$$p.Satt <- coef(summary(model.lmer))[, 5]
coeffs

Estimate Std..Error df t.value Pr...t.. df.Satt
(Intercept) -143.26916 18.9698712 977.2059 -7.552458 9.792167e-14 977.2059
Height 4.70294 0.2567663 1030.9565 18.316031 0.000000e+00 1030.9565
p.Satt
(Intercept) 9.792167e-14
Height 0.000000e+00

For categorical variables, like in the fixed effect model, lm(), the mixed effect model, lmer(), takes whatever comes first in the alphabet to be the reference level. “A” comes before “C”, so the slope representing the change from “A” to “C” for a categorical variable (e.g., Team) is in that direction. If the interpretation requires the reference category to be “C”, rather than “A”, then we need to change how we interpret the sign of the slope coefficient. However, interpretation of standard errors and significance would remain unchanged (as there are sign agnostic).

As the earlier model (model.lmer <- lmer(Weight ~ Height + (1|Team) + (1|Position), data= data)) did not account for age, the intercept may be biased between different age groups. If there are age effects – e.g., the distribution of weights may be bimodal (for younger and older players) – then the average weight may not be representative at all. Think of a study of mammals including 10 bipedal (humans) and 10 quadrupedal (dogs) where the mean number of legs of a mammal would be 3 ((10*2+10*4)/20=3), which is not informative and actually incorrect for mammals.

Adding Age as an additional fixed effect:

lmer.model.2 = lmer(Weight ~ Height + Age + (1|Team) + (1|Position), data=data)

This expands the original model object lmer.model with an age predictor. “Age” is added as a fixed effect, because the relationship between Age and Weight is systematic and predictable (not random). Older players are expected to have higher weights.

plot(Age, Weight, main="Scatterplot Age vs. Weight", xlab="Age ", ylab="Weight ", pch=19)
abline(lm(Weight~Age), col="red") # regression line (W~A)

<center>[[Image:SMHS_LinearModeling_Fig34.png|500px]]</center>

Note that Age is different from the random effects for Team and Position, where the relationship between these and Weight is more unpredictable or stochastic.

Look at the residuals of lmer.model.2 output:

summary(lmer.model.2)
Linear mixed model fit by REML ['lmerMod']
Formula: Weight ~ Height + Age + (1 | Team) + (1 | Position)
Data: data

REML criterion at convergence: 8792.2

<center>
Scaled Residuals
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
|Min||1Q||Median||3Q||Max
|-
| -2.9434||-0.6454||-0.0414||0.6022||4.4715
|}
</center>

<center>
Random Effects
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
|Groups Name||Variance||Std. Dev.
|-
|Team (Intercept)||1.136||1.066
|-
|Position (Intercept)||47.935||6.924
|-
|Residual||281.805||16.787
|}
Number of obs: 1034, groups: Team, 30; Position, 9
</center>

<center>
Fixed Effects
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
| ||Estimate Std.||Error||t Value
|-
|(Intercept)||-176.4537||19.0913||-9.243
|-
|Height||4.8043||0.2512||19.125
|-
|Age||0.8888||0.1222||7.273
|}
</center>

<center>
Correlation of Fixed Effects
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
|||(Intr)||Height
|-
|Height||-0.974||
|-
|Age||-0.240||0.056
|}
</center>

Note that compared to our earlier model without the fixed effect for Age, the variation that’s associated with the random effects for “Team” and “Position” are reduced. This is because the variation due to Age may be confounded with the variation that’s due to Team/Position. As the initial model didn’t know about Age, its predictions were relatively more varying, producing larger residuals.

Exploring the fixed effect coefficients:

<center>
Fixed Effects
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
| ||Estimate Std.||Error||t Value
|-
|(Intercept)||-176.4537||19.0913||-9.243
|-
|Height||4.8043||0.2512||19.125
|-
|Age||0.8888||0.1222||7.273
|}
</center>

We see that the impact of Age on Weight is about 0.9, with an intercept of -176 (pounds). The coefficient for the fixed effect of Height changed slightly, from 4.6973 to 4.8.

===Scientific Inference===

Reporting LME models requires explicit quantitative estimation of probability values expressing the statistical significance of these estimates. Interpretation of p-values for mixed models is different from their counterparts in fixed-effects linear models. The Likelihood Ratio Test provides one approach to obtain the p-values. Likelihood is the (conditional) probability of seeing the observed data given a model. The likelihood ratio test compares the (ratio of) two likelihoods corresponding to two alternative models. For instance, suppose we are interested in quantifying the significance of a factor A. The model without the factor A (the null model), will be compared to the model with the factor A.

Suppose we are comparing the following 2 models aiming to assess the significance of the impact of Age on Weight.

m1: Weight ~ Height + Age 
m2: Weight ~ Height

A significant difference between “m2” and “m1” would yield that Age matters as a predictor of Weight. Similarly, to estimate the effect of the Height, you would have to do a similar comparison:

m1’: Weight ~ Height + Age 
m2’: Weight ~ Age

In both cases, we compared a full model (with the fixed effects in question) against a reduced model without the variable of interest explicitly modeled. A fixed effect would be significant if the ratio between the likelihoods of these two models is significant. In R, we start by constructing the null model:

lmer.model.0 <- lmer(Weight ~ Height + (1|Team) + (1|Position), data=data, REML=FALSE)

Note the added the argument REML=FALSE that changes the calculation of the likelihood estimator, which is required when comparing models using the likelihood ratio test. Then, we re-do the full model, also with REML=FALSE:

lmer.model.1 <- lmer(Weight ~ Height + Age+ (1|Team) + (1|Position), data=data, REML=FALSE)

To compare the two models (the full model with the effect in question with the null model without the effect), we perform the likelihood ratio test using the anova() function:

anova(lmer.model.0, lmer.model.1)

The output of this call is:

Data: data
Models:
lmer.model.0: Weight ~ Height + (1 | Team) + (1 | Position)
lmer.model.1: Weight ~ Height + Age + (1 | Team) + (1 | Position)
Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
lmer.model.0 5 8854.3 8879.0 -4422.1 8844.3
lmer.model.1 6 8804.5 8834.1 -4396.2 8792.5 51.795 1 6.16e-13 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

The report starts with the formulas of the two models, computes a Chi-Square statistics with associated degrees of freedom (2-1), and reports the p-value representing the strength of the data-driven evidence to reject the null-model (and hence to accept the significance of the factor of interest, Age, as impactful on Weight). The qualitative interpretation of these quantitative results may be stated as:

“… Age affects Weight ''X''2(1)=51.79, p< 10-12), increasing it (annually) by about 0.89 lb ± 0.1222 (standard error) …”

We are using a Chi-Square test because Wilk’s Theorem states that $-2log(\frac{Likelihood\_Null\_model(m0)}{Likelihood\_full\_model(m1)}$) approaches a Chi-Square distribution with degrees of freedom equal to the number of parameters that differ between the models (in this case, only “Age”, so ''df''=1).

This likelihood-based inference approach is somewhat different from the classical t-tests, ANOVA and linear model inference. Instead of obtaining a p-value directly from the MLE model, we need to run a second-order analysis (in this case ANOVA on the 2 models) to compare them and derive a p-value.

Note that the “Height” predictor was present in both models (null and full models) as we aimed to assess the impact of Age using the likelihood ratio test. In this test, we think of the covariate “Height” as a control variable and of “Age” as the test variable.

What happens if we compare the following two models:

m0: Weight ~ 1 # intercept only constant model estimating the mean only 
m1: Weight ~ Height + Age # Intercept and 2 covariates model

Suppose the likelihood-ration test suggest significant differences between the 2 models, this would suggest that “m1” (full) and “m0” (null) are significantly different from one another. However, it would not attribute this difference to “Height” or “Age” alone. We may not be able to tease out conclusively which one of the two variables (or both) was crucial.

How about the possibility of having an Age-by-Height interaction effect? For instance, “Height” effect on Weight may be modulated through “Age”. If such inter-dependence between two factors (an interaction) is present or suspected, its impact may be assessed the same way:

full model: Weight ~ Height * Age 
reduced model: Weight ~ Height + Age

Interactions between two factors are commonly specified with a “*” rather than a “+”. Comparing these models via the likelihood ratio test and the anova() function yields a p-value quantifying the significance of the interaction term (Height * Age). A significant result implies that Height and Age are strongly inter-dependent on each other. An insignificant result implies that there is no strong evidence in these data for inter-dependence.

Note: 
lm.1 <- lm(y ~ x:z) # includes only the interaction (colon, “:”) between x & z,
# but not the original variables x and z 
lm.2 <- lm(y ~ x + z + x:z) # this is a complete model for y using x & z

#In regressions with a lot of variables, the product (*) notation provides a shortcut to minimize typing. 
# We can indicate this using a simple multiplication symbol (*): 
lm.3 <- lm(y ~ x*z) # equivalent to model lm.2, but shorter.

Using this code, R will automatically include both variables in the regression in addition to the interaction between the two

We can experiment with computing alternative likelihoods to contrast different models using these, or other, datasets. For instance, compare “Height*Age” vs. “Height + Age” vs. simply “1” (intercept only model). We need to specify REML=FALSE in the models to be able to use the log-likelihood ratio test.

'''Interpreting effect-sizes for random effects''' (random slopes vs. random intercepts)

Let’s inspect the coefficients of the mixed model by Team and by Position:

coef(lmer.model.1)

<center>
$\$$Team
{| class="wikitable" style="text-align:center; width:35%" border="1"

|||(Intercept)||Height||Age
|-
|ANA||-176.9872||4.810485||0.8900941
|-
|ARZ||-176.2895||4.810485||0.8900941
|-
|ATL||-177.2084||4.810485||0.8900941
|-
|BAL||-177.6145||4.810485||0.8900941
|-
|BOS||-177.0276||4.810485||0.8900941
|-
|CHC||-176.9496||4.810485||0.8900941
|-
|CIN||-176.7425||4.810485||0.8900941
|-
|CLE||-177.1519||4.810485||0.8900941
|-
|COL||-177.4466||4.810485||0.8900941
|-
|CWS||-176.4970||4.810485||0.8900941
|-
|DET||-176.7084||4.810485||0.8900941
|-
|FLA||-176.7071||4.810485||0.8900941
|-
|HOU||-177.0758||4.810485||0.8900941
|-
|KC||-177.5616||4.810485||0.8900941
|-
|LA||-176.6696||4.810485||0.8900941
|-
|MIN||-176.7251||4.810485||0.8900941
|-
|MLW||-176.4952||4.810485||0.8900941
|-
|NYM||-177.2486||4.810485||0.8900941
|-
|NYY||-176.7923||4.810485||0.8900941
|-
|OAK||-177.0576||4.810485||0.8900941
|-
|PHI||-177.8202||4.810485||0.8900941
|-
|PIT||-176.4746||4.810485||0.8900941
|-
|SD||-176.6908||4.810485||0.8900941
|-
|SEA||-177.1092||4.810485||0.8900941
|-
|SF||-176.8983||4.810485||0.8900941
|-
|STL||-177.1223||4.810485||0.8900941
|-
|TB||-177.2853||4.810485||0.8900941
|-
|TEX||-177.0813||4.810485||0.8900941
|-
|TOR||-176.8177||4.810485||0.8900941
|-
|WAS||-177.2275||4.810485||0.8900941
|}
</center>

<center>
$\$$Position
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
| ||(Intercept)||Height||Age
|-
|Catcher||-172.2235||4.810485||0.8900941
|-
|Designated_Hitter||-166.9709||4.810485||0.8900941
|-
|First_Baseman||-169.9896||4.810485||0.8900941
|-
|Outfielder||-177.8433||4.810485||0.8900941
|-
|Relief_Pitcher||-179.5896||4.810485||0.8900941
|-
|Second_Baseman||-183.9341||4.810485||0.8900941
|-
|Shortstop||-186.9628||4.810485||0.8900941
|-
|Starting_Pitcher||-179.2067||4.810485||0.8900941
|-
|Third_Baseman||-176.1245||4.810485||0.8900941
|}
</center>

attr(,"class")
[1] "coef.mer"

As expected from a mixed-effect model, each Team and each Position is assigned a different intercept, as we specified the model with “(1|Team)” and “(1|Position)” to take into account by-Team and by-Position variability:

lmer.model.1 <- lmer(Weight ~ Height + Age + (1|Team) + (1|Position), data=data, REML=FALSE)

The fixed effects (Height + Age) are all the same for all Team and Positions, as this model is a random intercept model where we account for baseline-differences in Weight assuming whatever the effect of Height is, it’s the same for all Teams and Positions.

This assumption may not always be valid – some Positions may demand more or less Weight. The Weight effect may be different for different Positions. Similarly, the Weight effect may be different for different Teams (recall the Water Polo National teams – Spain vs. Serbia).

Thus, we may need a random slope model, where Team and Positions may have differing intercepts as well as different slopes for the Weight. In R this can be coded as:

lmer.model.2 = lmer(Weight ~ Height + Age + (1+Height|Team) + (1+Height|Position), data=data, REML=FALSE)

This new model only includes more complicated random effects. In this case, the notation “(1+Height|Team)” means that the model expects differing baseline-levels of Weight (the intercept, represented by 1) and differing levels of “Height”. The same is true for Position.

Examining the coefficients of this updated model:

coef(lmer.model.2)

Generates the following output:

<center>
$\$$Team
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
| ||(Intercept)||Height||Age
|-
|ANA||-184.5752||4.913632||0.8799488
|-
|ARZ||-157.6363||4.564806||0.8799488
|-
|ATL||-185.3436||4.923583||0.8799488
|-
|BAL||-193.6560||5.031218||0.8799488
|-
|BOS||-183.8410||4.904126||0.8799488
|-
|CHC||-181.9705||4.879904||0.8799488
|-
|CIN||-176.1931||4.805094||0.8799488
|-
|CLE||-195.5968||5.056349||0.8799488
|-
|COL||-193.8297||5.033467||0.8799488
|-
|CWS||-174.9203||4.788613||0.8799488
|-
|DET||-168.4951||4.705414||0.8799488
|-
|FLA||-180.6757||4.863139||0.8799488
|-
|HOU||-191.5622||5.004105||0.8799488
|-
|KC||-204.9527||5.177497||0.8799488
|-
|LA||-166.8079||4.683568||0.8799488
|-
|MIN||-182.1954||4.882816||0.8799488
|-
|MLW||-164.4339||4.652826||0.8799488
|-
|NYM||-184.1068||4.907567||0.8799488
|-
|NYY||-186.9822||4.944800||0.8799488
|-
|OAK||-184.9647||4.918675||0.8799488
|-
|PHI||-208.3698||5.221744||0.8799488
|-
|PIT||-176.5423||4.809616||0.8799488
|-
|SD||-169.8045||4.722369||0.8799488
|-
|SEA||-183.9884||4.906034||0.8799488
|-
|SF||-180.9398||4.866558||0.8799488
|-
|STL||-183.5529||4.900395||0.8799488
|-
|TB||-186.5983||4.939829||0.8799488
|-
|TEX||-182.5549||4.887472||0.8799488
|-
|TOR||-193.1088||5.024132||0.8799488
|-
|WAS||-203.4900||5.158557||0.8799488

|}
</center>

<center>
$\$$Position
{| class="wikitable" style="text-align:center; width:35%" border="1"

|-
| ||(Intercept)||Height||Age
|-
|Catcher||-209.6130||5.323756||0.8799488
|-
|Designated_Hitter||-236.8530||5.766876||0.8799488
|-
|First_Baseman||-219.8348||5.490036||0.8799488
|-
|Outfielder||-180.9668||4.857761||0.8799488
|-
|Relief_Pitcher||-172.6381||4.722276||0.8799488
|-
|Second_Baseman||-141.1982||4.210837||0.8799488
|-
|Shortstop||-127.4526||3.987233||0.8799488
|-
|Starting_Pitcher||-173.4682||4.735780||0.8799488
|-
|Third_Baseman||-191.4820||5.028815||0.8799488
|}
</center>

attr(,"class")
[1] "coef.mer"

Note that the columns containing the by-team and by-position coefficients for the effect of “Height” are different for each Team and each Position. The fact that this column's values are always positive (quite similar to one another) implies that despite variation between teams/positions there is consistency in how Height impacts Weight. In other words, the Weight of all Players tends to go UP with Height, which is to be expected, albeit for some positions Weight may go UP slightly more than for other positions (e.g., Designated_Hitter=5.766876 vs. Shortstop=3.987233). On the other hand, the coefficients for Age remain static across positions and teams – why? Because the model (lmer.model.2) didn’t specify random slopes for the by-Position or by-Team effect of Age.

Next, we need to address the significance of these effects (i.e., compute the corresponding p-values using the likelihood ration test). We keep our model from above (lmer.model.2) and compare it to a new null model (lmer.model.0) using the likelihood ratio test:

lmer.model.0 = lmer(Weight ~ Age + (1+Height|Team) + (1+Height|Position), data=data, REML=FALSE)

lmer.model.2 = lmer(Weight ~ Height + Age + (1+Height|Team) + (1+Height|Position), data=data, REML=FALSE)

The null model (lmer.model.0) needs to have the same random effects structure as the full model (lmer.model.2). That is, all random slope parameters included in the full model must be present in the null model.

Let’s now do the likelihood ratio test:

anova(lmer.model.0, lmer.model.2)

Models:
lmer.model.0: Weight ~ Age + (1 + Height | Team) + (1 + Height | Position)
lmer.model.2: Weight ~ Height + Age + (1 + Height | Team) + (1 + Height | Position)
Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
lmer.model.0 9 8876.4 8920.8 -4429.2 8858.4
lmer.model.2 10 8809.3 8858.7 -4394.6 8789.3 69.082 1 < 2.2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Model differences are statistically significant. In general, ask: do we need random effects? and if so, which random slopes to include in the model? It’s a bit easier to work with random effect models that only include random intercept. However, it may be best to always include the random slopes in the models, as if these are insignificant, so we can determine that and reduce the model. In general, we can expect that the effect of an experimental manipulation (e.g., player position, team, etc.) may not be static across items (e.g., locations). There is some evidence from simulation studies that mixed models excluding random slopes may be too liberal - their Type I error rate may be higher than expected (i.e., we can find significant effects which are actually due to chance alone).

The full model (lmer.model.2) is focused on baseball players’ Weight. As Age is not a variable we are interested in studying, albeit it may affect Weight, we need to control for Age. Thus lmer.model.2 has random slopes for the effect of Height (by Team and Position) but not the effect of Age. In other words, we only modeled by-Team and by-Position variability in how Height affects Weight.

lmer.model.2 = lmer(Weight ~ Height + Age + (1+Height|Team) + (1+Height|Position), data=data, REML=FALSE)

9 http://www.rstudio.com/products/rstudio/download/

10 http://cran.r-project.org/web/packages/lme4/lme4.pdf

11 http://www.r-tutor.com/r-introduction/data-frame/data-import

12 http://www.statmethods.net/input/importingdata.html

13 http://wiki.socr.umich.edu/index.php/SOCR_Data_MLB_HeightsWeights

==Next See==
* [[SMHS_LinearModeling_LMM_Assumptions|Mixed Effect Model Assumptions section]]
* [[SMHS_LinearModeling_MachineLearning|Machine Learning Algorithms section]] for data modeling, training , testing, forecasting, prediction, and simulation.

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_LinearModeling_LMM}}

SMHS LinearModeling MLR

2016-05-23T12:55:19Z

Imoubara:

==[[SMHS_LinearModeling|SMHS Linear Modeling]] - Multiple Linear Regression ==

In this section, we expand our [[SMHS#Chapter_III:_Linear_Modeling |previous discussion of linear modeling]], review, and demonstrate computing and visualizing the regression-model coefficients (effect-sizes), (fixed-effect) linear model assumptions, examination of residual plots, and independence.

'''Questions''':
*Are there (linear) associations between predictors and a response variable(s)?
*When to look for linear relations and what assumptions play role?

Let’s use some of the data included in the Appendix. Snapshots of the first few rows in the data are shown below:

<center>
{| class="wikitable" style="text-align:center; width:99%" border="1"
|-
|Genotype||Race||Subject||Weight||Index||Subject||Day||Treatment||Obs
|-
|A||1||1||8||1||13||Day1 ||B||6.472687
|-
|A||1||2||9||2||14||Day1 ||B||7.01711
|-
|A||1||3||11||3||15||Day1 ||B||6.2007154
|-
|A||1||4||12||4||16||Day1 ||B||6.6139285
|-
|A||1||5||10||5||17||Day1 ||A||6.8299686
|-
|A||2||1||17||6||18||Day1 ||A||7.387583
|-
|...||||||||...||||||||
|}
</center>

Eyeballing the data may suggest that Race "2" subjects may have higher "Weights" (first dataset), or "Treatment A" yields higher "Observations" (second dataset). However, this cursory observation may be incorrect, as we may be looking at a small/exceptional sub-sample of the entire population. Data-driven linear modeling allows us to quantify such patterns and compute probability values expressing the strength of the evidence in the data to make such conclusions. In a nutshell, we express relationships of interest (e.g., weight as a function of race, or Observation as a function of treatment) using a linear function as an analytical representation of these inter-variable relations:

Weight ~ Race, Weight ~ Genotype, Obs ~ Treatment, Obs ~ Day, etc. 
W = a +b*R,

This "~" (tilde) notation implies "Weight predicted by Race" or "Observation as a linear function of Treatment". The "dependent variable" (a measurable response) on the left is predicted by the factor on the right acting as an "independent variable", co-variate, predictor, "explanatory variable", or "fixed effect".

Often times inter-dependencies may not be perfect, deterministic, or rigid (like in the case of predicting the Area of a disk knowing its radius, or predicting the 3D spatial location of a planet having a precise date and time). Weight may not be completely and uniquely determined by Race alone, as many different factors play role (genetics, environment, aging, etc.) Even if we can measure all factors we can identify as potentially influencing Weight, there will still be intrinsic random variability into the observed Weight measures, which can’t be control for. This intrinsic random variation may be captured and accounted for using "random" term at the end.

Weight ~ Race + ε~ D(m=0, s).

Epsilon "ε" represents the error term of predicting Weight by Gender alone and summarizes the aggregate impact of all factors aside from Race that impact individual’s Weight, which are experimentally uncontrollable or random. This formula is a schematic analytic representation of a linear model that we’re going to estimate, quantify, and use for prediction and inference. The right hand side splits the knowledge representation of Weight into 2 complementary components - a "fixed effect" for Race, which we understand and expect, and a "random effect" ("ε") what we don’t know well. (W ~ R represents the "structural" or "systematic" part of the linear model and "ε" stands for the "random" or "probabilistic" part of the model.

R Experiment (See Appendix)
mydata1 <- data.frame(
Subject = c(13, 14, 15, 16, 17, 18),
Day = c("Day1", "Day1", "Day1", "Day2", "Day2", "Day2"),
Treatment = c("B", "B", "B", "A", "A", "A"),
Obs = c(6.472687, 7.017110, 6.200715, 6.613928, 6.829968, 7.387583)
)

We construct an R frame object1 concatenating 3 data-elements for 6 subjects, and saving it into "mydata1."

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
mydata1
|-
|Subject||Day||Treatment||Obs
|-
|13||Day1||B||6.472687
|-
|14||Day1||B||7.017110
|-
|15||Day1||B||6.200715
|-
|16||Day2||A||6.613928
|-
|17||Day2||A||6.829968
|-
|18||Day2||A||7.387583

|}
</center>

Using the linear model Obs ~ Treatment + ε, we can invoke the linear modeling function
lm()2 . The "ε" term is implicit in all models so it need not be specified.

lm.1 <- lm(Obs ~ Treatment, mydata1)

The assignment operator "<-" stores the linear model result in object lm.1. For these data (the data object is "mydata1"), this model expresses Obs as a function of Treatment. To inspect the result of the linear model use the "summarize" function summary():

AIC(lm.1); BIC(lm.1)
summary(lm.1)

The result is:
Call:
lm(formula = Obs ~ Treatment, data = mydata1)

Residuals:
1 2 3 4 5 6
-0.10342 0.44100 -0.37540 0.03782 -0.27881 0.27881

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 7.1088 0.2507 28.350 9.21e-06 ***
TreatmentB -0.5327 0.3071 -1.734 0.158
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.3546 on 4 degrees of freedom
Multiple R-squared: 0.4293, Adjusted R-squared: 0.2866
F-statistic: 3.008 on 1 and 4 DF, p-value: 0.1579

The report shows:
*The model analytical formula specified by the lm() call.
*The residuals (errors, discrepancies between observed and model-predicted outcomes).
*The coefficients of the fixed effects (predictors, explanatory variables).
*And finally, the overall model quality (describing the ability of the model to describe the linear relations in these data). "Multiple R-squared" refers to the R2 statistic that measures the "variance explained by the model" or "variance accounted for by the model". 0≤R2≤1, in our result, R2 = 0.4293, which is good, but not great. In essence, 42.93% of the data variability may be explained by this specific (best linear fit) model. In this case, the model solely relies on "Treatment" (fixed effect) to explain Obs (outcome). So, the R2 reflects how much of the Obs variance is accounted for by different Treatments (A or B).

Models with high R2 values are preferred, subject to 2 conditions:
*What is considered a high R2 value is relative and depends on study/application.
*When the study phenomenon is highly deterministic, R2 values can approach 1.

Higher number of explanatory variable and higher model-complexity tend to yield higher R2 values, but are more difficult to interpret.

The "Adjusted R-squared" value is a modified R2 value that normalizes the total variance "explained" by the model by the number of fixed effects included in the model. Larger number predictors will lower the "Adjusted R-squared". The adjusted R2adj = 0.2866, but in general, R2adj can be much lower when the model includes many fixed effects.

The statistical test of "model significance" is quantified by the output "F-statistic: 3.008 on 1 and 4 DF, p-value: 0.1579". Under a null hypothesis where the model captures little or no information about the process, the probability value quantifies the data-driven evidence to reject the null and accept an alternative stating that this model does capture useful patterns in the data. Specifically, the p-value represents the conditional probability under the condition that the null hypothesis is true. In this case,

*The null hypothesis is Ho: "Treatment has no effect on Obs".
*Alternative research Hypothesis is H1: "Treatment has effect on Obs".

This p-value is 0.1579, and the linear model fails to reject the null hypothesis. This leaves open the possibility that Treatment may have no effect on Obs (just based on using these 6 data points). 
However, if the p-value was much smaller, and assuming Ho were true, then this data would be less likely to be observed in reality (hence we would interpret small p-values as showing that the alternative hypothesis "Treatment affects Obs" as more likely and the model result is "statistically significant"). 
There is a distinction between the overall "model-significance" (as quantified by the p-value at the very bottom of the output, which considers all effects together) and the p-value of individual effects (coefficients table including significance for each predictor).
The model F-statistic and the degrees of freedom are in 1-1 correspondence with the p-value – the latter is computed as the right tail probability for an F(df1,df2) distribution corresponding to the F-statistics (critical value). To report the overall model inference in this case, we can state: 
"Using a simple linear model of Obs as a function of Treatment, the model was not significant (F(1,4)=3.001, p>0.15), which indicates that "Treatment" may not be a critical explanatory factor describing the "Obs" outcome." 

To examine the coefficient table for (lm.1 model). 
Coefficients: 
       Estimate Std. Error t value Pr(>|t|) 
(Intercept) 7.1088 0.2507 28.350 9.21e-06 *** 
TreatmentB -0.5327 0.3071 -1.734 0.158

The overall model p-value (0.1579) is similar to the p-value quantifying the significance of the "Treatment" factor to explain Obs. This is because the model had only one fixed effect ("Treatment" itself). So, the significance of the overall model is the same as the significance for this coefficient (subject to rounding error).

In the presence of multiple fixed effects, the overall model significance will be different from the significance of each coefficient corresponding to a specific covariate.

Why does the report show "TreatmentB" not "Treatment"? The estimate of the "(Intercept)" is 7.1088. Let’s look at the mean Obs values within each of the 2 Treatment groups (A and B):

# Model: lm.1 <- lm(Obs ~ Treatment, mydata1)
mean(mydata1[mydata1$\$$Treatment=="A",]$\$$Obs)
> 7.108776 
mean(mydata1[mydata1$\$$Treatment=="B",]$\$$Obs)
> 6.57611
# in general, subsetting3 can be accomplished by:
subset_data <- mydata1[ which(mydata1$\$$Treatment=='A' &
mydata1$\$$Day=='Day2'),]

The mean of the Obs values for {Treatment=A} is the same as the "Intercept" term.

The estimate for "TreatmentB" is negative (-0.5327). Note that:

7.108776 - 0.5327 = 6.57611,

which is the mean of the "TreatmentB" cohort. Thus, 
the estimate for "(Intercept)" represents for the "TreatmentA" category, and 
the estimate for "TreatmentB" represents the difference between the "Treatment" "A" and "B" categories.

Analytically, the linear models represent "linear" associations, as in the plot below:

mydata2 <- data.frame(
Subject = c(13, 14, 15, 16, 17, 18),
Day = c("Day1", "Day1", "Day1", "Day1", "Day1", "Day1"),
Treatment = c(2, 2, 2, 2, 1, 1),
Obs = c(6.472687, 7.017110, 6.200715, 6.613928, 6.829968, 7.387583)
)
plot(mydata2$\$$Treatment, mydata2$\$$Obs, main="Scatterplot Treatment vs. Obs",
xlab="Treatment", ylab="Obs ", pch=19)
# Add fit lines
abline(lm(mydata2$\$$Obs~mydata2$\$$Treatment), col="red")

<center>[[Image:SMHS_LinearModeling_Fig14.png|500px]]</center>

The linear model represents the difference between Treatments "A" and "B" as a slope. Going From Treatment "A" to "B" we go down -0.5327 (in terms of the units measuring the "Obs" variable), which is exactly the "TreatmentB" coefficient, relative to Treatment "A".

Treatment "A" acts as baseline (center of the local coordinate system) and is represented by the "(Intercept)". The difference between Treatments "A" and "B" is expressed as a slope heading down from 7.108776 by 0.5327. The p-values in the coefficient table correspond to the significance that each coefficient (intercept or Treatment) is "non-trivial".

In our case, the Intercept is significant (10-5), but the Treatment change (from A to B) is not (0.15). By default, the lm() function takes lexicographical ordering to determine which level (A or B) of the predictor (Treatment) comes first to label Treatment "A" as the intercept and "B" as the slope. Categorical differences like Treatment "A" and "B" can be expressed as slopes because difference between two categories is directly correlated with the slope between the two categories.

The advantage of representing difference between two categories as lines crossing the two categories is that it allows us to use the same computational principles for numeric and categorical variables. That is the same interpretations can be made for Treatment as for continuous (e.g., age) or discrete (e.g., dosage) covariates.

For example, using the MBL Data, we can examine player’s Weight as a function of Age. Save the data table as a text file "01a_data.txt" and load it in RStudio:

# data <- read.table('C:\\Users\\Dinov\\Desktop\\01a_data.txt',as.is=T, header=T)
# Data: https://umich.instructure.com/courses/38100/files/folder/data
data <- read.table('https://umich.instructure.com/courses/38100/files/folder/data/01a_data.txt',as.is=T, header=T)
attach(data)

# Weight = Age + e
df.2 = data.frame(Age, Weight)
lm.2 = lm(Weight ~ Age, df.2)
summary(lm.2)

Call:
lm(formula = Weight ~ Age, data = df.2)

Residuals:
Min 1Q Median 3Q Max
-52.479 -14.489 -0.814 13.400 89.915

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 179.6684 4.3418 41.381 < 2e-16 ***
Age 0.7672 0.1494 5.135 3.37e-07 ***
--- 
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 20.75 on 1032 degrees of freedom
Multiple R-squared: 0.02492, Adjusted R-squared: 0.02397
F-statistic: 26.37 on 1 and 1032 DF, p-value: 3.368e-07

The significance of the intercept is not very interesting, as it just specifies the baseline. However, the p-value in each (predictor) row evaluates whether the corresponding coefficient is significantly non-trivial. Trivial coefficients can be removed from the model. The intercept (179.6684) represents the predicted Weight for a player at Age 0, which doesn’t make sense for Baseball players, but it captures the constant impact of Age on Weight.

The interesting part is the coefficient of ''Age'' (0.7672), which is a significant ''predictor'' of Weight ($3.368\times 10^{-7}$). Thus, for every increase of age by 1 year, The Weight is expected to go up by 0.7 to 0.8 lbs.

The regression line in the scatterplot represents the model-predicted mean Weight-gain with Age. The y-intercept (179.6684), for Age=0, and slope (0.7672) of the line represents the corresponding (Intercept and Age) coefficients of the model output.

plot(Age, Weight, main="Scatterplot Age vs. Weight", xlab="Age", ylab="Weight", pch=19)
abline(lm(Weight ~ Age), col="red")

<CENTER>[[Image:SMHS_LinearModeling_Fig15.png|500px]]</CENTER>

'''Interpreting Model Intercepts''' 
The model estimates of the intercept may not always be useful. For instance, if we subtract the mean Age from each player's Age:

df.2$\$$Age.centered = df.2$\$$Age - mean(df.2$\$$Age)
lm.2a = lm(Weight ~ Age.centered, df.2)
summary(lm.2a)

This creates a new column in the data.frame (df.2) called ''Age.centered'' representing the Age variable with the mean subtracted from it. This is the resulting coefficient table from running a linear model analysis of this ''centered'' data:

Coefficients: 
Estimate Std. Error t value Pr(>|t|) 
(Intercept) 201.7166 0.6452 312.648 < 2e-16 *** 
Age.centered 0.7672 0.1494 5.135 3.37e-07 *** 

Residual standard error: 20.75 on 1032 degrees of freedom 
Multiple R-squared: 0.02492, Adjusted R-squared: 0.02397 
F-statistic: 26.37 on 1 and 1032 DF, p-value: 3.368e-07 

The intercept estimate has changed from 179.6684 (predicted Player Weight at birth, Age=0) to 201.7166 (predicted player Weight at mean Age). However, the slope and its significance (0.7672, 3.37x10-07) are unchanged and neither is the significance of the full model
(3.368x10-07). So, centering the Age does not impact the nature of the linear model, it just changed the intercept that now points to the Weight at the mean Age.

As we have additional information for each MLB player, e.g., ''Team'', ''Position'', ''Height'', ''Weight'', ''Age'') we can include additional factors into the linear model (lm.2a) to increase its explanatory power (R2 = 0.02492). We can start by adding:

Weight ~ Age + Height + e.
lm.3 = lm(Weight ~ Age.centered + Height, df.2)
summary(lm.3)

Call:
lm(formula = Weight ~ Age.centered + Height, data = df.2)

Residuals:
Min 1Q Median 3Q Max
-50.818 -12.148 -0.344 10.720 74.175

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -164.0141 17.2897 -9.486 < 2e-16 ***
Age.centered 0.9624 0.1252 7.690 3.43e-14 ***
Height 4.9626 0.2345 21.163 < 2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 17.33 on 1031 degrees of freedom
Multiple R-squared: 0.3202, Adjusted R-squared: 0.3189
F-statistic: 242.8 on 2 and 1031 DF, p-value: < 2.2e-16

And them adding additional factors:

Weight ~ Age + Height + Position + Team + e.
lm.4 = lm(Weight ~ Age.centered + Height+ Position + Team, df.2)
summary(lm.4)

Call:
lm(formula = Weight ~ Age.centered + Height + Position + Team,
data = df.2)

Residuals:
Min 1Q Median 3Q Max
-48.692 -10.909 -0.778 9.858 73.649

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -139.4055 18.8556 -7.393 3.04e-13 ***
Age.centered 0.8906 0.1259 7.075 2.82e-12 ***
Height 4.7175 0.2563 18.405 < 2e-16 ***
PositionDesignated_Hitter 8.9037 4.4533 1.999 0.045842 *
PositionFirst_Baseman 2.4237 3.0058 0.806 0.420236
PositionOutfielder -6.2636 2.2784 -2.749 0.006084 **
PositionRelief_Pitcher -7.7695 2.1959 -3.538 0.000421 ***
PositionSecond_Baseman -13.0843 2.9638 -4.415 1.12e-05 ***
PositionShortstop -16.9562 3.0406 -5.577 3.16e-08 ***
PositionStarting_Pitcher -7.3599 2.2976 -3.203 0.001402 **
PositionThird_Baseman -4.6035 3.1689 -1.453 0.146613
TeamARZ 7.1881 4.2590 1.688 0.091777
TeamATL -1.5631 3.9757 -0.393 0.694278
TeamBAL -5.3128 4.0193 -1.322 0.186533
TeamBOS -0.2838 4.0034 -0.071 0.943492
TeamCHC 0.4026 3.9949 0.101 0.919749
TeamCIN 2.1051 3.9934 0.527 0.598211
TeamCLE -1.3160 4.0356 -0.326 0.744423
TeamCOL -3.7836 4.0287 -0.939 0.347881
TeamCWS 4.2944 4.1022 1.047 0.295413
TeamDET 2.3024 3.9725 0.580 0.562326
TeamFLA 2.6985 4.1336 0.653 0.514028
TeamHOU -0.6808 4.0634 -0.168 0.866976
TeamKC -4.7664 4.0242 -1.184 0.236525
TeamLA 2.8598 4.0817 0.701 0.483686
TeamMIN 2.1269 4.0947 0.519 0.603579
TeamMLW 4.2897 4.0243 1.066 0.286706
TeamNYM -1.9736 3.9493 -0.500 0.617370
TeamNYY 1.7483 4.1234 0.424 0.671655
TeamOAK -0.5464 3.9672 -0.138 0.890474
TeamPHI -6.8486 3.9949 -1.714 0.086778
TeamPIT 4.3023 4.0210 1.070 0.284890
TeamSD 2.6133 4.0915 0.639 0.523148
TeamSEA -0.9147 4.0516 -0.226 0.821436
TeamSF 0.8411 4.0520 0.208 0.835593
TeamSTL -1.1341 4.1193 -0.275 0.783132
TeamTB -2.6616 4.0944 -0.650 0.515798
TeamTEX -0.7695 4.0283 -0.191 0.848556
TeamTOR 1.3943 4.0681 0.343 0.731871
TeamWAS -1.7555 4.0038 -0.438 0.661142
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 16.78 on 994 degrees of freedom
Multiple R-squared: 0.3858, Adjusted R-squared: 0.3617
F-statistic: 16.01 on 39 and 994 DF, p-value: < 2.2e-16

Notice the linear model coefficients, the corresponding p-values, and the overall model quality, at the bottom of the output change. Are these changed between the 2 models?
*new model (Weight ~ Age + Height + Position + Team + e.) vs.
*old model (Weight ~ Age + Height + e)?

These examples illustrate "multiple linear regression" as a linear modeling technique involving 1 response (dependent) variable expressed as a (affine) function of multiple predictor (independent) variables.

1http://www.statmethods.net/input/datatypes.html 2http://www.statmethods.net/advstats/glm.html 
3http://www.statmethods.net/management/subset.html

===See next===
* [[SMHS_LinearModeling_MLR_VizModelCoeff|Visualizing the Regression-Model coefficients (effect-sizes) section]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_LinearModeling_MLR}}

SMHS LinearModeling MLR

2016-05-23T12:52:49Z

Imoubara:

==[[SMHS_LinearModeling|SMHS Linear Modeling]] - Multiple Linear Regression ==

In this section, we expand our [[SMHS#Chapter_III:_Linear_Modeling |previous discussion of linear modeling]], review, and demonstrate computing and visualizing the regression-model coefficients (effect-sizes), (fixed-effect) linear model assumptions, examination of residual plots, and independence.

'''Questions''':
*Are there (linear) associations between predictors and a response variable(s)?
*When to look for linear relations and what assumptions play role?

Let’s use some of the data included in the Appendix. Snapshots of the first few rows in the data are shown below:

<center>
{| class="wikitable" style="text-align:center; width:99%" border="1"
|-
|Genotype||Race||Subject||Weight||Index||Subject||Day||Treatment||Obs
|-
|A||1||1||8||1||13||Day1 ||B||6.472687
|-
|A||1||2||9||2||14||Day1 ||B||7.01711
|-
|A||1||3||11||3||15||Day1 ||B||6.2007154
|-
|A||1||4||12||4||16||Day1 ||B||6.6139285
|-
|A||1||5||10||5||17||Day1 ||A||6.8299686
|-
|A||2||1||17||6||18||Day1 ||A||7.387583
|-
|...||||||||...||||||||
|}
</center>

Eyeballing the data may suggest that Race "2" subjects may have higher "Weights" (first dataset), or "Treatment A" yields higher "Observations" (second dataset). However, this cursory observation may be incorrect, as we may be looking at a small/exceptional sub-sample of the entire population. Data-driven linear modeling allows us to quantify such patterns and compute probability values expressing the strength of the evidence in the data to make such conclusions. In a nutshell, we express relationships of interest (e.g., weight as a function of race, or Observation as a function of treatment) using a linear function as an analytical representation of these inter-variable relations:

Weight ~ Race, Weight ~ Genotype, Obs ~ Treatment, Obs ~ Day, etc. 
W = a +b*R,

This "~" (tilde) notation implies "Weight predicted by Race" or "Observation as a linear function of Treatment". The "dependent variable" (a measurable response) on the left is predicted by the factor on the right acting as an "independent variable", co-variate, predictor, "explanatory variable", or "fixed effect".

Often times inter-dependencies may not be perfect, deterministic, or rigid (like in the case of predicting the Area of a disk knowing its radius, or predicting the 3D spatial location of a planet having a precise date and time). Weight may not be completely and uniquely determined by Race alone, as many different factors play role (genetics, environment, aging, etc.) Even if we can measure all factors we can identify as potentially influencing Weight, there will still be intrinsic random variability into the observed Weight measures, which can’t be control for. This intrinsic random variation may be captured and accounted for using "random" term at the end.

Weight ~ Race + ε~ D(m=0, s).

Epsilon "ε" represents the error term of predicting Weight by Gender alone and summarizes the aggregate impact of all factors aside from Race that impact individual’s Weight, which are experimentally uncontrollable or random. This formula is a schematic analytic representation of a linear model that we’re going to estimate, quantify, and use for prediction and inference. The right hand side splits the knowledge representation of Weight into 2 complementary components - a "fixed effect" for Race, which we understand and expect, and a "random effect" ("ε") what we don’t know well. (W ~ R represents the "structural" or "systematic" part of the linear model and "ε" stands for the "random" or "probabilistic" part of the model.

R Experiment (See Appendix)
mydata1 <- data.frame(
Subject = c(13, 14, 15, 16, 17, 18),
Day = c("Day1", "Day1", "Day1", "Day2", "Day2", "Day2"),
Treatment = c("B", "B", "B", "A", "A", "A"),
Obs = c(6.472687, 7.017110, 6.200715, 6.613928, 6.829968, 7.387583)
)

We construct an R frame object1 concatenating 3 data-elements for 6 subjects, and saving it into "mydata1."

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
mydata1
|-
|Subject||Day||Treatment||Obs
|-
|13||Day1||B||6.472687
|-
|14||Day1||B||7.017110
|-
|15||Day1||B||6.200715
|-
|16||Day2||A||6.613928
|-
|17||Day2||A||6.829968
|-
|18||Day2||A||7.387583

|}
</center>

Using the linear model Obs ~ Treatment + ε, we can invoke the linear modeling function
lm()2 . The "ε" term is implicit in all models so it need not be specified.

lm.1 <- lm(Obs ~ Treatment, mydata1)

The assignment operator "<-" stores the linear model result in object lm.1. For these data (the data object is "mydata1"), this model expresses Obs as a function of Treatment. To inspect the result of the linear model use the "summarize" function summary():

AIC(lm.1); BIC(lm.1)
summary(lm.1)

The result is:
Call:
lm(formula = Obs ~ Treatment, data = mydata1)

Residuals:
1 2 3 4 5 6
-0.10342 0.44100 -0.37540 0.03782 -0.27881 0.27881

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 7.1088 0.2507 28.350 9.21e-06 ***
TreatmentB -0.5327 0.3071 -1.734 0.158
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.3546 on 4 degrees of freedom
Multiple R-squared: 0.4293, Adjusted R-squared: 0.2866
F-statistic: 3.008 on 1 and 4 DF, p-value: 0.1579

The report shows:
<li>The model analytical formula specified by the lm() call. </li>
<li>The residuals (errors, discrepancies between observed and model-predicted outcomes). </li>
<li>The coefficients of the fixed effects (predictors, explanatory variables). </li>
<li>And finally, the overall model quality (describing the ability of the model to describe the linear relations in these data). "Multiple R-squared" refers to the R2 statistic that measures the "variance explained by the model" or "variance accounted for by the model". 0≤R2≤1, in our result, R2 = 0.4293, which is good, but not great. In essence, 42.93% of the data variability may be explained by this specific (best linear fit) model. In this case, the model solely relies on "Treatment" (fixed effect) to explain Obs (outcome). So, the R2 reflects how much of the Obs variance is accounted for by different Treatments (A or B).</li>

Models with high R2 values are preferred, subject to 2 conditions:
<li>What is considered a high R2 value is relative and depends on study/application.</li>
<li>When the study phenomenon is highly deterministic, R2 values can approach 1. </li>

Higher number of explanatory variable and higher model-complexity tend to yield higher R2 values, but are more difficult to interpret.

The "Adjusted R-squared" value is a modified R2 value that normalizes the total variance "explained" by the model by the number of fixed effects included in the model. Larger number predictors will lower the "Adjusted R-squared". The adjusted R2adj = 0.2866, but in general, R2adj can be much lower when the model includes many fixed effects.

The statistical test of "model significance" is quantified by the output "F-statistic: 3.008 on 1 and 4 DF, p-value: 0.1579". Under a null hypothesis where the model captures little or no information about the process, the probability value quantifies the data-driven evidence to reject the null and accept an alternative stating that this model does capture useful patterns in the data. Specifically, the p-value represents the conditional probability under the condition that the null hypothesis is true. In this case,

<li>The null hypothesis is Ho: "Treatment has no effect on Obs". </li>
<li>Alternative research Hypothesis is H1: "Treatment has effect on Obs".</li>

This p-value is 0.1579, and the linear model fails to reject the null hypothesis. This leaves open the possibility that Treatment may have no effect on Obs (just based on using these 6 data points). 
However, if the p-value was much smaller, and assuming Ho were true, then this data would be less likely to be observed in reality (hence we would interpret small p-values as showing that the alternative hypothesis "Treatment affects Obs" as more likely and the model result is "statistically significant"). 
There is a distinction between the overall "model-significance" (as quantified by the p-value at the very bottom of the output, which considers all effects together) and the p-value of individual effects (coefficients table including significance for each predictor).
The model F-statistic and the degrees of freedom are in 1-1 correspondence with the p-value – the latter is computed as the right tail probability for an F(df1,df2) distribution corresponding to the F-statistics (critical value). To report the overall model inference in this case, we can state: 
"Using a simple linear model of Obs as a function of Treatment, the model was not significant (F(1,4)=3.001, p>0.15), which indicates that "Treatment" may not be a critical explanatory factor describing the "Obs" outcome." 

To examine the coefficient table for (lm.1 model). 
Coefficients: 
       Estimate Std. Error t value Pr(>|t|) 
(Intercept) 7.1088 0.2507 28.350 9.21e-06 *** 
TreatmentB -0.5327 0.3071 -1.734 0.158

The overall model p-value (0.1579) is similar to the p-value quantifying the significance of the "Treatment" factor to explain Obs. This is because the model had only one fixed effect ("Treatment" itself). So, the significance of the overall model is the same as the significance for this coefficient (subject to rounding error).

In the presence of multiple fixed effects, the overall model significance will be different from the significance of each coefficient corresponding to a specific covariate.

Why does the report show "TreatmentB" not "Treatment"? The estimate of the "(Intercept)" is 7.1088. Let’s look at the mean Obs values within each of the 2 Treatment groups (A and B):

# Model: lm.1 <- lm(Obs ~ Treatment, mydata1)
mean(mydata1[mydata1$\$$Treatment=="A",]$\$$Obs)
> 7.108776 
mean(mydata1[mydata1$\$$Treatment=="B",]$\$$Obs)
> 6.57611
# in general, subsetting3 can be accomplished by:
subset_data <- mydata1[ which(mydata1$\$$Treatment=='A' &
mydata1$\$$Day=='Day2'),]

The mean of the Obs values for {Treatment=A} is the same as the "Intercept" term.

The estimate for "TreatmentB" is negative (-0.5327). Note that:

7.108776 - 0.5327 = 6.57611,

which is the mean of the "TreatmentB" cohort. Thus, 
the estimate for "(Intercept)" represents for the "TreatmentA" category, and 
the estimate for "TreatmentB" represents the difference between the "Treatment" "A" and "B" categories.

Analytically, the linear models represent "linear" associations, as in the plot below:

mydata2 <- data.frame(
Subject = c(13, 14, 15, 16, 17, 18),
Day = c("Day1", "Day1", "Day1", "Day1", "Day1", "Day1"),
Treatment = c(2, 2, 2, 2, 1, 1),
Obs = c(6.472687, 7.017110, 6.200715, 6.613928, 6.829968, 7.387583)
)
plot(mydata2$\$$Treatment, mydata2$\$$Obs, main="Scatterplot Treatment vs. Obs",
xlab="Treatment", ylab="Obs ", pch=19)
# Add fit lines
abline(lm(mydata2$\$$Obs~mydata2$\$$Treatment), col="red")

<center>[[Image:SMHS_LinearModeling_Fig14.png|500px]]</center>

The linear model represents the difference between Treatments "A" and "B" as a slope. Going From Treatment "A" to "B" we go down -0.5327 (in terms of the units measuring the "Obs" variable), which is exactly the "TreatmentB" coefficient, relative to Treatment "A".

Treatment "A" acts as baseline (center of the local coordinate system) and is represented by the "(Intercept)". The difference between Treatments "A" and "B" is expressed as a slope heading down from 7.108776 by 0.5327. The p-values in the coefficient table correspond to the significance that each coefficient (intercept or Treatment) is "non-trivial".

In our case, the Intercept is significant (10-5), but the Treatment change (from A to B) is not (0.15). By default, the lm() function takes lexicographical ordering to determine which level (A or B) of the predictor (Treatment) comes first to label Treatment "A" as the intercept and "B" as the slope. Categorical differences like Treatment "A" and "B" can be expressed as slopes because difference between two categories is directly correlated with the slope between the two categories.

The advantage of representing difference between two categories as lines crossing the two categories is that it allows us to use the same computational principles for numeric and categorical variables. That is the same interpretations can be made for Treatment as for continuous (e.g., age) or discrete (e.g., dosage) covariates.

For example, using the MBL Data, we can examine player’s Weight as a function of Age. Save the data table as a text file "01a_data.txt" and load it in RStudio:

# data <- read.table('C:\\Users\\Dinov\\Desktop\\01a_data.txt',as.is=T, header=T)
# Data: https://umich.instructure.com/courses/38100/files/folder/data
data <- read.table('https://umich.instructure.com/courses/38100/files/folder/data/01a_data.txt',as.is=T, header=T)
attach(data)

# Weight = Age + e
df.2 = data.frame(Age, Weight)
lm.2 = lm(Weight ~ Age, df.2)
summary(lm.2)

Call:
lm(formula = Weight ~ Age, data = df.2)

Residuals:
Min 1Q Median 3Q Max
-52.479 -14.489 -0.814 13.400 89.915

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 179.6684 4.3418 41.381 < 2e-16 ***
Age 0.7672 0.1494 5.135 3.37e-07 ***
--- 
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 20.75 on 1032 degrees of freedom
Multiple R-squared: 0.02492, Adjusted R-squared: 0.02397
F-statistic: 26.37 on 1 and 1032 DF, p-value: 3.368e-07

The significance of the intercept is not very interesting, as it just specifies the baseline. However, the p-value in each (predictor) row evaluates whether the corresponding coefficient is significantly non-trivial. Trivial coefficients can be removed from the model. The intercept (179.6684) represents the predicted Weight for a player at Age 0, which doesn’t make sense for Baseball players, but it captures the constant impact of Age on Weight.

The interesting part is the coefficient of ''Age'' (0.7672), which is a significant ''predictor'' of Weight ($3.368\times 10^{-7}$). Thus, for every increase of age by 1 year, The Weight is expected to go up by 0.7 to 0.8 lbs.

The regression line in the scatterplot represents the model-predicted mean Weight-gain with Age. The y-intercept (179.6684), for Age=0, and slope (0.7672) of the line represents the corresponding (Intercept and Age) coefficients of the model output.

plot(Age, Weight, main="Scatterplot Age vs. Weight", xlab="Age", ylab="Weight", pch=19)
abline(lm(Weight ~ Age), col="red")

<CENTER>[[Image:SMHS_LinearModeling_Fig15.png|500px]]</CENTER>

'''Interpreting Model Intercepts''' 
The model estimates of the intercept may not always be useful. For instance, if we subtract the mean Age from each player's Age:

df.2$\$$Age.centered = df.2$\$$Age - mean(df.2$\$$Age)
lm.2a = lm(Weight ~ Age.centered, df.2)
summary(lm.2a)

This creates a new column in the data.frame (df.2) called ''Age.centered'' representing the Age variable with the mean subtracted from it. This is the resulting coefficient table from running a linear model analysis of this ''centered'' data:

Coefficients: 
Estimate Std. Error t value Pr(>|t|) 
(Intercept) 201.7166 0.6452 312.648 < 2e-16 *** 
Age.centered 0.7672 0.1494 5.135 3.37e-07 *** 

Residual standard error: 20.75 on 1032 degrees of freedom 
Multiple R-squared: 0.02492, Adjusted R-squared: 0.02397 
F-statistic: 26.37 on 1 and 1032 DF, p-value: 3.368e-07 

The intercept estimate has changed from 179.6684 (predicted Player Weight at birth, Age=0) to 201.7166 (predicted player Weight at mean Age). However, the slope and its significance (0.7672, 3.37x10-07) are unchanged and neither is the significance of the full model
(3.368x10-07). So, centering the Age does not impact the nature of the linear model, it just changed the intercept that now points to the Weight at the mean Age.

As we have additional information for each MLB player, e.g., ''Team'', ''Position'', ''Height'', ''Weight'', ''Age'') we can include additional factors into the linear model (lm.2a) to increase its explanatory power (R2 = 0.02492). We can start by adding:

Weight ~ Age + Height + e.
lm.3 = lm(Weight ~ Age.centered + Height, df.2)
summary(lm.3)

Call:
lm(formula = Weight ~ Age.centered + Height, data = df.2)

Residuals:
Min 1Q Median 3Q Max
-50.818 -12.148 -0.344 10.720 74.175

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -164.0141 17.2897 -9.486 < 2e-16 ***
Age.centered 0.9624 0.1252 7.690 3.43e-14 ***
Height 4.9626 0.2345 21.163 < 2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 17.33 on 1031 degrees of freedom
Multiple R-squared: 0.3202, Adjusted R-squared: 0.3189
F-statistic: 242.8 on 2 and 1031 DF, p-value: < 2.2e-16

And them adding additional factors:

Weight ~ Age + Height + Position + Team + e.
lm.4 = lm(Weight ~ Age.centered + Height+ Position + Team, df.2)
summary(lm.4)

Call:
lm(formula = Weight ~ Age.centered + Height + Position + Team,
data = df.2)

Residuals:
Min 1Q Median 3Q Max
-48.692 -10.909 -0.778 9.858 73.649

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -139.4055 18.8556 -7.393 3.04e-13 ***
Age.centered 0.8906 0.1259 7.075 2.82e-12 ***
Height 4.7175 0.2563 18.405 < 2e-16 ***
PositionDesignated_Hitter 8.9037 4.4533 1.999 0.045842 *
PositionFirst_Baseman 2.4237 3.0058 0.806 0.420236
PositionOutfielder -6.2636 2.2784 -2.749 0.006084 **
PositionRelief_Pitcher -7.7695 2.1959 -3.538 0.000421 ***
PositionSecond_Baseman -13.0843 2.9638 -4.415 1.12e-05 ***
PositionShortstop -16.9562 3.0406 -5.577 3.16e-08 ***
PositionStarting_Pitcher -7.3599 2.2976 -3.203 0.001402 **
PositionThird_Baseman -4.6035 3.1689 -1.453 0.146613
TeamARZ 7.1881 4.2590 1.688 0.091777
TeamATL -1.5631 3.9757 -0.393 0.694278
TeamBAL -5.3128 4.0193 -1.322 0.186533
TeamBOS -0.2838 4.0034 -0.071 0.943492
TeamCHC 0.4026 3.9949 0.101 0.919749
TeamCIN 2.1051 3.9934 0.527 0.598211
TeamCLE -1.3160 4.0356 -0.326 0.744423
TeamCOL -3.7836 4.0287 -0.939 0.347881
TeamCWS 4.2944 4.1022 1.047 0.295413
TeamDET 2.3024 3.9725 0.580 0.562326
TeamFLA 2.6985 4.1336 0.653 0.514028
TeamHOU -0.6808 4.0634 -0.168 0.866976
TeamKC -4.7664 4.0242 -1.184 0.236525
TeamLA 2.8598 4.0817 0.701 0.483686
TeamMIN 2.1269 4.0947 0.519 0.603579
TeamMLW 4.2897 4.0243 1.066 0.286706
TeamNYM -1.9736 3.9493 -0.500 0.617370
TeamNYY 1.7483 4.1234 0.424 0.671655
TeamOAK -0.5464 3.9672 -0.138 0.890474
TeamPHI -6.8486 3.9949 -1.714 0.086778
TeamPIT 4.3023 4.0210 1.070 0.284890
TeamSD 2.6133 4.0915 0.639 0.523148
TeamSEA -0.9147 4.0516 -0.226 0.821436
TeamSF 0.8411 4.0520 0.208 0.835593
TeamSTL -1.1341 4.1193 -0.275 0.783132
TeamTB -2.6616 4.0944 -0.650 0.515798
TeamTEX -0.7695 4.0283 -0.191 0.848556
TeamTOR 1.3943 4.0681 0.343 0.731871
TeamWAS -1.7555 4.0038 -0.438 0.661142
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 16.78 on 994 degrees of freedom
Multiple R-squared: 0.3858, Adjusted R-squared: 0.3617
F-statistic: 16.01 on 39 and 994 DF, p-value: < 2.2e-16

Notice the linear model coefficients, the corresponding p-values, and the overall model quality, at the bottom of the output change. Are these changed between the 2 models?
<LI>new model (Weight ~ Age + Height + Position + Team + e.) vs. </LI>
<LI>old model (Weight ~ Age + Height + e)? </LI>

These examples illustrate "multiple linear regression" as a linear modeling technique involving 1 response (dependent) variable expressed as a (affine) function of multiple predictor (independent) variables.

1http://www.statmethods.net/input/datatypes.html 2http://www.statmethods.net/advstats/glm.html 
3http://www.statmethods.net/management/subset.html

===See next===
* [[SMHS_LinearModeling_MLR_VizModelCoeff|Visualizing the Regression-Model coefficients (effect-sizes) section]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_LinearModeling_MLR}}

SMHS LinearModeling QC

2016-05-23T12:51:55Z

Imoubara:

==[[SMHS_LinearModeling|SMHS Linear Modeling]] - Quality Control ==

Discussion of data Quality Control (QC) and Quality Assurance (QA), which represent important components of data-driven modeling, analytics, and visualization.

'''Questions:
*Is the data what it’s supposed to be (does it represent the study cohort/population)?
*How to inspect the quality of the data?

Data Quality Control (QC) and Quality Assurance (QA) represent important components of all modeling, analytics, and visualization that precede all subsequent data processing steps. QC and QA may be performed manually or automatically. Statistical quality control involves quantitative methods for monitoring and controlling a process or data derived from observing a natural phenomenon. For example, is there evidence in the plots below of a change in the mean of these processes?

# simulate data with base value of 100 w/ normally distributed error
# install.packages("qcc")
library(qcc)
demo.data.1 <- rep(100, 1000) + rnorm(1000, mean=0, sd=2)
qcc(demo.data.1, type="xbar.one", center=100, add.stats=FALSE,
title="Simulation 1", xlab="Index")

<center>[[Image:SMHS_LinearModeling_Fig003.png|500px]]</center>

Now let’s introduce a trend.

# first 800 points have base value of 100 w/ normally distributed error,
# next 100 points have base value of 105 w/ normally distributed error
# last 100 points have base value of 110 w/ normally distributed error
M <- 110
SD=5
demo.data.2 <- c(rep(100, 800), rep(M, 100), rep(100+(M-100)/2, 100)) + rnorm(1000, mean=0, sd=SD)
qcc(demo.data.2, type="xbar.one", center=100, add.stats=FALSE,
title="Simulation 2", xlab="Index")

<center>[[Image:SMHS_LinearModeling_Fig004.png|500px]]</center>

Our goal is to use statistical quality control to automatically identify issues with the data. The qcc package in R provides methods for statistical quality control – given the data, it identifies candidate points as outliers based on the Shewhart Rules. Color-coding the data also helps point out irregular points.

The Shewhart control charts rules (cf. 1930’s) are based on monitoring events that are unlikely when the controlled process is stable. Incidences of such atypical events are alarm signals, suggesting that stability of the process may be compromised and the process is changed.

An instance of such an unlikely event would be the situation in which the upper/lower control limits (UCL or LCL) are exceeded. UCL and LCL are constructed as ±3? limits, indicating that the process is under control within them. Additional warning limits (LWL and UWL) are constructed at ±2? or ±?. Other rules specifying events having low probability when the process is under control can be constructed:

1. One point exceeds LCL/UCL.

2. Nine points above/below the central line.

3. Six consecutive points show increasing/decreasing trend.

4. Difference of consecutive values alternates in sign for fourteen points.

5. Two out of three points exceed LWL or UWL limits.

6. Four out of five points are above/below the central line and exceed ±? limit.

7. Fifteen points are within ±? limits.

8. Eight consecutive values are beyond ±? limits.

We can define training/testing dataset within qcc by adding the data we want to calibrate it with as the first parameter (demo.data.1), followed by the new data (demo.data.2) representing the test data.

#example using holdout/test sets
demo.data.1 <- rep(100, 1000) + rnorm(1000, mean=0, sd=2)
demo.data.2 <- c(rep(100, 800), rep(105, 100), rep(110, 100)) + rnorm(100, mean=0, sd=2)
MyQC <- qcc(demo.data.1, newdata=demo.data.2, type="xbar.one", center=100, add.stats=FALSE, title="Simulation 1 vs. 2", xlab="Index")
plot(MyQC) # , chart.all=FALSE)

<center>[[Image:SMHS_LinearModeling_Fig005.png|500px]]</center>

# add warning limits at 2 std. deviations
MyQC2 <- qcc(demo.data.1, newdata=demo.data.2, type="xbar.one", center=100, add.stats=FALSE, title="Second Simulation 1 vs. 2", xlab="Index")
warn.limits <- limits.xbar(MyQC2$\$$center, MyQC2$\$$std.dev, MyQC2$\$$sizes, 0.95)
plot(MyQC2, restore.par = FALSE)
abline(h = warn.limits, lty = 2, lwd=2, col = "blue")

## limits.xbar(center, std.dev, sizes, conf)
Center = sample/group center statistic
Sizes= samples sizes.
std.dev= within group standard deviation.
Conf= a numeric value used to compute control limits, specifying the number of standard deviations (if conf > 1) or the confidence level (if 0 < conf < 1)

<center>[[Image:SMHS_LinearModeling_Fig006.png|500px]]</center>

Natural processes may have errors that are non-normally distributed. However, using (appropriate) transformations we can often normalize the errors.

We can use thresholds to define zones in the data where each zone represents, say, one standard deviation span of the range of the dataset.

find_zones <- function(x) {
x.mean <- mean(x)
x.sd <- sd(x)
boundaries <- seq(-3, 3)
# creates a set of zones for each point in x
zones <- sapply(boundaries, function(i) {
i * rep(x.sd, length(x))
})
zones + x.mean
}
head(find_zones(demo.data.2))

evaluate_zones <- function(x) {
zones <- find_zones(x)
colnames(zones) <- paste("zone", -3:3, sep="_")
x.zones <- rowSums(x > zones) - 3
x.zones
}

evaluate_zones(demo.data.2)

find_violations <- function(x.zones, i) {
values <- x.zones[max(i-8, 1):i]
# rule4 <- ifelse(any(values > 0), 1,
rule4 <- ifelse(all(values > 0), 1,
ifelse(all(values < 0), -1,
0))
values <- x.zones[max(i-5, 1):i]
rule3 <- ifelse(sum(values >= 2) >= 2, 1,
ifelse(sum(values <= -2) >= 2, -1,
0))
values <- x.zones[max(i-3, 1):i]
rule2 <- ifelse(mean(values >= 3) >= 1, 1,
ifelse(mean(values <= -3) >= 1, -1,
0))
#values <- x.zones[]
values <- x.zones[max(i-3, 1):i]
rule1 <- ifelse(any(values > 2), 1,
ifelse(any(values < -2), -1,
0))
c("rule1"=rule1, "rule2"=rule2, "rule3"=rule3, "rule4"=rule4)
}

find_violations(evaluate_zones(demo.data.2), 20)

Now we can compute the rules for each point and assign a color to any violations.

library("plyr")
compute_violations <- function(x, start=1) {
x.zones <- evaluate_zones(x)
results <- ldply (start:length(x), function(i) {
find_violations(x.zones, i)
})
results$\$$color <- ifelse(results$\$$rule1!=0, "pink",
ifelse(results$\$$rule2!=0, "red",
ifelse(results$\$$rule3!=0, "orange",
ifelse(results$\$$rule4!=0, "yellow",
"black"))))
results
}

tail(compute_violations(demo.data.2))

Now let’s make a quality control chart.

plot.qcc <- function(x, holdout) {
my.qcc <- compute_violations(x, length(x) - holdout)
bands <- find_zones(x)
plot.data <- x[(length(x) - holdout):length(x)]
plot(plot.data, col= my.qcc$\$$color, type='b', pch=19,
ylim=c(min(bands), max(bands)),
main="QC Chart",
xlab="", ylab="")

for (i in 1:7) {
lines(bands[,i], col= my.qcc$\$$color[i], lwd=0.75, lty=2)
}
}

demo.data.4 <- c(rep(10, 90), rep(11, 10)) + rnorm(100, mean=0, sd=0.5)
plot.qcc (demo.data.4, 100)

<center>[[Image:SMHS_LinearModeling_Fig007.png|500px]]</center>

Let’s use the "Student's Sleep Data" (sleep) data.

library("qcc")
attach(sleep)
q <- qcc.groups(extra, group)
dim(q)
obj_avg_test_1_2 <- qcc(q[1:2,], type="xbar")
obj_avg_test_1_5 <- qcc(q[,1:5], type="xbar")
summary(obj_avg_test_1_5)
obj_avg_test_train <- qcc(q[,1:5], type="xbar", newdata=q[,6:10])

<center>[[Image:SMHS_LinearModeling_Fig008.png|500px]]</center>

# How is this different from this?
obj_avg_new <- qcc(q[,1:10], type="xbar")

This control chart has the solid horizontal line (center), the upper and lower control limits (dashed lines), and the sample group statistics (e.g., mean; drawn as a piece-wise line connecting the points). The bottom of the plot includes summary statistics and the number of points beyond control limits and the number of violating runs. If the process is "in-control", we can use estimated limits for monitoring prospective (new) data sampled from the same process/protocol. For instance,

obj_test_1_10_train_11_20 <- qcc(sleep[1:10,], type="xbar", newdata=sleep[11:20,])
plots the X chart for training and testing (11-20) sleep data where the statistics and the control limits are based on the first 10 (training) samples.

<center>[[Image:SMHS_LinearModeling_Fig009.png|500px]]</center>

Now try (range) QCC plot
obj_R <- qcc(q[,1:5], type="R", newdata=q[,6:10])

A control chart aims to enhance our ability to monitor and track a process proxied by the data. When special causes of variation (random or not) are present, the data may be considered "out of control". Corresponding action may need to be taken to identify, control for, or eliminate such causes. A process is declared to be "controlled" if the plot of all data points are randomly spread out within the control limits. These Lower and Upper Control Limits (LCL, UCL) are usually computed as ±3s from the center (e.g., mean). The QCC default limits can be changed using the argument nsigmas or by specifying the confidence level via the confidence level argument.

<center>
{| class="wikitable" style="text-align:left; width:99%" border="1"
! colspan="8" |Control Chart Variables
|-
|"xbar"||Sample means are plotted to control the mean level of a continuous process variable.
|-
|"xbar.one"||Sample values from a one–at–a-time data process to control the mean level of a continuous process variable.
|-
|"R"||Sample ranges are plotted to control the variability of a continuous process variable.
|-
|"S"||Sample standard deviations are plotted to control the variability of a continuous process variable.
|-
! colspan="8" |Control Charts for Attributes
|-
|"p"||The proportion of nonconforming units is plotted. Control limits are based on the binomial distribution.
|-
|"np"||The number of nonconforming units is plotted. Control limits are based on the binomial distribution.
|-
|"c"||The number of defectives per unit are plotted. This chart assumes that defects of the quality attribute are rare, and the control limits are computed based on the Poisson distribution.
|-
|"u"||The average number of defectives per unit is plotted. The Poisson distribution is used to compute control limits; but, unlike the c chart, this chart does not require a constant number of units.

|}
</center>

When the process is governed by a Gaussian distribution, the ±3s limits correspond to a two-tails probability of p=0.0027.

Finally, an operating characteristic (OC) curve shows the probability of not detecting a shift in the process (false-negative, type II error); i.e., the probability of erroneously accepting a process as being "in control", when in fact, it’s out of control.

# par(mfrow=c(1,1))
oc.curves(obj_test_1_10_train_11_20)
# oc.curves(obj_test_1_10_train_11_20, identify=TRUE) # to manually identify specific OC points

<center>[[Image:SMHS_LinearModeling_Fig11.png|500px]]</center>

The function oc.curves returns a matrix or a vector of probabilities values representing the type II errors for different sample-sizes. See help (oc.curves), e.g., identify=TRUE, which allows to interactively identify values on the plot, for all options.

Notice that the OC curve is "S"-shaped. As expected, this is because as the percent of non-conforming values increases, the probability of acceptance decreases. A small sub-sample, instead of inspecting the entire data, may be used to determine the quality of a process. We can accept the data as in-control as long as the process percent nonconforming is below a predefined level.

===Next see===
[[SMHS_LinearModeling_MLR|Multiple Linear Regression]] for a review and demonstration of computing and visualizing the regression-model coefficients (effect-sizes), (fixed-effect) linear model assumptions, examination of residual plots, and independence.

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_LinearModeling_QC}}

SMHS MethodsHeterogeneity CER

2016-05-20T14:50:24Z

Imoubara:

==[[SMHS_MethodsHeterogeneity| Methods for Studying Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research]] - Comparative Effectiveness Research (CER) ==

===Overview===

==Observational Studies: Tips for the CER Practitioners==

• Different study types can offer different understandings; neither should be discounted without closer examination.

• RCTs provide an accurate understanding of the effect of a particular intervention in a well-defined patient group under “controlled” circumstances.

• Observational studies provide an understanding of real-world care and its impact, but can be biased due to uncontrolled factors.

• Observational studies differ in the types of databases used. These databases may lack clinical detail and contain incomplete or inaccurate data.

• Before accepting the findings from an observational study, consider whether confounding factors may have influenced the results.

• In this scenario, subgroup analysis was vital in clarifying both study designs; what is true for the many (e.g., overall, estrogen appeared to be detrimental) may not be true for the few (e.g., that for the younger post-menopausal woman, the benefits were greater and the harms less frequent).

• Carefully examine the generalizability of the study. Do the study’s patients and intervention match those under consideration?

• Observational studies can identify associations but cannot prove cause-and-effect relationships.

===Case-Study 1: The Cetuximab Study===

What was done and what was found?

Cetuximab, an anti-epidermal growth factor receptor (EGFR) agent, has recently been added to the therapeutic armamentarium. Two important CRTs examined its impact in patients with mCRC (metastatic-stage Colorectal cancer). In the first one, 56 centers in 11 European countries investigated the outcomes associated with cetuximab therapy in 329 mCRC patients who experienced disease progression either on irinotecan therapy or within 3 months thereafter. The study reported that the group on a combination of irinotecan and cetuximab had a significantly higher rate of overall response to treatment (primary endpoint) than the group on cetuximab alone: 22.9% (95% CI, 17.5-29.1%) vs. 10.8% (95% CI, 5.7-18.1%) (P=0.007), respectively. Similarly, the median time to progression was significantly longer in the combination therapy group (4.1 vs. 1.5 months, P<0.001). As these patients had already progressed on irinotecan prior to the study, any response was viewed as positive. Safety between the two treatment arms was similar: approximately 80% of patients in each arm experienced a rash. Grade 3 or 4 (the more severe) toxic effects on the skin were slightly more frequent in the combination-therapy group compared to cetuximab monotherapy, observed in 9.4% and 5.2% of participants, respectively. Other side effects, such as diarrhea and neutropenia observed in the combination-therapy arm, were considered to be in the range expected for irinotecan alone. Data from this study demonstrated the efficacy and safety of cetuximab and were instrumental in the FDA’s 2004 approval.

A second CRT (2007) examined 572 patients and suggested efficacy of cetuximab in the treatment of mCRC. This study was a randomized, non-blinded, controlled trial that examined cetuximab monotherapy plus best supportive care compared to best supportive care alone in patients who had received and failed prior chemotherapy regimens. It reported that median overall survival (the primary endpoint) was significantly higher in patients receiving cetuximab plus best supportive care compared to best supportive care alone (6.1 vs. 4.6 months, respectively) (hazard ratio for death=0.77; 95% CI: 0.64- 0.92, P=0.005). This RCT described a greater incidence of adverse events in the cetuximab plus best supportive care group compared to best supportive care alone including (most significantly) rash, as well as edema, fatigue, nausea and vomiting.

Was this the right answer?

These RCTs had fairly broad enrollment criteria and the cetuximab benefits were modest. Emerging scientific theories raised the possibility that genetically defined population subsets might experience a greater-than-average treatment benefit. One such area of inquiry entailed examining “biomarkers,” or genetic indicators of a patient’s greater response to therapy. Even as the above RCTs were being conducted, data emerged showing the importance of the KRAS gene.

Emerging Data

Based on the emerging biochemical evidence that the epidermal growth factor receptor (EGFR) treatment mechanism (Cetuximab) was even more finely detailed than previously understood, the study authors of the 2007 RCT undertook a retrospective subgroup analysis using tumor tissue samples preserved from their initial study. Following laboratory analysis, all viable tissue samples were classified as having a wild-type (non-mutated) or a mutated KRAS gene. Instead of the previous two study arms (cetuximab plus best supportive care vs. best supportive care alone), there were 4 for this new analysis: each of the two original study arms was further divided by wild-type vs. mutated KRAS status. Laboratory evaluation determined that 40.9% and 42.3% of all patients in the RCT had a KRAS mutation in the cetuximab plus best supportive care group compared to the best supportive care group alone, respectively. The efficacy of cetuximab was found to be significantly correlated with KRAS status: in patients with wild-type (non-mutated). KRAS genes, cetuximab plus best supportive care compared to best supportive care alone improved overall survival (median 9.5 vs. 4.8 months, respectively; hazard ratio for death=0.55; 95% CI, 0.41-0.74, P<0.001), and progression-free survival (median 3.7 vs. 1.9 months, respectively; hazard ratio for progression or death=0.40; 95% CI, 0.30-0.54, P<0.001). Meanwhile, in patients with mutated KRAS tumors, the authors found no significant difference in outcome between cetuximab plus best supportive care vs. best supportive care alone.

What next?

Based on these and similar results from other studies, the FDA narrowed its product labeling in July 2009 to indicate that cetuximab is not recommended for mCRC patients with mutated KRAS tumors. This distinction reduces the relevant population by approximately 40%. Similarly, the American society of Clinical oncology released a provisional clinical recommendation that all mCRC patients have their tumors tested for KRAS status before receiving anti-EGFR therapy. The benefits of targeted treatment are many. Patients who previously underwent cetuximab therapy without knowing their genetic predisposition would no longer have to be exposed to the drug’s toxic effects if unnecessary, as the efficacy of cetuximab is markedly higher in the genetically defined appropriate patients. In a less-uncertain environment, clinicians can be more confident in advocating a course of action in their care of patients. And finally, knowledge that targeted therapy is possible suggests the potential for further innovation in treatment options. In fact, research continues to demonstrate options for targeted cetuximab treatment of mCRC at an even finer scale than seen with KRAS; and similar genetic targeting is being investigated, and advocated, in other cancer types.

Lessons Learned From this case Study

Although RCTs are generally viewed as the gold standard, results of one or even a series of trials may not accurately reflect the benefits experienced by an individual patient. This case-study suggests that cetuximab initially appeared to have rather modest clinical benefits. Albeit, new information that became available and subsequent genetic subgroup assessments led to very different conclusions. Clinicians should be aware that the current knowledge is likely to evolve and any decisions about patient care should be carefully considered with that sense of uncertainty in mind. As in this case study, subgroup analyses (e.g., genetic subtypes) need a theoretical rationale. Ideally, the analyses should be determined at the time of original RCT design and should not just occur as explorations of the subsequent data. When improperly employed, post hoc analyses may lead to incorrect patient care conclusions.

RCTs Tips for the CER Practitioners

• RCTs can determine whether an intervention can provide benefit in a very controlled environment.

• The controlled nature of an RCT may limit its generalizability to a broader population.

• No results are permanent; advances in scientific knowledge and understanding can influence how we view the effectiveness (or safety) of a therapeutic intervention.

• Targeted therapy illuminated by carefully thought out subgroup analyses can improve the efficacious and safe use of an intervention.

===Case-Study 2: The Rosiglitazone Study===

Meta-analysis

Often the results for the same intervention differ across clinical trials and it may not be clear whether one therapy provides more benefit than another. As CER increases and more studies are conducted, clinicians and policymakers are more likely to encounter this scenario. In a systematic review, a researcher identifies similar studies and displays their results in a table, enabling qualitative comparisons across the studies. With a meta-analysis, the data from included studies are statistically combined into a single “result.” Merging the data from a number of studies increases the effective sample size of the investigation, providing a statistically stronger conclusion about the body of research. By so doing, investigators may detect low frequency events and demonstrate more subtle distinctions between therapeutic alternatives.

When studies have been properly identified and combined, the meta-analysis produces a summary estimate of the findings and a confidence interval that can serve as a benchmark in medical opinion and practice. However, when done incorrectly, the quantitative and statistical analysis can create impressive “numbers” but biased results. The following are important criteria for properly conducted meta-analyses:

1. Carefully defining unbiased inclusion or exclusion criteria for study selection

2. Including only those studies that have similar design elements, such as patient population, drug regimen, outcomes being assessed, and time-frame

3. Applying correct statistical methods to combine and analyze the data

Reporting this information is essential for the reader to determine whether the data were suitable to combine, and if the meta-analysis draws unbiased conclusions. Meta-analyses of randomized clinical trials are considered to be the highest level of medical evidence as they are based upon a synthesis of rigorously controlled trials that systematically reduce bias and confounding. This technique is useful in summarizing available evidence and will likely become more common in the era of publicly funded comparative effectiveness research. The following case study will examine several key principles that will be useful as the reader encounters these publications.

Clinical Application

Heart disease is the leading cause of mortality in the United States, resulting in approximately 20% of all deaths. Diabetics are particularly susceptible to heart disease, with more than 65% of deaths attributable to it. The nonfatal complications of diabetes are wide-ranging and include kidney failure, nerve damage, amputation, stroke and blindness, among other outcomes. In 2007, the total estimated cost of diabetes in the United States was $174B; $116B was derived from direct medical expenditures and the rest from the indirect cost of lost productivity due to the disease. With such serious health effects and heavy direct and indirect costs tied to diabetes, proper disease management is critical. Historically, diabetes treatment has focused on strict blood sugar control, assuming that this goal not only targets diabetes but also reduces other serious comorbidities of the disease.

Anti-diabetic agents have long been associated with key questions as to their benefits/risks in the treatment of diabetes. The sulfonylurea tolbutamide, a first generation anti-diabetic drug, was found in a landmark study in the 1970s to significantly increase the CV mortality rate compared to patients not on this agent. Further analysis by external parties concluded that the methods employed in this trial were significantly flawed (e.g., use of an “arbitrary” definition of diabetes status, heterogeneous baseline characteristics of the populations studied, and incorrect statistical methods). Since these early studies, CV concerns continue to be an issue with selected oral hypoglycemic agents that have subsequently entered the marketplace.

A class of drugs, thiazolidinedione (TZD), was approved in the late 1990s, as a solution to the problems associated with the older generation of sulfonylureas. Rosiglitazone, a member of the TZD class, was approved by the FDA in 1999 and was widely prescribed for the treatment of type-2 diabetes. A number of RCTs supported the benefit of rosiglitazone as an important new oral antidiabetic agent. However, safety concerns developed as the FDA received reports of adverse cardiac events potentially associated with rosiglitazone. It was in this setting that a meta-analysis by Nissen and Wolski was published in the New England Journal of Medicine in June 2007.

What was done?

Nissen and Wolski conducted a meta-analysis examining the impact of rosiglitazone on cardiac events and mortality compared to alternative therapeutic approaches. The study began with a broad search to locate potential studies for review. The authors screened published phase II, III, and IV trials; the FDA website; and the drug manufacturer’s clinical-trial registry for applicable data relating to rosiglitazone use. When the initial search was complete, the studies were further categorized by pre-stated inclusion criteria. Meta-analysis inclusion criteria were simple: studies had to include rosiglitazone and a randomized comparator group treated with either another drug or placebo, study arms had to show similar length of treatment, and all groups had to have received more than 24 weeks of exposure to the study drugs. The studies had to contain outcome data of interest including the rate of myocardial infarction (MI) or death from all CV causes. Out of 116 studies surveyed by the authors, 42 met their inclusion criteria and were included in the meta-analysis. Of the studies they included, 23 had durations of 26 weeks or less, and only five studies followed patients for more than a year. Until this point, the study’s authors were following a path similar to that of any reviewer interested in CV outcomes, examining the results of these 42 studies and comparing them qualitatively. Quantitatively combining the data, however, required the authors to make choices about the studies they could merge and the statistical methods they should apply for analysis. Those decisions greatly influenced the results that were reported.

What was found?

When the studies were combined, the meta-analysis contained data from 15,565 patients in the rosiglitazone group and 12,282 patients as comparators. Analyzing their data, the authors chose one particular statistical method (the Peto odds ratio method, a fixed-effect statistical approach), which calculates the odds of events occurring where the outcomes of interest are rare and small in number. In comparing rosiglitazone with a “control” group that included other drugs or placebo, the authors reported odds ratios of 1.43 (95% CI, 1.03-1.98; P=0.03) and 1.64 (95% CI,
0.98-2.74; P=0.06) for MI and death from CV causes, respectively. In other words, the odds of an MI or death from a CV cause are higher for rosiglitazone patients than for patients on other therapies or placebo. The authors reported that rosiglitazone was significantly associated with an increase in the risk of MI and had borderline significance in increasing the risk of death from all CV causes. These findings appeared online on the same day that the FDA issued a safety alert regarding rosiglitazone. Discussion of the meta-analysis was immediately featured prominently in the news media. By December 2007, prescription claims for the drug at retail pharmacies had fallen by more than 50%.

As diabetic patients and their clinicians reacted to the news, a methodologic debate also ensued. This discussion included statistical issues pertaining to the conduct of the analysis, its implications for clinical care, and finally the FDA and drug manufacturer’s roles in overseeing and regulating rosiglitazone. The concern among patients with diabetes regarding treatment, continues in the medical community today.

Was this the right answer?

Should the studies have been combined? Commentators faulted the authors for including several studies that were not originally intended to investigate diabetes, and for combining both placebo and drug therapy data into one comparator arm. Some critics noted that despite the stated inclusion criteria, some data were derived from studies where the rosiglitazone arm was allowed a longer follow-up than the comparator arm. By failing to account for this longer follow-up period, commentators felt that the authors may have overestimated the effect of rosiglitazone on CV outcomes. Many reviewers were concerned that this meta-analysis excluded trials in which no patients suffered an MI or died from CV causes – the outcomes of greatest interest. Some reviewers also noted that the exclusion of zero-event trials from the pooled dataset not only gave an incomplete picture of the impact of rosiglitazone but could have increased the odds ratio estimate. In general, the pooled dataset was criticized by many for being a faulty microcosm of the information available regarding rosiglitazone.

It is essential that a meta-analysis be based on similarity in the data sources. If studies differ in important areas such as the patient populations, interventions, or outcomes, combining their data may not be suitable. The researchers accepted studies and populations that were clinically heterogeneous, yet pooled them as if they were not. The study reported that the results were combined from a number of trials that were not initially intended to investigate CV outcomes. Furthermore, the available data did not allow for time-to-event analysis, an essential tool in comparing the impact of alternative treatment options. Reviewers considered the data to be insufficiently homogeneous, and the line of cause and effect to be murkier than the authors described.

Were the statistical methods optimal?

The statistical methods for this meta-analysis also came under significant criticism. The critiques focused on the authors’ use of the Peto method as being an incorrect choice because data were pooled from both small and very large studies, resulting in a potential overestimation of treatment effect. Others reviewers pointed that the Peto method should not have been used, as a number of the underlying studies did not have patients assigned equally to rosiglitazone and comparator groups. Finally, critics suggested that the heterogeneity of the included studies required an altogether different set of analytic techniques.

Demonstrating the sensitivity of the authors’ initial analysis to the inclusion criteria and statistical tests used, a number of researchers reworked the data from this study. one researcher used the same studies but analyzed the data with a more commonly used statistical method (Mantel-Haenszel), and found no significant increase in the relative risk or common odds ratio with MI or CV death. When the pool of studies was expanded to include those originally eliminated because they had zero CV events, the odds ratios for MI and death from CV causes dropped from 1.43 to 1.26 (95% CI, 0.93-1.72) and from 1.64 to 1.14 (95% CI, 0.74-1.74), respectively. Neither of the recalculated odd ratios were significant for MI or CV death. Finally, several newer long-term studies have been published since the Nissen meta-analysis. Incorporating their results with the meta-analysis data showed that rosiglitazone is associated with an increased risk of MI but not of CV death. Thus, the findings from these meta-analyses varied with the methods employed, the studies included, and the addition of later trials.

Emerging Data

The controversy surrounding the rosiglitazone meta-analysis authored by Nissen and Wolski forced an unplanned interim analysis of a long-term, randomized trial investigating the CV effects of rosiglitazone among patients with type 2 diabetes. The authors of the RECORD trial noted that even though the follow-up at 3.75 years was shorter than expected, rosiglitazone, when added to standard glucose-lowering therapy, was found to be associated with an increase in the risk of heart failure but was not associated with any increase in death from CV or other causes. Data at the time were found to be insufficient to determine the effect of rosiglitazone on an increase in the risk of MI. the final report of that trial, published in June 2009, confirmed the elevated risk of heart failure in people with type 2 diabetes treated with rosiglitazone in addition to glucose-lowering drugs, but continued to show inconclusive results about the effect of the drug therapy on the risk of MI. Further, the RECORD trial clarified that rosiglitazone does not result in an increased risk of CV morbidity or mortality compared to standard glucose-lowering drugs. Other trials conducted since the publishing of the meta-analysis have corroborated these results, casting further doubt on the findings of the meta-analysis published by Nissen and Wolski.

Now what?

Some sources suggest that the original Nissen meta-analysis delivered more harm than benefit, and that a well-recognized medical journal may have erred in its process of peer review. Despite this criticism, it is important to note that subsequent publications support the risk of adverse CV events associated with rosiglitazone, although rosiglitazone use does not appear to increase deaths. These results and emerging data point to the need for further rigorous research to clarify the benefits and risks of rosiglitazone on a variety of outcomes, and the importance of directing the drug to the population that will maximally benefit from its use.

Lessons Learned From this Case Study

Results from initial randomized trials that seem definitive at one time may not be conclusive, as further trials may emerge to clarify, redirect, or negate previously accepted results. A meta-analysis of those trials can lead to varying results based upon the timing of the analysis and the choices made in its performance.

Meta-Analysis: Tips for CER Practitioners

• The results of a meta-analysis are highly dependent on the studies included (and excluded). Are these criteria properly defined and relevant to the purposes of the meta-analysis? Were the combined studies sufficiently similar? Can results from this cohort be generalized to other populations of interest?

• The statistical methodology can impact study results. Have there been reviews critiquing the methods used in the meta-analysis?

• A variety of statistical tests should be considered, and perhaps reported, in the analysis of results. Do the authors mention their rationale in choosing a statistical method? Do they show the stability of their results across a spectrum of analytical methods?

• Nothing is permanent. Emerging data may change the playing field, and meta- analysis results are only as good as the data and statistics from which they are derived.

===Case-Study 3: The Nurses’ Health Study===

An observational study

An observational study is a very common type of research design in which the effects of a treatment or condition are studied without formally randomizing patients in an experimental design. Such studies can be done prospectively, wherein data are collected about a group of patients going forward in time; or retrospectively, in which the researcher looks into the past, mining existing databases for data that have already been collected. Latter studies are frequently performed by using an electronic database that contains, for example, administrative, “billing,” or claims data. Less commonly, observational research uses electronic health records, which have greater clinical information that more closely resembles the data collected in an RCT. Observational studies often take place in “real- world” environments, which allow researchers to collect data for a wide array of outcomes. Patients are not randomized in these studies, but the findings can be used to generate hypotheses for investigation in a more constrained experimental setting. Perhaps the best known observational study is the “Framingham study,” which collected demographic and health data for a group of individuals over many years (and continues to do so) and has provided an understanding of the key risk factors for heart disease and stroke.

Observational studies present many advantages to the comparative effectiveness researcher. the study design can provide a unique glimpse of the use of a health care intervention in the “real world,” an essential step in gauging the gap between efficacy (can a treatment work in a controlled setting?) and effectiveness (does the treatment work in a real-life situation?). Furthermore, observational studies can be conducted at low cost, particularly if they involve the secondary analysis of existing data sources. CER often uses administrative databases, which are based upon the billing data submitted by providers during routine care. These databases typically have limited clinical information, may have errors in them, and generally do not undergo auditing.

The uncontrolled nature of observational studies allows them to be subject to bias and confounding. For example, doctors may prescribe a new medication only for the sickest patients. Comparing these outcomes (without careful statistical adjustment) with those from less ill patients receiving alternative treatment may lead to misleading results. Observational studies can identify important associations but cannot prove cause and effect. These studies can generate hypotheses that may require RCTs for fuller demonstration of those relationships. Secondary analysis can also be problematic if researchers overwork datasets by doing multiple exploratory analyses (e.g., data-dredging): the more we look, the more we find, even if those findings are merely statistical aberrations. Unfortunately, the growing need for CER and the wide availability of administrative databases may lead to selection of research of poor quality with inaccurate findings.

In comparative effectiveness research, observational studies are typically considered to be less conclusive than RCTs and meta-analyses. Nonetheless, they can be useful, especially because they examine typical care. Due to lower cost and improvements in health information, observational studies will become increasingly common. Critical assessment of whether the described results are helpful or biased (based upon how the study was performed) are necessary. This case will illustrate several characteristics of the types of studies that will assist in evaluating newly published work.

Clinical Applications

Cardiovascular diseases (CVD) are the leading cause of death in women older than the age of 50. Epidemiologic evidence suggests that estrogen is a key mediator in the development of CVD. Estrogen is an ovarian hormone whose production decreases as women approach menopause. The steep increase in CVD in women at menopause and older and in women who have had hysterectomies further supports a relationship between estrogen and CVD. Building on this evidence of biologic plausibility, epidemiological and observational studies suggested that estrogen replacement therapy (a form of hormone replacement therapy, or HRT) had positive effects on the risk of CVD in postmenopausal women, (albeit with some negative effects in its potential to increase the risk for breast cancer and stroke). Based on these findings, in the 1980s and 1990s HRT was routinely employed to treat menopausal symptoms and serve as prophylaxis against CVD.

What was done?

The Nurses’ Health Study (NHS) began collecting data in 1976. In the study, researchers intended to examine a broad range of health effects in women over a long period of time, and a key goal was to clarify the role of HRT in heart disease. The cohort (i.e., the group being followed) included married registered nurses aged 30-55 in 1976 who lived in the 11 most populous states. To collect data, the researchers mailed the study participants a survey every 2 years that asked questions about topics such as smoking, hormone use, menopausal status, and less frequently, diet. Data were collected for key end points that included MI, coronary-artery bypass grafting or angioplasty, stroke, total CVD mortality, and deaths from all causes.

What was found?

At a 10-year follow-up point, the NHS had a study pool of 48,470 women. The researchers found that estrogen use (alone, without progestin) in postmenopausal women was associated with a reduction in the incidence of CVD as well as in CVD mortality compared to non-users. Later, estrogen-progestin combination therapy was shown to be even more cardioprotective than estrogen monotherapy, and lower doses of estrogen replacement therapy were found to deliver equal cardioprotection and lower the risk for adverse events. NHS researchers were alert to the potential for bias in observational studies. Adjustment for risk factors such as age (a typical practice to eliminate confounding) did not change the reported findings.

Was this the right answer?

The NHS was not unique in reporting the benefits associated with HRT; other observational studies corroborated the NHS findings. A secondary retrospective data analysis of the UK primary care electronic medical record database, for example, also showed the protective effect associated with HRT use. Researchers were aware of the fundamental limitations of observational studies, particularly with regard to selection bias. They and practicing clinicians were also aware of the potential negative health effects of HRT, which had to be constantly weighed against the potential cardioprotective benefits in deciding a patient’s course of treatment. As a large section of the population could experience the health effects of HRT, researchers began planning RCTs to verify the promising observational study results. It was highly anticipated that those RCTs would corroborate the belief that estrogen replacement can reduce CVD risk.

Randomized Controlled Trial: The Women’s Health Initiative

The Women’s health Initiative (WHI) was a major study established by the National Institutes of health in 1992 to assess a broad range of health effects in postmenopausal women. The trial was intended to follow these women for 8 years, at a cost of millions of dollars in federal funding. Among its many facets, it included an RCT to confirm the results from the observational studies discussed above. To fully investigate earlier findings, the WHI had two subgroups. One subgroup consisted of women with prior hysterectomies; they received estrogen monotherapy. The second group consisted of women who had not undergone hysterectomy; they received estrogen in combination with progestin. The WHI enrolled 27,347 women in their HRT investigation: 10,739 in the estrogen-alone arm and 16,608 in the estrogen plus progestin arm. Within each arm, women were randomly assigned to receive either HRT or placebo. All women in the trial were postmenopausal and aged 50-79 years; the mean age was 63.6 years (a fact that would be important in later analysis). Some participants had experienced previous CV events. The primary outcome of both subgroups was coronary heart disease (CHD), as described by nonfatal MI or death due to CHD.

The estrogen-progestin arm of the WHI was halted after a mean follow-up of 5.2 years, 3 years earlier than expected, as the HRT users in this arm were found to be at increased risk for CHD compared to those who received placebo. The study also noted elevated rates of breast cancer and stroke, among other poor outcomes. The estrogen-alone arm continued for an average follow-up of 6.8 years before being similarly discontinued ahead of schedule. Although this part of the study did not find an increased risk of CHD, it also did not find any cardioprotective effect. Beyond failing to locate any clear CV benefits, the WHI also found real evidence of harm, including increased risk of blood clots, breast cancer and stroke. Initial WHI publications therefore recommended against HRT being prescribed for the secondary prevention of CVD.

What Next?

Scientists and the clinicians who relied on their data for guidance in treating patients, were faced with conflicting data: epidemiological and observational studies suggested that HRT was cardioprotective while the higher-quality evidence from RCTs strongly suggested the opposite. Clinicians primarily followed the WHI results, so prescriptions for HRT in postmenopausal women quickly declined. Meanwhile, researchers began to analyze the studies for potential discrepancies, and found that the women being followed in the NHS and the WHI differed in several important characteristics.

First, the WHI population was older than the NHS cohort, and many had entered menopause at least 10 years before they enrolled in the RCT. Thus, the WHI enrollees experienced a long duration from the onset of menopause to the commencement of HRT. At the same time, many in the NHS population were closer to the onset of menopause and were still displaying hormonal symptoms when they began HRT. Second, although the NHS researchers adjusted the data for various confounding effects, their results could still have been subject to bias. In general, the NHS cohort was more highly educated and of a higher socioeconomic status than the WHI participants, and therefore more likely to see a physician regularly. The NHS women were also leaner and generally healthier than their RCT counterparts, and had been selected for their evident lack of pre-existing CV conditions. This selection bias in the NHS enrollment may have led to a “healthy woman” effect that in turn led to an overestimation of the benefits of therapy in the observational study. Third, researchers noted that dosing differences between the two study types may have contributed to the divergent results. The NHS reported beneficial results following low-dose estrogen therapy. The WHL, meanwhile, used a higher estrogen dose, exposing women to a larger dosage of hormones and increasing their risk for adverse events. The increased risk profile of the WHI women (e.g., older, more comorbidities, higher estrogen dose) could have contributed to the evidence of harm seen in the WHI results.

Emerging Data
In addition to identifying the inherent differences between the two study populations, researchers began a secondary analysis of the NHS and WHI trials. NHS researchers reported that women who began HRT close to the onset of menopause had a significantly reduced risk of CHD. In the subgroups of women that were older and had a similar duration after menopause compared with the WHI women, they found no significant relationship between HRT and CHD. Also, the WHI study further stratified these results by age, and found that women who began HRT close to their onset of menopause experienced some cardioprotection, while women who were further from the onset of menopause had a slightly elevated risk for CHD.

Secondary analysis of both studies was therefore necessary to show that age and a short duration from the onset of menopause are crucial to HRT success as a cardioprotective agent. Neither study type provided “truth” or rather, both studies provided “truth” if viewed carefully (e.g., both produced valid and important results). The differences seen in the studies were rooted in the timing of HRT and the populations being studied.

Lessons Learned From this case Study

Although RCTs are given a higher evidence grade, observational studies provide important clinical insights. In this example, the study populations differed. For policymakers and clinicians, it is crucial to examine whether the CER was based upon patients similar to those being considered. Any study with a dissimilar population may provide non-relevant results. Thus, readers of CER need to carefully examine the generalizability of the findings being reported.

==Appendix==

General Classification and Regression Tree (CART) data analysis steps part of the R package rpart.

===Growing the Tree===

# To grow a tree, use
rpart(formula, data=, method=,control=), where
formula is in the format outcome ~ predictor1+predictor2+...
data= specifies the data frame
method= "class" for a classification tree, use "anova" for a regression tree
control= optional parameters for controlling tree growth. For example, control=rpart.control(minsplit=30, cp=0.001) requires that the minimum number of observations in a node be 30 before attempting a split and that a split must decrease the overall lack of fit by a factor of 0.001 (cost complexity factor) before being attempted.

===Examining Results===

# These functions help with examining the results.
printcp(fit) display complexity parameter (cp) table
plotcp(fit) plot cross-validation results
rsq.rpart(fit) plot approximate R-squared and relative error for different splits (2 plots). labels are only appropriate for the "anova" method.
print(fit) print results
summary(fit) detailed results including surrogate splits
plot(fit) plot decision tree
text(fit) label the decision tree plot
post(fit, file=) create postscript plot of decision tree
# In trees created by rpart(), move to the LEFT branch when the stated condition is true.

===Pruning Trees===

#In general, trees should be pruned back to avoid overfitting the data. The tree size should minimize the cross-#validated error – xerror column printed by printcp(). Pruning the tree is accomplished by:
prune(fit, cp= )
# use printcp( ) to examine the cross-validation error results, select the complexity parameter (CP) associated with minimum error, and insert the CP it into the prune() function. This (automatically selecting the complexity parameter associated with the smallest cross-validated error) can be done succinctly by:
fit$\$$cptable[which.min(fit$\$$cptable[,"xerror"]),"CP"]

===Compete Dataset for N-of-1 Example===
[[SMHS_MethodsHeterogeneity_CER_Nof1|This N-of-1 Dataset]] includes an example.

===[[SMHS_MethodsHeterogeneity|Back to the Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research section]]===

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php/SMHS_MethodsHeterogeneity_CER}}

SMHS MethodsHeterogeneity MetaAnalysis

2016-05-20T14:44:21Z

Imoubara: /* Quantile Treatment Effect (QTE) */

==[[SMHS_MethodsHeterogeneity| Methods for Studying Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research]] - Meta-Analyses ==

==Meta-analysis==

===Overview===

Meta-analysis is an approach to combine treatment effects across trials or studies into an aggregated treatment effect with higher statistical power than observed in each individual trials. It may detect HTE by testing for differences in treatment effects across similar RCTs. It requires that the individual treatment effects are similar to ensure pooling is meaningful. In the presence of large clinical or methodological differences between the trials, it may be to avoid meta-analyses. The presence of HTE across studies in a meta-analysis may be due to differences in the design or execution of the individual trials (e.g., randomization methods, patient selection criteria). Cochran's Q is a methods for detection of heterogeneity, which is computed as the weighted sum of squared differences between each study's treatment effect and the pooled effects across the studies. It is a barometer of inter-trial differences impacting the observed study result. A possible source of error in a meta-analysis is publication bias. Trial size may introduce publication bias since larger trials are more likely to be published. Language and accessibility represent other potential confounding factors. When the heterogeneity is not due to poor study design, it may be useful to optimize the treatment benefits for different cohorts of participants.

Cochran's Q statistics is the weighted sum of squares on a standardized scale. The corresponding P value indicates the strength of the evidence of presence of heterogeneity. This test may have low power to detect heterogeneity sometimes and it is suggested to use a value of 0.10 as a cut-off for significance (Higgins et al., 2003). The Q statistics also may have too much power as a test of heterogeneity when the number of studies is large.

===Simulation Example 1===

# Install and Load library
install.packages("meta")
library(meta)

# Set number of studies
n.studies = 15

# number of treatments: case1, case2, control
n.trt = 3

# number of outcomes
n.event = 2

# simulate the (balanced) number of cases (case1 and case2) and controls in each study
ctl.group = rbinom(n = n.studies, size = 200, prob = 0.3)
case1.group = rbinom(n = n.studies, size = 200, prob = 0.3)
case2.group = rbinom(n = n.studies, size = 200, prob = 0.3)

# Simulate the number of outcome events (e.g., deaths) and no events in the control group
event.ctl.group = rbinom(n = n.studies, size = ctl.group, prob = rep(0.1, length(ctl.group)))
noevent.ctl.group = ctl.group - event.ctl.group

# Simulate the number of events and no events in the case1 group
event.case1.group = rbinom(n = n.studies, size = case1.group, prob = rep(0.5, length(case1.group)))
noevent.case1.group = case1.group - event.case1.group

# Simulate the number of events and no events in the case2 group
event.case2.group = rbinom(n = n.studies, size = case2.group, prob = rep(0.6, length(case2.group)))
noevent.case2.group = case2.group - event.case2.group

# Run the univariate meta-analysis using metabin(), Meta-analysis of binary outcome data –
# Calculation of fixed and random effects estimates (risk ratio, odds ratio, risk difference or arcsine
# difference) for meta-analyses with binary outcome data. Mantel-Haenszel (MH),
# inverse variance and Peto method are available for pooling.

# method = A character string indicating which method is to be used for pooling of studies.
# one of "MH" , "Inverse" , or "Cochran"
# sm = A character string indicating which summary measure (“OR”, "RR" "RD"=risk difference) is to be
# used for pooling of studies

# Control vs. Case1, n.e and n.c are numbers in experimental and control groups
meta.ctr_case1 <- metabin(event.e = event.case1.group, n.e = case1.group, event.c = event.ctl.group,
n.c = ctl.group, method = "MH", sm = "OR")
# in this case we use Odds Ratio, of the odds of death in the experimental and control studies
forest(meta.ctr_case1)

<center>[[Image:SMHS_Methods8.png|500px]] </center>

# Control vs. Case2
meta.ctr_case2 <- metabin(event.e = event.case2.group, n.e = case2.group, event.c = event.ctl.group,
n.c = ctl.group, method = "MH", sm = "OR")
forest(meta.ctr_case2)

<center>[[Image:SMHS_Methods9.png|500px]] </center>

# Case1 vs. Case2
meta.case1_case2 <- metabin(event.e = event.case1.group, n.e = case1.group, event.c = event.case2.group,
n.c = case2.group, method = "MH", sm = "OR")
forest(meta.case1_case2)
summary(meta.case1_case2)

Test of heterogeneity:
Q d.f. p-value
11.99 14 0.6071

<center>[[Image:SMHS_Methods10.png|500px]] </center>

The forest plot shows the I2 test indicates the evidence to reject the null hypothesis (no study heterogeneity and the fixed effects model should be used).

==Series of “N of 1” trials==

This technique combines (a “series of”) n-of-1 trial data to identify HTE. An n-of-1 trial is a repeated crossover trial for a single patient, which randomly assigns the patient to one treatment vs. another for a given time period, after which the patient is re-randomized to treatment for the next time period, usually repeated for 4-6 time periods. Such trials are most feasibly done in chronic conditions, where little or no washout period is needed between treatments and treatment effects are identifiable in the short-term, such as pain or reliable surrogate markers. Combining data from identical n-of-1 trials across a set of patients enables the statistical analysis controlling for patient fixed or random effects, covariates, centers, or sequence effects, see Figure below. These combined trials are often analyzed within a Bayesian context using shrinkage estimators that combine individual and group mean treatment effects to create a “posterior” individual mean treatment effect estimate which is a form of inverse variance-weighted average of the individual and group effects. Such trials are typically more expensive than standard RCTs on a per-patient basis, however, they require much smaller sample sizes, often less than 100 patients (due to the efficient individual-as-own-control design), and create individual treatment effect estimates that are not possible in a non-crossover design . For the individual patient, the treatment effect can be re-estimated after each time period, and the trial stopped at any point when the more effective treatment is identified with reasonable statistical certainty.

====Example====

A study involving 8 participants collected data across 30 days, in which 15 treatment days and 15 control days are randomly assigned within each participant. The treatment effect is represented as a binary variable (control day=0; treatment day=1). The outcome variable represents the response to the intervention within each of the 8 participants. Study employed a fixed-effects modeling. By creating N − 1 dummy-coded variables representing the N=8 participants, where the last (i=8) participant serves as the reference (i.e., as the model intercept). So, each dummy-coded variable represents the difference between each participant (i) and the 8th participant. Thus, all other patients' values will be relative to the values of the 8th (reference) subject. The overall differences across participants in fixed effects can be evaluated with multiple degree-of-freedom F-tests.

<center>[[Image:SMHS_Methods11.png|500px]] </center>

<center>

{| class="wikitable" style="text-align:center; " border="1"
|-
|ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||1||33||8||0.97||5.00||4.03||1.03||53
|-
|1||2||1||33||8||-0.17||3.87||4.03||1.03||73
|-
|1||3||0||33||8||0.81||4.84||4.03||1.03||23
|-
|1||4||0||33||8||-0.41||3.62||4.03||1.03||36
|-
|...||...||...||...||...||...||...||...||...||...

|}
</center> Complete data is available in the Appendix.

<center>Data Summary

{| class="wikitable" style="text-align:center; " border="1"
|-
|Intercept||Constant
|-
|Physical Activity||PhyAct
|-
|Intervention||Tx
|-
|WP Social Support||WPSS
|-
|PM Social Support (1-3)||PMss3
|-
|Self Efficacy||SelfEff25

|}
</center>

rm(list=ls())
Nof1 <-read.table("https://umich.instructure.com/files/330385/download?download_frd=1&verifier=DwJUGSd6t24dvK7uYmzA2aDyzlmsohyaK6P7jK0Q", sep=",", header = TRUE) # 02_Nof1_Data.csv
attach(Nof1)
head(Nof1)

<center>

{| class="wikitable" style="text-align:center; " border="1"
|-
| ||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0

|}
</center>

df.1 = data.frame(PhyAct, Tx, WPSS, PMss3, SelfEff25)

# library("lme4")

lm.1 = model.lmer <- lmer(PhyAct ~ Tx + SelfEff + Tx*SelfEff + (1|Day) + (1|ID) , data= df.1)
summary(lm.1)

Linear mixed model fit by REML ['lmerMod']
Formula: PhyAct ~ Tx + SelfEff + Tx * SelfEff + (1 | Day) + (1 | ID)
Data: df.1

REML criterion at convergence: 8820

<center> Scaled Residuals
{| class="wikitable" style="text-align:center; " border="1"
|-
| Min||1Q||Median||3Q||Max
|-
|-2.7012||-0.6833||-0.0333||0.6542||3.9612
|}
</center>

<center> Random Effects
{| class="wikitable" style="text-align:center; " border="1"
|-
| Groups ||Name||Variance ||Std.Dev.
|-
| Day||(Intercept) ||0.0 || 0.00
|-

|ID|| (Intercept)||601.5||24.53
|-

|Residual|| ||969.0 ||31.13
|}
Number of obs: 900, groups: Day, 30; ID, 30
</center>

<center> Fixed Effects
{| class="wikitable" style="text-align:center; " border="1"
|-
|Estimate||Std.||Error||t value
|-
|(Intercept)||38.3772||14.4738||2.651
|-
|Tx||4.0283||6.3745||0.632
|-
|SelfEff||0.5818||0.5942||0.979
|-
|Tx:SelfEff||0.9702||0.2617||3.708
|}
</center>

<center> Correlation of Fixed Effects
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||(Intr)||Tx ||SlfEff
|-
| Tx|| -0.220|| ||
|-
| SelfEff||-0.946 ||0.208 ||
|-
| Tx:SelfEff ||0.208 ||-0.946 ||-0.220
|}
</center>

# Model: PhyAct = Tx + WPSS + PMss3 + Tx*WPSS + Tx*PMss3 + SelfEff25 + Tx*SelfEff25 + ε
lm.2 = lm(PhyAct ~ Tx + WPSS + PMss3 + Tx*WPSS + Tx*PMss3 + SelfEff25 + Tx*SelfEff25, df.1)
summary(lm.2)

Call:
lm(formula = PhyAct ~ Tx + WPSS + PMss3 + Tx * WPSS + Tx * PMss3 +
SelfEff25 + Tx * SelfEff25, data = df.1)

<center> Residuals
{| class="wikitable" style="text-align:center; " border="1"
|-
|Min||1Q||Median||3Q||Max
|-
| -102.39||-28.24||-1.47||25.16||122.41

|}
</center>

<center>Coefficients
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||Estimate||Std. Error||t value||$Pr(>|t|)$
|-
|(Intercept)||52.0067||1.8080||28.764||< 2e-16 ***
|-
|Tx||27.7366||2.5569||10.848||< 2e-16 ***
|-
|WPSS||1.9631||2.4272||0.809||0.418853
|-
|PMss3||13.5110||2.7853||4.851||1.45e-06 ***
|-
|SelfEff25||0.6289||0.2205||2.852||0.004439 **
|-
|Tx:WPSS||9.9114||3.4320||2.888||0.003971 **
|-
|Tx:PMss3||8.8422||3.9390||2.245||0.025025 *
|-
|Tx:SelfEff25||1.0460||0.3118||3.354||0.000829 ***

|}
</center>

[Using SAS (StudyI_Analyses.sas, StudyIIab_Analyses.sas)]

<center> Type 3 Tests of Fixed Effects
{| class="wikitable" style="text-align:center; " border="1"
|-
|Effect||Num DF||Den DF||F Value||$Pr>F$
|-
|Tx||1||224||67.46||<.0001
|-
|ID||7||224||25.95||<.0001
|-
|Tx*ID||7||224||2.92||0.0060
|}
</center>

==Quantile Treatment Effect (QTE)==

QTE employs quantile regression estimation (QRE) to examine the central tendency and statistical dispersion of the treatment effect in a population. These may not be revealed by the conventional mean estimation in RCTs. For instance, patients with different comorbidity scores may respond differently to a treatment. Quantile regression has the ability to reveal HTE according to the ranking of patients’ comorbidity scores or some other relevant covariate by which patients may be ranked. Therefore, in an attempt to inform patient-centered care, quantile regression provides more information on the distribution of the treatment effect than typical conditional mean treatment effect estimation. QTE characterizes the heterogeneous treatment effect on individuals and groups across various positions in the distributions of different outcomes of interest. This unique feature has given quantile regression analysis substantial attention and has been employed across a wide range of applications, particularly when evaluating the economic effects of welfare reform.

One caveat of applying QRE in clinical trials for examining HTE is that the QTE doesn’t demonstrate the treatment effect for a given patient. Instead, it focuses on the treatment effect among subjects within the qth quantile, such as those who are exactly at the top 10th percent in terms of blood pressure or a depression score for some covariate of interest, for example, comorbidity score. It is not uncommon for the qth quantiles to be two different sets of patients before and after the treatment. For this reason, we have to assume that these two groups of patients are homogeneous if they were in the same quantiles.

Income-Food Expenditure Example: Let’s examine the Engel data (N=235) on the relationship between food expenditure (foodexp) and household income (income). We can plot the data and then explore the superposition of the six fitted quantile regression lines.

install.packages("quantreg")
library(quantreg)
data(engel)
attach(engel)

<center>head(engel)
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Income||Foodexp
|-
|1||420.1577||255.8394
|-
|2||541.4117||310.9587
|-
|3||901.1575||485.6800
|-
|4||639.0802||402.9974
|-
|5||750.8756||495.5608
|-
|6||945.7989||633.7978

|}
</center>

<center>summary(engel)
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Income||Foodexp
|-
|Min||377.1||242.3
|-
|1st Qu.||638.9||429.7
|-
|Median||884.0||582.5
|-
|Mean||982.5||624.2
|-
|3rd Qu.||1164.0||743.9
|-
|Max||4957.8||2032.7

|}
</center>

Note: If Y be a real valued random variable with cumulative distribution function FY(y)=P(Y≤ y), then the τ-quantile of Y is given by

<center> QY(τ)=FY-1(τ)=inf{ y:FY(y)≥τ} </center>

where 0≤τ≤1.

<center>[[Image:SMHS_Methods12.png|500px]] </center>

# (1) Graphics
plot(income, foodexp, cex=.25, type="n", xlab="Household Income", ylab="Food Expenditure")
points(income, foodexp, cex=.5, col="blue")

# tau - the quantile(s) to be estimated, in the range from 0 to 1. An object "rq.process" and an object "rqs"
# are returned containing the matrix of coefficient estimates at the specified quantiles.
abline( rq(foodexp ~ income, tau=.5), col="blue") # Quantile Regression Model

abline( lm(foodexp ~ income), lty=2, lwd=3, col="red") # linear model
taus <- c(0.05, 0.1, 0.25, 0.75, 0.90, 0.95)
colors <- rainbow(length(taus))

models <- vector(mode = "list", length = length(taus)) # define a vector of models to store QR for diff taus
model.names <- vector(mode = "list", length = length(taus)) # define a vector model names

for( i in 1:length(taus)){
models[[i]] <- rq(foodexp ~ income, tau=taus[i])
var <- taus[i]
model.names[[i]] <- paste("Model [", i , "]: tau=", var)
abline( models[[i]], lwd=2, col= colors[[i]])
}
legend(3000, 1100, model.names, col= colors, pch= taus, bty='n', cex=.75)

<center>[[Image:SMHS_Methods13.png|500px]] </center>

# (2) Inference about quantile regression coefficients. As an alternative to the rank-inversion confidence intervals, we can obtain a table of coefficients, standard errors, t-statistics, and p-values using the summary function:

summary(models[[3]], se = "nid")

Call: rq(formula = foodexp ~ income, tau = taus[i])

tau: [1] 0.25

<center>Coefficients
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Value||Std. Error||t Value||$Pr(>|t|)$
|-
|(Intercept)||95.48354||21.39237||4.46344||0.00001
|-
|Income||0.47410||0.02906||16.31729||0.00000

|}
</center>

# Alternatively, we can use summary.rq to compute bootstrapped standard errors.
summary.rq(models[[3]], se = "nid")

Call: rq(formula = foodexp ~ income, tau = taus[i])
tau: [1] 0.25

<center>Coefficients
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Value||Std. Error||t Value||$Pr(>|t|)$
|-
|(Intercept)||95.48354||21.39237||4.46344||0.00001
|-
|Income||0.47410||0.02906||16.31729||0.00000

|}
</center>

==Nonparametric Regression Methods ==

Nonparametric regression enables dealing with HTE in RCTs. Different nonparametric methods, such as kernel smoothing methods and series methods, can be used to generate test statistics for examining the presence of HTE. A kernel method is a weighting scheme based on a kernel function (e.g. uniform, Gaussian). When evaluating the treatment effect of a patient in RCTs, the kernel method assigns larger weights to those observations with similar covariates. This is done because it is assumed that patients with similar covariates provide more relevant data on predicted treatment response. Examining participants that have different backgrounds (e.g., demographic, clinical), kernel smoothing methods utilize information from highly divergent participants when estimating a particular subject’s treatment effect. Lower weights are assigned to very different subjects and the kernel methods require choosing a set of smoothing parameters to group patients according to their relative degree of similarities. A drawback is that the corresponding proposed test statistics may be sensitive to the chosen bandwidths, which inhibits the interpretation of the results. Series methods use approximating functions (splines or power series of the explanatory variables) to construct test statistics. Compared to kernel smoothing methods, series methods normally have the advantage of computational convenience; however, the precision of test statistics depends on the number of terms selected in the series.

Canadian Wage Data Example: Nonparametric regression extends the classical parametric regression (e.g., lm, lmer) involving one continuous dependent variable, y, and (1 or more) continuous explanatory variable(s), x. Let’s start with a popular parametric model of a wage equation that we can extend to a fully nonparametric regression model. First, we will compare and contrast the parametric and nonparametric approach towards univariate regression and then proceed to multivariate regression.

Let’s use the Canadian cross-section wage data (cps71) consisting of a random sample taken from the 1971 Canadian Census for male individuals having common education (High-School). N=205 observations, 2 variables, the logarithm of the individual’s wage (logwage) and their age (age). The classical wage equation model includes a quadratic term of age.

# install.packages("np")
library("np")
data("cps71")

# (1) Linear Model -> R2 = 0.2308
model.lin <- lm( logwage ~ age + I(age^2), data = cps71)
summary(model.lin)

Call:
lm(formula = logwage ~ age + I(age^2), data = cps71)

Residuals:
Min 1Q Median 3Q Max
-2.4041 -0.1711 0.0884 0.3182 1.3940

<center>Coefficients
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||Estimate||Std. Error||t Value||$Pr(>|t|)$
|-
|(Intercept)||10.0419773||0.4559986||22.022||< 2e-16 ***
|-
|Age||0.1731310||0.0238317|| 7.265||7.96e-12 ***
|-
|I(age^2)||-0.0019771||0.0002898||-6.822||1.02e-10 ***

|}
</center>

Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.5608 on 202 degrees of freedom
Multiple R-squared: 0.2308, Adjusted R-squared: 0.2232
F-statistic: 30.3 on 2 and 202 DF, p-value: 3.103e-12

# (2) Next, we consider the local linear nonparametric method employing cross-validated
# bandwidth selection and estimation in one step. Start with computing the least-squares
# cross-validated bandwidths for the local constant estimator (default).
# Note that R2 = 0.3108675
bandwidth <- npregbw(formula= logwage ~ age, data = cps71)
model.np <- npreg(bandwidth, regtype = "ll", bwmethod = "cv.aic", gradients = TRUE, data = cps71)
summary(model.np)

Regression Data: 205 training points, in 1 variable(s) age
Bandwidth(s): 1.892157
Kernel Regression Estimator: Local-Constant
Bandwidth Type: Fixed
Residual standard error: 0.5307943
R-squared: 0.3108675
Continuous Kernel Type: Second-Order Gaussian
No. Continuous Explanatory Vars.: 1

# NP model significance may be tested by
npsigtest(model.np)

Kernel Regression Significance Test
Type I Test with IID Bootstrap (399 replications, Pivot=TRUE, joint=FALSE)
Explanatory variables tested for significance: age (1)

age
Bandwidth(s): 1.892157

Individual Significance Tests
P Value:
age < 2.22e-16 ***

# So, as was the case for the linear parametric model, Age is significant in the local linear NP-model

# (3) Graphical comparison of parametric and nonparametric models.
plot(cps71$\$$age, cps71$\$$logwage, xlab = "age", ylab = "log(wage)", cex=.1)
lines(cps71$\$$age, fitted(model.lin), lty = 2, col = " red")
lines(cps71$\$$age, fitted(model.np), lty = 1, col = "blue")
legend("topright", c("Data", "Linear", "Non-linear"), col=c("Black", "Red", "Blue"), pch = c(1, 1, 1), bty='n', cex=.75)

<center>[[Image:SMHS_Methods14.png|500px]] </center>

# some additional plots resenting the parametric (quadratic, dashed line) and the nonparametric estimates
# (solid line) of the regression function for the cps71 data.
plot(model.np, plot.errors.method = "asymptotic")
plot(model.np, gradients = TRUE)
lines(cps71$\$$age, coef(model.lin)[2]+2*cps71$\$$age*coef(model.lin)[3], lty = 2, col = "red")
plot(model.np, gradients = TRUE, plot.errors.method = "asymptotic")

# (4) using the Lin and NL models to generate predictions based on the obtained appropriate
# bandwidths and estimated a nonparametric model. We need to create a set of explanatory
# variables for which to generate predictions. These can be part of the original dataset or be
# outside its scope. Typically, we don’t have the outcome for the evaluation data and need only
# provide the explanatory variables for which predicted values are generated by the models.
# Occasionally, splitting the dataset into two independent samples (training/testing), allows estimation
# of a model on one sample, and evaluation of its performance on another.

cps.eval.data <- data.frame(age = seq(10,70, by=10)) # simulate some explanatory X values (ages)
pred.lin <- predict(model.lin, newdata = cps.eval.data) # Linear Prediction of log(Wage)
pred.np <- predict(model.np, newdata = cps.eval.data) # non-Linear Prediction of log(Wage)
plot(pred.lin, pred.np)
abline(lm(pred.np ~ pred.lin))

<center>[[Image:SMHS_Methods15.png|500px]] </center>

.
.
.

==Predictive risk models ==

Predictive risk models represent a class of methods for identifying potential for HTE when the individual patient risk for disease-related events at baseline depends on observed factors. For instance, common measures are disease staging criteria, such as those used in COPD or heart failure, Framingham risk scores for cardiovascular event risk, or genetic variations, e.g., HER2 for breast cancer. Initial predictive risk modeling, aka risk function estimation, is often performed without accounting for treatment effects. Least squares or Cox proportional hazards regression methods are appropriate in many cases and provide relatively more interpretable risk functions, but rely on linearity assumptions and may not provide optimal predictive metrics. Partial least squares is an extension of least squares methods that can reduce the dimensionality of the predictor space by interposing latent variables, predicted by linear combinations of observable characteristics, as the intermediate predictors of one or more outcomes. Recursive partitioning, such as random forests, support vector machines, and neural networks represent latter methods with better predictive power than linear methods. Risk function estimation can range from highly exploratory analyses to near meta-analytic model validation, and may be useful at any stage of product development.

HIV Example: The “hmohiv” dataset represents a study of HIV positive patients examining whether there was a difference in survival times of HIV positive patients between a cohort using intravenous drugs (drug=1) and a cohort not using the IV drug (drug=0). The hmohiv data includes the following variables:

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|ID||Time||Age||Drug||Censor||Entdate||Enddate
|-
|1||5||46||0||1||5/15/1990||10/14/1990
|-
|2||6||35||1||0||9/19/1989||3/20/1990
|-
|3||8||30||1||1||4/21/1991||12/20/1991
|-
|4||3||30||1||1||1/3/1991||4/4/1991
|-
|5||22||36||0||1||9/18/1989||7/19/1991
|-
|6||1||32||1||0||3/18/1991||4/17/1991
|-
|...||...||...||...||...||...||...

|}
</center>

#cleaning up environment
rm(list=ls())

# load survival library
library(survival)

# load hmohiv data
hmohiv<-read.table("http://www.ats.ucla.edu/stat/r/examples/asa/hmohiv.csv", sep=",", header = TRUE)
attach(hmohiv)

# Fit Cox proportional hazards regression model
cox.model <- coxph( Surv(time, censor) ~ drug, method="breslow")
fit.1 <- survfit(cox.model, newdata=drug.new)

# construct a frame of the 2 cohorts IV_drug and no-IV-drug
drug.new<-data.frame(drug=c(0,1))

# plot results
plot(fit.1, xlab="Survival Time (Months)", ylab="Survival Probability")
points(fit.1$\$$time, fit.1$\$$surv[,1], pch=1)
points(fit.1$\$$time, fit.1$\$$surv[,2], pch=2)
legend(40, .8, c("Drug Absent", "Drug Present"), pch=c(1,2))

<center>[[Image:SMHS_Methods16.png|500px]] </center>

# to inslect the resulting Cox Proportional Hazard Model
cox.model
Call:
coxph(formula = Surv(time, censor) ~ drug, method = "breslow")

coef exp(coef) se(coef) z p
drug 0.779 2.18 0.242 3.22 0.0013

Likelihood ratio test=10.2 on 1 df, p=0.00141 n= 100, number of events= 80

.
.
.

==[[SMHS_MethodsHeterogeneity_CER|Next see: Comparative Effectiveness Research (CER)]]==

<li> [[SMHS_MethodsHeterogeneity|Back to the Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research section]]</li>

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php/SMHS_MethodsHeterogeneity_MetaAnalysis}}

SMHS MethodsHeterogeneity CER

2016-05-19T20:46:35Z

Imoubara: /* Case-Study 3: The Nurses’ Health Study */

==[[SMHS_MethodsHeterogeneity| Methods for Studying Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research]] - Comparative Effectiveness Research (CER) ==

===Overview===

==Observational Studies: Tips for the CER Practitioners==

• Different study types can offer different understandings; neither should be discounted without closer examination.

• RCTs provide an accurate understanding of the effect of a particular intervention in a well-defined patient group under “controlled” circumstances.

• Observational studies provide an understanding of real-world care and its impact, but can be biased due to uncontrolled factors.

• Observational studies differ in the types of databases used. These databases may lack clinical detail and contain incomplete or inaccurate data.

• Before accepting the findings from an observational study, consider whether confounding factors may have influenced the results.

• In this scenario, subgroup analysis was vital in clarifying both study designs; what is true for the many (e.g., overall, estrogen appeared to be detrimental) may not be true for the few (e.g., that for the younger post-menopausal woman, the benefits were greater and the harms less frequent).

• Carefully examine the generalizability of the study. Do the study’s patients and intervention match those under consideration?

• Observational studies can identify associations but cannot prove cause-and-effect relationships.

===Case-Study 1: The Cetuximab Study===

What was done and what was found?

Cetuximab, an anti-epidermal growth factor receptor (EGFR) agent, has recently been added to the therapeutic armamentarium. Two important CRTs examined its impact in patients with mCRC (metastatic-stage Colorectal cancer). In the first one, 56 centers in 11 European countries investigated the outcomes associated with cetuximab therapy in 329 mCRC patients who experienced disease progression either on irinotecan therapy or within 3 months thereafter. The study reported that the group on a combination of irinotecan and cetuximab had a significantly higher rate of overall response to treatment (primary endpoint) than the group on cetuximab alone: 22.9% (95% CI, 17.5-29.1%) vs. 10.8% (95% CI, 5.7-18.1%) (P=0.007), respectively. Similarly, the median time to progression was significantly longer in the combination therapy group (4.1 vs. 1.5 months, P<0.001). As these patients had already progressed on irinotecan prior to the study, any response was viewed as positive. Safety between the two treatment arms was similar: approximately 80% of patients in each arm experienced a rash. Grade 3 or 4 (the more severe) toxic effects on the skin were slightly more frequent in the combination-therapy group compared to cetuximab monotherapy, observed in 9.4% and 5.2% of participants, respectively. Other side effects, such as diarrhea and neutropenia observed in the combination-therapy arm, were considered to be in the range expected for irinotecan alone. Data from this study demonstrated the efficacy and safety of cetuximab and were instrumental in the FDA’s 2004 approval.

A second CRT (2007) examined 572 patients and suggested efficacy of cetuximab in the treatment of mCRC. This study was a randomized, non-blinded, controlled trial that examined cetuximab monotherapy plus best supportive care compared to best supportive care alone in patients who had received and failed prior chemotherapy regimens. It reported that median overall survival (the primary endpoint) was significantly higher in patients receiving cetuximab plus best supportive care compared to best supportive care alone (6.1 vs. 4.6 months, respectively) (hazard ratio for death=0.77; 95% CI: 0.64- 0.92, P=0.005). This RCT described a greater incidence of adverse events in the cetuximab plus best supportive care group compared to best supportive care alone including (most significantly) rash, as well as edema, fatigue, nausea and vomiting.

Was this the right answer?

These RCTs had fairly broad enrollment criteria and the cetuximab benefits were modest. Emerging scientific theories raised the possibility that genetically defined population subsets might experience a greater-than-average treatment benefit. One such area of inquiry entailed examining “biomarkers,” or genetic indicators of a patient’s greater response to therapy. Even as the above RCTs were being conducted, data emerged showing the importance of the KRAS gene.

Emerging Data

Based on the emerging biochemical evidence that the epidermal growth factor receptor (EGFR) treatment mechanism (Cetuximab) was even more finely detailed than previously understood, the study authors of the 2007 RCT undertook a retrospective subgroup analysis using tumor tissue samples preserved from their initial study. Following laboratory analysis, all viable tissue samples were classified as having a wild-type (non-mutated) or a mutated KRAS gene. Instead of the previous two study arms (cetuximab plus best supportive care vs. best supportive care alone), there were 4 for this new analysis: each of the two original study arms was further divided by wild-type vs. mutated KRAS status. Laboratory evaluation determined that 40.9% and 42.3% of all patients in the RCT had a KRAS mutation in the cetuximab plus best supportive care group compared to the best supportive care group alone, respectively. The efficacy of cetuximab was found to be significantly correlated with KRAS status: in patients with wild-type (non-mutated). KRAS genes, cetuximab plus best supportive care compared to best supportive care alone improved overall survival (median 9.5 vs. 4.8 months, respectively; hazard ratio for death=0.55; 95% CI, 0.41-0.74, P<0.001), and progression-free survival (median 3.7 vs. 1.9 months, respectively; hazard ratio for progression or death=0.40; 95% CI, 0.30-0.54, P<0.001). Meanwhile, in patients with mutated KRAS tumors, the authors found no significant difference in outcome between cetuximab plus best supportive care vs. best supportive care alone.

What next?

Based on these and similar results from other studies, the FDA narrowed its product labeling in July 2009 to indicate that cetuximab is not recommended for mCRC patients with mutated KRAS tumors. This distinction reduces the relevant population by approximately 40%. Similarly, the American society of Clinical oncology released a provisional clinical recommendation that all mCRC patients have their tumors tested for KRAS status before receiving anti-EGFR therapy. The benefits of targeted treatment are many. Patients who previously underwent cetuximab therapy without knowing their genetic predisposition would no longer have to be exposed to the drug’s toxic effects if unnecessary, as the efficacy of cetuximab is markedly higher in the genetically defined appropriate patients. In a less-uncertain environment, clinicians can be more confident in advocating a course of action in their care of patients. And finally, knowledge that targeted therapy is possible suggests the potential for further innovation in treatment options. In fact, research continues to demonstrate options for targeted cetuximab treatment of mCRC at an even finer scale than seen with KRAS; and similar genetic targeting is being investigated, and advocated, in other cancer types.

Lessons Learned From this case Study

Although RCTs are generally viewed as the gold standard, results of one or even a series of trials may not accurately reflect the benefits experienced by an individual patient. This case-study suggests that cetuximab initially appeared to have rather modest clinical benefits. Albeit, new information that became available and subsequent genetic subgroup assessments led to very different conclusions. Clinicians should be aware that the current knowledge is likely to evolve and any decisions about patient care should be carefully considered with that sense of uncertainty in mind. As in this case study, subgroup analyses (e.g., genetic subtypes) need a theoretical rationale. Ideally, the analyses should be determined at the time of original RCT design and should not just occur as explorations of the subsequent data. When improperly employed, post hoc analyses may lead to incorrect patient care conclusions.

RCTs Tips for the CER Practitioners

o RCTs can determine whether an intervention can provide benefit in a very controlled environment.

o The controlled nature of an RCT may limit its generalizability to a broader population.

o No results are permanent; advances in scientific knowledge and understanding can influence how we view the effectiveness (or safety) of a therapeutic intervention.

o Targeted therapy illuminated by carefully thought out subgroup analyses can improve the efficacious and safe use of an intervention.

===Case-Study 2: The Rosiglitazone Study===

Meta-analysis

Often the results for the same intervention differ across clinical trials and it may not be clear whether one therapy provides more benefit than another. As CER increases and more studies are conducted, clinicians and policymakers are more likely to encounter this scenario. In a systematic review, a researcher identifies similar studies and displays their results in a table, enabling qualitative comparisons across the studies. With a meta-analysis, the data from included studies are statistically combined into a single “result.” Merging the data from a number of studies increases the effective sample size of the investigation, providing a statistically stronger conclusion about the body of research. By so doing, investigators may detect low frequency events and demonstrate more subtle distinctions between therapeutic alternatives.

When studies have been properly identified and combined, the meta-analysis produces a summary estimate of the findings and a confidence interval that can serve as a benchmark in medical opinion and practice. However, when done incorrectly, the quantitative and statistical analysis can create impressive “numbers” but biased results. The following are important criteria for properly conducted meta-analyses:

1. Carefully defining unbiased inclusion or exclusion criteria for study selection

2. Including only those studies that have similar design elements, such as patient population, drug regimen, outcomes being assessed, and time-frame

3. Applying correct statistical methods to combine and analyze the data

Reporting this information is essential for the reader to determine whether the data were suitable to combine, and if the meta-analysis draws unbiased conclusions. Meta-analyses of randomized clinical trials are considered to be the highest level of medical evidence as they are based upon a synthesis of rigorously controlled trials that systematically reduce bias and confounding. This technique is useful in summarizing available evidence and will likely become more common in the era of publicly funded comparative effectiveness research. The following case study will examine several key principles that will be useful as the reader encounters these publications.

Clinical Application

Heart disease is the leading cause of mortality in the United States, resulting in approximately 20% of all deaths. Diabetics are particularly susceptible to heart disease, with more than 65% of deaths attributable to it. The nonfatal complications of diabetes are wide-ranging and include kidney failure, nerve damage, amputation, stroke and blindness, among other outcomes. In 2007, the total estimated cost of diabetes in the United States was $174B; $116B was derived from direct medical expenditures and the rest from the indirect cost of lost productivity due to the disease. With such serious health effects and heavy direct and indirect costs tied to diabetes, proper disease management is critical. Historically, diabetes treatment has focused on strict blood sugar control, assuming that this goal not only targets diabetes but also reduces other serious comorbidities of the disease.

Anti-diabetic agents have long been associated with key questions as to their benefits/risks in the treatment of diabetes. The sulfonylurea tolbutamide, a first generation anti-diabetic drug, was found in a landmark study in the 1970s to significantly increase the CV mortality rate compared to patients not on this agent. Further analysis by external parties concluded that the methods employed in this trial were significantly flawed (e.g., use of an “arbitrary” definition of diabetes status, heterogeneous baseline characteristics of the populations studied, and incorrect statistical methods). Since these early studies, CV concerns continue to be an issue with selected oral hypoglycemic agents that have subsequently entered the marketplace.

A class of drugs, thiazolidinedione (TZD), was approved in the late 1990s, as a solution to the problems associated with the older generation of sulfonylureas. Rosiglitazone, a member of the TZD class, was approved by the FDA in 1999 and was widely prescribed for the treatment of type-2 diabetes. A number of RCTs supported the benefit of rosiglitazone as an important new oral antidiabetic agent. However, safety concerns developed as the FDA received reports of adverse cardiac events potentially associated with rosiglitazone. It was in this setting that a meta-analysis by Nissen and Wolski was published in the New England Journal of Medicine in June 2007.

What was done?

Nissen and Wolski conducted a meta-analysis examining the impact of rosiglitazone on cardiac events and mortality compared to alternative therapeutic approaches. The study began with a broad search to locate potential studies for review. The authors screened published phase II, III, and IV trials; the FDA website; and the drug manufacturer’s clinical-trial registry for applicable data relating to rosiglitazone use. When the initial search was complete, the studies were further categorized by pre-stated inclusion criteria. Meta-analysis inclusion criteria were simple: studies had to include rosiglitazone and a randomized comparator group treated with either another drug or placebo, study arms had to show similar length of treatment, and all groups had to have received more than 24 weeks of exposure to the study drugs. The studies had to contain outcome data of interest including the rate of myocardial infarction (MI) or death from all CV causes. Out of 116 studies surveyed by the authors, 42 met their inclusion criteria and were included in the meta-analysis. Of the studies they included, 23 had durations of 26 weeks or less, and only five studies followed patients for more than a year. Until this point, the study’s authors were following a path similar to that of any reviewer interested in CV outcomes, examining the results of these 42 studies and comparing them qualitatively. Quantitatively combining the data, however, required the authors to make choices about the studies they could merge and the statistical methods they should apply for analysis. Those decisions greatly influenced the results that were reported.

What was found?

When the studies were combined, the meta-analysis contained data from 15,565 patients in the rosiglitazone group and 12,282 patients as comparators. Analyzing their data, the authors chose one particular statistical method (the Peto odds ratio method, a fixed-effect statistical approach), which calculates the odds of events occurring where the outcomes of interest are rare and small in number. In comparing rosiglitazone with a “control” group that included other drugs or placebo, the authors reported odds ratios of 1.43 (95% CI, 1.03-1.98; P=0.03) and 1.64 (95% CI,
0.98-2.74; P=0.06) for MI and death from CV causes, respectively. In other words, the odds of an MI or death from a CV cause are higher for rosiglitazone patients than for patients on other therapies or placebo. The authors reported that rosiglitazone was significantly associated with an increase in the risk of MI and had borderline significance in increasing the risk of death from all CV causes. These findings appeared online on the same day that the FDA issued a safety alert regarding rosiglitazone. Discussion of the meta-analysis was immediately featured prominently in the news media. By December 2007, prescription claims for the drug at retail pharmacies had fallen by more than 50%.

As diabetic patients and their clinicians reacted to the news, a methodologic debate also ensued. This discussion included statistical issues pertaining to the conduct of the analysis, its implications for clinical care, and finally the FDA and drug manufacturer’s roles in overseeing and regulating rosiglitazone. The concern among patients with diabetes regarding treatment, continues in the medical community today.

Was this the right answer?

Should the studies have been combined? Commentators faulted the authors for including several studies that were not originally intended to investigate diabetes, and for combining both placebo and drug therapy data into one comparator arm. Some critics noted that despite the stated inclusion criteria, some data were derived from studies where the rosiglitazone arm was allowed a longer follow-up than the comparator arm. By failing to account for this longer follow-up period, commentators felt that the authors may have overestimated the effect of rosiglitazone on CV outcomes. Many reviewers were concerned that this meta-analysis excluded trials in which no patients suffered an MI or died from CV causes – the outcomes of greatest interest. Some reviewers also noted that the exclusion of zero-event trials from the pooled dataset not only gave an incomplete picture of the impact of rosiglitazone but could have increased the odds ratio estimate. In general, the pooled dataset was criticized by many for being a faulty microcosm of the information available regarding rosiglitazone.

It is essential that a meta-analysis be based on similarity in the data sources. If studies differ in important areas such as the patient populations, interventions, or outcomes, combining their data may not be suitable. The researchers accepted studies and populations that were clinically heterogeneous, yet pooled them as if they were not. The study reported that the results were combined from a number of trials that were not initially intended to investigate CV outcomes. Furthermore, the available data did not allow for time-to-event analysis, an essential tool in comparing the impact of alternative treatment options. Reviewers considered the data to be insufficiently homogeneous, and the line of cause and effect to be murkier than the authors described.

Were the statistical methods optimal?

The statistical methods for this meta-analysis also came under significant criticism. The critiques focused on the authors’ use of the Peto method as being an incorrect choice because data were pooled from both small and very large studies, resulting in a potential overestimation of treatment effect. Others reviewers pointed that the Peto method should not have been used, as a number of the underlying studies did not have patients assigned equally to rosiglitazone and comparator groups. Finally, critics suggested that the heterogeneity of the included studies required an altogether different set of analytic techniques.

Demonstrating the sensitivity of the authors’ initial analysis to the inclusion criteria and statistical tests used, a number of researchers reworked the data from this study. one researcher used the same studies but analyzed the data with a more commonly used statistical method (Mantel-Haenszel), and found no significant increase in the relative risk or common odds ratio with MI or CV death. When the pool of studies was expanded to include those originally eliminated because they had zero CV events, the odds ratios for MI and death from CV causes dropped from 1.43 to 1.26 (95% CI, 0.93-1.72) and from 1.64 to 1.14 (95% CI, 0.74-1.74), respectively. Neither of the recalculated odd ratios were significant for MI or CV death. Finally, several newer long-term studies have been published since the Nissen meta-analysis. Incorporating their results with the meta-analysis data showed that rosiglitazone is associated with an increased risk of MI but not of CV death. Thus, the findings from these meta-analyses varied with the methods employed, the studies included, and the addition of later trials.

Emerging Data

The controversy surrounding the rosiglitazone meta-analysis authored by Nissen and Wolski forced an unplanned interim analysis of a long-term, randomized trial investigating the CV effects of rosiglitazone among patients with type 2 diabetes. The authors of the RECORD trial noted that even though the follow-up at 3.75 years was shorter than expected, rosiglitazone, when added to standard glucose-lowering therapy, was found to be associated with an increase in the risk of heart failure but was not associated with any increase in death from CV or other causes. Data at the time were found to be insufficient to determine the effect of rosiglitazone on an increase in the risk of MI. the final report of that trial, published in June 2009, confirmed the elevated risk of heart failure in people with type 2 diabetes treated with rosiglitazone in addition to glucose-lowering drugs, but continued to show inconclusive results about the effect of the drug therapy on the risk of MI. Further, the RECORD trial clarified that rosiglitazone does not result in an increased risk of CV morbidity or mortality compared to standard glucose-lowering drugs. Other trials conducted since the publishing of the meta-analysis have corroborated these results, casting further doubt on the findings of the meta-analysis published by Nissen and Wolski.

Now what?

Some sources suggest that the original Nissen meta-analysis delivered more harm than benefit, and that a well-recognized medical journal may have erred in its process of peer review. Despite this criticism, it is important to note that subsequent publications support the risk of adverse CV events associated with rosiglitazone, although rosiglitazone use does not appear to increase deaths. These results and emerging data point to the need for further rigorous research to clarify the benefits and risks of rosiglitazone on a variety of outcomes, and the importance of directing the drug to the population that will maximally benefit from its use.

Lessons Learned From this Case Study

Results from initial randomized trials that seem definitive at one time may not be conclusive, as further trials may emerge to clarify, redirect, or negate previously accepted results. A meta-analysis of those trials can lead to varying results based upon the timing of the analysis and the choices made in its performance.

Meta-Analysis: Tips for CER Practitioners

o The results of a meta-analysis are highly dependent on the studies included (and excluded). Are these criteria properly defined and relevant to the purposes of the meta-analysis? Were the combined studies sufficiently similar? Can results from this cohort be generalized to other populations of interest?

o The statistical methodology can impact study results. Have there been reviews critiquing the methods used in the meta-analysis?

o A variety of statistical tests should be considered, and perhaps reported, in the analysis of results. Do the authors mention their rationale in choosing a statistical method? Do they show the stability of their results across a spectrum of analytical methods?

o Nothing is permanent. Emerging data may change the playing field, and meta- analysis results are only as good as the data and statistics from which they are derived.

===Case-Study 3: The Nurses’ Health Study===

An observational study

An observational study is a very common type of research design in which the effects of a treatment or condition are studied without formally randomizing patients in an experimental design. Such studies can be done prospectively, wherein data are collected about a group of patients going forward in time; or retrospectively, in which the researcher looks into the past, mining existing databases for data that have already been collected. Latter studies are frequently performed by using an electronic database that contains, for example, administrative, “billing,” or claims data. Less commonly, observational research uses electronic health records, which have greater clinical information that more closely resembles the data collected in an RCT. Observational studies often take place in “real- world” environments, which allow researchers to collect data for a wide array of outcomes. Patients are not randomized in these studies, but the findings can be used to generate hypotheses for investigation in a more constrained experimental setting. Perhaps the best known observational study is the “Framingham study,” which collected demographic and health data for a group of individuals over many years (and continues to do so) and has provided an understanding of the key risk factors for heart disease and stroke.

Observational studies present many advantages to the comparative effectiveness researcher. the study design can provide a unique glimpse of the use of a health care intervention in the “real world,” an essential step in gauging the gap between efficacy (can a treatment work in a controlled setting?) and effectiveness (does the treatment work in a real-life situation?). Furthermore, observational studies can be conducted at low cost, particularly if they involve the secondary analysis of existing data sources. CER often uses administrative databases, which are based upon the billing data submitted by providers during routine care. These databases typically have limited clinical information, may have errors in them, and generally do not undergo auditing.

The uncontrolled nature of observational studies allows them to be subject to bias and confounding. For example, doctors may prescribe a new medication only for the sickest patients. Comparing these outcomes (without careful statistical adjustment) with those from less ill patients receiving alternative treatment may lead to misleading results. Observational studies can identify important associations but cannot prove cause and effect. These studies can generate hypotheses that may require RCTs for fuller demonstration of those relationships. Secondary analysis can also be problematic if researchers overwork datasets by doing multiple exploratory analyses (e.g., data-dredging): the more we look, the more we find, even if those findings are merely statistical aberrations. Unfortunately, the growing need for CER and the wide availability of administrative databases may lead to selection of research of poor quality with inaccurate findings.

In comparative effectiveness research, observational studies are typically considered to be less conclusive than RCTs and meta-analyses. Nonetheless, they can be useful, especially because they examine typical care. Due to lower cost and improvements in health information, observational studies will become increasingly common. Critical assessment of whether the described results are helpful or biased (based upon how the study was performed) are necessary. This case will illustrate several characteristics of the types of studies that will assist in evaluating newly published work.

Clinical Applications

Cardiovascular diseases (CVD) are the leading cause of death in women older than the age of 50. Epidemiologic evidence suggests that estrogen is a key mediator in the development of CVD. Estrogen is an ovarian hormone whose production decreases as women approach menopause. The steep increase in CVD in women at menopause and older and in women who have had hysterectomies further supports a relationship between estrogen and CVD. Building on this evidence of biologic plausibility, epidemiological and observational studies suggested that estrogen replacement therapy (a form of hormone replacement therapy, or HRT) had positive effects on the risk of CVD in postmenopausal women, (albeit with some negative effects in its potential to increase the risk for breast cancer and stroke). Based on these findings, in the 1980s and 1990s HRT was routinely employed to treat menopausal symptoms and serve as prophylaxis against CVD.

What was done?

The Nurses’ Health Study (NHS) began collecting data in 1976. In the study, researchers intended to examine a broad range of health effects in women over a long period of time, and a key goal was to clarify the role of HRT in heart disease. The cohort (i.e., the group being followed) included married registered nurses aged 30-55 in 1976 who lived in the 11 most populous states. To collect data, the researchers mailed the study participants a survey every 2 years that asked questions about topics such as smoking, hormone use, menopausal status, and less frequently, diet. Data were collected for key end points that included MI, coronary-artery bypass grafting or angioplasty, stroke, total CVD mortality, and deaths from all causes.

What was found?

At a 10-year follow-up point, the NHS had a study pool of 48,470 women. The researchers found that estrogen use (alone, without progestin) in postmenopausal women was associated with a reduction in the incidence of CVD as well as in CVD mortality compared to non-users. Later, estrogen-progestin combination therapy was shown to be even more cardioprotective than estrogen monotherapy, and lower doses of estrogen replacement therapy were found to deliver equal cardioprotection and lower the risk for adverse events. NHS researchers were alert to the potential for bias in observational studies. Adjustment for risk factors such as age (a typical practice to eliminate confounding) did not change the reported findings.

Was this the right answer?

The NHS was not unique in reporting the benefits associated with HRT; other observational studies corroborated the NHS findings. A secondary retrospective data analysis of the UK primary care electronic medical record database, for example, also showed the protective effect associated with HRT use. Researchers were aware of the fundamental limitations of observational studies, particularly with regard to selection bias. They and practicing clinicians were also aware of the potential negative health effects of HRT, which had to be constantly weighed against the potential cardioprotective benefits in deciding a patient’s course of treatment. As a large section of the population could experience the health effects of HRT, researchers began planning RCTs to verify the promising observational study results. It was highly anticipated that those RCTs would corroborate the belief that estrogen replacement can reduce CVD risk.

Randomized Controlled Trial: The Women’s Health Initiative

The Women’s health Initiative (WHI) was a major study established by the National Institutes of health in 1992 to assess a broad range of health effects in postmenopausal women. The trial was intended to follow these women for 8 years, at a cost of millions of dollars in federal funding. Among its many facets, it included an RCT to confirm the results from the observational studies discussed above. To fully investigate earlier findings, the WHI had two subgroups. One subgroup consisted of women with prior hysterectomies; they received estrogen monotherapy. The second group consisted of women who had not undergone hysterectomy; they received estrogen in combination with progestin. The WHI enrolled 27,347 women in their HRT investigation: 10,739 in the estrogen-alone arm and 16,608 in the estrogen plus progestin arm. Within each arm, women were randomly assigned to receive either HRT or placebo. All women in the trial were postmenopausal and aged 50-79 years; the mean age was 63.6 years (a fact that would be important in later analysis). Some participants had experienced previous CV events. The primary outcome of both subgroups was coronary heart disease (CHD), as described by nonfatal MI or death due to CHD.

The estrogen-progestin arm of the WHI was halted after a mean follow-up of 5.2 years, 3 years earlier than expected, as the HRT users in this arm were found to be at increased risk for CHD compared to those who received placebo. The study also noted elevated rates of breast cancer and stroke, among other poor outcomes. The estrogen-alone arm continued for an average follow-up of 6.8 years before being similarly discontinued ahead of schedule. Although this part of the study did not find an increased risk of CHD, it also did not find any cardioprotective effect. Beyond failing to locate any clear CV benefits, the WHI also found real evidence of harm, including increased risk of blood clots, breast cancer and stroke. Initial WHI publications therefore recommended against HRT being prescribed for the secondary prevention of CVD.

What Next?

Scientists and the clinicians who relied on their data for guidance in treating patients, were faced with conflicting data: epidemiological and observational studies suggested that HRT was cardioprotective while the higher-quality evidence from RCTs strongly suggested the opposite. Clinicians primarily followed the WHI results, so prescriptions for HRT in postmenopausal women quickly declined. Meanwhile, researchers began to analyze the studies for potential discrepancies, and found that the women being followed in the NHS and the WHI differed in several important characteristics.

First, the WHI population was older than the NHS cohort, and many had entered menopause at least 10 years before they enrolled in the RCT. Thus, the WHI enrollees experienced a long duration from the onset of menopause to the commencement of HRT. At the same time, many in the NHS population were closer to the onset of menopause and were still displaying hormonal symptoms when they began HRT. Second, although the NHS researchers adjusted the data for various confounding effects, their results could still have been subject to bias. In general, the NHS cohort was more highly educated and of a higher socioeconomic status than the WHI participants, and therefore more likely to see a physician regularly. The NHS women were also leaner and generally healthier than their RCT counterparts, and had been selected for their evident lack of pre-existing CV conditions. This selection bias in the NHS enrollment may have led to a “healthy woman” effect that in turn led to an overestimation of the benefits of therapy in the observational study. Third, researchers noted that dosing differences between the two study types may have contributed to the divergent results. The NHS reported beneficial results following low-dose estrogen therapy. The WHL, meanwhile, used a higher estrogen dose, exposing women to a larger dosage of hormones and increasing their risk for adverse events. The increased risk profile of the WHI women (e.g., older, more comorbidities, higher estrogen dose) could have contributed to the evidence of harm seen in the WHI results.

Emerging Data
In addition to identifying the inherent differences between the two study populations, researchers began a secondary analysis of the NHS and WHI trials. NHS researchers reported that women who began HRT close to the onset of menopause had a significantly reduced risk of CHD. In the subgroups of women that were older and had a similar duration after menopause compared with the WHI women, they found no significant relationship between HRT and CHD. Also, the WHI study further stratified these results by age, and found that women who began HRT close to their onset of menopause experienced some cardioprotection, while women who were further from the onset of menopause had a slightly elevated risk for CHD.

Secondary analysis of both studies was therefore necessary to show that age and a short duration from the onset of menopause are crucial to HRT success as a cardioprotective agent. Neither study type provided “truth” or rather, both studies provided “truth” if viewed carefully (e.g., both produced valid and important results). The differences seen in the studies were rooted in the timing of HRT and the populations being studied.

Lessons Learned From this case Study

Although RCTs are given a higher evidence grade, observational studies provide important clinical insights. In this example, the study populations differed. For policymakers and clinicians, it is crucial to examine whether the CER was based upon patients similar to those being considered. Any study with a dissimilar population may provide non-relevant results. Thus, readers of CER need to carefully examine the generalizability of the findings being reported.

==Appendix==

General Classification and Regression Tree (CART) data analysis steps part of the R package rpart.

===Growing the Tree===

# To grow a tree, use
rpart(formula, data=, method=,control=), where
formula is in the format outcome ~ predictor1+predictor2+...
data= specifies the data frame
method= "class" for a classification tree, use "anova" for a regression tree
control= optional parameters for controlling tree growth. For example, control=rpart.control(minsplit=30, cp=0.001) requires that the minimum number of observations in a node be 30 before attempting a split and that a split must decrease the overall lack of fit by a factor of 0.001 (cost complexity factor) before being attempted.

===Examining Results===

# These functions help with examining the results.
printcp(fit) display complexity parameter (cp) table
plotcp(fit) plot cross-validation results
rsq.rpart(fit) plot approximate R-squared and relative error for different splits (2 plots). labels are only appropriate for the "anova" method.
print(fit) print results
summary(fit) detailed results including surrogate splits
plot(fit) plot decision tree
text(fit) label the decision tree plot
post(fit, file=) create postscript plot of decision tree
# In trees created by rpart(), move to the LEFT branch when the stated condition is true.

===Pruning Trees===

#In general, trees should be pruned back to avoid overfitting the data. The tree size should minimize the cross-#validated error – xerror column printed by printcp(). Pruning the tree is accomplished by:
prune(fit, cp= )
# use printcp( ) to examine the cross-validation error results, select the complexity parameter (CP) associated with minimum error, and insert the CP it into the prune() function. This (automatically selecting the complexity parameter associated with the smallest cross-validated error) can be done succinctly by:
fit$\$$cptable[which.min(fit$\$$cptable[,"xerror"]),"CP"]

===Compete Dataset for N-of-1 Example===
[[SMHS_MethodsHeterogeneity_CER_Nof1|This N-of-1 Dataset]] includes an example.

===[[SMHS_MethodsHeterogeneity|Back to the Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research section]]===

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php/SMHS_MethodsHeterogeneity_CER}}

SMHS MethodsHeterogeneity CER

2016-05-19T19:22:44Z

Imoubara: /* Observational Studies: Tips for the CER Practitioners */

==[[SMHS_MethodsHeterogeneity| Methods for Studying Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research]] - Comparative Effectiveness Research (CER) ==

===Overview===

==Observational Studies: Tips for the CER Practitioners==

• Different study types can offer different understandings; neither should be discounted without closer examination.

• RCTs provide an accurate understanding of the effect of a particular intervention in a well-defined patient group under “controlled” circumstances.

• Observational studies provide an understanding of real-world care and its impact, but can be biased due to uncontrolled factors.

• Observational studies differ in the types of databases used. These databases may lack clinical detail and contain incomplete or inaccurate data.

• Before accepting the findings from an observational study, consider whether confounding factors may have influenced the results.

• In this scenario, subgroup analysis was vital in clarifying both study designs; what is true for the many (e.g., overall, estrogen appeared to be detrimental) may not be true for the few (e.g., that for the younger post-menopausal woman, the benefits were greater and the harms less frequent).

• Carefully examine the generalizability of the study. Do the study’s patients and intervention match those under consideration?

• Observational studies can identify associations but cannot prove cause-and-effect relationships.

===Case-Study 1: The Cetuximab Study===

What was done and what was found?

Cetuximab, an anti-epidermal growth factor receptor (EGFR) agent, has recently been added to the therapeutic armamentarium. Two important CRTs examined its impact in patients with mCRC (metastatic-stage Colorectal cancer). In the first one, 56 centers in 11 European countries investigated the outcomes associated with cetuximab therapy in 329 mCRC patients who experienced disease progression either on irinotecan therapy or within 3 months thereafter. The study reported that the group on a combination of irinotecan and cetuximab had a significantly higher rate of overall response to treatment (primary endpoint) than the group on cetuximab alone: 22.9% (95% CI, 17.5-29.1%) vs. 10.8% (95% CI, 5.7-18.1%) (P=0.007), respectively. Similarly, the median time to progression was significantly longer in the combination therapy group (4.1 vs. 1.5 months, P<0.001). As these patients had already progressed on irinotecan prior to the study, any response was viewed as positive. Safety between the two treatment arms was similar: approximately 80% of patients in each arm experienced a rash. Grade 3 or 4 (the more severe) toxic effects on the skin were slightly more frequent in the combination-therapy group compared to cetuximab monotherapy, observed in 9.4% and 5.2% of participants, respectively. Other side effects, such as diarrhea and neutropenia observed in the combination-therapy arm, were considered to be in the range expected for irinotecan alone. Data from this study demonstrated the efficacy and safety of cetuximab and were instrumental in the FDA’s 2004 approval.

A second CRT (2007) examined 572 patients and suggested efficacy of cetuximab in the treatment of mCRC. This study was a randomized, non-blinded, controlled trial that examined cetuximab monotherapy plus best supportive care compared to best supportive care alone in patients who had received and failed prior chemotherapy regimens. It reported that median overall survival (the primary endpoint) was significantly higher in patients receiving cetuximab plus best supportive care compared to best supportive care alone (6.1 vs. 4.6 months, respectively) (hazard ratio for death=0.77; 95% CI: 0.64- 0.92, P=0.005). This RCT described a greater incidence of adverse events in the cetuximab plus best supportive care group compared to best supportive care alone including (most significantly) rash, as well as edema, fatigue, nausea and vomiting.

Was this the right answer?

These RCTs had fairly broad enrollment criteria and the cetuximab benefits were modest. Emerging scientific theories raised the possibility that genetically defined population subsets might experience a greater-than-average treatment benefit. One such area of inquiry entailed examining “biomarkers,” or genetic indicators of a patient’s greater response to therapy. Even as the above RCTs were being conducted, data emerged showing the importance of the KRAS gene.

Emerging Data

Based on the emerging biochemical evidence that the epidermal growth factor receptor (EGFR) treatment mechanism (Cetuximab) was even more finely detailed than previously understood, the study authors of the 2007 RCT undertook a retrospective subgroup analysis using tumor tissue samples preserved from their initial study. Following laboratory analysis, all viable tissue samples were classified as having a wild-type (non-mutated) or a mutated KRAS gene. Instead of the previous two study arms (cetuximab plus best supportive care vs. best supportive care alone), there were 4 for this new analysis: each of the two original study arms was further divided by wild-type vs. mutated KRAS status. Laboratory evaluation determined that 40.9% and 42.3% of all patients in the RCT had a KRAS mutation in the cetuximab plus best supportive care group compared to the best supportive care group alone, respectively. The efficacy of cetuximab was found to be significantly correlated with KRAS status: in patients with wild-type (non-mutated). KRAS genes, cetuximab plus best supportive care compared to best supportive care alone improved overall survival (median 9.5 vs. 4.8 months, respectively; hazard ratio for death=0.55; 95% CI, 0.41-0.74, P<0.001), and progression-free survival (median 3.7 vs. 1.9 months, respectively; hazard ratio for progression or death=0.40; 95% CI, 0.30-0.54, P<0.001). Meanwhile, in patients with mutated KRAS tumors, the authors found no significant difference in outcome between cetuximab plus best supportive care vs. best supportive care alone.

What next?

Based on these and similar results from other studies, the FDA narrowed its product labeling in July 2009 to indicate that cetuximab is not recommended for mCRC patients with mutated KRAS tumors. This distinction reduces the relevant population by approximately 40%. Similarly, the American society of Clinical oncology released a provisional clinical recommendation that all mCRC patients have their tumors tested for KRAS status before receiving anti-EGFR therapy. The benefits of targeted treatment are many. Patients who previously underwent cetuximab therapy without knowing their genetic predisposition would no longer have to be exposed to the drug’s toxic effects if unnecessary, as the efficacy of cetuximab is markedly higher in the genetically defined appropriate patients. In a less-uncertain environment, clinicians can be more confident in advocating a course of action in their care of patients. And finally, knowledge that targeted therapy is possible suggests the potential for further innovation in treatment options. In fact, research continues to demonstrate options for targeted cetuximab treatment of mCRC at an even finer scale than seen with KRAS; and similar genetic targeting is being investigated, and advocated, in other cancer types.

Lessons Learned From this case Study

Although RCTs are generally viewed as the gold standard, results of one or even a series of trials may not accurately reflect the benefits experienced by an individual patient. This case-study suggests that cetuximab initially appeared to have rather modest clinical benefits. Albeit, new information that became available and subsequent genetic subgroup assessments led to very different conclusions. Clinicians should be aware that the current knowledge is likely to evolve and any decisions about patient care should be carefully considered with that sense of uncertainty in mind. As in this case study, subgroup analyses (e.g., genetic subtypes) need a theoretical rationale. Ideally, the analyses should be determined at the time of original RCT design and should not just occur as explorations of the subsequent data. When improperly employed, post hoc analyses may lead to incorrect patient care conclusions.

RCTs Tips for the CER Practitioners

o RCTs can determine whether an intervention can provide benefit in a very controlled environment.

o The controlled nature of an RCT may limit its generalizability to a broader population.

o No results are permanent; advances in scientific knowledge and understanding can influence how we view the effectiveness (or safety) of a therapeutic intervention.

o Targeted therapy illuminated by carefully thought out subgroup analyses can improve the efficacious and safe use of an intervention.

===Case-Study 2: The Rosiglitazone Study===

Meta-analysis

Often the results for the same intervention differ across clinical trials and it may not be clear whether one therapy provides more benefit than another. As CER increases and more studies are conducted, clinicians and policymakers are more likely to encounter this scenario. In a systematic review, a researcher identifies similar studies and displays their results in a table, enabling qualitative comparisons across the studies. With a meta-analysis, the data from included studies are statistically combined into a single “result.” Merging the data from a number of studies increases the effective sample size of the investigation, providing a statistically stronger conclusion about the body of research. By so doing, investigators may detect low frequency events and demonstrate more subtle distinctions between therapeutic alternatives.

When studies have been properly identified and combined, the meta-analysis produces a summary estimate of the findings and a confidence interval that can serve as a benchmark in medical opinion and practice. However, when done incorrectly, the quantitative and statistical analysis can create impressive “numbers” but biased results. The following are important criteria for properly conducted meta-analyses:

1. Carefully defining unbiased inclusion or exclusion criteria for study selection

2. Including only those studies that have similar design elements, such as patient population, drug regimen, outcomes being assessed, and time-frame

3. Applying correct statistical methods to combine and analyze the data

Reporting this information is essential for the reader to determine whether the data were suitable to combine, and if the meta-analysis draws unbiased conclusions. Meta-analyses of randomized clinical trials are considered to be the highest level of medical evidence as they are based upon a synthesis of rigorously controlled trials that systematically reduce bias and confounding. This technique is useful in summarizing available evidence and will likely become more common in the era of publicly funded comparative effectiveness research. The following case study will examine several key principles that will be useful as the reader encounters these publications.

Clinical Application

Heart disease is the leading cause of mortality in the United States, resulting in approximately 20% of all deaths. Diabetics are particularly susceptible to heart disease, with more than 65% of deaths attributable to it. The nonfatal complications of diabetes are wide-ranging and include kidney failure, nerve damage, amputation, stroke and blindness, among other outcomes. In 2007, the total estimated cost of diabetes in the United States was $174B; $116B was derived from direct medical expenditures and the rest from the indirect cost of lost productivity due to the disease. With such serious health effects and heavy direct and indirect costs tied to diabetes, proper disease management is critical. Historically, diabetes treatment has focused on strict blood sugar control, assuming that this goal not only targets diabetes but also reduces other serious comorbidities of the disease.

Anti-diabetic agents have long been associated with key questions as to their benefits/risks in the treatment of diabetes. The sulfonylurea tolbutamide, a first generation anti-diabetic drug, was found in a landmark study in the 1970s to significantly increase the CV mortality rate compared to patients not on this agent. Further analysis by external parties concluded that the methods employed in this trial were significantly flawed (e.g., use of an “arbitrary” definition of diabetes status, heterogeneous baseline characteristics of the populations studied, and incorrect statistical methods). Since these early studies, CV concerns continue to be an issue with selected oral hypoglycemic agents that have subsequently entered the marketplace.

A class of drugs, thiazolidinedione (TZD), was approved in the late 1990s, as a solution to the problems associated with the older generation of sulfonylureas. Rosiglitazone, a member of the TZD class, was approved by the FDA in 1999 and was widely prescribed for the treatment of type-2 diabetes. A number of RCTs supported the benefit of rosiglitazone as an important new oral antidiabetic agent. However, safety concerns developed as the FDA received reports of adverse cardiac events potentially associated with rosiglitazone. It was in this setting that a meta-analysis by Nissen and Wolski was published in the New England Journal of Medicine in June 2007.

What was done?

Nissen and Wolski conducted a meta-analysis examining the impact of rosiglitazone on cardiac events and mortality compared to alternative therapeutic approaches. The study began with a broad search to locate potential studies for review. The authors screened published phase II, III, and IV trials; the FDA website; and the drug manufacturer’s clinical-trial registry for applicable data relating to rosiglitazone use. When the initial search was complete, the studies were further categorized by pre-stated inclusion criteria. Meta-analysis inclusion criteria were simple: studies had to include rosiglitazone and a randomized comparator group treated with either another drug or placebo, study arms had to show similar length of treatment, and all groups had to have received more than 24 weeks of exposure to the study drugs. The studies had to contain outcome data of interest including the rate of myocardial infarction (MI) or death from all CV causes. Out of 116 studies surveyed by the authors, 42 met their inclusion criteria and were included in the meta-analysis. Of the studies they included, 23 had durations of 26 weeks or less, and only five studies followed patients for more than a year. Until this point, the study’s authors were following a path similar to that of any reviewer interested in CV outcomes, examining the results of these 42 studies and comparing them qualitatively. Quantitatively combining the data, however, required the authors to make choices about the studies they could merge and the statistical methods they should apply for analysis. Those decisions greatly influenced the results that were reported.

What was found?

When the studies were combined, the meta-analysis contained data from 15,565 patients in the rosiglitazone group and 12,282 patients as comparators. Analyzing their data, the authors chose one particular statistical method (the Peto odds ratio method, a fixed-effect statistical approach), which calculates the odds of events occurring where the outcomes of interest are rare and small in number. In comparing rosiglitazone with a “control” group that included other drugs or placebo, the authors reported odds ratios of 1.43 (95% CI, 1.03-1.98; P=0.03) and 1.64 (95% CI,
0.98-2.74; P=0.06) for MI and death from CV causes, respectively. In other words, the odds of an MI or death from a CV cause are higher for rosiglitazone patients than for patients on other therapies or placebo. The authors reported that rosiglitazone was significantly associated with an increase in the risk of MI and had borderline significance in increasing the risk of death from all CV causes. These findings appeared online on the same day that the FDA issued a safety alert regarding rosiglitazone. Discussion of the meta-analysis was immediately featured prominently in the news media. By December 2007, prescription claims for the drug at retail pharmacies had fallen by more than 50%.

As diabetic patients and their clinicians reacted to the news, a methodologic debate also ensued. This discussion included statistical issues pertaining to the conduct of the analysis, its implications for clinical care, and finally the FDA and drug manufacturer’s roles in overseeing and regulating rosiglitazone. The concern among patients with diabetes regarding treatment, continues in the medical community today.

Was this the right answer?

Should the studies have been combined? Commentators faulted the authors for including several studies that were not originally intended to investigate diabetes, and for combining both placebo and drug therapy data into one comparator arm. Some critics noted that despite the stated inclusion criteria, some data were derived from studies where the rosiglitazone arm was allowed a longer follow-up than the comparator arm. By failing to account for this longer follow-up period, commentators felt that the authors may have overestimated the effect of rosiglitazone on CV outcomes. Many reviewers were concerned that this meta-analysis excluded trials in which no patients suffered an MI or died from CV causes – the outcomes of greatest interest. Some reviewers also noted that the exclusion of zero-event trials from the pooled dataset not only gave an incomplete picture of the impact of rosiglitazone but could have increased the odds ratio estimate. In general, the pooled dataset was criticized by many for being a faulty microcosm of the information available regarding rosiglitazone.

It is essential that a meta-analysis be based on similarity in the data sources. If studies differ in important areas such as the patient populations, interventions, or outcomes, combining their data may not be suitable. The researchers accepted studies and populations that were clinically heterogeneous, yet pooled them as if they were not. The study reported that the results were combined from a number of trials that were not initially intended to investigate CV outcomes. Furthermore, the available data did not allow for time-to-event analysis, an essential tool in comparing the impact of alternative treatment options. Reviewers considered the data to be insufficiently homogeneous, and the line of cause and effect to be murkier than the authors described.

Were the statistical methods optimal?

The statistical methods for this meta-analysis also came under significant criticism. The critiques focused on the authors’ use of the Peto method as being an incorrect choice because data were pooled from both small and very large studies, resulting in a potential overestimation of treatment effect. Others reviewers pointed that the Peto method should not have been used, as a number of the underlying studies did not have patients assigned equally to rosiglitazone and comparator groups. Finally, critics suggested that the heterogeneity of the included studies required an altogether different set of analytic techniques.

Demonstrating the sensitivity of the authors’ initial analysis to the inclusion criteria and statistical tests used, a number of researchers reworked the data from this study. one researcher used the same studies but analyzed the data with a more commonly used statistical method (Mantel-Haenszel), and found no significant increase in the relative risk or common odds ratio with MI or CV death. When the pool of studies was expanded to include those originally eliminated because they had zero CV events, the odds ratios for MI and death from CV causes dropped from 1.43 to 1.26 (95% CI, 0.93-1.72) and from 1.64 to 1.14 (95% CI, 0.74-1.74), respectively. Neither of the recalculated odd ratios were significant for MI or CV death. Finally, several newer long-term studies have been published since the Nissen meta-analysis. Incorporating their results with the meta-analysis data showed that rosiglitazone is associated with an increased risk of MI but not of CV death. Thus, the findings from these meta-analyses varied with the methods employed, the studies included, and the addition of later trials.

Emerging Data

The controversy surrounding the rosiglitazone meta-analysis authored by Nissen and Wolski forced an unplanned interim analysis of a long-term, randomized trial investigating the CV effects of rosiglitazone among patients with type 2 diabetes. The authors of the RECORD trial noted that even though the follow-up at 3.75 years was shorter than expected, rosiglitazone, when added to standard glucose-lowering therapy, was found to be associated with an increase in the risk of heart failure but was not associated with any increase in death from CV or other causes. Data at the time were found to be insufficient to determine the effect of rosiglitazone on an increase in the risk of MI. the final report of that trial, published in June 2009, confirmed the elevated risk of heart failure in people with type 2 diabetes treated with rosiglitazone in addition to glucose-lowering drugs, but continued to show inconclusive results about the effect of the drug therapy on the risk of MI. Further, the RECORD trial clarified that rosiglitazone does not result in an increased risk of CV morbidity or mortality compared to standard glucose-lowering drugs. Other trials conducted since the publishing of the meta-analysis have corroborated these results, casting further doubt on the findings of the meta-analysis published by Nissen and Wolski.

Now what?

Some sources suggest that the original Nissen meta-analysis delivered more harm than benefit, and that a well-recognized medical journal may have erred in its process of peer review. Despite this criticism, it is important to note that subsequent publications support the risk of adverse CV events associated with rosiglitazone, although rosiglitazone use does not appear to increase deaths. These results and emerging data point to the need for further rigorous research to clarify the benefits and risks of rosiglitazone on a variety of outcomes, and the importance of directing the drug to the population that will maximally benefit from its use.

Lessons Learned From this Case Study

Results from initial randomized trials that seem definitive at one time may not be conclusive, as further trials may emerge to clarify, redirect, or negate previously accepted results. A meta-analysis of those trials can lead to varying results based upon the timing of the analysis and the choices made in its performance.

Meta-Analysis: Tips for CER Practitioners

o The results of a meta-analysis are highly dependent on the studies included (and excluded). Are these criteria properly defined and relevant to the purposes of the meta-analysis? Were the combined studies sufficiently similar? Can results from this cohort be generalized to other populations of interest?

o The statistical methodology can impact study results. Have there been reviews critiquing the methods used in the meta-analysis?

o A variety of statistical tests should be considered, and perhaps reported, in the analysis of results. Do the authors mention their rationale in choosing a statistical method? Do they show the stability of their results across a spectrum of analytical methods?

o Nothing is permanent. Emerging data may change the playing field, and meta- analysis results are only as good as the data and statistics from which they are derived.

===Case-Study 3: The Nurses’ Health Study===

An observational study

An observational study is a very common type of research design in which the effects of a treatment or condition are studied without formally randomizing patients in an experimental design. Such studies can be done prospectively, wherein data are collected about a group of patients going forward in time; or retrospectively, in which the researcher looks into the past, mining existing databases for data that have already been collected. Latter studies are frequently performed by using an electronic database that contains, for example, administrative, “billing,” or claims data. Less commonly, observational research uses electronic health records, which have greater clinical information that more closely resembles the data collected in an RCT. Observational studies often take place in “real- world” environments, which allow researchers to collect data for a wide array of outcomes. Patients are not randomized in these studies, but the findings can be used to generate hypotheses for investigation in a more constrained experimental setting. Perhaps the best known observational study is the “Framingham study,” which collected demographic and health data for a group of individuals over many years (and continues to do so) and has provided an understanding of the key risk factors for heart disease and stroke.

Observational studies present many advantages to the comparative effectiveness researcher. the study design can provide a unique glimpse of the use of a health care intervention in the “real world,” an essential step in gauging the gap between efficacy (can a treatment work in a controlled setting?) and effectiveness (does the treatment work in a real-life situation?). Furthermore, observational studies can be conducted at low cost, particularly if they involve the secondary analysis of existing data sources. CER often uses administrative databases, which are based upon the billing data submitted by providers during routine care. These databases typically have limited clinical information, may have errors in them, and generally do not undergo auditing.

The uncontrolled nature of observational studies allows them to be subject to bias and confounding. For example, doctors may prescribe a new medication only for the sickest patients. Comparing these outcomes (without careful statistical adjustment) with those from less ill patients receiving alternative treatment may lead to misleading results. Observational studies can identify important associations but cannot prove cause and effect. These studies can generate hypotheses that may require RCTs for fuller demonstration of those relationships. Secondary analysis can also be problematic if researchers overwork datasets by doing multiple exploratory analyses (e.g., data-dredging): the more we look, the more we find, even if those findings are merely statistical aberrations. Unfortunately, the growing need for CER and the wide availability of administrative databases may lead to selection of research of poor quality with inaccurate findings.

In comparative effectiveness research, observational studies are typically considered to be less conclusive than RCTs and meta-analyses. Nonetheless, they can be useful, especially because they examine typical care. Due to lower cost and improvements in health information, observational studies will become increasingly common. Critical assessment of whether the described results are helpful or biased (based upon how the study was performed) are necessary. This case will illustrate several characteristics of the types of studies that will assist in evaluating newly published work.

Clinical Applications

Cardiovascular diseases (CVD) are the leading cause of death in women older than the age of 50. Epidemiologic evidence suggests that estrogen is a key mediator in the development of CVD. Estrogen is an ovarian hormone whose production decreases as women approach menopause. The steep increase in CVD in women at menopause and older and in women who have had hysterectomies further supports a relationship between estrogen and CVD. Building on this evidence of biologic plausibility, epidemiological and observational studies suggested that estrogen replacement therapy (a form of hormone replacement therapy, or HRT) had positive effects on the risk of CVD in postmenopausal women, (albeit with some negative effects in its potential to increase the risk for breast cancer and stroke).65 Based on these findings, in the 1980s and 1990s HRT was routinely employed to treat menopausal symptoms and serve as prophylaxis against CVD.

What was done?

The Nurses’ Health Study (NHS) began collecting data in 1976. In the study, researchers intended to examine a broad range of health effects in women over a long period of time, and a key goal was to clarify the role of HRT in heart disease. The cohort (i.e., the group being followed) included married registered nurses aged 30-55 in 1976 who lived in the 11 most populous states. To collect data, the researchers mailed the study participants a survey every 2 years that asked questions about topics such as smoking, hormone use, menopausal status, and less frequently, diet. Data were collected for key end points that included MI, coronary-artery bypass grafting or angioplasty, stroke, total CVD mortality, and deaths from all causes.

What was found?

At a 10-year follow-up point, the NHS had a study pool of 48,470 women. The researchers found that estrogen use (alone, without progestin) in postmenopausal women was associated with a reduction in the incidence of CVD as well as in CVD mortality compared to non-users. Later, estrogen-progestin combination therapy was shown to be even more cardioprotective than estrogen monotherapy, and lower doses of estrogen replacement therapy were found to deliver equal cardioprotection and lower the risk for adverse events. NHS researchers were alert to the potential for bias in observational studies. Adjustment for risk factors such as age (a typical practice to eliminate confounding) did not change the reported findings.

Was this the right answer?

The NHS was not unique in reporting the benefits associated with HRT; other observational studies corroborated the NHS findings. A secondary retrospective data analysis of the UK primary care electronic medical record database, for example, also showed the protective effect associated with HRT use. Researchers were aware of the fundamental limitations of observational studies, particularly with regard to selection bias. They and practicing clinicians were also aware of the potential negative health effects of HRT, which had to be constantly weighed against the potential cardioprotective benefits in deciding a patient’s course of treatment. As a large section of the population could experience the health effects of HRT, researchers began planning RCTs to verify the promising observational study results. It was highly anticipated that those RCTs would corroborate the belief that estrogen replacement can reduce CVD risk.

Randomized Controlled Trial: The Women’s Health Initiative

The Women’s health Initiative (WHI) was a major study established by the National Institutes of health in 1992 to assess a broad range of health effects in postmenopausal women. The trial was intended to follow these women for 8 years, at a cost of millions of dollars in federal funding. Among its many facets, it included an RCT to confirm the results from the observational studies discussed above. To fully investigate earlier findings, the WHI had two subgroups. One subgroup consisted of women with prior hysterectomies; they received estrogen monotherapy. The second group consisted of women who had not undergone hysterectomy; they received estrogen in combination with progestin. The WHI enrolled 27,347 women in their HRT investigation: 10,739 in the estrogen-alone arm and 16,608 in the estrogen plus progestin arm. Within each arm, women were randomly assigned to receive either HRT or placebo. All women in the trial were postmenopausal and aged 50-79 years; the mean age was 63.6 years (a fact that would be important in later analysis). Some participants had experienced previous CV events. The primary outcome of both subgroups was coronary heart disease (CHD), as described by nonfatal MI or death due to CHD.

The estrogen-progestin arm of the WHI was halted after a mean follow-up of 5.2 years, 3 years earlier than expected, as the HRT users in this arm were found to be at increased risk for CHD compared to those who received placebo. The study also noted elevated rates of breast cancer and stroke, among other poor outcomes. The estrogen-alone arm continued for an average follow-up of 6.8 years before being similarly discontinued ahead of schedule. Although this part of the study did not find an increased risk of CHD, it also did not find any cardioprotective effect. Beyond failing to locate any clear CV benefits, the WHI also found real evidence of harm, including increased risk of blood clots, breast cancer and stroke. Initial WHI publications therefore recommended against HRT being prescribed for the secondary prevention of CVD.

What Next?

Scientists and the clinicians who relied on their data for guidance in treating patients, were faced with conflicting data: epidemiological and observational studies suggested that HRT was cardioprotective while the higher-quality evidence from RCTs strongly suggested the opposite. Clinicians primarily followed the WHI results, so prescriptions for HRT in postmenopausal women quickly declined. Meanwhile, researchers began to analyze the studies for potential discrepancies, and found that the women being followed in the NHS and the WHI differed in several important characteristics.

First, the WHI population was older than the NHS cohort, and many had entered menopause at least 10 years before they enrolled in the RCT. Thus, the WHI enrollees experienced a long duration from the onset of menopause to the commencement of HRT. At the same time, many in the NHS population were closer to the onset of menopause and were still displaying hormonal symptoms when they began HRT. Second, although the NHS researchers adjusted the data for various confounding effects, their results could still have been subject to bias. In general, the NHS cohort was more highly educated and of a higher socioeconomic status than the WHI participants, and therefore more likely to see a physician regularly. The NHS women were also leaner and generally healthier than their RCT counterparts, and had been selected for their evident lack of pre-existing CV conditions. This selection bias in the NHS enrollment may have led to a “healthy woman” effect that in turn led to an overestimation of the benefits of therapy in the observational study. Third, researchers noted that dosing differences between the two study types may have contributed to the divergent results. The NHS reported beneficial results following low-dose estrogen therapy. The WHL, meanwhile, used a higher estrogen dose, exposing women to a larger dosage of hormones and increasing their risk for adverse events. The increased risk profile of the WHI women (e.g., older, more comorbidities, higher estrogen dose) could have contributed to the evidence of harm seen in the WHI results.

Emerging Data
In addition to identifying the inherent differences between the two study populations, researchers began a secondary analysis of the NHS and WHI trials. NHS researchers reported that women who began HRT close to the onset of menopause had a significantly reduced risk of CHD. In the subgroups of women that were older and had a similar duration after menopause compared with the WHI women, they found no significant relationship between HRT and CHD. Also, the WHI study further stratified these results by age, and found that women who began HRT close to their onset of menopause experienced some cardioprotection, while women who were further from the onset of menopause had a slightly elevated risk for CHD.

Secondary analysis of both studies was therefore necessary to show that age and a short duration from the onset of menopause are crucial to HRT success as a cardioprotective agent. Neither study type provided “truth” or rather, both studies provided “truth” if viewed carefully (e.g., both produced valid and important results). The differences seen in the studies were rooted in the timing of HRT and the populations being studied.

Lessons Learned From this case Study

Although RCTs are given a higher evidence grade, observational studies provide important clinical insights. In this example, the study populations differed. For policymakers and clinicians, it is crucial to examine whether the CER was based upon patients similar to those being considered. Any study with a dissimilar population may provide non-relevant results. Thus, readers of CER need to carefully examine the generalizability of the findings being reported.

==Appendix==

General Classification and Regression Tree (CART) data analysis steps part of the R package rpart.

===Growing the Tree===

# To grow a tree, use
rpart(formula, data=, method=,control=), where
formula is in the format outcome ~ predictor1+predictor2+...
data= specifies the data frame
method= "class" for a classification tree, use "anova" for a regression tree
control= optional parameters for controlling tree growth. For example, control=rpart.control(minsplit=30, cp=0.001) requires that the minimum number of observations in a node be 30 before attempting a split and that a split must decrease the overall lack of fit by a factor of 0.001 (cost complexity factor) before being attempted.

===Examining Results===

# These functions help with examining the results.
printcp(fit) display complexity parameter (cp) table
plotcp(fit) plot cross-validation results
rsq.rpart(fit) plot approximate R-squared and relative error for different splits (2 plots). labels are only appropriate for the "anova" method.
print(fit) print results
summary(fit) detailed results including surrogate splits
plot(fit) plot decision tree
text(fit) label the decision tree plot
post(fit, file=) create postscript plot of decision tree
# In trees created by rpart(), move to the LEFT branch when the stated condition is true.

===Pruning Trees===

#In general, trees should be pruned back to avoid overfitting the data. The tree size should minimize the cross-#validated error – xerror column printed by printcp(). Pruning the tree is accomplished by:
prune(fit, cp= )
# use printcp( ) to examine the cross-validation error results, select the complexity parameter (CP) associated with minimum error, and insert the CP it into the prune() function. This (automatically selecting the complexity parameter associated with the smallest cross-validated error) can be done succinctly by:
fit$\$$cptable[which.min(fit$\$$cptable[,"xerror"]),"CP"]

===Compete Dataset for N-of-1 Example===
[[SMHS_MethodsHeterogeneity_CER_Nof1|This N-of-1 Dataset]] includes an example.

===[[SMHS_MethodsHeterogeneity|Back to the Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research section]]===

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php/SMHS_MethodsHeterogeneity_CER}}

SMHS MethodsHeterogeneity CER

2016-05-19T19:00:40Z

Imoubara: /* Case-Study 1: The Cetuximab Study */

==[[SMHS_MethodsHeterogeneity| Methods for Studying Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research]] - Comparative Effectiveness Research (CER) ==

===Overview===

==Observational Studies: Tips for the CER Practitioners==

• Different study types can offer different understandings; neither should be discounted without closer examination.

• RCTs provide an accurate understanding of the effect of a particular intervention in a well-defined patient group under “controlled” circumstances.

• Observational studies provide an understanding of real-world care and its impact, but can be biased due to uncontrolled factors.

• Observational studies differ in the types of databases used. These databases may lack clinical detail and contain incomplete or inaccurate data.

• Before accepting the findings from an observational study, consider whether confounding factors may have influenced the results.

• In this scenario, subgroup analysis was vital in clarifying both study designs; what is true for the many (e.g., overall, estrogen appeared to be detrimental) may not be true for the few (e.g., that for the younger post-menopausal woman, the benefits were greater and the harms less frequent).

• Carefully examine the generalizability of the study. Do the study’s patients and intervention match those under consideration?

• Observational studies can identify associations but cannot prove cause-and-effect relationships.

===Case-Study 1: The Cetuximab Study===

What was done and what was found?

Cetuximab, an anti-epidermal growth factor receptor (EGFR) agent, has recently been added to the therapeutic armamentarium. Two important CRTs examined its impact in patients with mCRC (metastatic-stage Colorectal cancer). In the first one, 56 centers in 11 European countries investigated the outcomes associated with cetuximab therapy in 329 mCRC patients who experienced disease progression either on irinotecan therapy or within 3 months thereafter. The study reported that the group on a combination of irinotecan and cetuximab had a significantly higher rate of overall response to treatment (primary endpoint) than the group on cetuximab alone: 22.9% (95% CI, 17.5-29.1%) vs. 10.8% (95% CI, 5.7-18.1%) (P=0.007), respectively. Similarly, the median time to progression was significantly longer in the combination therapy group (4.1 vs. 1.5 months, P<0.001). As these patients had already progressed on irinotecan prior to the study, any response was viewed as positive. Safety between the two treatment arms was similar: approximately 80% of patients in each arm experienced a rash. Grade 3 or 4 (the more severe) toxic effects on the skin were slightly more frequent in the combination-therapy group compared to cetuximab monotherapy, observed in 9.4% and 5.2% of participants, respectively. Other side effects, such as diarrhea and neutropenia observed in the combination-therapy arm, were considered to be in the range expected for irinotecan alone. Data from this study demonstrated the efficacy and safety of cetuximab and were instrumental in the FDA’s 2004 approval.

A second CRT (2007) examined 572 patients and suggested efficacy of cetuximab in the treatment of mCRC. This study was a randomized, non-blinded, controlled trial that examined cetuximab monotherapy plus best supportive care compared to best supportive care alone in patients who had received and failed prior chemotherapy regimens. It reported that median overall survival (the primary endpoint) was significantly higher in patients receiving cetuximab plus best supportive care compared to best supportive care alone (6.1 vs. 4.6 months, respectively) (hazard ratio for death=0.77; 95% CI: 0.64- 0.92, P=0.005). This RCT described a greater incidence of adverse events in the cetuximab plus best supportive care group compared to best supportive care alone including (most significantly) rash, as well as edema, fatigue, nausea and vomiting.

Was this the right answer?

These RCTs had fairly broad enrollment criteria and the cetuximab benefits were modest. Emerging scientific theories raised the possibility that genetically defined population subsets might experience a greater-than-average treatment benefit. One such area of inquiry entailed examining “biomarkers,” or genetic indicators of a patient’s greater response to therapy. Even as the above RCTs were being conducted, data emerged showing the importance of the KRAS gene.

Emerging Data

Based on the emerging biochemical evidence that the epidermal growth factor receptor (EGFR) treatment mechanism (Cetuximab,) was even more finely detailed than previously understood, the study authors of the 2007 RCT undertook a retrospective subgroup analysis using tumor tissue samples preserved from their initial study. Following laboratory analysis, all viable tissue samples were classified as having a wild-type (non-mutated) or a mutated KRAS gene. Instead of the previous two study arms (cetuximab plus best supportive care vs. best supportive care alone), there were 4 for this new analysis: each of the two original study arms was further divided by wild-type vs. mutated KRAS status. Laboratory evaluation determined that 40.9% and 42.3% of all patients in the RCT had a KRAS mutation in the cetuximab plus best supportive care group compared to the best supportive care group alone, respectively. The efficacy of cetuximab was found to be significantly correlated with KRAS status: in patients with wild-type (non-mutated). KRAS genes, cetuximab plus best supportive care compared to best supportive care alone improved overall survival (median 9.5 vs. 4.8 months, respectively; hazard ratio for death=0.55; 95% CI, 0.41-0.74, P<0.001), and progression-free survival (median 3.7 vs. 1.9 months, respectively; hazard ratio for progression or death=0.40; 95% CI, 0.30-0.54, P<0.001). Meanwhile, in patients with mutated KRAS tumors, the authors found no significant difference in outcome between cetuximab plus best supportive care vs. best supportive care alone.

What next?

Based on these and similar results from other studies, the FDA narrowed its product labeling in July 2009 to indicate that cetuximab is not recommended for mCRC patients with mutated KRAS tumors. This distinction reduces the relevant population by approximately 40%. Similarly, the American society of Clinical oncology released a provisional clinical recommendation that all mCRC patients have their tumors tested for KRAS status before receiving anti-EGFR therapy. The benefits of targeted treatment are many. Patients who previously underwent cetuximab therapy without knowing their genetic predisposition would no longer have to be exposed to the drug’s toxic effects if unnecessary, as the efficacy of cetuximab is markedly higher in the genetically defined appropriate patients. In a less-uncertain environment, clinicians can be more confident in advocating a course of action in their care of patients. And finally, knowledge that targeted therapy is possible suggests the potential for further innovation in treatment options. In fact, research continues to demonstrate options for targeted cetuximab treatment of mCRC at an even finer scale than seen with KRAS; and similar genetic targeting is being investigated, and advocated, in other cancer types.

Lessons Learned From this case Study

Although RCTs are generally viewed as the gold standard, results of one or even a series of trials may not accurately reflect the benefits experienced by an individual patient. This case-study suggests that cetuximab initially appeared to have rather modest clinical benefits. Albeit, new information that became available and subsequent genetic subgroup assessments led to very different conclusions. Clinicians should be aware that the current knowledge is likely to evolve and any decisions about patient care should be carefully considered with that sense of uncertainty in mind. As in this case study, subgroup analyses (e.g., genetic subtypes) need a theoretical rationale. Ideally, the analyses should be determined at the time of original RCT design and should not just occur as explorations of the subsequent data. When improperly employed, post hoc analyses may lead to incorrect patient care conclusions.

RCTs Tips for the CER Practitioners

o RCTs can determine whether an intervention can provide benefit in a very controlled environment.

o The controlled nature of an RCT may limit its generalizability to a broader population.

o No results are permanent; advances in scientific knowledge and understanding can influence how we view the effectiveness (or safety) of a therapeutic intervention.

o Targeted therapy illuminated by carefully thought out subgroup analyses can improve the efficacious and safe use of an intervention.

===Case-Study 2: The Rosiglitazone Study===

Meta-analysis

Often the results for the same intervention differ across clinical trials and it may not be clear whether one therapy provides more benefit than another. As CER increases and more studies are conducted, clinicians and policymakers are more likely to encounter this scenario. In a systematic review, a researcher identifies similar studies and displays their results in a table, enabling qualitative comparisons across the studies. With a meta-analysis, the data from included studies are statistically combined into a single “result.” Merging the data from a number of studies increases the effective sample size of the investigation, providing a statistically stronger conclusion about the body of research. By so doing, investigators may detect low frequency events and demonstrate more subtle distinctions between therapeutic alternatives.

When studies have been properly identified and combined, the meta-analysis produces a summary estimate of the findings and a confidence interval that can serve as a benchmark in medical opinion and practice. However, when done incorrectly, the quantitative and statistical analysis can create impressive “numbers” but biased results. The following are important criteria for properly conducted meta-analyses:

1. Carefully defining unbiased inclusion or exclusion criteria for study selection

2. Including only those studies that have similar design elements, such as patient population, drug regimen, outcomes being assessed, and time-frame

3. Applying correct statistical methods to combine and analyze the data

Reporting this information is essential for the reader to determine whether the data were suitable to combine, and if the meta-analysis draws unbiased conclusions. Meta-analyses of randomized clinical trials are considered to be the highest level of medical evidence as they are based upon a synthesis of rigorously controlled trials that systematically reduce bias and confounding. This technique is useful in summarizing available evidence and will likely become more common in the era of publicly funded comparative effectiveness research. The following case study will examine several key principles that will be useful as the reader encounters these publications.

Clinical Application

Heart disease is the leading cause of mortality in the United States, resulting in approximately 20% of all deaths. Diabetics are particularly susceptible to heart disease, with more than 65% of deaths attributable to it. The nonfatal complications of diabetes are wide-ranging and include kidney failure, nerve damage, amputation, stroke and blindness, among other outcomes. In 2007, the total estimated cost of diabetes in the United States was $174B; $116B was derived from direct medical expenditures and the rest from the indirect cost of lost productivity due to the disease. With such serious health effects and heavy direct and indirect costs tied to diabetes, proper disease management is critical. Historically, diabetes treatment has focused on strict blood sugar control, assuming that this goal not only targets diabetes but also reduces other serious comorbidities of the disease.

Anti-diabetic agents have long been associated with key questions as to their benefits/risks in the treatment of diabetes. The sulfonylurea tolbutamide, a first generation anti-diabetic drug, was found in a landmark study in the 1970s to significantly increase the CV mortality rate compared to patients not on this agent. Further analysis by external parties concluded that the methods employed in this trial were significantly flawed (e.g., use of an “arbitrary” definition of diabetes status, heterogeneous baseline characteristics of the populations studied, and incorrect statistical methods). Since these early studies, CV concerns continue to be an issue with selected oral hypoglycemic agents that have subsequently entered the marketplace.

A class of drugs, thiazolidinedione (TZD), was approved in the late 1990s, as a solution to the problems associated with the older generation of sulfonylureas. Rosiglitazone, a member of the TZD class, was approved by the FDA in 1999 and was widely prescribed for the treatment of type-2 diabetes. A number of RCTs supported the benefit of rosiglitazone as an important new oral antidiabetic agent. However, safety concerns developed as the FDA received reports of adverse cardiac events potentially associated with rosiglitazone. It was in this setting that a meta-analysis by Nissen and Wolski was published in the New England Journal of Medicine in June 2007.

What was done?

Nissen and Wolski conducted a meta-analysis examining the impact of rosiglitazone on cardiac events and mortality compared to alternative therapeutic approaches. The study began with a broad search to locate potential studies for review. The authors screened published phase II, III, and IV trials; the FDA website; and the drug manufacturer’s clinical-trial registry for applicable data relating to rosiglitazone use. When the initial search was complete, the studies were further categorized by pre-stated inclusion criteria. Meta-analysis inclusion criteria were simple: studies had to include rosiglitazone and a randomized comparator group treated with either another drug or placebo, study arms had to show similar length of treatment, and all groups had to have received more than 24 weeks of exposure to the study drugs. The studies had to contain outcome data of interest including the rate of myocardial infarction (MI) or death from all CV causes. Out of 116 studies surveyed by the authors, 42 met their inclusion criteria and were included in the meta-analysis. Of the studies they included, 23 had durations of 26 weeks or less, and only five studies followed patients for more than a year. Until this point, the study’s authors were following a path similar to that of any reviewer interested in CV outcomes, examining the results of these 42 studies and comparing them qualitatively. Quantitatively combining the data, however, required the authors to make choices about the studies they could merge and the statistical methods they should apply for analysis. Those decisions greatly influenced the results that were reported.

What was found?

When the studies were combined, the meta-analysis contained data from 15,565 patients in the rosiglitazone group and 12,282 patients as comparators. Analyzing their data, the authors chose one particular statistical method (the Peto odds ratio method, a fixed-effect statistical approach), which calculates the odds of events occurring where the outcomes of interest are rare and small in number. In comparing rosiglitazone with a “control” group that included other drugs or placebo, the authors reported odds ratios of 1.43 (95% CI, 1.03-1.98; P=0.03) and 1.64 (95% CI,
0.98-2.74; P=0.06) for MI and death from CV causes, respectively. In other words, the odds of an MI or death from a CV cause are higher for rosiglitazone patients than for patients on other therapies or placebo. The authors reported that rosiglitazone was significantly associated with an increase in the risk of MI and had borderline significance in increasing the risk of death from all CV causes. These findings appeared online on the same day that the FDA issued a safety alert regarding rosiglitazone. Discussion of the meta-analysis was immediately featured prominently in the news media. By December 2007, prescription claims for the drug at retail pharmacies had fallen by more than 50%.

As diabetic patients and their clinicians reacted to the news, a methodologic debate also ensued. This discussion included statistical issues pertaining to the conduct of the analysis, its implications for clinical care, and finally the FDA and drug manufacturer’s roles in overseeing and regulating rosiglitazone. The concern among patients with diabetes regarding treatment, continues in the medical community today.

Was this the right answer?

Should the studies have been combined? Commentators faulted the authors for including several studies that were not originally intended to investigate diabetes, and for combining both placebo and drug therapy data into one comparator arm. Some critics noted that despite the stated inclusion criteria, some data were derived from studies where the rosiglitazone arm was allowed a longer follow-up than the comparator arm. By failing to account for this longer follow-up period, commentators felt that the authors may have overestimated the effect of rosiglitazone on CV outcomes. Many reviewers were concerned that this meta-analysis excluded trials in which no patients suffered an MI or died from CV causes – the outcomes of greatest interest. Some reviewers also noted that the exclusion of zero-event trials from the pooled dataset not only gave an incomplete picture of the impact of rosiglitazone but could have increased the odds ratio estimate. In general, the pooled dataset was criticized by many for being a faulty microcosm of the information available regarding rosiglitazone.

It is essential that a meta-analysis be based on similarity in the data sources. If studies differ in important areas such as the patient populations, interventions, or outcomes, combining their data may not be suitable. The researchers accepted studies and populations that were clinically heterogeneous, yet pooled them as if they were not. The study reported that the results were combined from a number of trials that were not initially intended to investigate CV outcomes. Furthermore, the available data did not allow for time-to-event analysis, an essential tool in comparing the impact of alternative treatment options. Reviewers considered the data to be insufficiently homogeneous, and the line of cause and effect to be murkier than the authors described.

Were the statistical methods optimal?

The statistical methods for this meta-analysis also came under significant criticism. The critiques focused on the authors’ use of the Peto method as being an incorrect choice because data were pooled from both small and very large studies, resulting in a potential overestimation of treatment effect. Others reviewers pointed that the Peto method should not have been used, as a number of the underlying studies did not have patients assigned equally to rosiglitazone and comparator groups. Finally, critics suggested that the heterogeneity of the included studies required an altogether different set of analytic techniques.

Demonstrating the sensitivity of the authors’ initial analysis to the inclusion criteria and statistical tests used, a number of researchers reworked the data from this study. one researcher used the same studies but analyzed the data with a more commonly used statistical method (Mantel-Haenszel), and found no significant increase in the relative risk or common odds ratio with MI or CV death. When the pool of studies was expanded to include those originally eliminated because they had zero CV events, the odds ratios for MI and death from CV causes dropped from 1.43 to 1.26 (95% CI, 0.93-1.72) and from 1.64 to 1.14 (95% CI, 0.74-1.74), respectively. Neither of the recalculated odd ratios were significant for MI or CV death. Finally, several newer long-term studies have been published since the Nissen meta-analysis. Incorporating their results with the meta-analysis data showed that rosiglitazone is associated with an increased risk of MI but not of CV death. Thus, the findings from these meta-analyses varied with the methods employed, the studies included, and the addition of later trials.

Emerging Data

The controversy surrounding the rosiglitazone meta-analysis authored by Nissen and Wolski forced an unplanned interim analysis of a long-term, randomized trial investigating the CV effects of rosiglitazone among patients with type 2 diabetes. The authors of the RECORD trial noted that even though the follow-up at 3.75 years was shorter than expected, rosiglitazone, when added to standard glucose-lowering therapy, was found to be associated with an increase in the risk of heart failure but was not associated with any increase in death from CV or other causes. Data at the time were found to be insufficient to determine the effect of rosiglitazone on an increase in the risk of MI. the final report of that trial, published in June 2009, confirmed the elevated risk of heart failure in people with type 2 diabetes treated with rosiglitazone in addition to glucose-lowering drugs, but continued to show inconclusive results about the effect of the drug therapy on the risk of MI. Further, the RECORD trial clarified that rosiglitazone does not result in an increased risk of CV morbidity or mortality compared to standard glucose-lowering drugs. Other trials conducted since the publishing of the meta-analysis have corroborated these results, casting further doubt on the findings of the meta-analysis published by Nissen and Wolski.

Now what?

Some sources suggest that the original Nissen meta-analysis delivered more harm than benefit, and that a well-recognized medical journal may have erred in its process of peer review. Despite this criticism, it is important to note that subsequent publications support the risk of adverse CV events associated with rosiglitazone, although rosiglitazone use does not appear to increase deaths. These results and emerging data point to the need for further rigorous research to clarify the benefits and risks of rosiglitazone on a variety of outcomes, and the importance of directing the drug to the population that will maximally benefit from its use.

Lessons Learned From this Case Study

Results from initial randomized trials that seem definitive at one time may not be conclusive, as further trials may emerge to clarify, redirect, or negate previously accepted results. A meta-analysis of those trials can lead to varying results based upon the timing of the analysis and the choices made in its performance.

Meta-Analysis: Tips for CER Practitioners

o The results of a meta-analysis are highly dependent on the studies included (and excluded). Are these criteria properly defined and relevant to the purposes of the meta-analysis? Were the combined studies sufficiently similar? Can results from this cohort be generalized to other populations of interest?

o The statistical methodology can impact study results. Have there been reviews critiquing the methods used in the meta-analysis?

o A variety of statistical tests should be considered, and perhaps reported, in the analysis of results. Do the authors mention their rationale in choosing a statistical method? Do they show the stability of their results across a spectrum of analytical methods?

o Nothing is permanent. Emerging data may change the playing field, and meta- analysis results are only as good as the data and statistics from which they are derived.

===Case-Study 3: The Nurses’ Health Study===

An observational study

An observational study is a very common type of research design in which the effects of a treatment or condition are studied without formally randomizing patients in an experimental design. Such studies can be done prospectively, wherein data are collected about a group of patients going forward in time; or retrospectively, in which the researcher looks into the past, mining existing databases for data that have already been collected. Latter studies are frequently performed by using an electronic database that contains, for example, administrative, “billing,” or claims data. Less commonly, observational research uses electronic health records, which have greater clinical information that more closely resembles the data collected in an RCT. Observational studies often take place in “real- world” environments, which allow researchers to collect data for a wide array of outcomes. Patients are not randomized in these studies, but the findings can be used to generate hypotheses for investigation in a more constrained experimental setting. Perhaps the best known observational study is the “Framingham study,” which collected demographic and health data for a group of individuals over many years (and continues to do so) and has provided an understanding of the key risk factors for heart disease and stroke.

Observational studies present many advantages to the comparative effectiveness researcher. the study design can provide a unique glimpse of the use of a health care intervention in the “real world,” an essential step in gauging the gap between efficacy (can a treatment work in a controlled setting?) and effectiveness (does the treatment work in a real-life situation?). Furthermore, observational studies can be conducted at low cost, particularly if they involve the secondary analysis of existing data sources. CER often uses administrative databases, which are based upon the billing data submitted by providers during routine care. These databases typically have limited clinical information, may have errors in them, and generally do not undergo auditing.

The uncontrolled nature of observational studies allows them to be subject to bias and confounding. For example, doctors may prescribe a new medication only for the sickest patients. Comparing these outcomes (without careful statistical adjustment) with those from less ill patients receiving alternative treatment may lead to misleading results. Observational studies can identify important associations but cannot prove cause and effect. These studies can generate hypotheses that may require RCTs for fuller demonstration of those relationships. Secondary analysis can also be problematic if researchers overwork datasets by doing multiple exploratory analyses (e.g., data-dredging): the more we look, the more we find, even if those findings are merely statistical aberrations. Unfortunately, the growing need for CER and the wide availability of administrative databases may lead to selection of research of poor quality with inaccurate findings.

In comparative effectiveness research, observational studies are typically considered to be less conclusive than RCTs and meta-analyses. Nonetheless, they can be useful, especially because they examine typical care. Due to lower cost and improvements in health information, observational studies will become increasingly common. Critical assessment of whether the described results are helpful or biased (based upon how the study was performed) are necessary. This case will illustrate several characteristics of the types of studies that will assist in evaluating newly published work.

Clinical Applications

Cardiovascular diseases (CVD) are the leading cause of death in women older than the age of 50. Epidemiologic evidence suggests that estrogen is a key mediator in the development of CVD. Estrogen is an ovarian hormone whose production decreases as women approach menopause. The steep increase in CVD in women at menopause and older and in women who have had hysterectomies further supports a relationship between estrogen and CVD. Building on this evidence of biologic plausibility, epidemiological and observational studies suggested that estrogen replacement therapy (a form of hormone replacement therapy, or HRT) had positive effects on the risk of CVD in postmenopausal women, (albeit with some negative effects in its potential to increase the risk for breast cancer and stroke).65 Based on these findings, in the 1980s and 1990s HRT was routinely employed to treat menopausal symptoms and serve as prophylaxis against CVD.

What was done?

The Nurses’ Health Study (NHS) began collecting data in 1976. In the study, researchers intended to examine a broad range of health effects in women over a long period of time, and a key goal was to clarify the role of HRT in heart disease. The cohort (i.e., the group being followed) included married registered nurses aged 30-55 in 1976 who lived in the 11 most populous states. To collect data, the researchers mailed the study participants a survey every 2 years that asked questions about topics such as smoking, hormone use, menopausal status, and less frequently, diet. Data were collected for key end points that included MI, coronary-artery bypass grafting or angioplasty, stroke, total CVD mortality, and deaths from all causes.

What was found?

At a 10-year follow-up point, the NHS had a study pool of 48,470 women. The researchers found that estrogen use (alone, without progestin) in postmenopausal women was associated with a reduction in the incidence of CVD as well as in CVD mortality compared to non-users. Later, estrogen-progestin combination therapy was shown to be even more cardioprotective than estrogen monotherapy, and lower doses of estrogen replacement therapy were found to deliver equal cardioprotection and lower the risk for adverse events. NHS researchers were alert to the potential for bias in observational studies. Adjustment for risk factors such as age (a typical practice to eliminate confounding) did not change the reported findings.

Was this the right answer?

The NHS was not unique in reporting the benefits associated with HRT; other observational studies corroborated the NHS findings. A secondary retrospective data analysis of the UK primary care electronic medical record database, for example, also showed the protective effect associated with HRT use. Researchers were aware of the fundamental limitations of observational studies, particularly with regard to selection bias. They and practicing clinicians were also aware of the potential negative health effects of HRT, which had to be constantly weighed against the potential cardioprotective benefits in deciding a patient’s course of treatment. As a large section of the population could experience the health effects of HRT, researchers began planning RCTs to verify the promising observational study results. It was highly anticipated that those RCTs would corroborate the belief that estrogen replacement can reduce CVD risk.

Randomized Controlled Trial: The Women’s Health Initiative

The Women’s health Initiative (WHI) was a major study established by the National Institutes of health in 1992 to assess a broad range of health effects in postmenopausal women. The trial was intended to follow these women for 8 years, at a cost of millions of dollars in federal funding. Among its many facets, it included an RCT to confirm the results from the observational studies discussed above. To fully investigate earlier findings, the WHI had two subgroups. One subgroup consisted of women with prior hysterectomies; they received estrogen monotherapy. The second group consisted of women who had not undergone hysterectomy; they received estrogen in combination with progestin. The WHI enrolled 27,347 women in their HRT investigation: 10,739 in the estrogen-alone arm and 16,608 in the estrogen plus progestin arm. Within each arm, women were randomly assigned to receive either HRT or placebo. All women in the trial were postmenopausal and aged 50-79 years; the mean age was 63.6 years (a fact that would be important in later analysis). Some participants had experienced previous CV events. The primary outcome of both subgroups was coronary heart disease (CHD), as described by nonfatal MI or death due to CHD.

The estrogen-progestin arm of the WHI was halted after a mean follow-up of 5.2 years, 3 years earlier than expected, as the HRT users in this arm were found to be at increased risk for CHD compared to those who received placebo. The study also noted elevated rates of breast cancer and stroke, among other poor outcomes. The estrogen-alone arm continued for an average follow-up of 6.8 years before being similarly discontinued ahead of schedule. Although this part of the study did not find an increased risk of CHD, it also did not find any cardioprotective effect. Beyond failing to locate any clear CV benefits, the WHI also found real evidence of harm, including increased risk of blood clots, breast cancer and stroke. Initial WHI publications therefore recommended against HRT being prescribed for the secondary prevention of CVD.

What Next?

Scientists and the clinicians who relied on their data for guidance in treating patients, were faced with conflicting data: epidemiological and observational studies suggested that HRT was cardioprotective while the higher-quality evidence from RCTs strongly suggested the opposite. Clinicians primarily followed the WHI results, so prescriptions for HRT in postmenopausal women quickly declined. Meanwhile, researchers began to analyze the studies for potential discrepancies, and found that the women being followed in the NHS and the WHI differed in several important characteristics.

First, the WHI population was older than the NHS cohort, and many had entered menopause at least 10 years before they enrolled in the RCT. Thus, the WHI enrollees experienced a long duration from the onset of menopause to the commencement of HRT. At the same time, many in the NHS population were closer to the onset of menopause and were still displaying hormonal symptoms when they began HRT. Second, although the NHS researchers adjusted the data for various confounding effects, their results could still have been subject to bias. In general, the NHS cohort was more highly educated and of a higher socioeconomic status than the WHI participants, and therefore more likely to see a physician regularly. The NHS women were also leaner and generally healthier than their RCT counterparts, and had been selected for their evident lack of pre-existing CV conditions. This selection bias in the NHS enrollment may have led to a “healthy woman” effect that in turn led to an overestimation of the benefits of therapy in the observational study. Third, researchers noted that dosing differences between the two study types may have contributed to the divergent results. The NHS reported beneficial results following low-dose estrogen therapy. The WHL, meanwhile, used a higher estrogen dose, exposing women to a larger dosage of hormones and increasing their risk for adverse events. The increased risk profile of the WHI women (e.g., older, more comorbidities, higher estrogen dose) could have contributed to the evidence of harm seen in the WHI results.

Emerging Data
In addition to identifying the inherent differences between the two study populations, researchers began a secondary analysis of the NHS and WHI trials. NHS researchers reported that women who began HRT close to the onset of menopause had a significantly reduced risk of CHD. In the subgroups of women that were older and had a similar duration after menopause compared with the WHI women, they found no significant relationship between HRT and CHD. Also, the WHI study further stratified these results by age, and found that women who began HRT close to their onset of menopause experienced some cardioprotection, while women who were further from the onset of menopause had a slightly elevated risk for CHD.

Secondary analysis of both studies was therefore necessary to show that age and a short duration from the onset of menopause are crucial to HRT success as a cardioprotective agent. Neither study type provided “truth” or rather, both studies provided “truth” if viewed carefully (e.g., both produced valid and important results). The differences seen in the studies were rooted in the timing of HRT and the populations being studied.

Lessons Learned From this case Study

Although RCTs are given a higher evidence grade, observational studies provide important clinical insights. In this example, the study populations differed. For policymakers and clinicians, it is crucial to examine whether the CER was based upon patients similar to those being considered. Any study with a dissimilar population may provide non-relevant results. Thus, readers of CER need to carefully examine the generalizability of the findings being reported.

==Appendix==

General Classification and Regression Tree (CART) data analysis steps part of the R package rpart.

===Growing the Tree===

# To grow a tree, use
rpart(formula, data=, method=,control=), where
formula is in the format outcome ~ predictor1+predictor2+...
data= specifies the data frame
method= "class" for a classification tree, use "anova" for a regression tree
control= optional parameters for controlling tree growth. For example, control=rpart.control(minsplit=30, cp=0.001) requires that the minimum number of observations in a node be 30 before attempting a split and that a split must decrease the overall lack of fit by a factor of 0.001 (cost complexity factor) before being attempted.

===Examining Results===

# These functions help with examining the results.
printcp(fit) display complexity parameter (cp) table
plotcp(fit) plot cross-validation results
rsq.rpart(fit) plot approximate R-squared and relative error for different splits (2 plots). labels are only appropriate for the "anova" method.
print(fit) print results
summary(fit) detailed results including surrogate splits
plot(fit) plot decision tree
text(fit) label the decision tree plot
post(fit, file=) create postscript plot of decision tree
# In trees created by rpart(), move to the LEFT branch when the stated condition is true.

===Pruning Trees===

#In general, trees should be pruned back to avoid overfitting the data. The tree size should minimize the cross-#validated error – xerror column printed by printcp(). Pruning the tree is accomplished by:
prune(fit, cp= )
# use printcp( ) to examine the cross-validation error results, select the complexity parameter (CP) associated with minimum error, and insert the CP it into the prune() function. This (automatically selecting the complexity parameter associated with the smallest cross-validated error) can be done succinctly by:
fit$\$$cptable[which.min(fit$\$$cptable[,"xerror"]),"CP"]

===Compete Dataset for N-of-1 Example===
[[SMHS_MethodsHeterogeneity_CER_Nof1|This N-of-1 Dataset]] includes an example.

===[[SMHS_MethodsHeterogeneity|Back to the Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research section]]===

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php/SMHS_MethodsHeterogeneity_CER}}

SMHS MethodsHeterogeneity MetaAnalysis

2016-05-19T15:57:39Z

Imoubara: /* Series of “N of 1” trials */

==[[SMHS_MethodsHeterogeneity| Methods for Studying Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research]] - Meta-Analyses ==

==Meta-analysis==

===Overview===

Meta-analysis is an approach to combine treatment effects across trials or studies into an aggregated treatment effect with higher statistical power than observed in each individual trials. It may detect HTE by testing for differences in treatment effects across similar RCTs. It requires that the individual treatment effects are similar to ensure pooling is meaningful. In the presence of large clinical or methodological differences between the trials, it may be to avoid meta-analyses. The presence of HTE across studies in a meta-analysis may be due to differences in the design or execution of the individual trials (e.g., randomization methods, patient selection criteria). Cochran's Q is a methods for detection of heterogeneity, which is computed as the weighted sum of squared differences between each study's treatment effect and the pooled effects across the studies. It is a barometer of inter-trial differences impacting the observed study result. A possible source of error in a meta-analysis is publication bias. Trial size may introduce publication bias since larger trials are more likely to be published. Language and accessibility represent other potential confounding factors. When the heterogeneity is not due to poor study design, it may be useful to optimize the treatment benefits for different cohorts of participants.

Cochran's Q statistics is the weighted sum of squares on a standardized scale. The corresponding P value indicates the strength of the evidence of presence of heterogeneity. This test may have low power to detect heterogeneity sometimes and it is suggested to use a value of 0.10 as a cut-off for significance (Higgins et al., 2003). The Q statistics also may have too much power as a test of heterogeneity when the number of studies is large.

===Simulation Example 1===

# Install and Load library
install.packages("meta")
library(meta)

# Set number of studies
n.studies = 15

# number of treatments: case1, case2, control
n.trt = 3

# number of outcomes
n.event = 2

# simulate the (balanced) number of cases (case1 and case2) and controls in each study
ctl.group = rbinom(n = n.studies, size = 200, prob = 0.3)
case1.group = rbinom(n = n.studies, size = 200, prob = 0.3)
case2.group = rbinom(n = n.studies, size = 200, prob = 0.3)

# Simulate the number of outcome events (e.g., deaths) and no events in the control group
event.ctl.group = rbinom(n = n.studies, size = ctl.group, prob = rep(0.1, length(ctl.group)))
noevent.ctl.group = ctl.group - event.ctl.group

# Simulate the number of events and no events in the case1 group
event.case1.group = rbinom(n = n.studies, size = case1.group, prob = rep(0.5, length(case1.group)))
noevent.case1.group = case1.group - event.case1.group

# Simulate the number of events and no events in the case2 group
event.case2.group = rbinom(n = n.studies, size = case2.group, prob = rep(0.6, length(case2.group)))
noevent.case2.group = case2.group - event.case2.group

# Run the univariate meta-analysis using metabin(), Meta-analysis of binary outcome data –
# Calculation of fixed and random effects estimates (risk ratio, odds ratio, risk difference or arcsine
# difference) for meta-analyses with binary outcome data. Mantel-Haenszel (MH),
# inverse variance and Peto method are available for pooling.

# method = A character string indicating which method is to be used for pooling of studies.
# one of "MH" , "Inverse" , or "Cochran"
# sm = A character string indicating which summary measure (“OR”, "RR" "RD"=risk difference) is to be
# used for pooling of studies

# Control vs. Case1, n.e and n.c are numbers in experimental and control groups
meta.ctr_case1 <- metabin(event.e = event.case1.group, n.e = case1.group, event.c = event.ctl.group,
n.c = ctl.group, method = "MH", sm = "OR")
# in this case we use Odds Ratio, of the odds of death in the experimental and control studies
forest(meta.ctr_case1)

<center>[[Image:SMHS_Methods8.png|500px]] </center>

# Control vs. Case2
meta.ctr_case2 <- metabin(event.e = event.case2.group, n.e = case2.group, event.c = event.ctl.group,
n.c = ctl.group, method = "MH", sm = "OR")
forest(meta.ctr_case2)

<center>[[Image:SMHS_Methods9.png|500px]] </center>

# Case1 vs. Case2
meta.case1_case2 <- metabin(event.e = event.case1.group, n.e = case1.group, event.c = event.case2.group,
n.c = case2.group, method = "MH", sm = "OR")
forest(meta.case1_case2)
summary(meta.case1_case2)

Test of heterogeneity:
Q d.f. p-value
11.99 14 0.6071

<center>[[Image:SMHS_Methods10.png|500px]] </center>

The forest plot shows the I2 test indicates the evidence to reject the null hypothesis (no study heterogeneity and the fixed effects model should be used).

==Series of “N of 1” trials==

This technique combines (a “series of”) n-of-1 trial data to identify HTE. An n-of-1 trial is a repeated crossover trial for a single patient, which randomly assigns the patient to one treatment vs. another for a given time period, after which the patient is re-randomized to treatment for the next time period, usually repeated for 4-6 time periods. Such trials are most feasibly done in chronic conditions, where little or no washout period is needed between treatments and treatment effects are identifiable in the short-term, such as pain or reliable surrogate markers. Combining data from identical n-of-1 trials across a set of patients enables the statistical analysis controlling for patient fixed or random effects, covariates, centers, or sequence effects, see Figure below. These combined trials are often analyzed within a Bayesian context using shrinkage estimators that combine individual and group mean treatment effects to create a “posterior” individual mean treatment effect estimate which is a form of inverse variance-weighted average of the individual and group effects. Such trials are typically more expensive than standard RCTs on a per-patient basis, however, they require much smaller sample sizes, often less than 100 patients (due to the efficient individual-as-own-control design), and create individual treatment effect estimates that are not possible in a non-crossover design . For the individual patient, the treatment effect can be re-estimated after each time period, and the trial stopped at any point when the more effective treatment is identified with reasonable statistical certainty.

====Example====

A study involving 8 participants collected data across 30 days, in which 15 treatment days and 15 control days are randomly assigned within each participant. The treatment effect is represented as a binary variable (control day=0; treatment day=1). The outcome variable represents the response to the intervention within each of the 8 participants. Study employed a fixed-effects modeling. By creating N − 1 dummy-coded variables representing the N=8 participants, where the last (i=8) participant serves as the reference (i.e., as the model intercept). So, each dummy-coded variable represents the difference between each participant (i) and the 8th participant. Thus, all other patients' values will be relative to the values of the 8th (reference) subject. The overall differences across participants in fixed effects can be evaluated with multiple degree-of-freedom F-tests.

<center>[[Image:SMHS_Methods11.png|500px]] </center>

<center>

{| class="wikitable" style="text-align:center; " border="1"
|-
|ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||1||33||8||0.97||5.00||4.03||1.03||53
|-
|1||2||1||33||8||-0.17||3.87||4.03||1.03||73
|-
|1||3||0||33||8||0.81||4.84||4.03||1.03||23
|-
|1||4||0||33||8||-0.41||3.62||4.03||1.03||36
|-
|...||...||...||...||...||...||...||...||...||...

|}
</center> Complete data is available in the Appendix.

<center>Data Summary

{| class="wikitable" style="text-align:center; " border="1"
|-
|Intercept||Constant
|-
|Physical Activity||PhyAct
|-
|Intervention||Tx
|-
|WP Social Support||WPSS
|-
|PM Social Support (1-3)||PMss3
|-
|Self Efficacy||SelfEff25

|}
</center>

rm(list=ls())
Nof1 <-read.table("https://umich.instructure.com/files/330385/download?download_frd=1&verifier=DwJUGSd6t24dvK7uYmzA2aDyzlmsohyaK6P7jK0Q", sep=",", header = TRUE) # 02_Nof1_Data.csv
attach(Nof1)
head(Nof1)

<center>

{| class="wikitable" style="text-align:center; " border="1"
|-
| ||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0

|}
</center>

df.1 = data.frame(PhyAct, Tx, WPSS, PMss3, SelfEff25)

# library("lme4")

lm.1 = model.lmer <- lmer(PhyAct ~ Tx + SelfEff + Tx*SelfEff + (1|Day) + (1|ID) , data= df.1)
summary(lm.1)

Linear mixed model fit by REML ['lmerMod']
Formula: PhyAct ~ Tx + SelfEff + Tx * SelfEff + (1 | Day) + (1 | ID)
Data: df.1

REML criterion at convergence: 8820

<center> Scaled Residuals
{| class="wikitable" style="text-align:center; " border="1"
|-
| Min||1Q||Median||3Q||Max
|-
|-2.7012||-0.6833||-0.0333||0.6542||3.9612
|}
</center>

<center> Random Effects
{| class="wikitable" style="text-align:center; " border="1"
|-
| Groups ||Name||Variance ||Std.Dev.
|-
| Day||(Intercept) ||0.0 || 0.00
|-

|ID|| (Intercept)||601.5||24.53
|-

|Residual|| ||969.0 ||31.13
|}
Number of obs: 900, groups: Day, 30; ID, 30
</center>

<center> Fixed Effects
{| class="wikitable" style="text-align:center; " border="1"
|-
|Estimate||Std.||Error||t value
|-
|(Intercept)||38.3772||14.4738||2.651
|-
|Tx||4.0283||6.3745||0.632
|-
|SelfEff||0.5818||0.5942||0.979
|-
|Tx:SelfEff||0.9702||0.2617||3.708
|}
</center>

<center> Correlation of Fixed Effects
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||(Intr)||Tx ||SlfEff
|-
| Tx|| -0.220|| ||
|-
| SelfEff||-0.946 ||0.208 ||
|-
| Tx:SelfEff ||0.208 ||-0.946 ||-0.220
|}
</center>

# Model: PhyAct = Tx + WPSS + PMss3 + Tx*WPSS + Tx*PMss3 + SelfEff25 + Tx*SelfEff25 + ε
lm.2 = lm(PhyAct ~ Tx + WPSS + PMss3 + Tx*WPSS + Tx*PMss3 + SelfEff25 + Tx*SelfEff25, df.1)
summary(lm.2)

Call:
lm(formula = PhyAct ~ Tx + WPSS + PMss3 + Tx * WPSS + Tx * PMss3 +
SelfEff25 + Tx * SelfEff25, data = df.1)

<center> Residuals
{| class="wikitable" style="text-align:center; " border="1"
|-
|Min||1Q||Median||3Q||Max
|-
| -102.39||-28.24||-1.47||25.16||122.41

|}
</center>

<center>Coefficients
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||Estimate||Std. Error||t value||$Pr(>|t|)$
|-
|(Intercept)||52.0067||1.8080||28.764||< 2e-16 ***
|-
|Tx||27.7366||2.5569||10.848||< 2e-16 ***
|-
|WPSS||1.9631||2.4272||0.809||0.418853
|-
|PMss3||13.5110||2.7853||4.851||1.45e-06 ***
|-
|SelfEff25||0.6289||0.2205||2.852||0.004439 **
|-
|Tx:WPSS||9.9114||3.4320||2.888||0.003971 **
|-
|Tx:PMss3||8.8422||3.9390||2.245||0.025025 *
|-
|Tx:SelfEff25||1.0460||0.3118||3.354||0.000829 ***

|}
</center>

[Using SAS (StudyI_Analyses.sas, StudyIIab_Analyses.sas)]

<center> Type 3 Tests of Fixed Effects
{| class="wikitable" style="text-align:center; " border="1"
|-
|Effect||Num DF||Den DF||F Value||$Pr>F$
|-
|Tx||1||224||67.46||<.0001
|-
|ID||7||224||25.95||<.0001
|-
|Tx*ID||7||224||2.92||0.0060
|}
</center>

==Quantile Treatment Effect (QTE)==

QTE employs quantile regression estimation (QRE) to examine the central tendency and statistical dispersion of the treatment effect in a population. These may not be revealed by the conventional mean estimation in RCTs. For instance, patients with different comorbidity scores may respond differently to a treatment. Quantile regression has the ability to reveal HTE according to the ranking of patients’ comorbidity scores or some other relevant covariate by which patients may be ranked. Therefore, in an attempt to inform patient-centered care, quantile regression provides more information on the distribution of the treatment effect than typical conditional mean treatment effect estimation. QTE characterizes the heterogeneous treatment effect on individuals and groups across various positions in the distributions of different outcomes of interest. This unique feature has given quantile regression analysis substantial attention and has been employed across a wide range of applications, particularly when evaluating the economic effects of welfare reform.

One caveat of applying QRE in clinical trials for examining HTE is that the QTE doesn’t demonstrate the treatment effect for a given patient. Instead, it focuses on the treatment effect among subjects within the qth quantile, such as those who are exactly at the top 10th percent in terms of blood pressure or a depression score for some covariate of interest, for example, comorbidity score. It is not uncommon for the qth quantiles to be two different sets of patients before and after the treatment. For this reason, we have to assume that these two groups of patients are homogeneous if they were in the same quantiles.

Income-Food Expenditure Example: Let’s examine the Engel data (N=235) on the relationship between food expenditure (foodexp) and household income (income). We can plot the data and then explore the superposition of the six fitted quantile regression lines.

install.packages("quantreg")
library(quantreg)
data(engel)
attach(engel)

<center>head(engel)
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Income||Foodexp
|-
|1||420.1577||255.8394
|-
|2||541.4117||310.9587
|-
|3||901.1575||485.6800
|-
|4||639.0802||402.9974
|-
|5||750.8756||495.5608
|-
|6||945.7989||633.7978

|}
</center>

<center>summary(engel)
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Income||Foodexp
|-
|Min||377.1||242.3
|-
|1st Qu.||638.9||429.7
|-
|Median||884.0||582.5
|-
|Mean||982.5||624.2
|-
|3rd Qu.||1164.0||743.9
|-
|Max||4957.8||2032.7

|}
</center>

Note: If Y be a real valued random variable with cumulative distribution function FY(y)=P(Y≤ y), then the τ-quantile of Y is given by

<center> QY(τ)=FY-1(τ)=inf{ y:FY(y)≥τ} </center>

where 0≤τ≤1.

<center>[[Image:SMHS_Methods12.png|500px]] </center>

# (1) Graphics
plot(income, foodexp, cex=.25, type="n", xlab="Household Income", ylab="Food Expenditure")
points(income, foodexp, cex=.5, col="blue")

# tau - the quantile(s) to be estimated, in the range from 0 to 1. An object "rq.process" and an object "rqs"
# are returned containing the matrix of coefficient estimates at the specified quantiles.
abline( rq(foodexp ~ income, tau=.5), col="blue") # Quantile Regression Model

abline( lm(foodexp ~ income), lty=2, lwd=3, col="red") # linear model
taus <- c(0.05, 0.1, 0.25, 0.75, 0.90, 0.95)
colors <- rainbow(length(taus))

models <- vector(mode = "list", length = length(taus)) # define a vector of models to store QR for diff taus
model.names <- vector(mode = "list", length = length(taus)) # define a vector model names

for( i in 1:length(taus)){
models[[i]] <- rq(foodexp ~ income, tau=taus[i])
var <- taus[i]
model.names[[i]] <- paste("Model [", i , "]: tau=", var)
abline( models[[i]], lwd=2, col= colors[[i]])
}
legend(3000, 1100, model.names, col= colors, pch= taus, bty='n', cex=.75)

<center>[[Image:SMHS_Methods13.png|500px]] </center>

# (2) Inference about quantile regression coefficients. As an alternative to the rank-inversion confidence intervals, we can obtain a table of coefficients, standard errors, t-statistics, and p-values using the summary function:

summary(models[[3]], se = "nid")

Call: rq(formula = foodexp ~ income, tau = taus[i])

tau: [1] 0.25

<center>Coefficients
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Value||Std. Error||t Value||$Pr(>|t|)$
|-
|(Intercept)||95.48354||21.39237||4.46344||0.00001
|-
|Income||0.47410||0.02906||16.31729||0.00000

|}
</center>

# Alternatively, we can use summary.rq to compute bootstrapped standard errors.
summary.rq(models[[3]], se = "nid")

Call: rq(formula = foodexp ~ income, tau = taus[i])
tau: [1] 0.25

<center>Coefficients
{| class="wikitable" style="text-align:center; " border="1"
|-
|||Value||Std. Error||t Value||$Pr(>|t|)$
|-
|(Intercept)||95.48354||21.39237||4.46344||0.00001
|-
|Income||0.47410||0.02906||16.31729||0.00000

|}
</center>

.
.
.

==Nonparametric Regression Methods ==

Nonparametric regression enables dealing with HTE in RCTs. Different nonparametric methods, such as kernel smoothing methods and series methods, can be used to generate test statistics for examining the presence of HTE. A kernel method is a weighting scheme based on a kernel function (e.g. uniform, Gaussian). When evaluating the treatment effect of a patient in RCTs, the kernel method assigns larger weights to those observations with similar covariates. This is done because it is assumed that patients with similar covariates provide more relevant data on predicted treatment response. Examining participants that have different backgrounds (e.g., demographic, clinical), kernel smoothing methods utilize information from highly divergent participants when estimating a particular subject’s treatment effect. Lower weights are assigned to very different subjects and the kernel methods require choosing a set of smoothing parameters to group patients according to their relative degree of similarities. A drawback is that the corresponding proposed test statistics may be sensitive to the chosen bandwidths, which inhibits the interpretation of the results. Series methods use approximating functions (splines or power series of the explanatory variables) to construct test statistics. Compared to kernel smoothing methods, series methods normally have the advantage of computational convenience; however, the precision of test statistics depends on the number of terms selected in the series.

Canadian Wage Data Example: Nonparametric regression extends the classical parametric regression (e.g., lm, lmer) involving one continuous dependent variable, y, and (1 or more) continuous explanatory variable(s), x. Let’s start with a popular parametric model of a wage equation that we can extend to a fully nonparametric regression model. First, we will compare and contrast the parametric and nonparametric approach towards univariate regression and then proceed to multivariate regression.

Let’s use the Canadian cross-section wage data (cps71) consisting of a random sample taken from the 1971 Canadian Census for male individuals having common education (High-School). N=205 observations, 2 variables, the logarithm of the individual’s wage (logwage) and their age (age). The classical wage equation model includes a quadratic term of age.

# install.packages("np")
library("np")
data("cps71")

# (1) Linear Model -> R2 = 0.2308
model.lin <- lm( logwage ~ age + I(age^2), data = cps71)
summary(model.lin)

Call:
lm(formula = logwage ~ age + I(age^2), data = cps71)

Residuals:
Min 1Q Median 3Q Max
-2.4041 -0.1711 0.0884 0.3182 1.3940

<center>Coefficients
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||Estimate||Std. Error||t Value||$Pr(>|t|)$
|-
|(Intercept)||10.0419773||0.4559986||22.022||< 2e-16 ***
|-
|Age||0.1731310||0.0238317|| 7.265||7.96e-12 ***
|-
|I(age^2)||-0.0019771||0.0002898||-6.822||1.02e-10 ***

|}
</center>

Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.5608 on 202 degrees of freedom
Multiple R-squared: 0.2308, Adjusted R-squared: 0.2232
F-statistic: 30.3 on 2 and 202 DF, p-value: 3.103e-12

# (2) Next, we consider the local linear nonparametric method employing cross-validated
# bandwidth selection and estimation in one step. Start with computing the least-squares
# cross-validated bandwidths for the local constant estimator (default).
# Note that R2 = 0.3108675
bandwidth <- npregbw(formula= logwage ~ age, data = cps71)
model.np <- npreg(bandwidth, regtype = "ll", bwmethod = "cv.aic", gradients = TRUE, data = cps71)
summary(model.np)

Regression Data: 205 training points, in 1 variable(s) age
Bandwidth(s): 1.892157
Kernel Regression Estimator: Local-Constant
Bandwidth Type: Fixed
Residual standard error: 0.5307943
R-squared: 0.3108675
Continuous Kernel Type: Second-Order Gaussian
No. Continuous Explanatory Vars.: 1

# NP model significance may be tested by
npsigtest(model.np)

Kernel Regression Significance Test
Type I Test with IID Bootstrap (399 replications, Pivot=TRUE, joint=FALSE)
Explanatory variables tested for significance: age (1)

age
Bandwidth(s): 1.892157

Individual Significance Tests
P Value:
age < 2.22e-16 ***

# So, as was the case for the linear parametric model, Age is significant in the local linear NP-model

# (3) Graphical comparison of parametric and nonparametric models.
plot(cps71$\$$age, cps71$\$$logwage, xlab = "age", ylab = "log(wage)", cex=.1)
lines(cps71$\$$age, fitted(model.lin), lty = 2, col = " red")
lines(cps71$\$$age, fitted(model.np), lty = 1, col = "blue")
legend("topright", c("Data", "Linear", "Non-linear"), col=c("Black", "Red", "Blue"), pch = c(1, 1, 1), bty='n', cex=.75)

<center>[[Image:SMHS_Methods14.png|500px]] </center>

# some additional plots resenting the parametric (quadratic, dashed line) and the nonparametric estimates
# (solid line) of the regression function for the cps71 data.
plot(model.np, plot.errors.method = "asymptotic")
plot(model.np, gradients = TRUE)
lines(cps71$\$$age, coef(model.lin)[2]+2*cps71$\$$age*coef(model.lin)[3], lty = 2, col = "red")
plot(model.np, gradients = TRUE, plot.errors.method = "asymptotic")

# (4) using the Lin and NL models to generate predictions based on the obtained appropriate
# bandwidths and estimated a nonparametric model. We need to create a set of explanatory
# variables for which to generate predictions. These can be part of the original dataset or be
# outside its scope. Typically, we don’t have the outcome for the evaluation data and need only
# provide the explanatory variables for which predicted values are generated by the models.
# Occasionally, splitting the dataset into two independent samples (training/testing), allows estimation
# of a model on one sample, and evaluation of its performance on another.

cps.eval.data <- data.frame(age = seq(10,70, by=10)) # simulate some explanatory X values (ages)
pred.lin <- predict(model.lin, newdata = cps.eval.data) # Linear Prediction of log(Wage)
pred.np <- predict(model.np, newdata = cps.eval.data) # non-Linear Prediction of log(Wage)
plot(pred.lin, pred.np)
abline(lm(pred.np ~ pred.lin))

<center>[[Image:SMHS_Methods15.png|500px]] </center>

.
.
.

==Predictive risk models ==

Predictive risk models represent a class of methods for identifying potential for HTE when the individual patient risk for disease-related events at baseline depends on observed factors. For instance, common measures are disease staging criteria, such as those used in COPD or heart failure, Framingham risk scores for cardiovascular event risk, or genetic variations, e.g., HER2 for breast cancer. Initial predictive risk modeling, aka risk function estimation, is often performed without accounting for treatment effects. Least squares or Cox proportional hazards regression methods are appropriate in many cases and provide relatively more interpretable risk functions, but rely on linearity assumptions and may not provide optimal predictive metrics. Partial least squares is an extension of least squares methods that can reduce the dimensionality of the predictor space by interposing latent variables, predicted by linear combinations of observable characteristics, as the intermediate predictors of one or more outcomes. Recursive partitioning, such as random forests, support vector machines, and neural networks represent latter methods with better predictive power than linear methods. Risk function estimation can range from highly exploratory analyses to near meta-analytic model validation, and may be useful at any stage of product development.

HIV Example: The “hmohiv” dataset represents a study of HIV positive patients examining whether there was a difference in survival times of HIV positive patients between a cohort using intravenous drugs (drug=1) and a cohort not using the IV drug (drug=0). The hmohiv data includes the following variables:

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|ID||Time||Age||Drug||Censor||Entdate||Enddate
|-
|1||5||46||0||1||5/15/1990||10/14/1990
|-
|2||6||35||1||0||9/19/1989||3/20/1990
|-
|3||8||30||1||1||4/21/1991||12/20/1991
|-
|4||3||30||1||1||1/3/1991||4/4/1991
|-
|5||22||36||0||1||9/18/1989||7/19/1991
|-
|6||1||32||1||0||3/18/1991||4/17/1991
|-
|...||...||...||...||...||...||...

|}
</center>

#cleaning up environment
rm(list=ls())

# load survival library
library(survival)

# load hmohiv data
hmohiv<-read.table("http://www.ats.ucla.edu/stat/r/examples/asa/hmohiv.csv", sep=",", header = TRUE)
attach(hmohiv)

# Fit Cox proportional hazards regression model
cox.model <- coxph( Surv(time, censor) ~ drug, method="breslow")
fit.1 <- survfit(cox.model, newdata=drug.new)

# construct a frame of the 2 cohorts IV_drug and no-IV-drug
drug.new<-data.frame(drug=c(0,1))

# plot results
plot(fit.1, xlab="Survival Time (Months)", ylab="Survival Probability")
points(fit.1$\$$time, fit.1$\$$surv[,1], pch=1)
points(fit.1$\$$time, fit.1$\$$surv[,2], pch=2)
legend(40, .8, c("Drug Absent", "Drug Present"), pch=c(1,2))

<center>[[Image:SMHS_Methods16.png|500px]] </center>

# to inslect the resulting Cox Proportional Hazard Model
cox.model
Call:
coxph(formula = Surv(time, censor) ~ drug, method = "breslow")

coef exp(coef) se(coef) z p
drug 0.779 2.18 0.242 3.22 0.0013

Likelihood ratio test=10.2 on 1 df, p=0.00141 n= 100, number of events= 80

.
.
.

==[[SMHS_MethodsHeterogeneity_CER|Next see: Comparative Effectiveness Research (CER)]]==

<li> [[SMHS_MethodsHeterogeneity|Back to the Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research section]]</li>

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php/SMHS_MethodsHeterogeneity_MetaAnalysis}}

SMHS MethodsHeterogeneity HTE

2016-05-19T14:57:55Z

Imoubara: /* Latent growth and growth mixture modeling (LGM/GMM) */

==[[SMHS_MethodsHeterogeneity| Methods for Studying Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research]] - Methods and Approaches for HTE Analytics ==

===Overview===

Recursive partitioning is a data mining technique for exploring structure and patterns in complex data. It facilitates the visualization of decision rules for predicting categorical (classification tree) or continuous (regression tree) outcome variables. The R rpart package provides the tools for Classification and Regression Tree (CART) modeling, conditional inference trees, and random forests. Additional resources include an Introduction to Recursive Partitioning Using the RPART Routines . The Appendix includes description of the main CART analysis steps.

install.packages("rpart")
library("rpart")

===CART===
Classification and Regression Tree (CART) is a decision-tree based technique that considers how variation observed in a given response variable (continuous or categorical) can be understood through a systematic deconstruction of the overall study population into subgroups, using explanatory variables of interest. For HTE analysis, CART is best suited for early-stage, exploratory analyses. Its relative simplicity can be powerful in identifying basic relationships between variables of interest, and thus identify potential subgroups for more advanced analyses. The key to CART is its ‘systematic’ approach to the development of the subgroups, which are constructed sequentially through repeated, binary splits of the population of interest, one explanatory variable at a time. In other words, each ‘parent’ group is divided into two ‘child’ groups, with the objective of creating increasingly homogeneous subgroups. The process is repeated and the subgroups are then further split, until no additional variables are available for further subgroup development. The resulting tree structure is oftentimes overgrown, but additional techniques are used to ‘trim’ the tree to a point at which its predictive power is balanced against issues of over-fitting. Because the CART approach does not make assumptions regarding the distribution of the dependent variable, it can be used in situations where other multivariate modeling techniques often used for exploratory predictive risk modeling would not be appropriate – namely in situations where data are not normally distributed.

CART analyses are useful in situations where there is some evidence to suggest that HTE exists, but the subgroups defining the heterogeneous response are not well understood. CART allows for an exploration of response in a myriad of complex subpopulations, and more recently developed ensemble methods (such as Bayesian Additive Regression Trees) allow for more robust analyses through the combination of multiple CART analyses.

====Example Fifth Dutch growth study====

# Let’s use the Fifth Dutch growth study (2009) fdgs . Is it true that “the world’s tallest nation has stopped growing taller: the height of Dutch children from 1955 to 2009”?

#install.packages("mice")
library("mice")
?fdgs
head(fdgs)

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||ID ||Reg ||Age ||Sex ||HGT ||WGT ||HGT.Z ||WGT.Z
|-
|1 ||100001||West||13.09514||boy||175.5||75.0||1.751||2.410
|-
|2 ||100003||West||13.81793 ||boy||148.4||40.0||2.292||1.494
|-
|3 ||100004||West||13.97125||boy||159.9||46.5||0.743||0.783
|-
|4 ||100005||West||13.98220 ||girl||159.7||46.5 ||0.743 ||0.783
|-
|5||100006||West||13.52225||girl||160.3||47.8||0.414||0.355
|-
|6||100018||East||10.21492||boy||157.8||39.7||2.025||0.823
|}
</center>

summary(fdgs)
summary(fdgs)

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|ID ||Reg ||Age ||Sex ||HGT
|-
|Min.:100001||North:732||Min.:0.008214||boy:4829||Min.:46.0
|-
|1st Qu.:106353||East:2528||1st Qu.:1.618754||girl:5201||1st Qu.:83.8
|-
|Median:203855||South:2931||Median:8.084873|| ||Median:131.5
|-
|Mean:180091||West:2578||Mean:8.157936|| ||Mean:123.9
|-
|3rd Qu.210591||City:1261||3rd Qu.:13.547570|| ||3rd Qu.:162.3
|-
|Max:401955|| ||Max.:21.993155|| ||Max.:208.0
|-
| || || || ||NA's: 23
|}
</center>

(1) Classification Tree

Let's use the data frame fdgs to predict Region, from Age, Height, and Weight.
# grow tree
fit.1 <- rpart(reg ~ age + hgt + wgt, method="class", data= fdgs[,-1])

printcp(fit.1) # display the results
plotcp(fit.1) # visualize cross-validation results
summary(fit.1) # detailed summary of splits

# plot tree
par(oma=c(0,0,2,0))
plot(fit.1, uniform=TRUE, margin=0.3, main="Classification Tree for Region (FDGS Data)")
text(fit.1, use.n=TRUE, all=TRUE, cex=1.0)

<center>[[Image:SMHS_Methods2.png|500px]] </center>

# create a better plot of the classification tree
post(fit.1, title = "Classification Tree for Region (FDGS Data)", file = "")

<center>[[Image:SMHS_Methods3.png|500px]] </center>

(2) Pruning the tree

pruned.fit.1<- prune(fit.1, cp= fit.1$\$$cptable[which.min(fit.1$\$$\$$cptable[,"xerror"]),"CP"])

# plot the pruned tree
plot(pruned.fit.1, uniform=TRUE, main="Pruned Classification Tree for Region (FDGS Data)")
text(pruned.fit.1, use.n=TRUE, all=TRUE, cex=1.0)
post(pruned.fit.1, title = "Pruned Classification Tree for Region (FDGS Data)")

Not much change, as the initial tree is not complex!

===Random Forests ===
Random forests may improve predictive accuracy by generating a large number of bootstrapped trees (based on random samples of variables). It classifies cases using each tree in this new "forest", and decides the final predicted outcome by combining the results across all of the trees (an average in regression, a majority vote in classification). See the randomForest package.

library(randomForest)
fit.2 <- randomForest(reg ~ age + hgt + wgt, method="class", na.action = na.omit, data= fdgs[,-1])
print(fit.2) # view results
importance(fit.2) # importance of each predictor

Note on missing values/incomplete data: If the data have missing values, we have 3 choices:

1. Use a different tool (rpart handles missing values well)

2. Impute the missing values

3. For a small number of missing cases, we can use na.action = na.omit

===Latent growth and growth mixture modeling (LGM/GMM)===

LGM and GMM represent structural equation modeling techniques that capture inter-individual differences in longitudinal change corresponding to a particular treatment. For instance, patients’ different timing patterns of the treatment effects may represent the underlying sources of HTE. LGM distinguish if (yes/no) and how (fast/slow, temporary/lasting) patients respond to treatment. The heterogeneous individual growth trajectories are estimated from intra-individual changes over time by examining common population parameters, i.e., slopes, intercepts, and error variances. Suppose each individual has unique initial status (intercept) and response rate (slope) during a specific time interval. Then the variances of the individuals’ baseline measures (intercepts) and changes (slopes) in health outcomes will represent the degree of HTE. The LGM-identified HTE of individual growth curves can be attributed to observed predictors, including both fixed and time varying covariates.

LGM assumes that all individuals are from the same population (too restrictive in some cases). If the HTE is due to observed demographic variables, such as age, gender, and marital status, one may utilize multiple-group LGM. Despite its successful applications for modeling longitudinal change, there may be multiple subpopulations with unobserved heterogeneities. Growth mixture modeling (GMM) extends LGM to allow the identification and prediction of unobserved subpopulations in longitudinal data analysis. Each unobserved subpopulation may constitute its own latent class and behave differently than individuals in other latent classes. Within each latent class, there are also different trajectories across individuals; however, different latent classes don’t share common population parameters. Suppose we are interested in studying retirees’ psychological well-being change trajectory when multiple unknown subpopulations exist. We can add another layer (a latent class variable) on the LGM framework so that the unobserved latent classes can be inferred from the data. The covariates in GMM are designed to affect growth factors distinctly across different latent classes. Therefore, there are two types of HTE: 1) the latent class variable in GMM divides individuals into groups with different growth curves; and 2) coefficient estimates vary across latent classes.

Latent variables are not directly observed – they are inferred (via a model) from other actually observed and directly measured variables. Models that explain observed variables in terms of latent variables are called latent variable models. Then the latent (unobserved) variable is discrete, it’s referred to as latent class variable.

Breast Cancer Example: Recall the LMER package, earlier review discussions, where Linear Mixed Model (LMM) are used for longitudinal data to examine change over time of outcomes according relative to predictive covariates. LMM assumptions include:

(i) continuous longitudinal outcome

(ii) Gaussian random-effects and errors

(iii) linearity of the relationships with the outcome

(iv) homogeneous population

(v) missing at random data

The objectives of LGM/GMM models (see Latent Class Mixed Models, lcmm R package) are to extend the linear mixed model estimation to:

(i) heterogeneous populations (relax (iv) above). Use hlme for latent class linear mixed models (i.e. Gaussian continuous outcome)

(ii) other types of longitudinal outcomes : ordinal, (bounded) quantitative non-Gaussian outcomes (relax (i), (ii), (iii), (iv)). Use lcmm for general latent class mixed models with outcomes of different nature

(iii) joint analysis of a time-to-event (relax (iv), (v)). Use Jointlcmm for joint latent class models with a longitudinal outcome and a right-censored (left-truncated) time-to-event</blockquote>

Let’s use these data (http://www.ats.ucla.edu/stat/data/hdp.csv), representing cancer phenotypes and predictors (e.g., "IL6", "CRP", "LengthofStay", "Experience") and outcome measures (e.g., remission) collected on patients, nested within doctors (DID) and within hospitals (HID).

We can illustrate the latent class linear mixed models implemented in hlme through a study of the quadratic trajectories of the response (remission) with TumorSize, adjusting for CO2*Pain interaction and assuming correlated random-effects for the functions of SmokingHx and Sex. To estimate the corresponding standard linear mixed model using 1 latent class where CO2 interacts with Pain:

# install.packages("lcmm")
library("lcmm")

hdp <- read.csv("http://www.ats.ucla.edu/stat/data/hdp.csv")
hdp <- within(hdp, {
Married <- factor(Married, levels = 0:1, labels = c("no", "yes"))
DID <- factor(DID)
HID <- factor(HID)
})

add a new subject ID column (last column in the data, “ID”), this is necessary for the hmle call
hdp$\$$ID <- seq.int(nrow(hdp))

model.hlme <- hlme(remission ~ IL6 + CRP + LengthofStay + Experience + I(tumorsize^2) + co2*pain + I(tumorsize^2)*pain, random=~ SmokingHx + Sex, subject='ID', data=hdp, ng=1)
summary(model.hlme)

Heterogenous linear mixed model
fitted by maximum likelihood method

hlme(fixed = remission ~ IL6 + CRP + LengthofStay + Experience +
I(tumorsize^2) + co2 * pain + I(tumorsize^2) * pain, random = ~SmokingHx +
Sex, subject = "ID", ng = 1, data = hdp)

Statistical Model:
Dataset: hdp
Number of subjects: 8525
Number of observations: 8525
Number of latent classes: 1
Number of parameters: 21

Iteration process:
Convergence criteria satisfied
Number of iterations: 34
Convergence criteria: parameters= 1.2e-09
: likelihood= 8.3e-06
: second derivatives= 2.7e-05

Goodness-of-fit statistics:
maximum log-likelihood: -5223.9
AIC: 10489.79
BIC: 10637.86

Maximum Likelihood Estimates:

<center>Fixed effects in the Longitudinal Model:

{| class="wikitable" style="text-align:center; " border="1"
|-
| ||coef||Se||Wald||p-value
|-
|Intercept||0.28636||0.24314||1.178||0.23890
|-
|IL6||-0.01134||0.00183||-6.184||0.00000
|-
|CRP||-0.00674||0.00167||-4.043||0.00005
|-
|LengthofStay||-0.04834||0.00463||-10.436||0.00000
|-
|Experience||0.01695||0.00119||14.263||0.00000
|-
|I(tumorsize^2)||0.00000||0.00001||-0.076||0.93953
|-
|co2||-0.03549||0.16204||-0.219||0.82663
|-
|pain||0.03930||0.04278||0.919||0.35832
|-
|co2:pain||-0.01489||0.02871||-0.519||0.60395
|-
|I(tumorsize^2):pain||0.00000||0.00000||0.553||0.58045
|}
</center>

<center>Variance-covariance matrix of the random-effects

{| class="wikitable" style="text-align:center; " border="1"
|-
| ||intercept||SmokingHxformer||SmokingHxnever||Sexmale
|-
|intercept||0.19310943|| || ||
|-
|SmokingHxformer||-0.10617988||0.209155186|| ||
|-
|SmokingHxnever||-0.12388534||0.068342049||2.262655e-01||
|-
|Sexmale||-0.08130975||-0.007353491||-1.873934e-05||0.1730187

|}
</center>

Residual standard error:

coef: 0.1299767

se: 1.187426

Results interpretation:

(1) The first part of the summary provides information about the dataset, the number of subjects, observations, observations deleted (since by default, missing observations are deleted), number of latent classes and number of parameters.

(2) Next, details about the algorithm convergence is provided along with the number of iterations, the convergence criteria, and the information indicating if the model converged correctly: "convergence criteria satisfied".

(3) The maximum log-likelihood, Akaike criterion (AIC) and Bayesian Information criterion (BIC) are reported.

(4) Estimates of parameters, the estimated standard error, the Wald Test statistics (with Normal approximation) and the corresponding p-values are reported below.

(5) For the random-effect distribution, the estimated matrix of covariance of the random-effects is displayed.

(6) The standard error of the residuals is given along with its estimated standard error.

(7) The effect of TumorSize seems not associated with change over Pain of Remission. This may be formally assessed using a multivariate Wald test:

WaldMult(model.hlme, pos=c(6,8))
# pos - a vector containing the indices in model.hlme of the parameters to test
Wald Test p_value
I(tumorsize^2) = pain = 0 0.85562 0.65193

We may consider the model with an adjustment for CRP only on the intercept. Below we estimate the corresponding models for a varying number of latent classes (from 1 to 3) using the default initial values:

# Initial Model: model.hlme <- hlme(remission ~ IL6 + CRP + LengthofStay + Experience + I(tumorsize^2) + co2*pain + I(tumorsize^2)*pain, random=~ SmokingHx + Sex, subject='ID', data=hdp, ng=1)

model.hlme.1 <- hlme(tumorsize ~ IL6 + CRP + LengthofStay, subject='ID', data=hdp, ng=1)
model.hlme.2 <- hlme(tumorsize ~ IL6 + CRP + LengthofStay + SmokingHx, mixture=~ SmokingHx, subject='ID', data=hdp, ng=2)
model.hlme.3 <- hlme(tumorsize ~ IL6 + CRP + LengthofStay + SmokingHx, mixture=~ SmokingHx, subject='ID', data=hdp, ng=3)

The estimation process for a varying number of latent classes can be summarized with summarytable, which gives the log-likelihood, the number of parameters, the Bayesian Information Criterion, and the posterior proportion of each class:

summarytable(model.hlme.1, model.hlme.2, model.hlme.3)
G loglik npm BIC %class1 %class2 %class3
model.hlme.1 1 -33301.82 5 66648.89 100.000000
model.hlme.2 2 -31592.79 11 63285.15 99.214076 0.7859238
model.hlme.3 3 -31589.55 15 63314.86 6.357771 82.2991202 11.34311

The program took 404.65 seconds

In this example, the optimal number of latent classes according to the BIC is two (the smallest BIC). The posterior classification is described with:

postprob(model.hlme.2)

Posterior classification:
class1 class2
N 8458.00 67.00
% 99.21 0.79

Posterior classification table:
--> mean of posterior probabilities in each class
prob1 prob2
class1 0.8555 0.1445
class2 0.4362 0.5638

Posterior probabilities above a threshold (%):
class1 class2
prob>0.7 92.48 2.99
prob>0.8 77.38 0.00
prob>0.9 38.53 0.00

In this example, the first class includes a posteriori 8458 subjects (99%) while class 2 includes 67 (0.79%) subjects. Subjects were classified in class 1 with a mean posterior probability of 0.8555 %.

In class 1, 92.48% were classified with a posterior probability above 0.7 while 2.99% of the subjects were classified in class 2 with a posterior probability above 0.7. Goodness-of-fit of the model can be assessed by displaying the residuals as in figure and the mean predictions of the model as in figure, according to the time variable given in var.time:

plot(model.hlme.2)
# Figure (left panel)
plot(model.hlme.2, which="fit", var.time="Age", bty="l", ylab=" Remission ", xlab="Age", lwd=2)
# Figure (right panel)
plot(model.hlme.2, which="fit", var.time="Age", bty="l", ylab=" Remission ", xlab="Age", lwd=2, marg=FALSE)

<center>[[Image:SMHS_Methods4.png|500px]] </center>

<center>[[Image:SMHS_Methods5.png|500px]] </center>

<center>[[Image:SMHS_Methods6.png|500px]] </center>

The latent process mixed models implemented in lcmm are illustrated through the study of the linear trajectory of ntumors with Age adjusted for Sex and assuming correlated random-effects for the intercept and Age. Lines estimate the corresponding latent process mixed model with different link functions:

model.hlme.lin <- lcmm(ntumors ~ Age*Sex, random=~ Age ,subject='ID', data=hdp)
model.hlme.beta <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='beta')
model.hlme.spl <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='splines')
model.hlme.spl5q <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='5-quant-splines')

link function: An optional family of link functions. By default,

<li>"linear" option specifies a linear link function leading to a standard linear mixed model (homogeneous or heterogeneous as estimated in hlme). </li>
<li>"beta" for estimating a link function from the family of Beta cumulative distribution functions, "thresholds" for using a threshold model to describe the correspondence between each level of an ordinal outcome and the underlying latent process, and</li>
<li>"Splines" for approximating the link function by I-splines. For this latter case, the number of nodes and the nodes location should be also specified. The number of nodes is first entered followed by,</li>
<li> -, then the location is specified with "equi", "quant" or "manual" for respectively equidistant nodes, nodes at quantiles of the marker distribution or interior nodes entered manually in argument</li>
<li>intnodes. It is followed by - and finally "splines" is indicated. For example, "7-equi-splines" means I-splines with 7 equidistant nodes, "6-quant-splines" means I-splines with 6 nodes located at the quantiles of the marker distribution and "9-manual-splines" means I-splines with 9 nodes, the vector of 7 interior nodes being entered in the argument intnodes.</li>

summary (model.hlme.lin)

General latent class mixed model fitted by maximum likelihood method

lcmm(fixed = ntumors ~ Age * Sex, random = ~Age, subject = "ID",data = hdp)

Statistical Model:
Dataset: hdp
Number of subjects: 8525
Number of observations: 8525
Number of latent classes: 1
Number of parameters: 8
Link function: linear

Iteration process:
Maximum number of iteration reached without convergence
Number of iterations: 100
Convergence criteria: parameters= 5.4e-10
: likelihood= 5.5e-10
: second derivatives= 1

Goodness-of-fit statistics:
maximum log-likelihood: -19915.24
AIC: 39846.49
BIC: 39902.89

Discrete posterior log-likelihood: 0
Discrete AIC: 16

Mean discrete AIC per subject: 9e-04
Mean UACV per subject: 0
Mean discrete LL per subject: 0

Maximum Likelihood Estimates:

Fixed effects in the longitudinal model:

coef Se Wald p-value
intercept (not estimated) 0.00000
Age 0.09491
Sexmale -0.66303
Age:Sexmale 0.01132

Variance-covariance matrix of the random-effects:
intercept Age
intercept 20.5013715
Age -0.2889814 0.007696382

Residual standard error (not estimated) = 1

Parameters of the link function:

coef Se Wald p-value
Linear 1 (intercept) -0.36768
Linear 2 (std err) 0.71432

Objects mlin, mbeta, mspl and mspl3eq are latent process mixed models that assume the exact same trajectory for the underlying latent process but respectively a linear, BetaCDF, I-splines with 5 equidistant knots (default with link=’splines’) and I-splines with 5 knots at percentiles. mlin reduces to a standard linear mixed model (link=’linear’ by default). The only difference with a hlme object is the parameterization for the intercept and the residual standard error that are considered as rescaling parameters.

col <- rainbow(4)
plot(model.hlme.lin, which="linkfunction", bty='l', ylab="Number-of-Tumors", col=col[1], lwd=2, xlab="underlying latent process")
plot(model.hlme.beta, which="linkfunction", add=T, col=col[2], lwd=2)
plot(model.hlme.spl, which="linkfunction", add=T, col=col[3], lwd=2)
plot(model.hlme.spl5q, which="linkfunction", add=T, col=col[4], lwd=2)
legend(x="topleft",legend=c("linear", "beta","splines (5equidistant)", "splines (5 at quantiles)"), lty=1,col=col,bty="n",lwd=2)

# to obtain confidence bands use function predictlink
link.lin <- predictlink(model.hlme.lin, ndraws=2000)

Error in predictlink.lcmm(model.hlme.spl, ndraws = 2000):
No confidence intervals can be produced since the program did not converge properly

model.hlme.lin$\$$conv # double-check the convergence of the algorithm[1] 2
# status of convergence:
# =1 if the convergence criteria were satisfied,
# =2 if the maximum number of iterations was reached,
# =4 or 5 if a problem occured during optimisation

model.hlme.lin <- lcmm(ntumors ~ Age*Sex, random=~ Age ,subject='ID', epsY = 0.5, convB = 1e-01, convL = 1e-01, convG = 1e-01, maxiter=200, data=hdp); model.hlme.lin$conv

# Now that we have convergence, we can obtain CI’s!!!
link.lin <- predictlink(model.hlme.lin, ndraws=2000)

# plot(model.hlme.lin, which="linkfunction", bty='l', ylab="Number-of-Tumors", col=col[1], lwd=2, xlab="underlying latent process")
plot(link.lin, add=TRUE, col=col[1], lty=2, lwd=2)
legend(x="left", legend=c("95% confidence bands", "for linear fit"), lty=c(2,NA), col=c(col[1],NA), bty="n", lwd=2)

<center>[[Image:SMHS_Methods7.png|500px]] </center>

# Repeat using the other link functions … model.hlme.beta, model.hlme.spl, …
model.hlme.beta <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='beta',
convB = 1e-01, convL = 1e-01, convG = 1e-01, maxiter=200); model.hlme.beta$\$$conv
link.beta <- predictlink(model.hlme.beta, ndraws=2000)
plot(link.beta, add=TRUE, col=col[2], lty=2, lwd=2)
legend(x="left", legend=c("95% confidence bands", "for BETA fit"), lty=c(3,NA), col=c(col[2],NA), bty="n", lwd=1)

===[[SMHS_MethodsHeterogeneity_MetaAnalysis|Next see: Meta-Analysis]]===
* [[SMHS_MethodsHeterogeneity|Back to the Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research section]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php/SMHS_MethodsHeterogeneity_HTE}}

SMHS MethodsHeterogeneity HTE

2016-05-19T14:44:41Z

Imoubara: /* Latent growth and growth mixture modeling (LGM/GMM) */

==[[SMHS_MethodsHeterogeneity| Methods for Studying Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research]] - Methods and Approaches for HTE Analytics ==

===Overview===

Recursive partitioning is a data mining technique for exploring structure and patterns in complex data. It facilitates the visualization of decision rules for predicting categorical (classification tree) or continuous (regression tree) outcome variables. The R rpart package provides the tools for Classification and Regression Tree (CART) modeling, conditional inference trees, and random forests. Additional resources include an Introduction to Recursive Partitioning Using the RPART Routines . The Appendix includes description of the main CART analysis steps.

install.packages("rpart")
library("rpart")

===CART===
Classification and Regression Tree (CART) is a decision-tree based technique that considers how variation observed in a given response variable (continuous or categorical) can be understood through a systematic deconstruction of the overall study population into subgroups, using explanatory variables of interest. For HTE analysis, CART is best suited for early-stage, exploratory analyses. Its relative simplicity can be powerful in identifying basic relationships between variables of interest, and thus identify potential subgroups for more advanced analyses. The key to CART is its ‘systematic’ approach to the development of the subgroups, which are constructed sequentially through repeated, binary splits of the population of interest, one explanatory variable at a time. In other words, each ‘parent’ group is divided into two ‘child’ groups, with the objective of creating increasingly homogeneous subgroups. The process is repeated and the subgroups are then further split, until no additional variables are available for further subgroup development. The resulting tree structure is oftentimes overgrown, but additional techniques are used to ‘trim’ the tree to a point at which its predictive power is balanced against issues of over-fitting. Because the CART approach does not make assumptions regarding the distribution of the dependent variable, it can be used in situations where other multivariate modeling techniques often used for exploratory predictive risk modeling would not be appropriate – namely in situations where data are not normally distributed.

CART analyses are useful in situations where there is some evidence to suggest that HTE exists, but the subgroups defining the heterogeneous response are not well understood. CART allows for an exploration of response in a myriad of complex subpopulations, and more recently developed ensemble methods (such as Bayesian Additive Regression Trees) allow for more robust analyses through the combination of multiple CART analyses.

====Example Fifth Dutch growth study====

# Let’s use the Fifth Dutch growth study (2009) fdgs . Is it true that “the world’s tallest nation has stopped growing taller: the height of Dutch children from 1955 to 2009”?

#install.packages("mice")
library("mice")
?fdgs
head(fdgs)

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||ID ||Reg ||Age ||Sex ||HGT ||WGT ||HGT.Z ||WGT.Z
|-
|1 ||100001||West||13.09514||boy||175.5||75.0||1.751||2.410
|-
|2 ||100003||West||13.81793 ||boy||148.4||40.0||2.292||1.494
|-
|3 ||100004||West||13.97125||boy||159.9||46.5||0.743||0.783
|-
|4 ||100005||West||13.98220 ||girl||159.7||46.5 ||0.743 ||0.783
|-
|5||100006||West||13.52225||girl||160.3||47.8||0.414||0.355
|-
|6||100018||East||10.21492||boy||157.8||39.7||2.025||0.823
|}
</center>

summary(fdgs)
summary(fdgs)

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|ID ||Reg ||Age ||Sex ||HGT
|-
|Min.:100001||North:732||Min.:0.008214||boy:4829||Min.:46.0
|-
|1st Qu.:106353||East:2528||1st Qu.:1.618754||girl:5201||1st Qu.:83.8
|-
|Median:203855||South:2931||Median:8.084873|| ||Median:131.5
|-
|Mean:180091||West:2578||Mean:8.157936|| ||Mean:123.9
|-
|3rd Qu.210591||City:1261||3rd Qu.:13.547570|| ||3rd Qu.:162.3
|-
|Max:401955|| ||Max.:21.993155|| ||Max.:208.0
|-
| || || || ||NA's: 23
|}
</center>

(1) Classification Tree

Let's use the data frame fdgs to predict Region, from Age, Height, and Weight.
# grow tree
fit.1 <- rpart(reg ~ age + hgt + wgt, method="class", data= fdgs[,-1])

printcp(fit.1) # display the results
plotcp(fit.1) # visualize cross-validation results
summary(fit.1) # detailed summary of splits

# plot tree
par(oma=c(0,0,2,0))
plot(fit.1, uniform=TRUE, margin=0.3, main="Classification Tree for Region (FDGS Data)")
text(fit.1, use.n=TRUE, all=TRUE, cex=1.0)

<center>[[Image:SMHS_Methods2.png|500px]] </center>

# create a better plot of the classification tree
post(fit.1, title = "Classification Tree for Region (FDGS Data)", file = "")

<center>[[Image:SMHS_Methods3.png|500px]] </center>

(2) Pruning the tree

pruned.fit.1<- prune(fit.1, cp= fit.1$\$$cptable[which.min(fit.1$\$$\$$cptable[,"xerror"]),"CP"])

# plot the pruned tree
plot(pruned.fit.1, uniform=TRUE, main="Pruned Classification Tree for Region (FDGS Data)")
text(pruned.fit.1, use.n=TRUE, all=TRUE, cex=1.0)
post(pruned.fit.1, title = "Pruned Classification Tree for Region (FDGS Data)")

Not much change, as the initial tree is not complex!

===Random Forests ===
Random forests may improve predictive accuracy by generating a large number of bootstrapped trees (based on random samples of variables). It classifies cases using each tree in this new "forest", and decides the final predicted outcome by combining the results across all of the trees (an average in regression, a majority vote in classification). See the randomForest package.

library(randomForest)
fit.2 <- randomForest(reg ~ age + hgt + wgt, method="class", na.action = na.omit, data= fdgs[,-1])
print(fit.2) # view results
importance(fit.2) # importance of each predictor

Note on missing values/incomplete data: If the data have missing values, we have 3 choices:

1. Use a different tool (rpart handles missing values well)

2. Impute the missing values

3. For a small number of missing cases, we can use na.action = na.omit

===Latent growth and growth mixture modeling (LGM/GMM)===

LGM and GMM represent structural equation modeling techniques that capture inter-individual differences in longitudinal change corresponding to a particular treatment. For instance, patients’ different timing patterns of the treatment effects may represent the underlying sources of HTE. LGM distinguish if (yes/no) and how (fast/slow, temporary/lasting) patients respond to treatment. The heterogeneous individual growth trajectories are estimated from intra-individual changes over time by examining common population parameters, i.e., slopes, intercepts, and error variances. Suppose each individual has unique initial status (intercept) and response rate (slope) during a specific time interval. Then the variances of the individuals’ baseline measures (intercepts) and changes (slopes) in health outcomes will represent the degree of HTE. The LGM-identified HTE of individual growth curves can be attributed to observed predictors, including both fixed and time varying covariates.

LGM assumes that all individuals are from the same population (too restrictive in some cases). If the HTE is due to observed demographic variables, such as age, gender, and marital status, one may utilize multiple-group LGM. Despite its successful applications for modeling longitudinal change, there may be multiple subpopulations with unobserved heterogeneities. Growth mixture modeling (GMM) extends LGM to allow the identification and prediction of unobserved subpopulations in longitudinal data analysis. Each unobserved subpopulation may constitute its own latent class and behave differently than individuals in other latent classes. Within each latent class, there are also different trajectories across individuals; however, different latent classes don’t share common population parameters. Suppose we are interested in studying retirees’ psychological well-being change trajectory when multiple unknown subpopulations exist. We can add another layer (a latent class variable) on the LGM framework so that the unobserved latent classes can be inferred from the data. The covariates in GMM are designed to affect growth factors distinctly across different latent classes. Therefore, there are two types of HTE: 1) the latent class variable in GMM divides individuals into groups with different growth curves; and 2) coefficient estimates vary across latent classes.

Latent variables are not directly observed – they are inferred (via a model) from other actually observed and directly measured variables. Models that explain observed variables in terms of latent variables are called latent variable models. Then the latent (unobserved) variable is discrete, it’s referred to as latent class variable.

Breast Cancer Example: Recall the LMER package, earlier review discussions, where Linear Mixed Model (LMM) are used for longitudinal data to examine change over time of outcomes according relative to predictive covariates. LMM assumptions include:

(i) continuous longitudinal outcome

(ii) Gaussian random-effects and errors

(iii) linearity of the relationships with the outcome

(iv) homogeneous population

(v) missing at random data

The objectives of LGM/GMM models (see Latent Class Mixed Models, lcmm R package) are to extend the linear mixed model estimation to:

(i) heterogeneous populations (relax (iv) above). Use hlme for latent class linear mixed models (i.e. Gaussian continuous outcome)

(ii) other types of longitudinal outcomes : ordinal, (bounded) quantitative non-Gaussian outcomes (relax (i), (ii), (iii), (iv)). Use lcmm for general latent class mixed models with outcomes of different nature

(iii) joint analysis of a time-to-event (relax (iv), (v)). Use Jointlcmm for joint latent class models with a longitudinal outcome and a right-censored (left-truncated) time-to-event</blockquote>

Let’s use these data (http://www.ats.ucla.edu/stat/data/hdp.csv), representing cancer phenotypes and predictors (e.g., "IL6", "CRP", "LengthofStay", "Experience") and outcome measures (e.g., remission) collected on patients, nested within doctors (DID) and within hospitals (HID).

We can illustrate the latent class linear mixed models implemented in hlme through a study of the quadratic trajectories of the response (remission) with TumorSize, adjusting for CO2*Pain interaction and assuming correlated random-effects for the functions of SmokingHx and Sex. To estimate the corresponding standard linear mixed model using 1 latent class where CO2 interacts with Pain:

# install.packages("lcmm")
library("lcmm")

hdp <- read.csv("http://www.ats.ucla.edu/stat/data/hdp.csv")
hdp <- within(hdp, {
Married <- factor(Married, levels = 0:1, labels = c("no", "yes"))
DID <- factor(DID)
HID <- factor(HID)
})

add a new subject ID column (last column in the data, “ID”), this is necessary for the hmle call
hdp$\$$ID <- seq.int(nrow(hdp))

model.hlme <- hlme(remission ~ IL6 + CRP + LengthofStay + Experience + I(tumorsize^2) + co2*pain + I(tumorsize^2)*pain, random=~ SmokingHx + Sex, subject='ID', data=hdp, ng=1)
summary(model.hlme)

Heterogenous linear mixed model
fitted by maximum likelihood method

hlme(fixed = remission ~ IL6 + CRP + LengthofStay + Experience +
I(tumorsize^2) + co2 * pain + I(tumorsize^2) * pain, random = ~SmokingHx +
Sex, subject = "ID", ng = 1, data = hdp)

Statistical Model:
Dataset: hdp
Number of subjects: 8525
Number of observations: 8525
Number of latent classes: 1
Number of parameters: 21

Iteration process:
Convergence criteria satisfied
Number of iterations: 34
Convergence criteria: parameters= 1.2e-09
: likelihood= 8.3e-06
: second derivatives= 2.7e-05

Goodness-of-fit statistics:
maximum log-likelihood: -5223.9
AIC: 10489.79
BIC: 10637.86

Maximum Likelihood Estimates:

<center>Fixed effects in the Longitudinal Model:

{| class="wikitable" style="text-align:center; " border="1"
|-
| ||coef||Se||Wald||p-value
|-
|Intercept||0.28636||0.24314||1.178||0.23890
|-
|IL6||-0.01134||0.00183||-6.184||0.00000
|-
|CRP||-0.00674||0.00167||-4.043||0.00005
|-
|LengthofStay||-0.04834||0.00463||-10.436||0.00000
|-
|Experience||0.01695||0.00119||14.263||0.00000
|-
|I(tumorsize^2)||0.00000||0.00001||-0.076||0.93953
|-
|co2||-0.03549||0.16204||-0.219||0.82663
|-
|pain||0.03930||0.04278||0.919||0.35832
|-
|co2:pain||-0.01489||0.02871||-0.519||0.60395
|-
|I(tumorsize^2):pain||0.00000||0.00000||0.553||0.58045
|}
</center>

<center>Variance-covariance matrix of the random-effects

{| class="wikitable" style="text-align:center; " border="1"
|-
| ||intercept||SmokingHxformer||SmokingHxnever||Sexmale
|-
|intercept||0.19310943|| || ||
|-
|SmokingHxformer||-0.10617988||0.209155186|| ||
|-
|SmokingHxnever||-0.12388534||0.068342049||2.262655e-01||
|-
|Sexmale||-0.08130975||-0.007353491||-1.873934e-05||0.1730187

|}
</center>

Residual standard error:

coef: 0.1299767

se: 1.187426

Results interpretation:

(1) The first part of the summary provides information about the dataset, the number of subjects, observations, observations deleted (since by default, missing observations are deleted), number of latent classes and number of parameters.

(2) Next, details about the algorithm convergence is provided along with the number of iterations, the convergence criteria, and the information indicating if the model converged correctly: "convergence criteria satisfied".

(3) The maximum log-likelihood, Akaike criterion (AIC) and Bayesian Information criterion (BIC) are reported.

(4) Estimates of parameters, the estimated standard error, the Wald Test statistics (with Normal approximation) and the corresponding p-values are reported below.

(5) For the random-effect distribution, the estimated matrix of covariance of the random-effects is displayed.

(6) The standard error of the residuals is given along with its estimated standard error.

(7) The effect of TumorSize seems not associated with change over Pain of Remission. This may be formally assessed using a multivariate Wald test:

WaldMult(model.hlme, pos=c(6,8))
# pos - a vector containing the indices in model.hlme of the parameters to test
Wald Test p_value
I(tumorsize^2) = pain = 0 0.85562 0.65193

We may consider the model with an adjustment for CRP only on the intercept. Below we estimate the corresponding models for a varying number of latent classes (from 1 to 3) using the default initial values:

# Initial Model: model.hlme <- hlme(remission ~ IL6 + CRP + LengthofStay + Experience + I(tumorsize^2) + co2*pain + I(tumorsize^2)*pain, random=~ SmokingHx + Sex, subject='ID', data=hdp, ng=1)

model.hlme.1 <- hlme(tumorsize ~ IL6 + CRP + LengthofStay, subject='ID', data=hdp, ng=1)
model.hlme.2 <- hlme(tumorsize ~ IL6 + CRP + LengthofStay + SmokingHx, mixture=~ SmokingHx, subject='ID', data=hdp, ng=2)
model.hlme.3 <- hlme(tumorsize ~ IL6 + CRP + LengthofStay + SmokingHx, mixture=~ SmokingHx, subject='ID', data=hdp, ng=3)

The estimation process for a varying number of latent classes can be summarized with summarytable, which gives the log-likelihood, the number of parameters, the Bayesian Information Criterion, and the posterior proportion of each class:

summarytable(model.hlme.1, model.hlme.2, model.hlme.3)
G loglik npm BIC %class1 %class2 %class3
model.hlme.1 1 -33301.82 5 66648.89 100.000000
model.hlme.2 2 -31592.79 11 63285.15 99.214076 0.7859238
model.hlme.3 3 -31589.55 15 63314.86 6.357771 82.2991202 11.34311

The program took 404.65 seconds)

In this example, the optimal number of latent classes according to the BIC is two (the smallest BIC). The posterior classification is described with:

postprob(model.hlme.2)

Posterior classification:
class1 class2
N 8458.00 67.00
% 99.21 0.79

Posterior classification table:
--> mean of posterior probabilities in each class
prob1 prob2
class1 0.8555 0.1445
class2 0.4362 0.5638

Posterior probabilities above a threshold (%):
class1 class2
prob>0.7 92.48 2.99
prob>0.8 77.38 0.00
prob>0.9 38.53 0.00

In this example, the first class includes a posteriori 8458 subjects (99%) while class 2 includes 67 (0.79%) subjects. Subjects were classified in class 1 with a mean posterior probability of 0.8555 %.

In class 1, 92.48% were classified with a posterior probability above 0.7 while 2.99% of the subjects were classified in class 2 with a posterior probability above 0.7. Goodness-of-fit of the model can be assessed by displaying the residuals as in figure and the mean predictions of the model as in figure, according to the time variable given in var.time:

plot(model.hlme.2)
# Figure (left panel)
plot(model.hlme.2, which="fit", var.time="Age", bty="l", ylab=" Remission ", xlab="Age", lwd=2)
# Figure (right panel)
plot(model.hlme.2, which="fit", var.time="Age", bty="l", ylab=" Remission ", xlab="Age", lwd=2, marg=FALSE)

<center>[[Image:SMHS_Methods4.png|500px]] </center>

<center>[[Image:SMHS_Methods5.png|500px]] </center>

<center>[[Image:SMHS_Methods6.png|500px]] </center>

The latent process mixed models implemented in lcmm are illustrated through the study of the linear trajectory of ntumors with Age adjusted for Sex and assuming correlated random-effects for the intercept and Age. Lines estimate the corresponding latent process mixed model with different link functions:

model.hlme.lin <- lcmm(ntumors ~ Age*Sex, random=~ Age ,subject='ID', data=hdp)
model.hlme.beta <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='beta')
model.hlme.spl <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='splines')
model.hlme.spl5q <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='5-quant-splines')

link function: An optional family of link functions. By default,

<li>"linear" option specifies a linear link function leading to a standard linear mixed model (homogeneous or heterogeneous as estimated in hlme). </li>
<li>"beta" for estimating a link function from the family of Beta cumulative distribution functions, "thresholds" for using a threshold model to describe the correspondence between each level of an ordinal outcome and the underlying latent process, and</li>
<li>"Splines" for approximating the link function by I-splines. For this latter case, the number of nodes and the nodes location should be also specified. The number of nodes is first entered followed by,</li>
<li> -, then the location is specified with "equi", "quant" or "manual" for respectively equidistant nodes, nodes at quantiles of the marker distribution or interior nodes entered manually in argument</li>
<li>intnodes. It is followed by - and finally "splines" is indicated. For example, "7-equi-splines" means I-splines with 7 equidistant nodes, "6-quant-splines" means I-splines with 6 nodes located at the quantiles of the marker distribution and "9-manual-splines" means I-splines with 9 nodes, the vector of 7 interior nodes being entered in the argument intnodes.</li>

summary (model.hlme.lin)

General latent class mixed model fitted by maximum likelihood method

lcmm(fixed = ntumors ~ Age * Sex, random = ~Age, subject = "ID",data = hdp)

Statistical Model:
Dataset: hdp
Number of subjects: 8525
Number of observations: 8525
Number of latent classes: 1
Number of parameters: 8
Link function: linear

Iteration process:
Maximum number of iteration reached without convergence
Number of iterations: 100
Convergence criteria: parameters= 5.4e-10
: likelihood= 5.5e-10
: second derivatives= 1

Goodness-of-fit statistics:
maximum log-likelihood: -19915.24
AIC: 39846.49
BIC: 39902.89

Discrete posterior log-likelihood: 0
Discrete AIC: 16

Mean discrete AIC per subject: 9e-04
Mean UACV per subject: 0
Mean discrete LL per subject: 0

Maximum Likelihood Estimates:

Fixed effects in the longitudinal model:

coef Se Wald p-value
intercept (not estimated) 0.00000
Age 0.09491
Sexmale -0.66303
Age:Sexmale 0.01132

Variance-covariance matrix of the random-effects:
intercept Age
intercept 20.5013715
Age -0.2889814 0.007696382

Residual standard error (not estimated) = 1

Parameters of the link function:

coef Se Wald p-value
Linear 1 (intercept) -0.36768
Linear 2 (std err) 0.71432

Objects mlin, mbeta, mspl and mspl3eq are latent process mixed models that assume the exact same trajectory for the underlying latent process but respectively a linear, BetaCDF, I-splines with 5 equidistant knots (default with link=’splines’) and I-splines with 5 knots at percentiles. mlin reduces to a standard linear mixed model (link=’linear’ by default). The only difference with a hlme object is the parameterization for the intercept and the residual standard error that are considered as rescaling parameters.

col <- rainbow(4)
plot(model.hlme.lin, which="linkfunction", bty='l', ylab="Number-of-Tumors", col=col[1], lwd=2, xlab="underlying latent process")
plot(model.hlme.beta, which="linkfunction", add=T, col=col[2], lwd=2)
plot(model.hlme.spl, which="linkfunction", add=T, col=col[3], lwd=2)
plot(model.hlme.spl5q, which="linkfunction", add=T, col=col[4], lwd=2)
legend(x="topleft",legend=c("linear", "beta","splines (5equidistant)", "splines (5 at quantiles)"), lty=1,col=col,bty="n",lwd=2)

# to obtain confidence bands use function predictlink
link.lin <- predictlink(model.hlme.lin, ndraws=2000)

Error in predictlink.lcmm(model.hlme.spl, ndraws = 2000):
No confidence intervals can be produced since the program did not converge properly

model.hlme.lin$\$$conv # double-check the convergence of the algorithm[1] 2
# status of convergence:
# =1 if the convergence criteria were satisfied,
# =2 if the maximum number of iterations was reached,
# =4 or 5 if a problem occured during optimisation

model.hlme.lin <- lcmm(ntumors ~ Age*Sex, random=~ Age ,subject='ID', epsY = 0.5, convB = 1e-01, convL = 1e-01, convG = 1e-01, maxiter=200, data=hdp); model.hlme.lin$conv

# Now that we have convergence, we can obtain CI’s!!!
link.lin <- predictlink(model.hlme.lin, ndraws=2000)

# plot(model.hlme.lin, which="linkfunction", bty='l', ylab="Number-of-Tumors", col=col[1], lwd=2, xlab="underlying latent process")
plot(link.lin, add=TRUE, col=col[1], lty=2, lwd=2)
legend(x="left", legend=c("95% confidence bands", "for linear fit"), lty=c(2,NA), col=c(col[1],NA), bty="n", lwd=2)

<center>[[Image:SMHS_Methods7.png|500px]] </center>

# Repeat using the other link functions … model.hlme.beta, model.hlme.spl, …
model.hlme.beta <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='beta',
convB = 1e-01, convL = 1e-01, convG = 1e-01, maxiter=200); model.hlme.beta$\$$conv
link.beta <- predictlink(model.hlme.beta, ndraws=2000)
plot(link.beta, add=TRUE, col=col[2], lty=2, lwd=2)
legend(x="left", legend=c("95% confidence bands", "for BETA fit"), lty=c(3,NA), col=c(col[2],NA), bty="n", lwd=1)

===[[SMHS_MethodsHeterogeneity_MetaAnalysis|Next see: Meta-Analysis]]===
* [[SMHS_MethodsHeterogeneity|Back to the Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research section]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php/SMHS_MethodsHeterogeneity_HTE}}

SMHS MethodsHeterogeneity HTE

2016-05-19T14:42:38Z

Imoubara: /* Latent growth and growth mixture modeling (LGM/GMM) */

==[[SMHS_MethodsHeterogeneity| Methods for Studying Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research]] - Methods and Approaches for HTE Analytics ==

===Overview===

Recursive partitioning is a data mining technique for exploring structure and patterns in complex data. It facilitates the visualization of decision rules for predicting categorical (classification tree) or continuous (regression tree) outcome variables. The R rpart package provides the tools for Classification and Regression Tree (CART) modeling, conditional inference trees, and random forests. Additional resources include an Introduction to Recursive Partitioning Using the RPART Routines . The Appendix includes description of the main CART analysis steps.

install.packages("rpart")
library("rpart")

===CART===
Classification and Regression Tree (CART) is a decision-tree based technique that considers how variation observed in a given response variable (continuous or categorical) can be understood through a systematic deconstruction of the overall study population into subgroups, using explanatory variables of interest. For HTE analysis, CART is best suited for early-stage, exploratory analyses. Its relative simplicity can be powerful in identifying basic relationships between variables of interest, and thus identify potential subgroups for more advanced analyses. The key to CART is its ‘systematic’ approach to the development of the subgroups, which are constructed sequentially through repeated, binary splits of the population of interest, one explanatory variable at a time. In other words, each ‘parent’ group is divided into two ‘child’ groups, with the objective of creating increasingly homogeneous subgroups. The process is repeated and the subgroups are then further split, until no additional variables are available for further subgroup development. The resulting tree structure is oftentimes overgrown, but additional techniques are used to ‘trim’ the tree to a point at which its predictive power is balanced against issues of over-fitting. Because the CART approach does not make assumptions regarding the distribution of the dependent variable, it can be used in situations where other multivariate modeling techniques often used for exploratory predictive risk modeling would not be appropriate – namely in situations where data are not normally distributed.

CART analyses are useful in situations where there is some evidence to suggest that HTE exists, but the subgroups defining the heterogeneous response are not well understood. CART allows for an exploration of response in a myriad of complex subpopulations, and more recently developed ensemble methods (such as Bayesian Additive Regression Trees) allow for more robust analyses through the combination of multiple CART analyses.

====Example Fifth Dutch growth study====

# Let’s use the Fifth Dutch growth study (2009) fdgs . Is it true that “the world’s tallest nation has stopped growing taller: the height of Dutch children from 1955 to 2009”?

#install.packages("mice")
library("mice")
?fdgs
head(fdgs)

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||ID ||Reg ||Age ||Sex ||HGT ||WGT ||HGT.Z ||WGT.Z
|-
|1 ||100001||West||13.09514||boy||175.5||75.0||1.751||2.410
|-
|2 ||100003||West||13.81793 ||boy||148.4||40.0||2.292||1.494
|-
|3 ||100004||West||13.97125||boy||159.9||46.5||0.743||0.783
|-
|4 ||100005||West||13.98220 ||girl||159.7||46.5 ||0.743 ||0.783
|-
|5||100006||West||13.52225||girl||160.3||47.8||0.414||0.355
|-
|6||100018||East||10.21492||boy||157.8||39.7||2.025||0.823
|}
</center>

summary(fdgs)
summary(fdgs)

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
|ID ||Reg ||Age ||Sex ||HGT
|-
|Min.:100001||North:732||Min.:0.008214||boy:4829||Min.:46.0
|-
|1st Qu.:106353||East:2528||1st Qu.:1.618754||girl:5201||1st Qu.:83.8
|-
|Median:203855||South:2931||Median:8.084873|| ||Median:131.5
|-
|Mean:180091||West:2578||Mean:8.157936|| ||Mean:123.9
|-
|3rd Qu.210591||City:1261||3rd Qu.:13.547570|| ||3rd Qu.:162.3
|-
|Max:401955|| ||Max.:21.993155|| ||Max.:208.0
|-
| || || || ||NA's: 23
|}
</center>

(1) Classification Tree

Let's use the data frame fdgs to predict Region, from Age, Height, and Weight.
# grow tree
fit.1 <- rpart(reg ~ age + hgt + wgt, method="class", data= fdgs[,-1])

printcp(fit.1) # display the results
plotcp(fit.1) # visualize cross-validation results
summary(fit.1) # detailed summary of splits

# plot tree
par(oma=c(0,0,2,0))
plot(fit.1, uniform=TRUE, margin=0.3, main="Classification Tree for Region (FDGS Data)")
text(fit.1, use.n=TRUE, all=TRUE, cex=1.0)

<center>[[Image:SMHS_Methods2.png|500px]] </center>

# create a better plot of the classification tree
post(fit.1, title = "Classification Tree for Region (FDGS Data)", file = "")

<center>[[Image:SMHS_Methods3.png|500px]] </center>

(2) Pruning the tree

pruned.fit.1<- prune(fit.1, cp= fit.1$\$$cptable[which.min(fit.1$\$$\$$cptable[,"xerror"]),"CP"])

# plot the pruned tree
plot(pruned.fit.1, uniform=TRUE, main="Pruned Classification Tree for Region (FDGS Data)")
text(pruned.fit.1, use.n=TRUE, all=TRUE, cex=1.0)
post(pruned.fit.1, title = "Pruned Classification Tree for Region (FDGS Data)")

Not much change, as the initial tree is not complex!

===Random Forests ===
Random forests may improve predictive accuracy by generating a large number of bootstrapped trees (based on random samples of variables). It classifies cases using each tree in this new "forest", and decides the final predicted outcome by combining the results across all of the trees (an average in regression, a majority vote in classification). See the randomForest package.

library(randomForest)
fit.2 <- randomForest(reg ~ age + hgt + wgt, method="class", na.action = na.omit, data= fdgs[,-1])
print(fit.2) # view results
importance(fit.2) # importance of each predictor

Note on missing values/incomplete data: If the data have missing values, we have 3 choices:

1. Use a different tool (rpart handles missing values well)

2. Impute the missing values

3. For a small number of missing cases, we can use na.action = na.omit

===Latent growth and growth mixture modeling (LGM/GMM)===

LGM and GMM represent structural equation modeling techniques that capture inter-individual differences in longitudinal change corresponding to a particular treatment. For instance, patients’ different timing patterns of the treatment effects may represent the underlying sources of HTE. LGM distinguish if (yes/no) and how (fast/slow, temporary/lasting) patients respond to treatment. The heterogeneous individual growth trajectories are estimated from intra-individual changes over time by examining common population parameters, i.e., slopes, intercepts, and error variances. Suppose each individual has unique initial status (intercept) and response rate (slope) during a specific time interval. Then the variances of the individuals’ baseline measures (intercepts) and changes (slopes) in health outcomes will represent the degree of HTE. The LGM-identified HTE of individual growth curves can be attributed to observed predictors, including both fixed and time varying covariates.

LGM assumes that all individuals are from the same population (too restrictive in some cases). If the HTE is due to observed demographic variables, such as age, gender, and marital status, one may utilize multiple-group LGM. Despite its successful applications for modeling longitudinal change, there may be multiple subpopulations with unobserved heterogeneities. Growth mixture modeling (GMM) extends LGM to allow the identification and prediction of unobserved subpopulations in longitudinal data analysis. Each unobserved subpopulation may constitute its own latent class and behave differently than individuals in other latent classes. Within each latent class, there are also different trajectories across individuals; however, different latent classes don’t share common population parameters. Suppose we are interested in studying retirees’ psychological well-being change trajectory when multiple unknown subpopulations exist. We can add another layer (a latent class variable) on the LGM framework so that the unobserved latent classes can be inferred from the data. The covariates in GMM are designed to affect growth factors distinctly across different latent classes. Therefore, there are two types of HTE: 1) the latent class variable in GMM divides individuals into groups with different growth curves; and 2) coefficient estimates vary across latent classes.

Latent variables are not directly observed – they are inferred (via a model) from other actually observed and directly measured variables. Models that explain observed variables in terms of latent variables are called latent variable models. Then the latent (unobserved) variable is discrete, it’s referred to as latent class variable.

Breast Cancer Example: Recall the LMER package, earlier review discussions, where Linear Mixed Model (LMM) are used for longitudinal data to examine change over time of outcomes according relative to predictive covariates. LMM assumptions include:

<blockquote>(i) continuous longitudinal outcome</blockquote>

<blockquote>(ii) Gaussian random-effects and errors</blockquote>

<blockquote>(iii) linearity of the relationships with the outcome</blockquote>

<blockquote>(iv) homogeneous population</blockquote>

<blockquote>(v) missing at random data</blockquote>

The objectives of LGM/GMM models (see Latent Class Mixed Models, lcmm R package) are to extend the linear mixed model estimation to:

<blockquote>(i) heterogeneous populations (relax (iv) above). Use hlme for latent class linear mixed models (i.e. Gaussian continuous outcome)</blockquote>

<blockquote>(ii) other types of longitudinal outcomes : ordinal, (bounded) quantitative non-Gaussian outcomes (relax (i), (ii), (iii), (iv)). Use lcmm for general latent class mixed models with outcomes of different nature</blockquote>

<blockquote>(iii) joint analysis of a time-to-event (relax (iv), (v)). Use Jointlcmm for joint latent class models with a longitudinal outcome and a right-censored (left-truncated) time-to-event</blockquote>

Let’s use these data (http://www.ats.ucla.edu/stat/data/hdp.csv), representing cancer phenotypes and predictors (e.g., "IL6", "CRP", "LengthofStay", "Experience") and outcome measures (e.g., remission) collected on patients, nested within doctors (DID) and within hospitals (HID).

We can illustrate the latent class linear mixed models implemented in hlme through a study of the quadratic trajectories of the response (remission) with TumorSize, adjusting for CO2*Pain interaction and assuming correlated random-effects for the functions of SmokingHx and Sex. To estimate the corresponding standard linear mixed model using 1 latent class where CO2 interacts with Pain:

# install.packages("lcmm")
library("lcmm")

hdp <- read.csv("http://www.ats.ucla.edu/stat/data/hdp.csv")
hdp <- within(hdp, {
Married <- factor(Married, levels = 0:1, labels = c("no", "yes"))
DID <- factor(DID)
HID <- factor(HID)
})

add a new subject ID column (last column in the data, “ID”), this is necessary for the hmle call
hdp$\$$ID <- seq.int(nrow(hdp))

model.hlme <- hlme(remission ~ IL6 + CRP + LengthofStay + Experience + I(tumorsize^2) + co2*pain + I(tumorsize^2)*pain, random=~ SmokingHx + Sex, subject='ID', data=hdp, ng=1)
summary(model.hlme)

Heterogenous linear mixed model
fitted by maximum likelihood method

hlme(fixed = remission ~ IL6 + CRP + LengthofStay + Experience +
I(tumorsize^2) + co2 * pain + I(tumorsize^2) * pain, random = ~SmokingHx +
Sex, subject = "ID", ng = 1, data = hdp)

Statistical Model:
Dataset: hdp
Number of subjects: 8525
Number of observations: 8525
Number of latent classes: 1
Number of parameters: 21

Iteration process:
Convergence criteria satisfied
Number of iterations: 34
Convergence criteria: parameters= 1.2e-09
: likelihood= 8.3e-06
: second derivatives= 2.7e-05

Goodness-of-fit statistics:
maximum log-likelihood: -5223.9
AIC: 10489.79
BIC: 10637.86

Maximum Likelihood Estimates:

<center>Fixed effects in the Longitudinal Model:

{| class="wikitable" style="text-align:center; " border="1"
|-
| ||coef||Se||Wald||p-value
|-
|Intercept||0.28636||0.24314||1.178||0.23890
|-
|IL6||-0.01134||0.00183||-6.184||0.00000
|-
|CRP||-0.00674||0.00167||-4.043||0.00005
|-
|LengthofStay||-0.04834||0.00463||-10.436||0.00000
|-
|Experience||0.01695||0.00119||14.263||0.00000
|-
|I(tumorsize^2)||0.00000||0.00001||-0.076||0.93953
|-
|co2||-0.03549||0.16204||-0.219||0.82663
|-
|pain||0.03930||0.04278||0.919||0.35832
|-
|co2:pain||-0.01489||0.02871||-0.519||0.60395
|-
|I(tumorsize^2):pain||0.00000||0.00000||0.553||0.58045
|}
</center>

<center>Variance-covariance matrix of the random-effects

{| class="wikitable" style="text-align:center; " border="1"
|-
| ||intercept||SmokingHxformer||SmokingHxnever||Sexmale
|-
|intercept||0.19310943|| || ||
|-
|SmokingHxformer||-0.10617988||0.209155186|| ||
|-
|SmokingHxnever||-0.12388534||0.068342049||2.262655e-01||
|-
|Sexmale||-0.08130975||-0.007353491||-1.873934e-05||0.1730187

|}
</center>

Residual standard error:

coef: 0.1299767

se: 1.187426

Results interpretation:

(1) The first part of the summary provides information about the dataset, the number of subjects, observations, observations deleted (since by default, missing observations are deleted), number of latent classes and number of parameters.

(2) Next, details about the algorithm convergence is provided along with the number of iterations, the convergence criteria, and the information indicating if the model converged correctly: "convergence criteria satisfied".

(3) The maximum log-likelihood, Akaike criterion (AIC) and Bayesian Information criterion (BIC) are reported.

(4) Estimates of parameters, the estimated standard error, the Wald Test statistics (with Normal approximation) and the corresponding p-values are reported below.

(5) For the random-effect distribution, the estimated matrix of covariance of the random-effects is displayed.

(6) The standard error of the residuals is given along with its estimated standard error.

(7) The effect of TumorSize seems not associated with change over Pain of Remission. This may be formally assessed using a multivariate Wald test:

WaldMult(model.hlme, pos=c(6,8))
# pos - a vector containing the indices in model.hlme of the parameters to test
Wald Test p_value
I(tumorsize^2) = pain = 0 0.85562 0.65193

We may consider the model with an adjustment for CRP only on the intercept. Below we estimate the corresponding models for a varying number of latent classes (from 1 to 3) using the default initial values:

# Initial Model: model.hlme <- hlme(remission ~ IL6 + CRP + LengthofStay + Experience + I(tumorsize^2) + co2*pain + I(tumorsize^2)*pain, random=~ SmokingHx + Sex, subject='ID', data=hdp, ng=1)

model.hlme.1 <- hlme(tumorsize ~ IL6 + CRP + LengthofStay, subject='ID', data=hdp, ng=1)
model.hlme.2 <- hlme(tumorsize ~ IL6 + CRP + LengthofStay + SmokingHx, mixture=~ SmokingHx, subject='ID', data=hdp, ng=2)
model.hlme.3 <- hlme(tumorsize ~ IL6 + CRP + LengthofStay + SmokingHx, mixture=~ SmokingHx, subject='ID', data=hdp, ng=3)

The estimation process for a varying number of latent classes can be summarized with summarytable, which gives the log-likelihood, the number of parameters, the Bayesian Information Criterion, and the posterior proportion of each class:

summarytable(model.hlme.1, model.hlme.2, model.hlme.3)
G loglik npm BIC %class1 %class2 %class3
model.hlme.1 1 -33301.82 5 66648.89 100.000000
model.hlme.2 2 -31592.79 11 63285.15 99.214076 0.7859238
model.hlme.3 3 -31589.55 15 63314.86 6.357771 82.2991202 11.34311

The program took 404.65 seconds)

In this example, the optimal number of latent classes according to the BIC is two (the smallest BIC). The posterior classification is described with:

postprob(model.hlme.2)

Posterior classification:
class1 class2
N 8458.00 67.00
% 99.21 0.79

Posterior classification table:
--> mean of posterior probabilities in each class
prob1 prob2
class1 0.8555 0.1445
class2 0.4362 0.5638

Posterior probabilities above a threshold (%):
class1 class2
prob>0.7 92.48 2.99
prob>0.8 77.38 0.00
prob>0.9 38.53 0.00

In this example, the first class includes a posteriori 8458 subjects (99%) while class 2 includes 67 (0.79%) subjects. Subjects were classified in class 1 with a mean posterior probability of 0.8555 %.

In class 1, 92.48% were classified with a posterior probability above 0.7 while 2.99% of the subjects were classified in class 2 with a posterior probability above 0.7. Goodness-of-fit of the model can be assessed by displaying the residuals as in figure and the mean predictions of the model as in figure, according to the time variable given in var.time:

plot(model.hlme.2)
# Figure (left panel)
plot(model.hlme.2, which="fit", var.time="Age", bty="l", ylab=" Remission ", xlab="Age", lwd=2)
# Figure (right panel)
plot(model.hlme.2, which="fit", var.time="Age", bty="l", ylab=" Remission ", xlab="Age", lwd=2, marg=FALSE)

<center>[[Image:SMHS_Methods4.png|500px]] </center>

<center>[[Image:SMHS_Methods5.png|500px]] </center>

<center>[[Image:SMHS_Methods6.png|500px]] </center>

The latent process mixed models implemented in lcmm are illustrated through the study of the linear trajectory of ntumors with Age adjusted for Sex and assuming correlated random-effects for the intercept and Age. Lines estimate the corresponding latent process mixed model with different link functions:

model.hlme.lin <- lcmm(ntumors ~ Age*Sex, random=~ Age ,subject='ID', data=hdp)
model.hlme.beta <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='beta')
model.hlme.spl <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='splines')
model.hlme.spl5q <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='5-quant-splines')

link function: An optional family of link functions. By default,

<li>"linear" option specifies a linear link function leading to a standard linear mixed model (homogeneous or heterogeneous as estimated in hlme). </li>
<li>"beta" for estimating a link function from the family of Beta cumulative distribution functions, "thresholds" for using a threshold model to describe the correspondence between each level of an ordinal outcome and the underlying latent process, and</li>
<li>"Splines" for approximating the link function by I-splines. For this latter case, the number of nodes and the nodes location should be also specified. The number of nodes is first entered followed by,</li>
<li> -, then the location is specified with "equi", "quant" or "manual" for respectively equidistant nodes, nodes at quantiles of the marker distribution or interior nodes entered manually in argument</li>
<li>intnodes. It is followed by - and finally "splines" is indicated. For example, "7-equi-splines" means I-splines with 7 equidistant nodes, "6-quant-splines" means I-splines with 6 nodes located at the quantiles of the marker distribution and "9-manual-splines" means I-splines with 9 nodes, the vector of 7 interior nodes being entered in the argument intnodes.</li>

summary (model.hlme.lin)

General latent class mixed model fitted by maximum likelihood method

lcmm(fixed = ntumors ~ Age * Sex, random = ~Age, subject = "ID",data = hdp)

Statistical Model:
Dataset: hdp
Number of subjects: 8525
Number of observations: 8525
Number of latent classes: 1
Number of parameters: 8
Link function: linear

Iteration process:
Maximum number of iteration reached without convergence
Number of iterations: 100
Convergence criteria: parameters= 5.4e-10
: likelihood= 5.5e-10
: second derivatives= 1

Goodness-of-fit statistics:
maximum log-likelihood: -19915.24
AIC: 39846.49
BIC: 39902.89

Discrete posterior log-likelihood: 0
Discrete AIC: 16

Mean discrete AIC per subject: 9e-04
Mean UACV per subject: 0
Mean discrete LL per subject: 0

Maximum Likelihood Estimates:

Fixed effects in the longitudinal model:

coef Se Wald p-value
intercept (not estimated) 0.00000
Age 0.09491
Sexmale -0.66303
Age:Sexmale 0.01132

Variance-covariance matrix of the random-effects:
intercept Age
intercept 20.5013715
Age -0.2889814 0.007696382

Residual standard error (not estimated) = 1

Parameters of the link function:

coef Se Wald p-value
Linear 1 (intercept) -0.36768
Linear 2 (std err) 0.71432

Objects mlin, mbeta, mspl and mspl3eq are latent process mixed models that assume the exact same trajectory for the underlying latent process but respectively a linear, BetaCDF, I-splines with 5 equidistant knots (default with link=’splines’) and I-splines with 5 knots at percentiles. mlin reduces to a standard linear mixed model (link=’linear’ by default). The only difference with a hlme object is the parameterization for the intercept and the residual standard error that are considered as rescaling parameters.

col <- rainbow(4)
plot(model.hlme.lin, which="linkfunction", bty='l', ylab="Number-of-Tumors", col=col[1], lwd=2, xlab="underlying latent process")
plot(model.hlme.beta, which="linkfunction", add=T, col=col[2], lwd=2)
plot(model.hlme.spl, which="linkfunction", add=T, col=col[3], lwd=2)
plot(model.hlme.spl5q, which="linkfunction", add=T, col=col[4], lwd=2)
legend(x="topleft",legend=c("linear", "beta","splines (5equidistant)", "splines (5 at quantiles)"), lty=1,col=col,bty="n",lwd=2)

# to obtain confidence bands use function predictlink
link.lin <- predictlink(model.hlme.lin, ndraws=2000)

Error in predictlink.lcmm(model.hlme.spl, ndraws = 2000):
No confidence intervals can be produced since the program did not converge properly

model.hlme.lin$\$$conv # double-check the convergence of the algorithm[1] 2
# status of convergence:
# =1 if the convergence criteria were satisfied,
# =2 if the maximum number of iterations was reached,
# =4 or 5 if a problem occured during optimisation

model.hlme.lin <- lcmm(ntumors ~ Age*Sex, random=~ Age ,subject='ID', epsY = 0.5, convB = 1e-01, convL = 1e-01, convG = 1e-01, maxiter=200, data=hdp); model.hlme.lin$conv

# Now that we have convergence, we can obtain CI’s!!!
link.lin <- predictlink(model.hlme.lin, ndraws=2000)

# plot(model.hlme.lin, which="linkfunction", bty='l', ylab="Number-of-Tumors", col=col[1], lwd=2, xlab="underlying latent process")
plot(link.lin, add=TRUE, col=col[1], lty=2, lwd=2)
legend(x="left", legend=c("95% confidence bands", "for linear fit"), lty=c(2,NA), col=c(col[1],NA), bty="n", lwd=2)

<center>[[Image:SMHS_Methods7.png|500px]] </center>

# Repeat using the other link functions … model.hlme.beta, model.hlme.spl, …
model.hlme.beta <- lcmm(ntumors ~ Age*Sex, random=~ Age, subject='ID', data=hdp, link='beta',
convB = 1e-01, convL = 1e-01, convG = 1e-01, maxiter=200); model.hlme.beta$\$$conv
link.beta <- predictlink(model.hlme.beta, ndraws=2000)
plot(link.beta, add=TRUE, col=col[2], lty=2, lwd=2)
legend(x="left", legend=c("95% confidence bands", "for BETA fit"), lty=c(3,NA), col=c(col[2],NA), bty="n", lwd=1)

===[[SMHS_MethodsHeterogeneity_MetaAnalysis|Next see: Meta-Analysis]]===
* [[SMHS_MethodsHeterogeneity|Back to the Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research section]]

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php/SMHS_MethodsHeterogeneity_HTE}}

SMHS MethodsHeterogeneity

2016-05-19T14:40:58Z

Imoubara:

==[[SMHS| Scientific Methods for Health Sciences]] - Methods for Studying Heterogeneity of Treatment Effects, Case-Studies of Comparative Effectiveness Research ==

==Methods and Approaches for HTE Analytics==

<center>
{| class="wikitable" style="text-align:center; width:99%" border="1"
! colspan="8" |Methods and Approaches for HTE Analytics ****
|-
|||Meta-analysis||CART*||N of 1 trials||LGM/GMM**||QTE***||Nonparametric||Predictive risk models
|-
|Intent of the Analysis||Exploratory and confirmatory||Exploratory||Exploratory and initial testing||"Exploratory, initial testing, and confirmatory"||"Exploratory, initial testing, & confirmatory"||Exploratory and confirmatory||Initial testing and confirmatory
|-
|Data Structure ||"Trial summary results, possibly with subgroup results"||Panel or cross-section||Repeated measures for a single patient: time series||Time series and panel||Panel and cross-sectional||"Panel, time series, and cross-sectional"||Panel or cross-sectional
|-
|Data Size Consideration ||Advantage of combining small sample sizes||Large sample sizes||Small sample sizes||LGM: small to large sample sizes; GMM: Large sample sizes ||Moderate to large sample sizes||Large sample sizes||Sample sizes depends on specific risk function
|-
|Key Strength(s)||Increase statistical power by pooling of results||Does not require assumptions around normality of distribution Can utilize different types of response variables; Possible to identify HTE across trials Possibility to measure and explain covariate's effect on treatment effect ||Patient is own control; Estimates patient-specific effects ||Accounting for unobserved characteristics Heterogeneous response across time||Robust to outcome outliers Heterogeneous response across quantiles||No functional form assumptions Flexible regressions||Multivariate approach to identifying risk factors or HTE
Estimates patient-specific effects
|-
|Key Limitation(s)||Included studies need to be similar enough to be meaningful Assumed distribution; Selection bias||Fairly sensitive to changes in underlying data May not fully identify additive impacts of multiple variables||Requires de novo study Not applicable to all conditions or treatments||Criteria for optimization solutions not clear||"Treatment effect designed for a quantile, not a specific patient"||Computationally demanding Smoothing parameters required for kernel methods||May be more or less interpretable or useful clinically
|}
</center>

<li> *CART: Classification and regression tree (CART) analysis</li>
<li> LGM/GMM: Latent growth modeling/Growth mixture modeling.</li>
<li> QTE: Quantile Treatment Effect.</li>
<li> Standard meta-analysis like fixed and random effect models, and tests of heterogeneity, together with various plots and summaries, can be found in the [http://cran.r-project.org/web/packages/rmeta R-package rmeta]. Non-parametric R approaches are included in the [http://cran.r-project.org/web/packages/np/vignettes/np.pdf np package]. </li>

Additional details are provided in a paper entitled [http://dx.doi.org/10.1186/1471-2288-12-185 From concepts, theory, and evidence of heterogeneity of treatment effects to methodological approaches: a primer].

==[[SMHS_MethodsHeterogeneity_HTE |HTE Analytics, Latent growth and growth mixture modeling (LGM/GMM)]]==

==[[SMHS_MethodsHeterogeneity_MetaAnalysis |Meta-analysis]]==

==[[SMHS_MethodsHeterogeneity_CER| Comparative Effectiveness Research (CER)]]==

<hr>
* SOCR Home page: http://www.socr.umich.edu

{{translate|pageName=http://wiki.socr.umich.edu/index.php/SMHS_MethodsHeterogeneity_HTE}}

SMHS SciVisualization NetworkViz

2016-05-19T14:30:22Z

Imoubara: /* See Next */

==[[SMHS_SciVisualization| SMHS Scientific Visualization]] - Complex Network Visualization ==

===Background===
[[SMHS_SciVisualization_SOCR_Excel_R_Charts|First see the SOCR, Excel and R charts section]].

# Install package
# install.packages("igraph")
library("igraph")

# build a simple graph
g <- graph( c(1,2, 1,3, 2,3, 3,4), n=10)
plot(g)

summary(g); g; is.igraph(g); is.directed(g); vcount(g); ecount(g)

<center>[[Image:SMHS_SciVisualization38.png|300px]] </center>

<center>[[Image:SMHS_SciVisualization39.png|300px]] </center>

plot(g, layout=layout.circle)

plot(g, layout=layout.fruchterman.reingold)
plot(g, layout=layout.graphopt)
plot(g, layout=layout.kamada.kawai, vertex.color="cyan")

# Interactive
tkplot(g, layout=layout.kamada.kawai)
# 3D plot
rglplot(g, layout=layout.kamada.kawai(g))

Dataset 1: Coappearance network in the novel “les miserablese”.

D. E. Knuth, The Stanford GraphBase: A Platform for Combinatorial Computing, Addison-Wesley, Reading, MA (1993).

The data contains the weighted network of coappearances of characters in Victor Hugo's novel "Les Miserables".

Nodes represent characters as indicated by the labels and edges connect any pair of characters that appear in the same chapter of the book. The values on the edges are the number of such coappearances.

Alternatively, we can use a directed, weighted network representing the neural network of the nematode

C. Elegans. D. Watts and S. Strogatz, Nature 393, 440-442 (1998).

The file celegansneural.gml describes a weighted, directed network where the nodes have been renumbered to be consecutive.

Edge weights are the weights given by Watts.

install.packages("rgl")
library("igraph")

g<-read.graph("C:\\Users\\Dinov\\Desktop\\celegansneural.gml",format=c("gml"))
g
plot(g, layout=layout.graphopt)

data_g <- read.table("https://umich.instructure.com/files/330389/download?download_frd=1&verifier=u1jqCGS8AAU0MsO5ffLCyvVFYXXAflpdLtg8RXhk", sep=" ", header = FALSE)

data_g_mat <- as.matrix(data_g, byrow=TRUE, nc=2)
g_miserab <- graph.edgelist(data_g_mat, dir=FALSE)
summary(g_miserab)
plot(g_miserab, layout=layout.graphopt)
# rglplot(g_miserab, layout=layout.kamada.kawai(g_miserab))

# to name the vertices and and plot the graph of the first 10 vertices
V(g_miserab)$\$$name
g_miserab.1 <- graph.ring(10)
V(g_miserab.1)$\$$name <- sample(letters, vcount(g_miserab.1))
plot(g_miserab.1, layout=layout.graphopt)

# compute the node adjacency matrix
g <- g_miserab; as_adjacency_matrix(g)
E(g)$\$$weight <- runif(ecount(g))
W <- get.adjacency(g, attr="weight")
W

===Social Network Analysis Example===

# free memory
# rm(list = ls())
# gc()

# load termDocMatrix dataset
# These data include Twitter text data of @RDataMining representing a general social network analysis
# example. The terms represent people and the tweets represent LinkedIn groups.
# The term-document matrix can be viewed as the group membership of people.
# We may want to build a network of terms based on their co-occurrence in the same tweets,
# similarly to a network of people based on their group membership.
# https://umich.instructure.com/files/541336/download?download_frd=1

load("E:\\Ivo.dir\\Research\\UMichigan\\Education_Teaching_Curricula\\2015_2016\\HS_853_Fall_2015\\Modules_docx\\data\\03_GraphNetwork_TermDocMatrix.rdata")

<center>Labeled graph [[Image:SMHS_SciVisualization40.png|300px]] </center>

<center>Adjacency matrix [[Image:SMHS_SciVisualization41.png|300px]] Coordinates are 1-6.</center>

# inspect part of the matrix
termDocMatrix [5:10,1:20]
# change it to a Boolean matrix == incidence matrix
termDocMatrix [termDocMatrix >=1] <- 1

# transform into a term-term adjacency matrix (n×n), where (i,j)th entries correspond to the number of edges
# node from xi to node xj.
# Matrix Multiplication in R: http://www.statmethods.net/advstats/matrix.html, dim(t(termDocMatrix))
termMatrix <- termDocMatrix %*% t(termDocMatrix)

# A graph has no loops, when all entries of the adjacency matrix on the main diagonal of are zeroes
# http://mathonline.wikidot.com/adjacency-matrices
diag(termMatrix)

# The matrix product of incidence matrix (B) and it’s transpose B×B^T represents the degrees of all nodes!
# inspect terms numbered 5 to 10
termMatrix[5:10,5:10]

# library("igraph")
# build a graph from the adjacency matrix
g <- graph.adjacency(termMatrix, weighted=T, mode="undirected")
plot(g)

# remove loops
g <- simplify(g); plot(g)

# set labels and degrees of V(g)
V(g)$\$$label <- V(g)$\$$name
V(g)$\$$degree <- degree(g)

# set seed to make the layout reproducible
set.seed(1953)
layout1 <- layout.fruchterman.reingold(g) # Fruchterman-Reingold layout
plot(g, layout=layout1)

# plot(g, layout=layout.kamada.kawai)
# tkplot(g, layout=layout.kamada.kawai)

<center>[[Image:SMHS_SciVisualization42.png|400px]] </center>

# Finesse the graph appearance – vertices and edges
V(g)$\$$label.cex <- 2.2 * V(g)$\$$degree / max(V(g)$\$$degree)+ .2
V(g)$\$$label.color <- rgb(0, 0, .2, .8)
V(g)$\$$frame.color <- rgb(0,0,1)
egam <- (log(E(g)$\$$weight)+.4) / max(log(E(g)$\$$weight)+.4)
E(g)$\$$color <- rgb(.5, .5, 0, egam) # Graph Edges, E(g)
E(g)$\$$width <- egam
# plot the graph in layout1
plot(g, layout=layout1)

V(g)$\$$label <- V(g)$\$$name
V(g)$\$$label.color <- rgb(0, 0, 0, 0.5)
V(g)$\$$label.dist <- 1.0 # relative distance of labels from node center
V(g)$\$$label.angle<- 3/8 #in radians
V(g)$\$$label.cex <- 1.4*V(g)$\$$degree/max(V(g)$\$$degree) + 1
V(g)$\$$color <- rgb(1, 0, 0, .4)
V(g)$\$$size <- 22 * V(g)$\$$degree / max(V(g)$\$$degree)+ 2
V(g)$\$$shape <- "rectangle"
# V(g)$\$$.size=10*(strwidth(V(g)$\$$label) + strwidth("oo")) * 10
# V(g)$\$$.size2=strheight("I") * 10
V(g)$\$$frame.color <- NA
# set vertex labels and their colors and sizes
# set edge width and color
E(g)$\$$width <- .3
E(g)$\$$color <- rgb(.5, .5, 0, .3)

set.seed(1234)
plot(g, layout=layout.fruchterman.reingold)

<center>[[Image:SMHS_SciVisualization43.png|400px]] </center>

===Hands-on activity (oncological primary doctor and a second-opinion)===

We use some of the Stanford Real Graph Data (http://snap.stanford.edu/data/) or this graph data on cancer patients seen by a primary doctor and a second-opinion doctor, stage of the disease, and diagnostic agreement between primary and secondary oncologist: Primary, Secondary, Stage, DxAgreement

# 03_GraphData_Health.txt
healthGraphTable <- read.table("https://umich.instructure.com/files/554234/download?download_frd=1", sep='\t', dec=',', header=T)
#specify the path, separator(tab, comma, ...), decimal point symbol, etc.

<center>head(healthGraphTable)
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Primary||Secondary||Stage||DxAgreement
|-
|1||AA||DD||3||Y
|-
|2||AB||DD||3||R
|-
|3||AF||BA||3||Q
|-
|4||DD||DA||3||Q
|-
|5||CD||EC||3||X
|-
|6||DD||CE||3||Y

|}
</center>

# Transform the table into the required graph format:
healthGraph.network<-graph.data.frame(healthGraphTable, directed=F)
# the 'directed' attribute specifies whether the edges are directed
# or equivalent irrespective of the position (1st vs 2nd column). For directed graphs use 'directed=T'

# Inspect the data:
V(healthGraph.network) <blockquote># prints the list of vertices (physicians/oncologists)</blockquote>
E(healthGraph.network) <blockquote># prints the list of edges (primary-secondary relationships)</blockquote>
degree(healthGraph.network) <blockquote># print the number of edges (relationships) per node (physician)</blockquote>

# first plot of graph
plot(healthGraph.network)

#Subset the data. If we want to exclude only physicians who are mostly outside of the network
# i.e., participate only tangentially (with 1 or 2 relationships only)
# we can exclude nodes by subsetting the graph on the basis of the node/physician’s 'degree':
healthGraph.out.network <- V(healthGraph.network)[degree(healthGraph.network)<=2]
#identify those vertices part of less than or equal to 2 connections (edges)
healthGraph.in.network <- delete.vertices(healthGraph.network, healthGraph.out.network)
#exclude them from the graph

# Plot the data by specifying certain details about the graph, e.g., separate some nodes (people) by color:
V(healthGraph.in.network)$\$$color <- ifelse(V(healthGraph.in.network)$\$$name=='CA', 'blue', 'red')
#useful for highlighting certain people. Works by matching the name attribute of the vertex to the one specified in the 'ifelse' expression
# We can also color the connecting edges differently depending on the 'Stage':
E(healthGraph.in.network)$\$$color<-ifelse(E(healthGraph.in.network)$\$$Stage>3, "red", "grey")
# or depending on the different diagnostic agreement labels ('DxAgreement'):
E(healthGraph.in.network)$\$$color<-ifelse(E(healthGraph.in.network)$\$$DxAgreement =='X', "red", ifelse(E(healthGraph.in.network)$\$$DxAgreement=='Y', "blue", "grey"))

# Note: the example uses nested ifelse expressions which can be improved
# Additional attributes like size can be further specified in an analogous manner:
V(healthGraph.in.network)$\$$size<-degree(healthGraph.in.network)/10
#here the size of the vertices is specified by the degree of the vertex, so that people supervising more have get proportionally bigger dots. Getting the right scale gets some playing around with the parameters of the scale function (from the 'base' package)

# Note that if the same attribute is specified beforehand and inside the function, the former will be overridden.
# And finally the plot itself:
par(mai=c(0,0,1,0))
#this specifies the size of the margins, default settings leave too much free space on all sides
plot(healthGraph.in.network, #the graph to be plotted
layout=layout.fruchterman.reingold, # the layout method. see the igraph documentation for details
main='Onco Physician Network Example', #specifies the title
vertex.label.dist=0.5, #puts the name labels slightly off the dots
vertex.frame.color='blue', #the color of the border of the dots
vertex.label.color='black', #the color of the name labels
vertex.label.font=2, #the font of the name labels
vertex.label=V(healthGraph.in.network)$\$$name, #specifies the labels of the vertices
vertex.label.cex=1 #specifies the size of the font of the labels
)

# Save or export the plot as a metafile to the clipboard, a pdf or png (and other formats).
png(filename="org_network.png", height=1900, width=1200) #call the png writer
# alternatively print to high-res PDF file # pdf(file="org_network.pdf")

#run the plot

dev.off() #don’t forget to close the device

==Pathway analysis==

Pathway analysis is a technique that reduces complexity and increased explanatory power in studies examining underlying biological structure of differentially expressed genes and proteins.

# install package
# install.packages("dendsort") – contains the “” dataset
# Data: Sample data matrix from the integrated pathway analysis of gastric cancer from the
# Cancer Genome Atlas (TCGA) study. A multivariate table obtained from the integrated pathway analysis
# of gastric cancer from the Cancer Genome Atlas (TCGA) study. Each column represents a pathway
# consisting of a set of genes and each row represents a cohort of samples based on specific clinical
# or genetic features. For each pair of a pathway and a feature, a continuous value of between
# 1 and -1 is assigned to score positive or negative association, respectively.
# A data frame with 215 rows and 117 variables

library("dendsort")
data(sample_tcga)
dataTable <- t(sample_tcga)
head(dataTable)
write.csv(dataTable, "E:\\Ivo.dir\\Research\\UMichigan\\Education_Teaching_Curricula\\2015_2016\\HS_853_Fall_2015\\Modules_docx\\data\\03_TCGA_Data_117x215.csv")
# data.new <- read.csv("https://umich.instructure.com/files/330393/download?download_frd=1")

# install SPIA package: http://bioconductor.org/packages/2.6/bioc/html/SPIA.html
# source("http://bioconductor.org/biocLite.R")
# biocLite("SPIA")
library("SPIA")

# “top” Colorectal cancer dataset provided by SPIA package.
data(Vessels)
head(top)
# pathway analysis based on combined evidence;
# use nB=2000 or more for more accurate results
res<-spia(de=DE_Vessels,all=ALL_Vessels,organism="hsa",nB=500,plots=FALSE,beta=NULL,verbose=FALSE)
#make the output fit this screen
res$\$$Name=substr(res$\$$Name,1,10)
#show first 15 pathways, omitting KEGG links
res[1:15,-12]

==GIS/Distortion mapping==

# install the R GISTools package
# install.packages("GISTools")
library("GISTools")
data(georgia)
…

Java Applet: http://www.socr.ucla.edu/htmls/SOCR_Cartograhy.html
Activities: http://wiki.stat.ucla.edu/socr/index.php/SOCR_Cartography_Project

==Circos Connectogram/Table visualization==

Circular chord/ribbon diagrams present a mechanism to visualize numeric tables containing information of directional relations. This type of chart visualizes tables in a circular way. Sectors of the plot is union(rownames(mat), colnames(mat)). When there is no rowname or colname, the chart assigns names for it (rows could be auto-named as "R1", "R2", ... and columns may be named as "C1", "C2").

• Circos: http://circos.ca

• R circlize: http://cran.r-project.org/web/packages/circlize/circlize.pdf

===Example Early-Onset Alzheimer’s Disease===

Recent studies examined the Interactions between imaging (Structural Brain Change) and genetics (SNP) biomarkers in Early-Onset Alzheimer's Disease Subjects. Circular representation of the significant SNP-Neuroimaging interactions. The left and right parts of the graph contain the 15-ROI imaging markers and the 20-SNP genotypes, respectively. The strength of the connection between each SNP-ROI pair is presented as a ribbon, whose size, color and location are proportional to -log (p). Clearly, there are a lot of spurious effects (skinny red lines on background) and several significantly strong associations (thicker purple ribbons on foreground), e.g., purple association between SNP_5 (rs7718456) and ROI_10 (L_hippocampus, Volume). SNP: single nucleotide polymorphism, ROI: region of interest.

<center>[[Image:SMHS_SciVisualization44.png|400px]] </center>

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|SNPROI||ROI_1||ROI_2||ROI_3||ROI_4||ROI_5||ROI_6||ROI_7||ROI_8||ROI_9||ROI_10||ROI_11||ROI_12||ROI_13||ROI_14||ROI_15
|-
|rs17029131||10||10||10||10||10||10||10||10||10||10||188||10||10||10||10
|-
|rs1822144||10||10||10||10||10||200||10||10||10||10||188||10||10||10||10
|-
|rs6446443||10||10||10||126||113||10||10||113||10||10||10||10||10||10||10
|-
|rs12506164||10||10||10||10||10||167||10||10||10||10||10||10||10||10||10
|-
|rs7718456||10||202||144||206||10||10||10||169||225||321||10||10||290||10||10
|-
|rs9377090||10||145||10||10||10||10||10||153||10||10||10||10||10||10||10
|-
|rs2776932||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs4933672||10||10||113||10||10||10||10||10||10||10||10||232||10||10||10
|-
|rs11193270||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs11193272||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs11193274||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs12218153||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs1338956||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs1338025||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs12101936||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs16964473||10||10||10||10||10||10||10||10||10||10||112||10||10||10||10
|-
|rs12972537||10||10||10||10||10||10||125||10||10||10||126||10||10||10||10
|-
|rs2212356||10||10||10||10||10||10||10||10||10||10||10||129||10||10||10
|-
|rs2831165||10||10||10||10||10||10||10||10||10||10||10||10||10||10||169
|-
|rs1266320||10||120||10||10||10||10||10||10||10||145||10||10||10||10||129
|}
</center>

# install.packages("circlize")
library("circlize")

# 03_CircularTable_EOAD_Data.csv
EOAD_data <- read.csv("https://umich.instructure.com/files/330388/download?download_frd=1", sep=",", row.names=1, header = TRUE)

rownames(EOAD_data)
colnames(EOAD_data)
EOAD_matrix <- as.matrix(EOAD_data)

### graphics settings
# par(mfrow = c(3, 2))
# par(mar = c(1, 1, 1, 1))
chordDiagram(EOAD_matrix)

circos.clear()
circos.par(gap.degree = c(rep(2, nrow(EOAD_matrix)-1), 10, rep(2, ncol(EOAD_matrix)-1), 10))
chordDiagram(EOAD_matrix)

circos.clear()
circos.par(start.degree = 90)
chordDiagram(EOAD_matrix)

circos.clear()
# chordDiagram(EOAD_matrix, order = c("ROI_1", "ROI_2", "ROI_3", "ROI_4", "ROI_5", "ROI_6", "ROI_7", "ROI_8", "ROI_9", "ROI_10", "ROI_11", "ROI_12", "ROI_13", "ROI_14", "ROI_15"))
chordDiagram(EOAD_matrix, directional = TRUE)
chordDiagram(EOAD_matrix, directional = TRUE, diffHeight = 0.06)

circos.clear()

### colors settings
rand_color = function(n, alpha = 1) {
return(rgb(runif(n), runif(n), runif(n), alpha = alpha))
}

par(mfrow = c(2, 2))
par(mar = c(1, 1, 1, 1))
grid.col = NULL

# random grid/sector and ribbon/chord colors
col_mat = rand_color(length(EOAD_matrix), alpha = 0.5)
grid_col = rand_color(length(rownames(EOAD_matrix)) + length(colnames(EOAD_matrix)), alpha = 0.5)
dim(col_mat) = dim(EOAD_matrix)
chordDiagram(EOAD_matrix, grid.col = grid_col, col = col_mat)

# grid/sector and ribbon/chord colors according to cell values
# Generate quantile values for the color mapping relative to table cell-values
seqs <- seq(0.92, 1, 0.008)

chordDiagram(EOAD_matrix, grid.col = grid_col, col = colorRamp2(quantile(EOAD_matrix, seqs), rev(heat.colors(11))), transparency = 0.5)
circos.clear()

<center>[[Image:SMHS_SciVisualization46.png|500px]] </center>

===Practice===

Repeat these charts using the 03_NIPS_Baby_VitK_Shot_DataSummaryAnalysis_March2012_Short.csv dataset (Appendix), https://umich.instructure.com/files/330392/download?download_frd=1

==Graphical Workflow Protocol Visualization==

(1) Brain Imaging & Genetics Data:

a. ADNI: http://adni.loni.usc.edu/

b. PPMI: http://ppmi-info.org/

c. XNAT Central: https://central.xnat.org/

d. Pipeline Data (see client library)

e. Cloud Services (AWS/Box/Drive)

(2) Pipeline Environment

a. http://pipeline.loni.usc.edu/

b. Web-Java Client: http://pipeline.loni.usc.edu/products-services/pws/

c. Videos: http://pipeline.loni.usc.edu/learn/basic-videos/

d. Publications: http://pipeline.loni.usc.edu/get-started/acknowledgmentscredits/

(3) End-to-end Computational workflows

a. Navigator: http://pipeline.loni.usc.edu/explore/library-navigator/

b. Detailed Descriptions: http://wiki.loni.usc.edu/twiki/bin/view/CCB/PipelineWorkflows

<center>[[Image:SMHS_SciVisualization47.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization48.png|500px]] </center>

==Appendix==

===Neonate Infant Pain Score (NIPS) Data (Vitamin K shots) Dataset===

<center>A short version of the Neonate Infant Pain Score (NIPS) Data (Vitamin K shots) dataset, http://wiki.socr.umich.edu/index.php/SOCR_Data_NIPS_InfantVitK_ShotData
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|Index||Immediate||30_Sec||60_Sec||120_Sec||TotalCryTime
|-
|1||6||7||6||2||63
|-
|2||5||1||2||0||0
|-
|3||7||6||6||7||54
|-
|4||3||7||3||0||27
|-
|5||7||5||6||0||19
|-
|6||6||6||6||2||2
|-
|7||7||7||6||0||46
|-
|8||6||7||0||0||33
|-
|9||5||0||4||0||56
|-
|10||7||7||7||6||63
|-
|105||6||0||0||0||11
|-
|106||7||6||0||0||59
|-
|107||7||4||4||0||28
|-
|108||7||7||7||1||64
|-
|109||7||0||0||0||8
|-
|110||5||0||1||3||64
|-
|111||7||5||7||7||72
|-
|112||4||2||0||2||50
|-
|113||7||6||7||0||44
|-
|114||7||1||0||0||11
|}
</center>

==See Next==
* [[SMHS_SciVisualization| Back to the Scientific Visualization section]]
* [[SMHS| Back to the Scientific Methods for Health Sciences EBook ToC]]

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_SciVisualization_SOCR_Excel_R_Charts}}

SMHS SciVisualization NetworkViz

2016-05-19T14:08:38Z

Imoubara: /* Background */

==[[SMHS_SciVisualization| SMHS Scientific Visualization]] - Complex Network Visualization ==

===Background===
[[SMHS_SciVisualization_SOCR_Excel_R_Charts|First see the SOCR, Excel and R charts section]].

# Install package
# install.packages("igraph")
library("igraph")

# build a simple graph
g <- graph( c(1,2, 1,3, 2,3, 3,4), n=10)
plot(g)

summary(g); g; is.igraph(g); is.directed(g); vcount(g); ecount(g)

<center>[[Image:SMHS_SciVisualization38.png|300px]] </center>

<center>[[Image:SMHS_SciVisualization39.png|300px]] </center>

plot(g, layout=layout.circle)

plot(g, layout=layout.fruchterman.reingold)
plot(g, layout=layout.graphopt)
plot(g, layout=layout.kamada.kawai, vertex.color="cyan")

# Interactive
tkplot(g, layout=layout.kamada.kawai)
# 3D plot
rglplot(g, layout=layout.kamada.kawai(g))

Dataset 1: Coappearance network in the novel “les miserablese”.

D. E. Knuth, The Stanford GraphBase: A Platform for Combinatorial Computing, Addison-Wesley, Reading, MA (1993).

The data contains the weighted network of coappearances of characters in Victor Hugo's novel "Les Miserables".

Nodes represent characters as indicated by the labels and edges connect any pair of characters that appear in the same chapter of the book. The values on the edges are the number of such coappearances.

Alternatively, we can use a directed, weighted network representing the neural network of the nematode

C. Elegans. D. Watts and S. Strogatz, Nature 393, 440-442 (1998).

The file celegansneural.gml describes a weighted, directed network where the nodes have been renumbered to be consecutive.

Edge weights are the weights given by Watts.

install.packages("rgl")
library("igraph")

g<-read.graph("C:\\Users\\Dinov\\Desktop\\celegansneural.gml",format=c("gml"))
g
plot(g, layout=layout.graphopt)

data_g <- read.table("https://umich.instructure.com/files/330389/download?download_frd=1&verifier=u1jqCGS8AAU0MsO5ffLCyvVFYXXAflpdLtg8RXhk", sep=" ", header = FALSE)

data_g_mat <- as.matrix(data_g, byrow=TRUE, nc=2)
g_miserab <- graph.edgelist(data_g_mat, dir=FALSE)
summary(g_miserab)
plot(g_miserab, layout=layout.graphopt)
# rglplot(g_miserab, layout=layout.kamada.kawai(g_miserab))

# to name the vertices and and plot the graph of the first 10 vertices
V(g_miserab)$\$$name
g_miserab.1 <- graph.ring(10)
V(g_miserab.1)$\$$name <- sample(letters, vcount(g_miserab.1))
plot(g_miserab.1, layout=layout.graphopt)

# compute the node adjacency matrix
g <- g_miserab; as_adjacency_matrix(g)
E(g)$\$$weight <- runif(ecount(g))
W <- get.adjacency(g, attr="weight")
W

===Social Network Analysis Example===

# free memory
# rm(list = ls())
# gc()

# load termDocMatrix dataset
# These data include Twitter text data of @RDataMining representing a general social network analysis
# example. The terms represent people and the tweets represent LinkedIn groups.
# The term-document matrix can be viewed as the group membership of people.
# We may want to build a network of terms based on their co-occurrence in the same tweets,
# similarly to a network of people based on their group membership.
# https://umich.instructure.com/files/541336/download?download_frd=1

load("E:\\Ivo.dir\\Research\\UMichigan\\Education_Teaching_Curricula\\2015_2016\\HS_853_Fall_2015\\Modules_docx\\data\\03_GraphNetwork_TermDocMatrix.rdata")

<center>Labeled graph [[Image:SMHS_SciVisualization40.png|300px]] </center>

<center>Adjacency matrix [[Image:SMHS_SciVisualization41.png|300px]] Coordinates are 1-6.</center>

# inspect part of the matrix
termDocMatrix [5:10,1:20]
# change it to a Boolean matrix == incidence matrix
termDocMatrix [termDocMatrix >=1] <- 1

# transform into a term-term adjacency matrix (n×n), where (i,j)th entries correspond to the number of edges
# node from xi to node xj.
# Matrix Multiplication in R: http://www.statmethods.net/advstats/matrix.html, dim(t(termDocMatrix))
termMatrix <- termDocMatrix %*% t(termDocMatrix)

# A graph has no loops, when all entries of the adjacency matrix on the main diagonal of are zeroes
# http://mathonline.wikidot.com/adjacency-matrices
diag(termMatrix)

# The matrix product of incidence matrix (B) and it’s transpose B×B^T represents the degrees of all nodes!
# inspect terms numbered 5 to 10
termMatrix[5:10,5:10]

# library("igraph")
# build a graph from the adjacency matrix
g <- graph.adjacency(termMatrix, weighted=T, mode="undirected")
plot(g)

# remove loops
g <- simplify(g); plot(g)

# set labels and degrees of V(g)
V(g)$\$$label <- V(g)$\$$name
V(g)$\$$degree <- degree(g)

# set seed to make the layout reproducible
set.seed(1953)
layout1 <- layout.fruchterman.reingold(g) # Fruchterman-Reingold layout
plot(g, layout=layout1)

# plot(g, layout=layout.kamada.kawai)
# tkplot(g, layout=layout.kamada.kawai)

<center>[[Image:SMHS_SciVisualization42.png|400px]] </center>

# Finesse the graph appearance – vertices and edges
V(g)$\$$label.cex <- 2.2 * V(g)$\$$degree / max(V(g)$\$$degree)+ .2
V(g)$\$$label.color <- rgb(0, 0, .2, .8)
V(g)$\$$frame.color <- rgb(0,0,1)
egam <- (log(E(g)$\$$weight)+.4) / max(log(E(g)$\$$weight)+.4)
E(g)$\$$color <- rgb(.5, .5, 0, egam) # Graph Edges, E(g)
E(g)$\$$width <- egam
# plot the graph in layout1
plot(g, layout=layout1)

V(g)$\$$label <- V(g)$\$$name
V(g)$\$$label.color <- rgb(0, 0, 0, 0.5)
V(g)$\$$label.dist <- 1.0 # relative distance of labels from node center
V(g)$\$$label.angle<- 3/8 #in radians
V(g)$\$$label.cex <- 1.4*V(g)$\$$degree/max(V(g)$\$$degree) + 1
V(g)$\$$color <- rgb(1, 0, 0, .4)
V(g)$\$$size <- 22 * V(g)$\$$degree / max(V(g)$\$$degree)+ 2
V(g)$\$$shape <- "rectangle"
# V(g)$\$$.size=10*(strwidth(V(g)$\$$label) + strwidth("oo")) * 10
# V(g)$\$$.size2=strheight("I") * 10
V(g)$\$$frame.color <- NA
# set vertex labels and their colors and sizes
# set edge width and color
E(g)$\$$width <- .3
E(g)$\$$color <- rgb(.5, .5, 0, .3)

set.seed(1234)
plot(g, layout=layout.fruchterman.reingold)

<center>[[Image:SMHS_SciVisualization43.png|400px]] </center>

===Hands-on activity (oncological primary doctor and a second-opinion)===

We use some of the Stanford Real Graph Data (http://snap.stanford.edu/data/) or this graph data on cancer patients seen by a primary doctor and a second-opinion doctor, stage of the disease, and diagnostic agreement between primary and secondary oncologist: Primary, Secondary, Stage, DxAgreement

# 03_GraphData_Health.txt
healthGraphTable <- read.table("https://umich.instructure.com/files/554234/download?download_frd=1", sep='\t', dec=',', header=T)
#specify the path, separator(tab, comma, ...), decimal point symbol, etc.

<center>head(healthGraphTable)
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Primary||Secondary||Stage||DxAgreement
|-
|1||AA||DD||3||Y
|-
|2||AB||DD||3||R
|-
|3||AF||BA||3||Q
|-
|4||DD||DA||3||Q
|-
|5||CD||EC||3||X
|-
|6||DD||CE||3||Y

|}
</center>

# Transform the table into the required graph format:
healthGraph.network<-graph.data.frame(healthGraphTable, directed=F)
# the 'directed' attribute specifies whether the edges are directed
# or equivalent irrespective of the position (1st vs 2nd column). For directed graphs use 'directed=T'

# Inspect the data:
V(healthGraph.network) <blockquote># prints the list of vertices (physicians/oncologists)</blockquote>
E(healthGraph.network) <blockquote># prints the list of edges (primary-secondary relationships)</blockquote>
degree(healthGraph.network) <blockquote># print the number of edges (relationships) per node (physician)</blockquote>

# first plot of graph
plot(healthGraph.network)

#Subset the data. If we want to exclude only physicians who are mostly outside of the network
# i.e., participate only tangentially (with 1 or 2 relationships only)
# we can exclude nodes by subsetting the graph on the basis of the node/physician’s 'degree':
healthGraph.out.network <- V(healthGraph.network)[degree(healthGraph.network)<=2]
#identify those vertices part of less than or equal to 2 connections (edges)
healthGraph.in.network <- delete.vertices(healthGraph.network, healthGraph.out.network)
#exclude them from the graph

# Plot the data by specifying certain details about the graph, e.g., separate some nodes (people) by color:
V(healthGraph.in.network)$\$$color <- ifelse(V(healthGraph.in.network)$\$$name=='CA', 'blue', 'red')
#useful for highlighting certain people. Works by matching the name attribute of the vertex to the one specified in the 'ifelse' expression
# We can also color the connecting edges differently depending on the 'Stage':
E(healthGraph.in.network)$\$$color<-ifelse(E(healthGraph.in.network)$\$$Stage>3, "red", "grey")
# or depending on the different diagnostic agreement labels ('DxAgreement'):
E(healthGraph.in.network)$\$$color<-ifelse(E(healthGraph.in.network)$\$$DxAgreement =='X', "red", ifelse(E(healthGraph.in.network)$\$$DxAgreement=='Y', "blue", "grey"))

# Note: the example uses nested ifelse expressions which can be improved
# Additional attributes like size can be further specified in an analogous manner:
V(healthGraph.in.network)$\$$size<-degree(healthGraph.in.network)/10
#here the size of the vertices is specified by the degree of the vertex, so that people supervising more have get proportionally bigger dots. Getting the right scale gets some playing around with the parameters of the scale function (from the 'base' package)

# Note that if the same attribute is specified beforehand and inside the function, the former will be overridden.
# And finally the plot itself:
par(mai=c(0,0,1,0))
#this specifies the size of the margins, default settings leave too much free space on all sides
plot(healthGraph.in.network, #the graph to be plotted
layout=layout.fruchterman.reingold, # the layout method. see the igraph documentation for details
main='Onco Physician Network Example', #specifies the title
vertex.label.dist=0.5, #puts the name labels slightly off the dots
vertex.frame.color='blue', #the color of the border of the dots
vertex.label.color='black', #the color of the name labels
vertex.label.font=2, #the font of the name labels
vertex.label=V(healthGraph.in.network)$\$$name, #specifies the labels of the vertices
vertex.label.cex=1 #specifies the size of the font of the labels
)

# Save or export the plot as a metafile to the clipboard, a pdf or png (and other formats).
png(filename="org_network.png", height=1900, width=1200) #call the png writer
# alternatively print to high-res PDF file # pdf(file="org_network.pdf")

#run the plot

dev.off() #don’t forget to close the device

==Pathway analysis==

Pathway analysis is a technique that reduces complexity and increased explanatory power in studies examining underlying biological structure of differentially expressed genes and proteins.

# install package
# install.packages("dendsort") – contains the “” dataset
# Data: Sample data matrix from the integrated pathway analysis of gastric cancer from the
# Cancer Genome Atlas (TCGA) study. A multivariate table obtained from the integrated pathway analysis
# of gastric cancer from the Cancer Genome Atlas (TCGA) study. Each column represents a pathway
# consisting of a set of genes and each row represents a cohort of samples based on specific clinical
# or genetic features. For each pair of a pathway and a feature, a continuous value of between
# 1 and -1 is assigned to score positive or negative association, respectively.
# A data frame with 215 rows and 117 variables

library("dendsort")
data(sample_tcga)
dataTable <- t(sample_tcga)
head(dataTable)
write.csv(dataTable, "E:\\Ivo.dir\\Research\\UMichigan\\Education_Teaching_Curricula\\2015_2016\\HS_853_Fall_2015\\Modules_docx\\data\\03_TCGA_Data_117x215.csv")
# data.new <- read.csv("https://umich.instructure.com/files/330393/download?download_frd=1")

# install SPIA package: http://bioconductor.org/packages/2.6/bioc/html/SPIA.html
# source("http://bioconductor.org/biocLite.R")
# biocLite("SPIA")
library("SPIA")

# “top” Colorectal cancer dataset provided by SPIA package.
data(Vessels)
head(top)
# pathway analysis based on combined evidence;
# use nB=2000 or more for more accurate results
res<-spia(de=DE_Vessels,all=ALL_Vessels,organism="hsa",nB=500,plots=FALSE,beta=NULL,verbose=FALSE)
#make the output fit this screen
res$\$$Name=substr(res$\$$Name,1,10)
#show first 15 pathways, omitting KEGG links
res[1:15,-12]

==GIS/Distortion mapping==

# install the R GISTools package
# install.packages("GISTools")
library("GISTools")
data(georgia)
…

Java Applet: http://www.socr.ucla.edu/htmls/SOCR_Cartograhy.html
Activities: http://wiki.stat.ucla.edu/socr/index.php/SOCR_Cartography_Project

==Circos Connectogram/Table visualization==

Circular chord/ribbon diagrams present a mechanism to visualize numeric tables containing information of directional relations. This type of chart visualizes tables in a circular way. Sectors of the plot is union(rownames(mat), colnames(mat)). When there is no rowname or colname, the chart assigns names for it (rows could be auto-named as "R1", "R2", ... and columns may be named as "C1", "C2").

• Circos: http://circos.ca

• R circlize: http://cran.r-project.org/web/packages/circlize/circlize.pdf

===Example Early-Onset Alzheimer’s Disease===

Recent studies examined the Interactions between imaging (Structural Brain Change) and genetics (SNP) biomarkers in Early-Onset Alzheimer's Disease Subjects. Circular representation of the significant SNP-Neuroimaging interactions. The left and right parts of the graph contain the 15-ROI imaging markers and the 20-SNP genotypes, respectively. The strength of the connection between each SNP-ROI pair is presented as a ribbon, whose size, color and location are proportional to -log (p). Clearly, there are a lot of spurious effects (skinny red lines on background) and several significantly strong associations (thicker purple ribbons on foreground), e.g., purple association between SNP_5 (rs7718456) and ROI_10 (L_hippocampus, Volume). SNP: single nucleotide polymorphism, ROI: region of interest.

<center>[[Image:SMHS_SciVisualization44.png|400px]] </center>

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|SNPROI||ROI_1||ROI_2||ROI_3||ROI_4||ROI_5||ROI_6||ROI_7||ROI_8||ROI_9||ROI_10||ROI_11||ROI_12||ROI_13||ROI_14||ROI_15
|-
|rs17029131||10||10||10||10||10||10||10||10||10||10||188||10||10||10||10
|-
|rs1822144||10||10||10||10||10||200||10||10||10||10||188||10||10||10||10
|-
|rs6446443||10||10||10||126||113||10||10||113||10||10||10||10||10||10||10
|-
|rs12506164||10||10||10||10||10||167||10||10||10||10||10||10||10||10||10
|-
|rs7718456||10||202||144||206||10||10||10||169||225||321||10||10||290||10||10
|-
|rs9377090||10||145||10||10||10||10||10||153||10||10||10||10||10||10||10
|-
|rs2776932||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs4933672||10||10||113||10||10||10||10||10||10||10||10||232||10||10||10
|-
|rs11193270||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs11193272||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs11193274||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs12218153||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs1338956||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs1338025||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs12101936||10||10||10||10||10||10||10||10||10||10||10||10||10||10||10
|-
|rs16964473||10||10||10||10||10||10||10||10||10||10||112||10||10||10||10
|-
|rs12972537||10||10||10||10||10||10||125||10||10||10||126||10||10||10||10
|-
|rs2212356||10||10||10||10||10||10||10||10||10||10||10||129||10||10||10
|-
|rs2831165||10||10||10||10||10||10||10||10||10||10||10||10||10||10||169
|-
|rs1266320||10||120||10||10||10||10||10||10||10||145||10||10||10||10||129
|}
</center>

# install.packages("circlize")
library("circlize")

# 03_CircularTable_EOAD_Data.csv
EOAD_data <- read.csv("https://umich.instructure.com/files/330388/download?download_frd=1", sep=",", row.names=1, header = TRUE)

rownames(EOAD_data)
colnames(EOAD_data)
EOAD_matrix <- as.matrix(EOAD_data)

### graphics settings
# par(mfrow = c(3, 2))
# par(mar = c(1, 1, 1, 1))
chordDiagram(EOAD_matrix)

circos.clear()
circos.par(gap.degree = c(rep(2, nrow(EOAD_matrix)-1), 10, rep(2, ncol(EOAD_matrix)-1), 10))
chordDiagram(EOAD_matrix)

circos.clear()
circos.par(start.degree = 90)
chordDiagram(EOAD_matrix)

circos.clear()
# chordDiagram(EOAD_matrix, order = c("ROI_1", "ROI_2", "ROI_3", "ROI_4", "ROI_5", "ROI_6", "ROI_7", "ROI_8", "ROI_9", "ROI_10", "ROI_11", "ROI_12", "ROI_13", "ROI_14", "ROI_15"))
chordDiagram(EOAD_matrix, directional = TRUE)
chordDiagram(EOAD_matrix, directional = TRUE, diffHeight = 0.06)

circos.clear()

### colors settings
rand_color = function(n, alpha = 1) {
return(rgb(runif(n), runif(n), runif(n), alpha = alpha))
}

par(mfrow = c(2, 2))
par(mar = c(1, 1, 1, 1))
grid.col = NULL

# random grid/sector and ribbon/chord colors
col_mat = rand_color(length(EOAD_matrix), alpha = 0.5)
grid_col = rand_color(length(rownames(EOAD_matrix)) + length(colnames(EOAD_matrix)), alpha = 0.5)
dim(col_mat) = dim(EOAD_matrix)
chordDiagram(EOAD_matrix, grid.col = grid_col, col = col_mat)

# grid/sector and ribbon/chord colors according to cell values
# Generate quantile values for the color mapping relative to table cell-values
seqs <- seq(0.92, 1, 0.008)

chordDiagram(EOAD_matrix, grid.col = grid_col, col = colorRamp2(quantile(EOAD_matrix, seqs), rev(heat.colors(11))), transparency = 0.5)
circos.clear()

<center>[[Image:SMHS_SciVisualization46.png|500px]] </center>

===Practice===

Repeat these charts using the 03_NIPS_Baby_VitK_Shot_DataSummaryAnalysis_March2012_Short.csv dataset (Appendix), https://umich.instructure.com/files/330392/download?download_frd=1

==Graphical Workflow Protocol Visualization==

(1) Brain Imaging & Genetics Data:

a. ADNI: http://adni.loni.usc.edu/

b. PPMI: http://ppmi-info.org/

c. XNAT Central: https://central.xnat.org/

d. Pipeline Data (see client library)

e. Cloud Services (AWS/Box/Drive)

(2) Pipeline Environment

a. http://pipeline.loni.usc.edu/

b. Web-Java Client: http://pipeline.loni.usc.edu/products-services/pws/

c. Videos: http://pipeline.loni.usc.edu/learn/basic-videos/

d. Publications: http://pipeline.loni.usc.edu/get-started/acknowledgmentscredits/

(3) End-to-end Computational workflows

a. Navigator: http://pipeline.loni.usc.edu/explore/library-navigator/

b. Detailed Descriptions: http://wiki.loni.usc.edu/twiki/bin/view/CCB/PipelineWorkflows

<center>[[Image:SMHS_SciVisualization47.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization48.png|500px]] </center>

==Appendix==

===Neonate Infant Pain Score (NIPS) Data (Vitamin K shots) Dataset===

<center>A short version of the Neonate Infant Pain Score (NIPS) Data (Vitamin K shots) dataset, http://wiki.socr.umich.edu/index.php/SOCR_Data_NIPS_InfantVitK_ShotData
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|Index||Immediate||30_Sec||60_Sec||120_Sec||TotalCryTime
|-
|1||6||7||6||2||63
|-
|2||5||1||2||0||0
|-
|3||7||6||6||7||54
|-
|4||3||7||3||0||27
|-
|5||7||5||6||0||19
|-
|6||6||6||6||2||2
|-
|7||7||7||6||0||46
|-
|8||6||7||0||0||33
|-
|9||5||0||4||0||56
|-
|10||7||7||7||6||63
|-
|105||6||0||0||0||11
|-
|106||7||6||0||0||59
|-
|107||7||4||4||0||28
|-
|108||7||7||7||1||64
|-
|109||7||0||0||0||8
|-
|110||5||0||1||3||64
|-
|111||7||5||7||7||72
|-
|112||4||2||0||2||50
|-
|113||7||6||7||0||44
|-
|114||7||1||0||0||11
|}
</center>

===See Next===
* [[SMHS_SciVisualization| Back to the Scientific Visualization section]]
* [[SMHS| Back to the Scientific Methods for Health Sciences EBook ToC]]

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_SciVisualization_SOCR_Excel_R_Charts}}

SMHS SciVisualization SOCR Excel R Charts

2016-05-19T13:59:42Z

Imoubara: /* Trees and Graphs */

==[[SMHS_SciVisualization| SMHS Scientific Visualization]] - SOCR, Excel and R charts ==

==SOCR Charts==

• URL: http://socr.umich.edu/html/cha/ (Java applet)

• About/List: http://wiki.stat.ucla.edu/socr/index.php/About_pages_for_SOCR_Chart_List

• Activities: http://wiki.stat.ucla.edu/socr/index.php/SOCR_EduMaterials_ChartsActivities

• Data: http://wiki.socr.umich.edu/index.php/SOCR_Data

<center>[[Image:SMHS_SciVisualization2.png|500px]] </center>

==Excel Charts==

MS Excel provides a large number of charts that can be used to quickly and effectively render complex multivariate data. For instance, the table below contains the principal component analysis (PCA) of 50 derived neuroimaging biomarkers (region of interest (ROI) by shape morphometry metric). The loadings of these 50 variables on the top 5 (most significant) principal component directions are shown in the table. Experiment with effective visualizations of these data.

<center>
{| class="wikitable" style="text-align:center; width:99%" border="1"
!Hemi||ROI||measure||ROI_Measure||Dim.1||Dim.2||Dim.3||Dim.4||Dim.5
|-
|L||insular||AvgMeanCurvature||L_insular_cortex_AvgMeanCurvature||0.72||0||0.06||0.06||0
|-
|L||insular||ComputeArea||L_insular_cortex_ComputeArea||0.77||0.06||0.04||0.01||0
|-
|L||insular||Volume||L_insular_cortex_Volume||0.72||0.09||0.04||0.03||0.01
|-
|L||insular||ShapeIndex||L_insular_cortex_ShapeIndex||0.46||0.06||0.01||0.02||0.01
|-
|L||insular||Curvedness||L_insular_cortex_Curvedness||0.78||0||0.05||0.03||0.01
|-
|R||insular||AvgMeanCurvature||R_insular_cortex_AvgMeanCurvature||0.79||0||0.03||0.08||0
|-
|R||insular||ComputeArea||R_insular_cortex_ComputeArea||0.79||0.09||0.03||0.01||0
|-
|R||insular||Volume||R_insular_cortex_Volume||0.73||0.11||0.03||0.03||0
|-
|R||insular||ShapeIndex||R_insular_cortex_ShapeIndex||0.27||0.17||0||0.07||0
|-
|R||insular||Curvedness||R_insular_cortex_Curvedness||0.84||0.02||0.03||0.01||0
|-
|L||cingulate||AvgMeanCurvature||L_cingulate_gyrus_AvgMeanCurvature||0.72||0||0.05||0.02||0.02
|-
|L||cingulate||ComputeArea||L_cingulate_gyrus_ComputeArea||0.74||0.05||0.06||0.04||0.01
|-
|L||cingulate||Volume||L_cingulate_gyrus_Volume||0.69||0.08||0.05||0.05||0.01
|-
|L||cingulate||ShapeIndex||L_cingulate_gyrus_ShapeIndex||0.53||0||0.05||0||0.03
|-
|L||cingulate||Curvedness||L_cingulate_gyrus_Curvedness||0.7||0.01||0.05||0.04||0.03
|-
|R||cingulate||AvgMeanCurvature||R_cingulate_gyrus_AvgMeanCurvature||0.6||0||0.02||0.03||0.01
|-
|R||cingulate||ComputeArea||R_cingulate_gyrus_ComputeArea||0.73||0.06||0.04||0.03||0.01
|-
|R||cingulate||Volume||R_cingulate_gyrus_Volume||0.68||0.09||0.04||0.04||0.01
|-
|R||cingulate||ShapeIndex||R_cingulate_gyrus_ShapeIndex||0.56||0.01||0.05||0||0.01
|-
|R||cingulate||Curvedness||R_cingulate_gyrus_Curvedness||0.25||0||0.01||0.04||0
|-
|L||caudate||AvgMeanCurvature||L_caudate_AvgMeanCurvature||0.52||0||0.05||0||0.01
|-
|L||caudate||ComputeArea||L_caudate_ComputeArea||0.51||0.09||0.03||0.04||0.02
|-
|L||caudate||Volume||L_caudate_Volume||0.44||0.09||0.03||0.06||0.03
|-
|L||caudate||ShapeIndex||L_caudate_ShapeIndex||0.2||0.03||0.04||0.04||0
|-
|L||caudate||Curvedness||L_caudate_Curvedness||0.51||0.12||0.02||0.01||0.01
|-
|R||caudate||AvgMeanCurvature||R_caudate_AvgMeanCurvature||0.68||0.04||0.04||0.02||0
|-
|R||caudate||ComputeArea||R_caudate_ComputeArea||0.67||0.17||0.03||0.02||0.01
|-
|R||caudate||Volume||R_caudate_Volume||0.61||0.16||0.02||0.03||0.01
|-
|R||caudate||ShapeIndex||R_caudate_ShapeIndex||0.18||0.02||0.03||0.11||0
|-
|R||caudate||Curvedness||R_caudate_Curvedness||0.65||0.19||0.01||0||0
|-
|L||putamen||AvgMeanCurvature||L_putamen_AvgMeanCurvature||0.62||0||0.04||0.03||0.02
|-
|L||putamen||ComputeArea||L_putamen_ComputeArea||0.56||0.05||0.04||0.03||0.05
|-
|L||putamen||Volume||L_putamen_Volume||0.52||0.07||0.04||0.05||0.05
|-
|L||putamen||ShapeIndex||L_putamen_ShapeIndex||0.06||0.13||0||0.15||0
|-
|L||putamen||Curvedness||L_putamen_Curvedness||0.64||0.11||0.03||0.01||0.03
|-
|R||putamen||AvgMeanCurvature||R_putamen_AvgMeanCurvature||0.62||0||0.07||0.04||0.01
|-
|R||putamen||ComputeArea||R_putamen_ComputeArea||0.66||0.08||0.03||0.01||0.03
|-
|R||putamen||Volume||R_putamen_Volume||0.64||0.12||0.03||0.02||0.03
|-
|R||putamen||ShapeIndex||R_putamen_ShapeIndex||0.15||0.24||0||0.08||0.03
|-
|R||putamen||Curvedness||R_putamen_Curvedness||0.65||0.05||0.05||0||0.02
|-
|L||hippocampus||AvgMeanCurvature||L_hippocampus_AvgMeanCurvature||0.78||0||0.01||0.04||0
|-
|L||hippocampus||ComputeArea||L_hippocampus_ComputeArea||0.75||0.07||0.01||0||0.02
|-
|L||hippocampus||Volume||L_hippocampus_Volume||0.72||0.09||0.01||0.01||0.01
|-
|L||hippocampus||ShapeIndex||L_hippocampus_ShapeIndex||0.45||0.17||0||0.04||0.02
|-
|L||hippocampus||Curvedness||L_hippocampus_Curvedness||0.79||0.03||0.01||0||0.02
|-
|R||hippocampus||AvgMeanCurvature||R_hippocampus_AvgMeanCurvature||0.72||0||0||0.1||0.01
|-
|R||hippocampus||ComputeArea||R_hippocampus_ComputeArea||0.71||0.09||0||0||0.05
|-
|R||hippocampus||Volume||R_hippocampus_Volume||0.68||0.1||0||0||0.04
|-
|R||hippocampus||ShapeIndex||R_hippocampus_ShapeIndex||0.37||0.18||0||0.02||0.03
|-
|R||hippocampus||Curvedness||R_hippocampus_Curvedness||0.77||0.03||0||0.02||0.04
|}
</center>

<center>[[Image:SMHS_SciVisualization3.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization4.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization5.png|500px]] </center>

==R-Charts==

There are 100’s of packages and 1,000 of different charts, plots and graphs that can be generated using R. Such interactive visualizations enable deeper exploration of data, models and results. JavaScript libraries, e.g., D3, provide advantages for data visualization as these involve HTML5 and are easily shareable online. The R community is developing R interfaces to some popular JavaScript libraries to allow users to create interactive visualizations without detailed knowledge of JavaScript.

===Examples of powerful R interactive visualization packages===

• ggplot2 – http://ggplot2.org

• ggvis – interactive plots extending the static ggplot2 charts, http://ggvis.rstudio.com

• rCharts – R interface to multiple JavaScript charting libraries, http://rcharts.io

• plotly – transforming ggplot2 charts into interactive plots, https://plot.ly/r

• googleVis – Google Charts using R, http://cran.r-project.org/web/packages/googleVis/vignettes/googleVis_examples.html

• HTMLWidgets
<blockquote>o leaflet – library for creating dynamic maps, supports panning and zooming, annotations, markers, polygons, etc. http://www.htmlwidgets.org/showcase_leaflet.html</blockquote>

<blockquote>o dygraphs – provides mechanism for charting time-series data, supports interactive navigation features including series/point highlighting, zooming, and panning, http://www.htmlwidgets.org/showcase_dygraphs.html</blockquote>

<blockquote>o networkD3 – library for creating D3 network graphs including force directed networks, Sankey diagrams, and Reingold-Tilford tree networks, http://www.htmlwidgets.org/showcase_networkD3.html</blockquote>

<blockquote>o DataTables – displays R matrices or data frames as interactive HTML tables that support filtering, pagination, and sorting, http://www.htmlwidgets.org/showcase_datatables.html</blockquote>

<blockquote>o Rthreejs – features 3D scatterplots and globes based on WebGL, http://www.htmlwidgets.org/showcase_threejs.html</blockquote>

• Other R graphic examples
<blockquote>o To write out plots out to file use:</blockquote>
# pdf() command all graphs are redirected to test.pdf. Also works with other common formats: jpeg, png, ps, tiff.
pdf("C:\\Users\\Dinov\\Desktop\\test.pdf"); plot(1:100, 1:100); dev.off()
# Generates Scalable Vector Graphics (SVG) that can be edited by vector graphics software
svg("test.svg"); plot(1:100, 1:100); dev.off()

===Paired ScatterPlots===

set.seed(100)
x <- matrix(runif(50), ncol=5, dimnames=list(letters[1:10], LETTERS[1:5]))
describe(x) # library("Hmisc")
plot(x[,1], x[,2], pch=20, col="red", main="Symbols and Labels")
text(x[,1]+0.03, x[,2], rownames(x))

<center>[[Image:SMHS_SciVisualization6.png|500px]] </center>

pairs(x)

<center>[[Image:SMHS_SciVisualization7.png|500px]] </center>

Another way to generate scatterplots is by using ggplot:

# library(ggplot2)
x <- sample(1:20, 20); y <- sample(1:20, 20); cat <- rep(c("A", "B", "C", "D"), 5)
#vs. cat <- rep(c("A", "B", "C", "D"), each=5)
plot.1 <- qplot(x, y, geom="point", size=5*x, color=cat, main="GGplot with Relative Dot Size and Color") + theme(legend.position = "topleft")
print(plot.1)

# Use Case-Studies: https://umich.instructure.com/courses/38100/files/folder/Case_Studies
# Case_03_MentalHealthServicesSurvey
# data1 <- read.table('https://umich.instructure.com/files/399128/download?download_frd=1&verifier=AG2e9QUKUm1jvDBpkX7D9jbEjKNc4irA0ECk0f7p', header=T)
head(data1)
attach(data1)
# library("Hmisc")
describe(data1)

plot(data1[,3], data1[,4], pch=20, col="red", main="Symbols and Labels")
# text(data1 [,3]+0.03, data1 [,4], rownames(data1))
plot.1 <- qplot(x, y, geom="point", size=5*x, color=cat, main="GGplot with Relative Dot Size and Color") + theme(legend.position = "topleft")
print(plot.1)

# redo plots using majorfundtype FacilityType Ownership Focus
# pairs(data1, na.action=na.omit)

<center>[[Image:SMHS_SciVisualization8.png|500px]] </center>

# Scatterplot with regression line. Use the “diamonds” dataset, which is a data frame with
# 53,940 rows and 10 variables ()
# describe(diamonds)

# Use Case-Studies: https://umich.instructure.com/courses/38100/files/folder/Case_Studies
# CaseStudy01_Divorce_YoungAdults
# data1 <- read.csv('https://umich.instructure.com/files/399118/download?download_frd=1&verifier=ESACv31KcyiHbkPZPuT8Oo4V7XzPtgTTbs6PQLTv', header=T)
attach(data1)
# plot variables: DIVYEAR momint dadint momclose depression livewithmom gethitched

set.seed(110)
# par(mfrow=c(1,2))
data.2 <- diamonds[sample(nrow(diamonds), 500), ]
plot.2 <- qplot(price, depth, data = data.2, geom = c("point", "smooth"), method = "lm")
plot.3 <- qplot(carat, price, data=data.2, geom=c("point", "smooth"), span=0.4)
print(plot.2); print(plot.3)

<center>[[Image:SMHS_SciVisualization9.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization10.png|500px]] </center>

===Barplots===

x <- matrix(runif(50), ncol=5, dimnames=list(letters[1:10], LETTERS[1:5]))
barplot(x[1:4,], ylim=c(0, max(x[1:4,])+0.3), beside=TRUE, legend.text = letters[1:4],
args.legend = list(x = "topleft"))
text(labels=round(as.vector(as.matrix(x[1:4,])),2), x=seq(1.5, 21, by=1) + sort(rep(c(0,1,2,3,4), 4)), y=as.vector(as.matrix(x[1:4,]))+0.1)

<center>[[Image:SMHS_SciVisualization11.png|500px]] </center>

# to put error bars on barplot:

# 10 rows (a, b, c, …):
bar <- barplot(m <- rowMeans(x) * 10, ylim=c(0, 10))
stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

# Case_04_ChildTrauma
# data1 <- read.table('https://umich.instructure.com/files/399129/download?download_frd=1&verifier=Hmv0YW2Kie5ZTV9CKBUNArSHR66f3GWSmVzZDBxc', header=T)
attach(data1)
head(x)
head(data1)
# plot data
data2 <- data1[,-5] # remove the 5th columns text
data1 <- data2[,-5] # remove the 6th columns text
# or data1 <- data1[,c(-5,-6)]

data2 <- as.data.frame(data1)
Blacks <- data2[which(data2$\$$race=="black"),]
Other <- data2[which(data2$\$$race=="other"),]
Hispanic <- data2[which(data2$\$$race=="hispanic"),]
White <- data2[which(data2$\$$race=="white"),]

A <- c(mean(Blacks$\$$age), mean(Blacks$\$$service))
#colnames(A) <- c("age "," service ")
B <- c(mean(Other$\$$age), mean(Other$\$$service))
C <- c(mean(Hispanic$\$$age), mean(Hispanic$\$$service))
D <- c(mean(White$\$$age), mean(White$\$$service))

x <- cbind(A, B, C, D)

bar <- barplot(x[1:2,], ylim=c(0, max(x[1:2,])+2.0), beside=TRUE,
legend.text = c("age","service") , args.legend = list(x = "right"))
text(labels=round(as.vector(as.matrix(x[1:2,])),2), x=seq(1.4, 21, by=1.5), #y=as.vector(as.matrix(x[1:2,]))+0.3)
y=11.5)

m <- x; stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

barplot(as.matrix(data1[1:4,]), ylim=c(0, max(data1[1:4,])+0.3), beside=TRUE, legend.text = data1[1:4,1], args.legend = list(x = "topleft"))
text(labels=round(as.vector(as.matrix(data1[1:4,])),2), x=seq(1.5, 21, by=1), y=as.vector(as.matrix(data1[1:4,]))+0.1)

<center>[[Image:SMHS_SciVisualization12.png|500px]] </center>

# Columns (A, B, C, D, E):
bar <- barplot(m <- colMeans(x) * 5, ylim=c(0, 5))
stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

<center>[[Image:SMHS_SciVisualization13.png|500px]] </center>

===Histograms and Density Plots===

hist(x, freq=TRUE, breaks=10)

<center>[[Image:SMHS_SciVisualization14.png|500px]] </center>

plot(density(x), lwd = 10, col="green")

<center>[[Image:SMHS_SciVisualization15.png|500px]] </center>

===Pie Chart===

# first , “A”, and second, “B”, columns
par (mfrow=c(1,2))
pie(x[,1], col=rainbow(length(x[,1]), start=0.1, end=0.8), clockwise=TRUE)

pie(x[,1], col=rainbow(length(x[,1]), start=0.1, end=0.8), clockwise=TRUE)

pie(x[,2], col=rainbow(length(x[,2]), start=0.1, end=0.8), clockwise=TRUE)
legend("topleft", legend=row.names(x), cex=1.3, bty="n", pch=15, pt.cex=1.8, col=rainbow(length(x[,2]), start=0.1, end=0.8), ncol=1)

<center>[[Image:SMHS_SciVisualization16.png|500px]] </center>

You can export the data:
write.table(x, " ", "data.txt")
# copy-paste it in SOCR Pie chart to generate another Pie view of data

===Line Plots Using ggplot===

head(diamonds)

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||Carat||Cut||Color||Clarity||Depth||Table||Price||X||Y||Z
|-
|1||0.23||Ideal||E||SI2||61.5||55||326||3.95||3.98||2.43
|-
|2||0.21||Premium||E||SI1||59.8||61||326||3.89||3.84||2.31
|-
|3||0.23||Good||E||VS1||56.9||65||237||4.05||4.07||2.31
|-
|4||0.29||Premium||I||VS2||62.4||58||334||4.2||4.23||2.63
|-
|5||0.31||Good||J||SI2||63.3||58||335||4.34||4.35||4.75
|-
|6||0.24||VeryGood||J||VVS2||62.8||57||336||3.94||3.96||2.48
|}
</center>

plot.2 <- ggplot(diamonds, aes(carat, price, group=cut, color=cut)) + geom_line()
print(plot.2)

<center>[[Image:SMHS_SciVisualization17.png|500px]] </center>

plot.2 <- ggplot(data1, aes(age, service, group=race, color=race)) + geom_line()
print(plot.2)

# Faceting plot (geometrically, faceting (or facetting) is the process of removing parts of a polygon, polyhedron or polytope, without creating any new vertices)
plot.3 <- ggplot(diamonds, aes(carat, price)) + geom_line(aes(color=cut), size=1) +
facet_wrap(~cut, ncol=1)
print(plot.3)

<center>[[Image:SMHS_SciVisualization18.png|500px]] </center>

===Barplots with ggplot===

plot.4 <- ggplot(diamonds, aes(cut, fill=cut)) + geom_bar() + facet_grid(. ~ clarity)
print(plot.4)

<center>[[Image:SMHS_SciVisualization19.png|500px]] </center>

New_var <- service+rnorm(1000, 0,1)
data1$\$$New_var <- int(New_var)
plot.4 <- ggplot(data1, aes(race, fill= traumatype)) + geom_bar() + facet_grid(. ~ New_var)
print(plot.4)

plot.4a <- ggplot(diamonds, aes(color, price/carat, fill=color)) + geom_boxplot()
print(plot.4a)

<center>[[Image:SMHS_SciVisualization20.png|500px]] </center>

===Jitter plot===

plot.5 <- ggplot(diamonds, aes(color, price/carat)) + geom_jitter(alpha = I(1 / 2), aes(color=color))
print(plot.5)

<center>[[Image:SMHS_SciVisualization21.png|500px]] </center>

===Density Plots===

plot.6 <- ggplot(diamonds, aes(carat, size=2)) + geom_density(aes(color = cut))
print(plot.6)

<center>[[Image:SMHS_SciVisualization22.png|500px]] </center>

plot.6 <- ggplot(data1, aes(age, size=2)) + geom_density(aes(color = traumatype))
print(plot.6)

plot.7 <- ggplot(diamonds, aes(carat, size=2)) + geom_density(aes(fill = color))
print(plot.7)

<center>[[Image:SMHS_SciVisualization23.png|500px]] </center>

plot.8 <- ggplot(diamonds, aes(x=carat, size=1)) + geom_histogram(aes(y = price), binwidth=0.2) + geom_density()
print(plot.8)

<center>[[Image:SMHS_SciVisualization24.png|500px]] </center>

plot.8a <- ggplot(diamonds, aes(x=carat, size=1)) + geom_histogram(aes(y = price), stat="identity") + geom_density()
print(plot.8a)

<center>[[Image:SMHS_SciVisualization25.png|500px]] </center>

===Heatmaps===

# Generating Dendogram Association Heatmap Plot (Genotype vs. Imaging phenotype)
# http://stat.ethz.ch/R-manual/R-patched/library/stats/html/heatmap.html
# http://www.ncbi.nlm.nih.gov/pmc/articles/PMC4005931/

AD_Associations_Data <- read.table("https://umich.instructure.com/files/330387/download?download_frd=1&verifier=gLk2ADgrLhXGeknI6mqIeJugi2ODr8RARsQlBUMe", header=TRUE, row.names=1, sep=",", dec=".")

MCI_Associations_Data <- read.table("https://umich.instructure.com/files/330390/download?download_frd=1&verifier=FczlJD6ISRPZhu69xvHuoZHx2c7gXX9YEvvPCTBG", header=TRUE, row.names=1, sep=",", dec=".")

NC_Associations_Data <- read.table("https://umich.instructure.com/files/330391/download?download_frd=1&verifier=i2BEtSpmpbrzQUPoA2ST06IzzcaenyVEHRepHSF3", header=TRUE, row.names=1, sep=",", dec=".")

require(graphics)
require(grDevices)
library(gplots)

AD_Data <- AD_Associations_Data
MCI_Data <- MCI_Associations_Data
NC_Data <- NC_Associations_Data

AD_mat <- as.matrix(AD_Data); class(AD_mat) <- "numeric"
MCI_mat <- as.matrix(MCI_Data); class(MCI_mat) <- "numeric"
NC_mat <- as.matrix(NC_Data); class(NC_mat) <- "numeric"

# set up the rol (rc) and column (cc) colors for each cohort
rcAD <- rainbow(nrow(AD_mat), start = 0, end = 1.0); ccAD<-rainbow(ncol(AD_mat), start = 0, end = 1.0)
rcMCI <- rainbow(nrow(MCI_mat), start = 0, end=1.0); ccMCI<-rainbow(ncol(MCI_mat),start=0,end=1.0)
rcNC <- rainbow(nrow(NC_mat), start = 0, end = 1.0); ccNC<-rainbow(ncol(NC_mat), start = 0, end = 1.0)

# set up 1x3 graph display - par (mfrow=c(1,3)) – does not work with ‘heatmap’
hvAD <- heatmap(AD_mat, col = cm.colors(256), scale = "column", RowSideColors = rcAD, ColSideColors = ccAD, margins = c(2,2), main="AD Cohort SNP-ROI_volume Association (p_values)")
hvMCI <- heatmap(MCI_mat, col = cm.colors(256), scale = "column", RowSideColors = rcMCI, ColSideColors = ccMCI, margins = c(2,2), main="MCI Cohort SNP-ROI_volume Association (p_values)")
hvNC <- heatmap(NC_mat, col = cm.colors(256), scale = "column", RowSideColors = rcNC, ColSideColors = ccNC, margins = c(2,2), main="NC Cohort SNP-ROI_volume Association (p_values)")

<center>[[Image:SMHS_SciVisualization26.png|500px]] </center>

# Alternatively, we can use the R package gplots
install.packages("gplots")
library(gplots)
## col dendrogram plotted and col reordering done.
# heatmap.2(AD_mat, keysize=2)
## A more decorative heatmap, with z-score scaling along columns
heatmap.2(AD_mat, col=cm.colors(255), scale="column", RowSideColors=rcAD, ColSideColors=ccAD, margin=c(8, 7), xlab="Imaging Biomarkers (ROI volume)", ylab= "Genetics Biomarkers (SNPs)", main="AD Associations Heatmap (SNP-Imaging)", tracecol="green", density="density")

<center>[[Image:SMHS_SciVisualization27.png|500px]] </center>

===Correlation Plots===

The corrplot package is a graphical display of a correlation matrix and confidence intervals, with some tools for matrix reordering. There are seven visualization methods (parameter method) in corrplot package, named "circle", "square", "ellipse", "number", "shade", "color", "pie".
# install.packages("corrplot")
library(corrplot)
NC_Associations_Data <- read.table("https://umich.instructure.com/files/330391/download?download_frd=1&verifier=i2BEtSpmpbrzQUPoA2ST06IzzcaenyVEHRepHSF3", header=TRUE, row.names=1, sep=",", dec=".")
M <- cor(NC_Associations_Data)

<center>[[Image:SMHS_SciVisualization28.png|500px]] </center>

===Hyperbolic Visualization===

• URL: http://socr.umich.edu/html/Navigators.html

• Tools:

<blockquote>o Java/Jar applet: http://socr.umich.edu/html/navigators/HW/jars/SOCR_HW_Viewer.jar</blockquote>

<blockquote>o JavaScript: http://socr.umich.edu/html/navigators/D3/SOCR_D3_Viewer.html (JSON)</blockquote>

• Data Format

<blockquote>o XML data: http://socr.umich.edu/html/navigators/HW/SOCR_HyperTree.xml</blockquote>

<blockquote>o JSON data: http://socr.umich.edu/html/navigators/D3/xml/SOCR_HyperTree.json</blockquote>

• D3 Visualization

<blockquote>o E:\Ivo.dir\Research\UMichigan\Education_Teaching_Curricula\2015_2016\HS_853_Fall_2015\Modules_docx\Tools\TreeViewer_JS</blockquote>

<blockquote>o treeJS.json</blockquote>

<blockquote>o flareD3.json</blockquote>

<center>[[Image:SMHS_SciVisualization29.png|400px]] </center>

<center>[[Image:SMHS_SciVisualization30.png|400px]] </center>

• URL: https://github.com/mbostock/d3/wiki/Gallery

• Source code: https://github.com/mbostock/d3

<center>[[Image:SMHS_SciVisualization31.png|400px]] </center>

===Motion Charts===

• Video: http://www.socr.ucla.edu/SOCR_MotionCharts/SOCR_HTML5_MotionChart_Video2.gif

• Java: http://www.socr.ucla.edu/SOCR_MotionCharts/

• HTML5: http://socr.umich.edu/HTML5/MotionChart/

• Activities: http://wiki.socr.umich.edu/index.php/SOCR_MotionCharts

<center>[[Image:SMHS_SciVisualization32.png|500px]] </center>

===1D/2D/3D signal/area/volume/surface/model/atlas visualization===

• 1D: (See R/SOCR Visualization tools above)

• 2D: http://imagej.nih.gov/ij/

• 3D: http://socr.umich.edu/HTML5/BrainViewer/

Supported File Formats:
Volumes (.nii / .nii.gz / .img&.hdr / .mgh / .mgz / .nrrd)
Shapes (.dx / .vtk / .stl / FreeSurfer)
Fibers (.trk)

<center>[[Image:SMHS_SciVisualization33.png|500px]] </center>

===Trees and Graphs===

• Trees/Hierarchies and general Graphs

# Install and load the APE package, needed for the phylogenetic tree rendering (as.phylo)
# install.packages("ape")
library("ape")

Load data

# Data: 02_Nof1_Data.csv
data.1 <- read.table("https://umich.instructure.com/files/330385/download?download_frd=1&verifier=DwJUGSd6t24dvK7uYmzA2aDyzlmsohyaK6P7jK0Q ", sep=",", header = TRUE)
head(data.1)

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
mydata1
|-
|||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0

|}
</center>

Clustering

hc = hclust(dist(data.1), 'ave')
# the agglomeration method can be specified "ward.D", "ward.D2", "single","complete", "average" (= UPGMA), "mcquitty" (= WPGMA),"median" (= WPGMC) or "centroid" (= UPGMC)

# (3) Plot clustering diagram
par (mfrow=c(1,1))
# very simple dendrogram
plot(hc)

<center>[[Image:SMHS_SciVisualization34.png|500px]] </center>

require(graphics)
(x <- identify(hc)) ## Terminate with 2nd mouse button !!
identify(hc, function(k) print(table(data.1[k,5])))

You can now cut the tree into branches. You can split the tree into 2 groups, by setting the number of cuts with the k=2 parameter, or by specifying height to cut the tree at (?cutree):

k- an integer scalar or vector with the desired number of groups

h- numeric scalar or vector with heights where the tree should be cut

cutree(hc, k = 2)
# alternatively specify the height, which is, the value of the criterion associated with the clustering method
# for the particular agglomeration.
cutree(hc, h= 50) # cut at h=50
table(cutree(hc, h= 50)) # cluster distribution
# To identify the number of cases for varying number of clusters we can combine calls to cutree and table
# in a call to sapply -- to see the sizes of the clusters for 2≤ k≤10 cluster-solutions:
# numbClusters=5;
myClusters = sapply(2:10,function(numbClusters)table(cutree(hc, numbClusters)))
names(myClusters) <- paste("Number of Clusters=", 2:10, sep = "")
myClusters
#To see which SubjectIDs are in which clusters:
groups.10 <- cutree(hc, k = 10)
sapply(unique(groups.10),function(g)data.1$\$$ID[groups.10 == g])
#To see which Treatments (Tx) are in which clusters:
groups.2 <- cutree(hc, k = 2)
sapply(unique(groups.2),function(g)data.1$\$$Tx[groups.2 == g])
# drill down deeper
table(groups.2, data.1$\$$Tx)
# For a small number of observations, we can often interpret the cluster solution directly by looking
# at the labels of the observations that are in each cluster.
# This is hard for larger data sets. To characterize clusters we can look at cluster summary statistics,
# like the median, of the variables that were used to perform the cluster analysis broken down
# by the groups that the cluster analysis identified.

The aggregate function will compute stats (e.g., median) on many variables simultaneously.

To look at the median values for the variables we've used in the cluster analysis, broken up by the cluster groups:

aggregate(data.1, list(groups.10),median) # may have to shrink data.1 prior to clustering!
# data.2 <- data.1[,-c(1,3)] # Remove ID and Tx variables?
aggregate(data.2, list(groups.2),median) # for only 2 clusters

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Group||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||14||16||0||20||-5||-0.040||2.995||3.275||0.275||41
|-
|2||2||16||15||1||25||0||0.025||3.280||3.360||0.360||104

|}
</center>

table(groups.2, data.1$\$$PhyAct)

# library("Hmisc")

describe(data.1$\$$PhyAct)

# It’s useful to add the numbers of observations in each group (aggregate returns a data frame,
# that can be manipulated)

df.2 <- aggregate(data.1, list(groups.2),median)

data.frame(Cluster= df.2[,1], Freq=as.vector(table(groups.2)), df.2[,-1])

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Cluster||Freq||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||570||14||16||0||20||-5||-0.040||2.995||3.275||0.275||41
|-
|2||2||330||16||15||1||25||0||0.025||3.280||3.360||0.360||104

|}
</center>

===Publications===

• This paper examines nasal and bronchial tissue cultures as appropriate in vitro models for the assessment of smoking-induced adverse effects in the respiratory system (doi: 10.1177/1091581814551647), using “hclust” package. No data.

• This paper classified subtypes of gastric cancer based on epidemiologic and histologic and gene expression data. These new classifications of gastric cancer have implications for improving our understanding of disease biology and identification of unique molecular drivers for each gastric cancer subtype (doi: 10.1158/1078-0432.CCR-10-2203).

Repeat the clustering

# using centroids and squared Euclidean distance
# cut the tree into 10 clusters and reconstruct the upper part of the tree from the cluster centers.
hc <- hclust(dist(data.1), "cen")
mem <- cutree(hc, k = 10)
cent <- NULL
for(k in 1:10){
cent <- rbind(cent, colMeans(data.1[mem == k, , drop = FALSE]))
}

hc1 <- hclust(dist(cent), method = "cen", members = table(mem))

opar <- par(mfrow = c(1, 2))
plot(hc, labels = FALSE, hang = -1, main = "Original Tree")
plot(hc1, hang = -1, main = "Re-start from 10 clusters")
par(opar)

<center>[[Image:SMHS_SciVisualization35.png|500px]] </center>

Identify subjects within each of the 10 classes

rect.hclust(hc, h=10)

# To save the cluster numbers to a new variable in the dataset, use the cutree function.
# data.1$\$$clusterID <- cutree(hc, 10)
data.1$\$$clusterID <- cutree(hc, 10)
head(data.1)

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct||CluserID
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53||1
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73||1
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23||2
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36||2
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21||2
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0||2

|}
</center>

Phylogenetic tree diagram

# library("ape")
plot(as.phylo(hc1), use.edge.length = TRUE, type = "fan")
plot(as.phylo(hc), use.edge.length = TRUE, type = "fan", tip.color = hsv(runif(15, 0.65, 0.95), 1, 1, 0.7), label.offset = 1, cex = log(data.1$\$$ID, 10), col = "red")

<center>[[Image:SMHS_SciVisualization36.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization37.png|500px]] </center>

===Hands-on Activity (Health Behavior Risks)===

# load data CaseStudy09_HealthBehaviorRisks_Data
data.2 <- read.csv("https://umich.instructure.com/files/399182/download?download_frd=1 ", sep=",", header = TRUE)

# Classify the cases using these variables: "AGE_G" "SEX" "RACEGR3" "IMPEDUC" "IMPMRTL"
# "EMPLOY1" "INCOMG" "CVDINFR4" "CVDCRHD4" "CVDSTRK3" "DIABETE3" "RFSMOK3"
# "FRTLT1" "VEGLT1"
data.raw <- data.2[,-c(1,14,17)]

# Does the classification match either of these:
# TOTINDA (Leisure time physical activities per month, 1=Yes, 2=No, 9=Don’t know/Refused/Missing)
# RFDRHV4 (Heavy alcohol consumption, 1=No, 2=Yes, 9=Don’t know/Refused/Missing)

hc = hclust(dist(data.raw), 'ave')
# the agglomeration method can be specified "ward.D", "ward.D2", "single", "complete", "average" (= UPGMA), "mcquitty" (= WPGMA), "median" (= WPGMC) or "centroid" (= UPGMC)

# (3) Plot clustering diagram
par (mfrow=c(1,1))
# very simple dendrogram
plot(hc)

summary(data.2$\$$TOTINDA); summary(data.2$\$$RFDRHV4)

cutree(hc, k = 2)
# alternatively specify the height, which is, the value of the criterion associated with the
# clustering method for the particular agglomeration -- cutree(hc, h= 10)

table(cutree(hc, h= 10)) # cluster distribution

# To identify the number of cases for varying number of clusters we can combine calls to cutree and table
# in a call to sapply -- to see the sizes of the clusters for 2≤ k≤10 cluster-solutions:
# numbClusters=4;
myClusters = sapply(2:5,function(numbClusters)table(cutree(hc, numbClusters)))
names(myClusters) <- paste("Number of Clusters=", 2:5, sep = "")
myClusters

#To see which SubjectIDs are in which clusters:
table(cutree(hc, k=2))
groups.k.2 <- cutree(hc, k = 2)
sapply(unique(groups.k.2),function(g)data.2$\$$ID[groups.k.2 == g])

#To see which TOTINDA (Leisure time physical activities per month, 1=Yes, 2=No, 9=Don’t
# know/Refused/Missing) & whch RFDRHV4 are in which clusters:
groups.k.3 <- cutree(hc, k = 3)
sapply(unique(groups.k.3),function(g)data.2$\$$TOTINDA [groups.k.3 == g])
sapply(unique(groups.k.3),function(g)data.2$\$$RFDRHV4[groups.k.3 == g])

# Perhaps there are intrinsically 3 groups here e.g., 1, 2 and 9 …
groups.k.3 <- cutree(hc, k = 3)
sapply(unique(groups.k.3),function(g)data.2$\$$TOTINDA [groups.k.3 == g])
sapply(unique(groups.k.3),function(g)data.2$\$$RFDRHV4 [groups.k.3 == g])

# Note that there is quite a dependence between the outcome variables …
plot(data.2$\$$RFDRHV4, data.2$\$$TOTINDA)

# drill down deeper
table(groups.k.3, data.2$\$$RFDRHV4)

# To characterize clusters we can look at cluster summary statistics,
# like the median, of the variables that were used to perform the cluster analysis broken down
# by the groups that the cluster analysis identified. The aggregate function will compute stats
# (e.g., median) on many variables simultaneously. To look at the median values for the variables
# we've used in the cluster analysis, broken up by the cluster groups:
aggregate(data.2, list(groups.k.3),median)

==See Next==
<li> [[SMHS_SciVisualization_NetworkViz|Next See the Complex Network Visualization section]]</li>
<li> [[SMHS| Back to the Scientific Methods for Health Sciences EBook ToC]]/<li>

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_SciVisualization_SOCR_Excel_R_Charts}}

SMHS SciVisualization SOCR Excel R Charts

2016-05-19T13:58:53Z

Imoubara: /* Hyperbolic Visualization */

==[[SMHS_SciVisualization| SMHS Scientific Visualization]] - SOCR, Excel and R charts ==

==SOCR Charts==

• URL: http://socr.umich.edu/html/cha/ (Java applet)

• About/List: http://wiki.stat.ucla.edu/socr/index.php/About_pages_for_SOCR_Chart_List

• Activities: http://wiki.stat.ucla.edu/socr/index.php/SOCR_EduMaterials_ChartsActivities

• Data: http://wiki.socr.umich.edu/index.php/SOCR_Data

<center>[[Image:SMHS_SciVisualization2.png|500px]] </center>

==Excel Charts==

MS Excel provides a large number of charts that can be used to quickly and effectively render complex multivariate data. For instance, the table below contains the principal component analysis (PCA) of 50 derived neuroimaging biomarkers (region of interest (ROI) by shape morphometry metric). The loadings of these 50 variables on the top 5 (most significant) principal component directions are shown in the table. Experiment with effective visualizations of these data.

<center>
{| class="wikitable" style="text-align:center; width:99%" border="1"
!Hemi||ROI||measure||ROI_Measure||Dim.1||Dim.2||Dim.3||Dim.4||Dim.5
|-
|L||insular||AvgMeanCurvature||L_insular_cortex_AvgMeanCurvature||0.72||0||0.06||0.06||0
|-
|L||insular||ComputeArea||L_insular_cortex_ComputeArea||0.77||0.06||0.04||0.01||0
|-
|L||insular||Volume||L_insular_cortex_Volume||0.72||0.09||0.04||0.03||0.01
|-
|L||insular||ShapeIndex||L_insular_cortex_ShapeIndex||0.46||0.06||0.01||0.02||0.01
|-
|L||insular||Curvedness||L_insular_cortex_Curvedness||0.78||0||0.05||0.03||0.01
|-
|R||insular||AvgMeanCurvature||R_insular_cortex_AvgMeanCurvature||0.79||0||0.03||0.08||0
|-
|R||insular||ComputeArea||R_insular_cortex_ComputeArea||0.79||0.09||0.03||0.01||0
|-
|R||insular||Volume||R_insular_cortex_Volume||0.73||0.11||0.03||0.03||0
|-
|R||insular||ShapeIndex||R_insular_cortex_ShapeIndex||0.27||0.17||0||0.07||0
|-
|R||insular||Curvedness||R_insular_cortex_Curvedness||0.84||0.02||0.03||0.01||0
|-
|L||cingulate||AvgMeanCurvature||L_cingulate_gyrus_AvgMeanCurvature||0.72||0||0.05||0.02||0.02
|-
|L||cingulate||ComputeArea||L_cingulate_gyrus_ComputeArea||0.74||0.05||0.06||0.04||0.01
|-
|L||cingulate||Volume||L_cingulate_gyrus_Volume||0.69||0.08||0.05||0.05||0.01
|-
|L||cingulate||ShapeIndex||L_cingulate_gyrus_ShapeIndex||0.53||0||0.05||0||0.03
|-
|L||cingulate||Curvedness||L_cingulate_gyrus_Curvedness||0.7||0.01||0.05||0.04||0.03
|-
|R||cingulate||AvgMeanCurvature||R_cingulate_gyrus_AvgMeanCurvature||0.6||0||0.02||0.03||0.01
|-
|R||cingulate||ComputeArea||R_cingulate_gyrus_ComputeArea||0.73||0.06||0.04||0.03||0.01
|-
|R||cingulate||Volume||R_cingulate_gyrus_Volume||0.68||0.09||0.04||0.04||0.01
|-
|R||cingulate||ShapeIndex||R_cingulate_gyrus_ShapeIndex||0.56||0.01||0.05||0||0.01
|-
|R||cingulate||Curvedness||R_cingulate_gyrus_Curvedness||0.25||0||0.01||0.04||0
|-
|L||caudate||AvgMeanCurvature||L_caudate_AvgMeanCurvature||0.52||0||0.05||0||0.01
|-
|L||caudate||ComputeArea||L_caudate_ComputeArea||0.51||0.09||0.03||0.04||0.02
|-
|L||caudate||Volume||L_caudate_Volume||0.44||0.09||0.03||0.06||0.03
|-
|L||caudate||ShapeIndex||L_caudate_ShapeIndex||0.2||0.03||0.04||0.04||0
|-
|L||caudate||Curvedness||L_caudate_Curvedness||0.51||0.12||0.02||0.01||0.01
|-
|R||caudate||AvgMeanCurvature||R_caudate_AvgMeanCurvature||0.68||0.04||0.04||0.02||0
|-
|R||caudate||ComputeArea||R_caudate_ComputeArea||0.67||0.17||0.03||0.02||0.01
|-
|R||caudate||Volume||R_caudate_Volume||0.61||0.16||0.02||0.03||0.01
|-
|R||caudate||ShapeIndex||R_caudate_ShapeIndex||0.18||0.02||0.03||0.11||0
|-
|R||caudate||Curvedness||R_caudate_Curvedness||0.65||0.19||0.01||0||0
|-
|L||putamen||AvgMeanCurvature||L_putamen_AvgMeanCurvature||0.62||0||0.04||0.03||0.02
|-
|L||putamen||ComputeArea||L_putamen_ComputeArea||0.56||0.05||0.04||0.03||0.05
|-
|L||putamen||Volume||L_putamen_Volume||0.52||0.07||0.04||0.05||0.05
|-
|L||putamen||ShapeIndex||L_putamen_ShapeIndex||0.06||0.13||0||0.15||0
|-
|L||putamen||Curvedness||L_putamen_Curvedness||0.64||0.11||0.03||0.01||0.03
|-
|R||putamen||AvgMeanCurvature||R_putamen_AvgMeanCurvature||0.62||0||0.07||0.04||0.01
|-
|R||putamen||ComputeArea||R_putamen_ComputeArea||0.66||0.08||0.03||0.01||0.03
|-
|R||putamen||Volume||R_putamen_Volume||0.64||0.12||0.03||0.02||0.03
|-
|R||putamen||ShapeIndex||R_putamen_ShapeIndex||0.15||0.24||0||0.08||0.03
|-
|R||putamen||Curvedness||R_putamen_Curvedness||0.65||0.05||0.05||0||0.02
|-
|L||hippocampus||AvgMeanCurvature||L_hippocampus_AvgMeanCurvature||0.78||0||0.01||0.04||0
|-
|L||hippocampus||ComputeArea||L_hippocampus_ComputeArea||0.75||0.07||0.01||0||0.02
|-
|L||hippocampus||Volume||L_hippocampus_Volume||0.72||0.09||0.01||0.01||0.01
|-
|L||hippocampus||ShapeIndex||L_hippocampus_ShapeIndex||0.45||0.17||0||0.04||0.02
|-
|L||hippocampus||Curvedness||L_hippocampus_Curvedness||0.79||0.03||0.01||0||0.02
|-
|R||hippocampus||AvgMeanCurvature||R_hippocampus_AvgMeanCurvature||0.72||0||0||0.1||0.01
|-
|R||hippocampus||ComputeArea||R_hippocampus_ComputeArea||0.71||0.09||0||0||0.05
|-
|R||hippocampus||Volume||R_hippocampus_Volume||0.68||0.1||0||0||0.04
|-
|R||hippocampus||ShapeIndex||R_hippocampus_ShapeIndex||0.37||0.18||0||0.02||0.03
|-
|R||hippocampus||Curvedness||R_hippocampus_Curvedness||0.77||0.03||0||0.02||0.04
|}
</center>

<center>[[Image:SMHS_SciVisualization3.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization4.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization5.png|500px]] </center>

==R-Charts==

There are 100’s of packages and 1,000 of different charts, plots and graphs that can be generated using R. Such interactive visualizations enable deeper exploration of data, models and results. JavaScript libraries, e.g., D3, provide advantages for data visualization as these involve HTML5 and are easily shareable online. The R community is developing R interfaces to some popular JavaScript libraries to allow users to create interactive visualizations without detailed knowledge of JavaScript.

===Examples of powerful R interactive visualization packages===

• ggplot2 – http://ggplot2.org

• ggvis – interactive plots extending the static ggplot2 charts, http://ggvis.rstudio.com

• rCharts – R interface to multiple JavaScript charting libraries, http://rcharts.io

• plotly – transforming ggplot2 charts into interactive plots, https://plot.ly/r

• googleVis – Google Charts using R, http://cran.r-project.org/web/packages/googleVis/vignettes/googleVis_examples.html

• HTMLWidgets
<blockquote>o leaflet – library for creating dynamic maps, supports panning and zooming, annotations, markers, polygons, etc. http://www.htmlwidgets.org/showcase_leaflet.html</blockquote>

<blockquote>o dygraphs – provides mechanism for charting time-series data, supports interactive navigation features including series/point highlighting, zooming, and panning, http://www.htmlwidgets.org/showcase_dygraphs.html</blockquote>

<blockquote>o networkD3 – library for creating D3 network graphs including force directed networks, Sankey diagrams, and Reingold-Tilford tree networks, http://www.htmlwidgets.org/showcase_networkD3.html</blockquote>

<blockquote>o DataTables – displays R matrices or data frames as interactive HTML tables that support filtering, pagination, and sorting, http://www.htmlwidgets.org/showcase_datatables.html</blockquote>

<blockquote>o Rthreejs – features 3D scatterplots and globes based on WebGL, http://www.htmlwidgets.org/showcase_threejs.html</blockquote>

• Other R graphic examples
<blockquote>o To write out plots out to file use:</blockquote>
# pdf() command all graphs are redirected to test.pdf. Also works with other common formats: jpeg, png, ps, tiff.
pdf("C:\\Users\\Dinov\\Desktop\\test.pdf"); plot(1:100, 1:100); dev.off()
# Generates Scalable Vector Graphics (SVG) that can be edited by vector graphics software
svg("test.svg"); plot(1:100, 1:100); dev.off()

===Paired ScatterPlots===

set.seed(100)
x <- matrix(runif(50), ncol=5, dimnames=list(letters[1:10], LETTERS[1:5]))
describe(x) # library("Hmisc")
plot(x[,1], x[,2], pch=20, col="red", main="Symbols and Labels")
text(x[,1]+0.03, x[,2], rownames(x))

<center>[[Image:SMHS_SciVisualization6.png|500px]] </center>

pairs(x)

<center>[[Image:SMHS_SciVisualization7.png|500px]] </center>

Another way to generate scatterplots is by using ggplot:

# library(ggplot2)
x <- sample(1:20, 20); y <- sample(1:20, 20); cat <- rep(c("A", "B", "C", "D"), 5)
#vs. cat <- rep(c("A", "B", "C", "D"), each=5)
plot.1 <- qplot(x, y, geom="point", size=5*x, color=cat, main="GGplot with Relative Dot Size and Color") + theme(legend.position = "topleft")
print(plot.1)

# Use Case-Studies: https://umich.instructure.com/courses/38100/files/folder/Case_Studies
# Case_03_MentalHealthServicesSurvey
# data1 <- read.table('https://umich.instructure.com/files/399128/download?download_frd=1&verifier=AG2e9QUKUm1jvDBpkX7D9jbEjKNc4irA0ECk0f7p', header=T)
head(data1)
attach(data1)
# library("Hmisc")
describe(data1)

plot(data1[,3], data1[,4], pch=20, col="red", main="Symbols and Labels")
# text(data1 [,3]+0.03, data1 [,4], rownames(data1))
plot.1 <- qplot(x, y, geom="point", size=5*x, color=cat, main="GGplot with Relative Dot Size and Color") + theme(legend.position = "topleft")
print(plot.1)

# redo plots using majorfundtype FacilityType Ownership Focus
# pairs(data1, na.action=na.omit)

<center>[[Image:SMHS_SciVisualization8.png|500px]] </center>

# Scatterplot with regression line. Use the “diamonds” dataset, which is a data frame with
# 53,940 rows and 10 variables ()
# describe(diamonds)

# Use Case-Studies: https://umich.instructure.com/courses/38100/files/folder/Case_Studies
# CaseStudy01_Divorce_YoungAdults
# data1 <- read.csv('https://umich.instructure.com/files/399118/download?download_frd=1&verifier=ESACv31KcyiHbkPZPuT8Oo4V7XzPtgTTbs6PQLTv', header=T)
attach(data1)
# plot variables: DIVYEAR momint dadint momclose depression livewithmom gethitched

set.seed(110)
# par(mfrow=c(1,2))
data.2 <- diamonds[sample(nrow(diamonds), 500), ]
plot.2 <- qplot(price, depth, data = data.2, geom = c("point", "smooth"), method = "lm")
plot.3 <- qplot(carat, price, data=data.2, geom=c("point", "smooth"), span=0.4)
print(plot.2); print(plot.3)

<center>[[Image:SMHS_SciVisualization9.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization10.png|500px]] </center>

===Barplots===

x <- matrix(runif(50), ncol=5, dimnames=list(letters[1:10], LETTERS[1:5]))
barplot(x[1:4,], ylim=c(0, max(x[1:4,])+0.3), beside=TRUE, legend.text = letters[1:4],
args.legend = list(x = "topleft"))
text(labels=round(as.vector(as.matrix(x[1:4,])),2), x=seq(1.5, 21, by=1) + sort(rep(c(0,1,2,3,4), 4)), y=as.vector(as.matrix(x[1:4,]))+0.1)

<center>[[Image:SMHS_SciVisualization11.png|500px]] </center>

# to put error bars on barplot:

# 10 rows (a, b, c, …):
bar <- barplot(m <- rowMeans(x) * 10, ylim=c(0, 10))
stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

# Case_04_ChildTrauma
# data1 <- read.table('https://umich.instructure.com/files/399129/download?download_frd=1&verifier=Hmv0YW2Kie5ZTV9CKBUNArSHR66f3GWSmVzZDBxc', header=T)
attach(data1)
head(x)
head(data1)
# plot data
data2 <- data1[,-5] # remove the 5th columns text
data1 <- data2[,-5] # remove the 6th columns text
# or data1 <- data1[,c(-5,-6)]

data2 <- as.data.frame(data1)
Blacks <- data2[which(data2$\$$race=="black"),]
Other <- data2[which(data2$\$$race=="other"),]
Hispanic <- data2[which(data2$\$$race=="hispanic"),]
White <- data2[which(data2$\$$race=="white"),]

A <- c(mean(Blacks$\$$age), mean(Blacks$\$$service))
#colnames(A) <- c("age "," service ")
B <- c(mean(Other$\$$age), mean(Other$\$$service))
C <- c(mean(Hispanic$\$$age), mean(Hispanic$\$$service))
D <- c(mean(White$\$$age), mean(White$\$$service))

x <- cbind(A, B, C, D)

bar <- barplot(x[1:2,], ylim=c(0, max(x[1:2,])+2.0), beside=TRUE,
legend.text = c("age","service") , args.legend = list(x = "right"))
text(labels=round(as.vector(as.matrix(x[1:2,])),2), x=seq(1.4, 21, by=1.5), #y=as.vector(as.matrix(x[1:2,]))+0.3)
y=11.5)

m <- x; stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

barplot(as.matrix(data1[1:4,]), ylim=c(0, max(data1[1:4,])+0.3), beside=TRUE, legend.text = data1[1:4,1], args.legend = list(x = "topleft"))
text(labels=round(as.vector(as.matrix(data1[1:4,])),2), x=seq(1.5, 21, by=1), y=as.vector(as.matrix(data1[1:4,]))+0.1)

<center>[[Image:SMHS_SciVisualization12.png|500px]] </center>

# Columns (A, B, C, D, E):
bar <- barplot(m <- colMeans(x) * 5, ylim=c(0, 5))
stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

<center>[[Image:SMHS_SciVisualization13.png|500px]] </center>

===Histograms and Density Plots===

hist(x, freq=TRUE, breaks=10)

<center>[[Image:SMHS_SciVisualization14.png|500px]] </center>

plot(density(x), lwd = 10, col="green")

<center>[[Image:SMHS_SciVisualization15.png|500px]] </center>

===Pie Chart===

# first , “A”, and second, “B”, columns
par (mfrow=c(1,2))
pie(x[,1], col=rainbow(length(x[,1]), start=0.1, end=0.8), clockwise=TRUE)

pie(x[,1], col=rainbow(length(x[,1]), start=0.1, end=0.8), clockwise=TRUE)

pie(x[,2], col=rainbow(length(x[,2]), start=0.1, end=0.8), clockwise=TRUE)
legend("topleft", legend=row.names(x), cex=1.3, bty="n", pch=15, pt.cex=1.8, col=rainbow(length(x[,2]), start=0.1, end=0.8), ncol=1)

<center>[[Image:SMHS_SciVisualization16.png|500px]] </center>

You can export the data:
write.table(x, " ", "data.txt")
# copy-paste it in SOCR Pie chart to generate another Pie view of data

===Line Plots Using ggplot===

head(diamonds)

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||Carat||Cut||Color||Clarity||Depth||Table||Price||X||Y||Z
|-
|1||0.23||Ideal||E||SI2||61.5||55||326||3.95||3.98||2.43
|-
|2||0.21||Premium||E||SI1||59.8||61||326||3.89||3.84||2.31
|-
|3||0.23||Good||E||VS1||56.9||65||237||4.05||4.07||2.31
|-
|4||0.29||Premium||I||VS2||62.4||58||334||4.2||4.23||2.63
|-
|5||0.31||Good||J||SI2||63.3||58||335||4.34||4.35||4.75
|-
|6||0.24||VeryGood||J||VVS2||62.8||57||336||3.94||3.96||2.48
|}
</center>

plot.2 <- ggplot(diamonds, aes(carat, price, group=cut, color=cut)) + geom_line()
print(plot.2)

<center>[[Image:SMHS_SciVisualization17.png|500px]] </center>

plot.2 <- ggplot(data1, aes(age, service, group=race, color=race)) + geom_line()
print(plot.2)

# Faceting plot (geometrically, faceting (or facetting) is the process of removing parts of a polygon, polyhedron or polytope, without creating any new vertices)
plot.3 <- ggplot(diamonds, aes(carat, price)) + geom_line(aes(color=cut), size=1) +
facet_wrap(~cut, ncol=1)
print(plot.3)

<center>[[Image:SMHS_SciVisualization18.png|500px]] </center>

===Barplots with ggplot===

plot.4 <- ggplot(diamonds, aes(cut, fill=cut)) + geom_bar() + facet_grid(. ~ clarity)
print(plot.4)

<center>[[Image:SMHS_SciVisualization19.png|500px]] </center>

New_var <- service+rnorm(1000, 0,1)
data1$\$$New_var <- int(New_var)
plot.4 <- ggplot(data1, aes(race, fill= traumatype)) + geom_bar() + facet_grid(. ~ New_var)
print(plot.4)

plot.4a <- ggplot(diamonds, aes(color, price/carat, fill=color)) + geom_boxplot()
print(plot.4a)

<center>[[Image:SMHS_SciVisualization20.png|500px]] </center>

===Jitter plot===

plot.5 <- ggplot(diamonds, aes(color, price/carat)) + geom_jitter(alpha = I(1 / 2), aes(color=color))
print(plot.5)

<center>[[Image:SMHS_SciVisualization21.png|500px]] </center>

===Density Plots===

plot.6 <- ggplot(diamonds, aes(carat, size=2)) + geom_density(aes(color = cut))
print(plot.6)

<center>[[Image:SMHS_SciVisualization22.png|500px]] </center>

plot.6 <- ggplot(data1, aes(age, size=2)) + geom_density(aes(color = traumatype))
print(plot.6)

plot.7 <- ggplot(diamonds, aes(carat, size=2)) + geom_density(aes(fill = color))
print(plot.7)

<center>[[Image:SMHS_SciVisualization23.png|500px]] </center>

plot.8 <- ggplot(diamonds, aes(x=carat, size=1)) + geom_histogram(aes(y = price), binwidth=0.2) + geom_density()
print(plot.8)

<center>[[Image:SMHS_SciVisualization24.png|500px]] </center>

plot.8a <- ggplot(diamonds, aes(x=carat, size=1)) + geom_histogram(aes(y = price), stat="identity") + geom_density()
print(plot.8a)

<center>[[Image:SMHS_SciVisualization25.png|500px]] </center>

===Heatmaps===

# Generating Dendogram Association Heatmap Plot (Genotype vs. Imaging phenotype)
# http://stat.ethz.ch/R-manual/R-patched/library/stats/html/heatmap.html
# http://www.ncbi.nlm.nih.gov/pmc/articles/PMC4005931/

AD_Associations_Data <- read.table("https://umich.instructure.com/files/330387/download?download_frd=1&verifier=gLk2ADgrLhXGeknI6mqIeJugi2ODr8RARsQlBUMe", header=TRUE, row.names=1, sep=",", dec=".")

MCI_Associations_Data <- read.table("https://umich.instructure.com/files/330390/download?download_frd=1&verifier=FczlJD6ISRPZhu69xvHuoZHx2c7gXX9YEvvPCTBG", header=TRUE, row.names=1, sep=",", dec=".")

NC_Associations_Data <- read.table("https://umich.instructure.com/files/330391/download?download_frd=1&verifier=i2BEtSpmpbrzQUPoA2ST06IzzcaenyVEHRepHSF3", header=TRUE, row.names=1, sep=",", dec=".")

require(graphics)
require(grDevices)
library(gplots)

AD_Data <- AD_Associations_Data
MCI_Data <- MCI_Associations_Data
NC_Data <- NC_Associations_Data

AD_mat <- as.matrix(AD_Data); class(AD_mat) <- "numeric"
MCI_mat <- as.matrix(MCI_Data); class(MCI_mat) <- "numeric"
NC_mat <- as.matrix(NC_Data); class(NC_mat) <- "numeric"

# set up the rol (rc) and column (cc) colors for each cohort
rcAD <- rainbow(nrow(AD_mat), start = 0, end = 1.0); ccAD<-rainbow(ncol(AD_mat), start = 0, end = 1.0)
rcMCI <- rainbow(nrow(MCI_mat), start = 0, end=1.0); ccMCI<-rainbow(ncol(MCI_mat),start=0,end=1.0)
rcNC <- rainbow(nrow(NC_mat), start = 0, end = 1.0); ccNC<-rainbow(ncol(NC_mat), start = 0, end = 1.0)

# set up 1x3 graph display - par (mfrow=c(1,3)) – does not work with ‘heatmap’
hvAD <- heatmap(AD_mat, col = cm.colors(256), scale = "column", RowSideColors = rcAD, ColSideColors = ccAD, margins = c(2,2), main="AD Cohort SNP-ROI_volume Association (p_values)")
hvMCI <- heatmap(MCI_mat, col = cm.colors(256), scale = "column", RowSideColors = rcMCI, ColSideColors = ccMCI, margins = c(2,2), main="MCI Cohort SNP-ROI_volume Association (p_values)")
hvNC <- heatmap(NC_mat, col = cm.colors(256), scale = "column", RowSideColors = rcNC, ColSideColors = ccNC, margins = c(2,2), main="NC Cohort SNP-ROI_volume Association (p_values)")

<center>[[Image:SMHS_SciVisualization26.png|500px]] </center>

# Alternatively, we can use the R package gplots
install.packages("gplots")
library(gplots)
## col dendrogram plotted and col reordering done.
# heatmap.2(AD_mat, keysize=2)
## A more decorative heatmap, with z-score scaling along columns
heatmap.2(AD_mat, col=cm.colors(255), scale="column", RowSideColors=rcAD, ColSideColors=ccAD, margin=c(8, 7), xlab="Imaging Biomarkers (ROI volume)", ylab= "Genetics Biomarkers (SNPs)", main="AD Associations Heatmap (SNP-Imaging)", tracecol="green", density="density")

<center>[[Image:SMHS_SciVisualization27.png|500px]] </center>

===Correlation Plots===

The corrplot package is a graphical display of a correlation matrix and confidence intervals, with some tools for matrix reordering. There are seven visualization methods (parameter method) in corrplot package, named "circle", "square", "ellipse", "number", "shade", "color", "pie".
# install.packages("corrplot")
library(corrplot)
NC_Associations_Data <- read.table("https://umich.instructure.com/files/330391/download?download_frd=1&verifier=i2BEtSpmpbrzQUPoA2ST06IzzcaenyVEHRepHSF3", header=TRUE, row.names=1, sep=",", dec=".")
M <- cor(NC_Associations_Data)

<center>[[Image:SMHS_SciVisualization28.png|500px]] </center>

===Hyperbolic Visualization===

• URL: http://socr.umich.edu/html/Navigators.html

• Tools:

<blockquote>o Java/Jar applet: http://socr.umich.edu/html/navigators/HW/jars/SOCR_HW_Viewer.jar</blockquote>

<blockquote>o JavaScript: http://socr.umich.edu/html/navigators/D3/SOCR_D3_Viewer.html (JSON)</blockquote>

• Data Format

<blockquote>o XML data: http://socr.umich.edu/html/navigators/HW/SOCR_HyperTree.xml</blockquote>

<blockquote>o JSON data: http://socr.umich.edu/html/navigators/D3/xml/SOCR_HyperTree.json</blockquote>

• D3 Visualization

<blockquote>o E:\Ivo.dir\Research\UMichigan\Education_Teaching_Curricula\2015_2016\HS_853_Fall_2015\Modules_docx\Tools\TreeViewer_JS</blockquote>

<blockquote>o treeJS.json</blockquote>

<blockquote>o flareD3.json</blockquote>

<center>[[Image:SMHS_SciVisualization29.png|400px]] </center>

<center>[[Image:SMHS_SciVisualization30.png|400px]] </center>

• URL: https://github.com/mbostock/d3/wiki/Gallery

• Source code: https://github.com/mbostock/d3

<center>[[Image:SMHS_SciVisualization31.png|400px]] </center>

===Motion Charts===

• Video: http://www.socr.ucla.edu/SOCR_MotionCharts/SOCR_HTML5_MotionChart_Video2.gif

• Java: http://www.socr.ucla.edu/SOCR_MotionCharts/

• HTML5: http://socr.umich.edu/HTML5/MotionChart/

• Activities: http://wiki.socr.umich.edu/index.php/SOCR_MotionCharts

<center>[[Image:SMHS_SciVisualization32.png|500px]] </center>

===1D/2D/3D signal/area/volume/surface/model/atlas visualization===

• 1D: (See R/SOCR Visualization tools above)

• 2D: http://imagej.nih.gov/ij/

• 3D: http://socr.umich.edu/HTML5/BrainViewer/

Supported File Formats:
Volumes (.nii / .nii.gz / .img&.hdr / .mgh / .mgz / .nrrd)
Shapes (.dx / .vtk / .stl / FreeSurfer)
Fibers (.trk)

<center>[[Image:SMHS_SciVisualization33.png|500px]] </center>

===Trees and Graphs===

• Trees/Hierarchies and general Graphs

# Install and load the APE package, needed for the phylogenetic tree rendering (as.phylo)
# install.packages("ape")
library("ape")

Load data

# Data: 02_Nof1_Data.csv
data.1 <- read.table("https://umich.instructure.com/files/330385/download?download_frd=1&verifier=DwJUGSd6t24dvK7uYmzA2aDyzlmsohyaK6P7jK0Q ", sep=",", header = TRUE)
head(data.1)

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
mydata1
|-
|||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0

|}
</center>

Clustering

hc = hclust(dist(data.1), 'ave')
# the agglomeration method can be specified "ward.D", "ward.D2", "single","complete", "average" (= UPGMA), "mcquitty" (= WPGMA),"median" (= WPGMC) or "centroid" (= UPGMC)

# (3) Plot clustering diagram
par (mfrow=c(1,1))
# very simple dendrogram
plot(hc)

<center>[[Image:SMHS_SciVisualization34.png|500px]] </center>

require(graphics)
(x <- identify(hc)) ## Terminate with 2nd mouse button !!
identify(hc, function(k) print(table(data.1[k,5])))

You can now cut the tree into branches. You can split the tree into 2 groups, by setting the number of cuts with the k=2 parameter, or by specifying height to cut the tree at (?cutree):

k an integer scalar or vector with the desired number of groups
h numeric scalar or vector with heights where the tree should be cut

cutree(hc, k = 2)
# alternatively specify the height, which is, the value of the criterion associated with the clustering method
# for the particular agglomeration.
cutree(hc, h= 50) # cut at h=50
table(cutree(hc, h= 50)) # cluster distribution
# To identify the number of cases for varying number of clusters we can combine calls to cutree and table
# in a call to sapply -- to see the sizes of the clusters for 2≤ k≤10 cluster-solutions:
# numbClusters=5;
myClusters = sapply(2:10,function(numbClusters)table(cutree(hc, numbClusters)))
names(myClusters) <- paste("Number of Clusters=", 2:10, sep = "")
myClusters
#To see which SubjectIDs are in which clusters:
groups.10 <- cutree(hc, k = 10)
sapply(unique(groups.10),function(g)data.1$\$$ID[groups.10 == g])
#To see which Treatments (Tx) are in which clusters:
groups.2 <- cutree(hc, k = 2)
sapply(unique(groups.2),function(g)data.1$\$$Tx[groups.2 == g])
# drill down deeper
table(groups.2, data.1$\$$Tx)
# For a small number of observations, we can often interpret the cluster solution directly by looking
# at the labels of the observations that are in each cluster.
# This is hard for larger data sets. To characterize clusters we can look at cluster summary statistics,
# like the median, of the variables that were used to perform the cluster analysis broken down
# by the groups that the cluster analysis identified.

The aggregate function will compute stats (e.g., median) on many variables simultaneously.

To look at the median values for the variables we've used in the cluster analysis, broken up by the cluster groups:

aggregate(data.1, list(groups.10),median) # may have to shrink data.1 prior to clustering!
# data.2 <- data.1[,-c(1,3)] # Remove ID and Tx variables?
aggregate(data.2, list(groups.2),median) # for only 2 clusters

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Group||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||14||16||0||20||-5||-0.040||2.995||3.275||0.275||41
|-
|2||2||16||15||1||25||0||0.025||3.280||3.360||0.360||104

|}
</center>

table(groups.2, data.1$\$$PhyAct)

# library("Hmisc")

describe(data.1$\$$PhyAct)

# It’s useful to add the numbers of observations in each group (aggregate returns a data frame,
# that can be manipulated)

df.2 <- aggregate(data.1, list(groups.2),median)

data.frame(Cluster= df.2[,1], Freq=as.vector(table(groups.2)), df.2[,-1])

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Cluster||Freq||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||570||14||16||0||20||-5||-0.040||2.995||3.275||0.275||41
|-
|2||2||330||16||15||1||25||0||0.025||3.280||3.360||0.360||104

|}
</center>

===Publications===

• This paper examines nasal and bronchial tissue cultures as appropriate in vitro models for the assessment of smoking-induced adverse effects in the respiratory system (doi: 10.1177/1091581814551647), using “hclust” package. No data.

• This paper classified subtypes of gastric cancer based on epidemiologic and histologic and gene expression data. These new classifications of gastric cancer have implications for improving our understanding of disease biology and identification of unique molecular drivers for each gastric cancer subtype (doi: 10.1158/1078-0432.CCR-10-2203).

Repeat the clustering

# using centroids and squared Euclidean distance
# cut the tree into 10 clusters and reconstruct the upper part of the tree from the cluster centers.
hc <- hclust(dist(data.1), "cen")
mem <- cutree(hc, k = 10)
cent <- NULL
for(k in 1:10){
cent <- rbind(cent, colMeans(data.1[mem == k, , drop = FALSE]))
}

hc1 <- hclust(dist(cent), method = "cen", members = table(mem))

opar <- par(mfrow = c(1, 2))
plot(hc, labels = FALSE, hang = -1, main = "Original Tree")
plot(hc1, hang = -1, main = "Re-start from 10 clusters")
par(opar)

<center>[[Image:SMHS_SciVisualization35.png|500px]] </center>

Identify subjects within each of the 10 classes

rect.hclust(hc, h=10)

# To save the cluster numbers to a new variable in the dataset, use the cutree function.
# data.1$\$$clusterID <- cutree(hc, 10)
data.1$\$$clusterID <- cutree(hc, 10)
head(data.1)

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct||CluserID
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53||1
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73||1
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23||2
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36||2
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21||2
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0||2

|}
</center>

Phylogenetic tree diagram

# library("ape")
plot(as.phylo(hc1), use.edge.length = TRUE, type = "fan")
plot(as.phylo(hc), use.edge.length = TRUE, type = "fan", tip.color = hsv(runif(15, 0.65, 0.95), 1, 1, 0.7), label.offset = 1, cex = log(data.1$\$$ID, 10), col = "red")

<center>[[Image:SMHS_SciVisualization36.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization37.png|500px]] </center>

===Hands-on Activity (Health Behavior Risks)===

# load data CaseStudy09_HealthBehaviorRisks_Data
data.2 <- read.csv("https://umich.instructure.com/files/399182/download?download_frd=1 ", sep=",", header = TRUE)

# Classify the cases using these variables: "AGE_G" "SEX" "RACEGR3" "IMPEDUC" "IMPMRTL"
# "EMPLOY1" "INCOMG" "CVDINFR4" "CVDCRHD4" "CVDSTRK3" "DIABETE3" "RFSMOK3"
# "FRTLT1" "VEGLT1"
data.raw <- data.2[,-c(1,14,17)]

# Does the classification match either of these:
# TOTINDA (Leisure time physical activities per month, 1=Yes, 2=No, 9=Don’t know/Refused/Missing)
# RFDRHV4 (Heavy alcohol consumption, 1=No, 2=Yes, 9=Don’t know/Refused/Missing)

hc = hclust(dist(data.raw), 'ave')
# the agglomeration method can be specified "ward.D", "ward.D2", "single", "complete", "average" (= UPGMA), "mcquitty" (= WPGMA), "median" (= WPGMC) or "centroid" (= UPGMC)

# (3) Plot clustering diagram
par (mfrow=c(1,1))
# very simple dendrogram
plot(hc)

summary(data.2$\$$TOTINDA); summary(data.2$\$$RFDRHV4)

cutree(hc, k = 2)
# alternatively specify the height, which is, the value of the criterion associated with the
# clustering method for the particular agglomeration -- cutree(hc, h= 10)

table(cutree(hc, h= 10)) # cluster distribution

# To identify the number of cases for varying number of clusters we can combine calls to cutree and table
# in a call to sapply -- to see the sizes of the clusters for 2≤ k≤10 cluster-solutions:
# numbClusters=4;
myClusters = sapply(2:5,function(numbClusters)table(cutree(hc, numbClusters)))
names(myClusters) <- paste("Number of Clusters=", 2:5, sep = "")
myClusters

#To see which SubjectIDs are in which clusters:
table(cutree(hc, k=2))
groups.k.2 <- cutree(hc, k = 2)
sapply(unique(groups.k.2),function(g)data.2$\$$ID[groups.k.2 == g])

#To see which TOTINDA (Leisure time physical activities per month, 1=Yes, 2=No, 9=Don’t
# know/Refused/Missing) & whch RFDRHV4 are in which clusters:
groups.k.3 <- cutree(hc, k = 3)
sapply(unique(groups.k.3),function(g)data.2$\$$TOTINDA [groups.k.3 == g])
sapply(unique(groups.k.3),function(g)data.2$\$$RFDRHV4[groups.k.3 == g])

# Perhaps there are intrinsically 3 groups here e.g., 1, 2 and 9 …
groups.k.3 <- cutree(hc, k = 3)
sapply(unique(groups.k.3),function(g)data.2$\$$TOTINDA [groups.k.3 == g])
sapply(unique(groups.k.3),function(g)data.2$\$$RFDRHV4 [groups.k.3 == g])

# Note that there is quite a dependence between the outcome variables …
plot(data.2$\$$RFDRHV4, data.2$\$$TOTINDA)

# drill down deeper
table(groups.k.3, data.2$\$$RFDRHV4)

# To characterize clusters we can look at cluster summary statistics,
# like the median, of the variables that were used to perform the cluster analysis broken down
# by the groups that the cluster analysis identified. The aggregate function will compute stats
# (e.g., median) on many variables simultaneously. To look at the median values for the variables
# we've used in the cluster analysis, broken up by the cluster groups:
aggregate(data.2, list(groups.k.3),median)

==See Next==
<li> [[SMHS_SciVisualization_NetworkViz|Next See the Complex Network Visualization section]]</li>
<li> [[SMHS| Back to the Scientific Methods for Health Sciences EBook ToC]]/<li>

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_SciVisualization_SOCR_Excel_R_Charts}}

SMHS SciVisualization SOCR Excel R Charts

2016-05-19T13:58:33Z

Imoubara: /* Hyperbolic Visualization */

==[[SMHS_SciVisualization| SMHS Scientific Visualization]] - SOCR, Excel and R charts ==

==SOCR Charts==

• URL: http://socr.umich.edu/html/cha/ (Java applet)

• About/List: http://wiki.stat.ucla.edu/socr/index.php/About_pages_for_SOCR_Chart_List

• Activities: http://wiki.stat.ucla.edu/socr/index.php/SOCR_EduMaterials_ChartsActivities

• Data: http://wiki.socr.umich.edu/index.php/SOCR_Data

<center>[[Image:SMHS_SciVisualization2.png|500px]] </center>

==Excel Charts==

MS Excel provides a large number of charts that can be used to quickly and effectively render complex multivariate data. For instance, the table below contains the principal component analysis (PCA) of 50 derived neuroimaging biomarkers (region of interest (ROI) by shape morphometry metric). The loadings of these 50 variables on the top 5 (most significant) principal component directions are shown in the table. Experiment with effective visualizations of these data.

<center>
{| class="wikitable" style="text-align:center; width:99%" border="1"
!Hemi||ROI||measure||ROI_Measure||Dim.1||Dim.2||Dim.3||Dim.4||Dim.5
|-
|L||insular||AvgMeanCurvature||L_insular_cortex_AvgMeanCurvature||0.72||0||0.06||0.06||0
|-
|L||insular||ComputeArea||L_insular_cortex_ComputeArea||0.77||0.06||0.04||0.01||0
|-
|L||insular||Volume||L_insular_cortex_Volume||0.72||0.09||0.04||0.03||0.01
|-
|L||insular||ShapeIndex||L_insular_cortex_ShapeIndex||0.46||0.06||0.01||0.02||0.01
|-
|L||insular||Curvedness||L_insular_cortex_Curvedness||0.78||0||0.05||0.03||0.01
|-
|R||insular||AvgMeanCurvature||R_insular_cortex_AvgMeanCurvature||0.79||0||0.03||0.08||0
|-
|R||insular||ComputeArea||R_insular_cortex_ComputeArea||0.79||0.09||0.03||0.01||0
|-
|R||insular||Volume||R_insular_cortex_Volume||0.73||0.11||0.03||0.03||0
|-
|R||insular||ShapeIndex||R_insular_cortex_ShapeIndex||0.27||0.17||0||0.07||0
|-
|R||insular||Curvedness||R_insular_cortex_Curvedness||0.84||0.02||0.03||0.01||0
|-
|L||cingulate||AvgMeanCurvature||L_cingulate_gyrus_AvgMeanCurvature||0.72||0||0.05||0.02||0.02
|-
|L||cingulate||ComputeArea||L_cingulate_gyrus_ComputeArea||0.74||0.05||0.06||0.04||0.01
|-
|L||cingulate||Volume||L_cingulate_gyrus_Volume||0.69||0.08||0.05||0.05||0.01
|-
|L||cingulate||ShapeIndex||L_cingulate_gyrus_ShapeIndex||0.53||0||0.05||0||0.03
|-
|L||cingulate||Curvedness||L_cingulate_gyrus_Curvedness||0.7||0.01||0.05||0.04||0.03
|-
|R||cingulate||AvgMeanCurvature||R_cingulate_gyrus_AvgMeanCurvature||0.6||0||0.02||0.03||0.01
|-
|R||cingulate||ComputeArea||R_cingulate_gyrus_ComputeArea||0.73||0.06||0.04||0.03||0.01
|-
|R||cingulate||Volume||R_cingulate_gyrus_Volume||0.68||0.09||0.04||0.04||0.01
|-
|R||cingulate||ShapeIndex||R_cingulate_gyrus_ShapeIndex||0.56||0.01||0.05||0||0.01
|-
|R||cingulate||Curvedness||R_cingulate_gyrus_Curvedness||0.25||0||0.01||0.04||0
|-
|L||caudate||AvgMeanCurvature||L_caudate_AvgMeanCurvature||0.52||0||0.05||0||0.01
|-
|L||caudate||ComputeArea||L_caudate_ComputeArea||0.51||0.09||0.03||0.04||0.02
|-
|L||caudate||Volume||L_caudate_Volume||0.44||0.09||0.03||0.06||0.03
|-
|L||caudate||ShapeIndex||L_caudate_ShapeIndex||0.2||0.03||0.04||0.04||0
|-
|L||caudate||Curvedness||L_caudate_Curvedness||0.51||0.12||0.02||0.01||0.01
|-
|R||caudate||AvgMeanCurvature||R_caudate_AvgMeanCurvature||0.68||0.04||0.04||0.02||0
|-
|R||caudate||ComputeArea||R_caudate_ComputeArea||0.67||0.17||0.03||0.02||0.01
|-
|R||caudate||Volume||R_caudate_Volume||0.61||0.16||0.02||0.03||0.01
|-
|R||caudate||ShapeIndex||R_caudate_ShapeIndex||0.18||0.02||0.03||0.11||0
|-
|R||caudate||Curvedness||R_caudate_Curvedness||0.65||0.19||0.01||0||0
|-
|L||putamen||AvgMeanCurvature||L_putamen_AvgMeanCurvature||0.62||0||0.04||0.03||0.02
|-
|L||putamen||ComputeArea||L_putamen_ComputeArea||0.56||0.05||0.04||0.03||0.05
|-
|L||putamen||Volume||L_putamen_Volume||0.52||0.07||0.04||0.05||0.05
|-
|L||putamen||ShapeIndex||L_putamen_ShapeIndex||0.06||0.13||0||0.15||0
|-
|L||putamen||Curvedness||L_putamen_Curvedness||0.64||0.11||0.03||0.01||0.03
|-
|R||putamen||AvgMeanCurvature||R_putamen_AvgMeanCurvature||0.62||0||0.07||0.04||0.01
|-
|R||putamen||ComputeArea||R_putamen_ComputeArea||0.66||0.08||0.03||0.01||0.03
|-
|R||putamen||Volume||R_putamen_Volume||0.64||0.12||0.03||0.02||0.03
|-
|R||putamen||ShapeIndex||R_putamen_ShapeIndex||0.15||0.24||0||0.08||0.03
|-
|R||putamen||Curvedness||R_putamen_Curvedness||0.65||0.05||0.05||0||0.02
|-
|L||hippocampus||AvgMeanCurvature||L_hippocampus_AvgMeanCurvature||0.78||0||0.01||0.04||0
|-
|L||hippocampus||ComputeArea||L_hippocampus_ComputeArea||0.75||0.07||0.01||0||0.02
|-
|L||hippocampus||Volume||L_hippocampus_Volume||0.72||0.09||0.01||0.01||0.01
|-
|L||hippocampus||ShapeIndex||L_hippocampus_ShapeIndex||0.45||0.17||0||0.04||0.02
|-
|L||hippocampus||Curvedness||L_hippocampus_Curvedness||0.79||0.03||0.01||0||0.02
|-
|R||hippocampus||AvgMeanCurvature||R_hippocampus_AvgMeanCurvature||0.72||0||0||0.1||0.01
|-
|R||hippocampus||ComputeArea||R_hippocampus_ComputeArea||0.71||0.09||0||0||0.05
|-
|R||hippocampus||Volume||R_hippocampus_Volume||0.68||0.1||0||0||0.04
|-
|R||hippocampus||ShapeIndex||R_hippocampus_ShapeIndex||0.37||0.18||0||0.02||0.03
|-
|R||hippocampus||Curvedness||R_hippocampus_Curvedness||0.77||0.03||0||0.02||0.04
|}
</center>

<center>[[Image:SMHS_SciVisualization3.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization4.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization5.png|500px]] </center>

==R-Charts==

There are 100’s of packages and 1,000 of different charts, plots and graphs that can be generated using R. Such interactive visualizations enable deeper exploration of data, models and results. JavaScript libraries, e.g., D3, provide advantages for data visualization as these involve HTML5 and are easily shareable online. The R community is developing R interfaces to some popular JavaScript libraries to allow users to create interactive visualizations without detailed knowledge of JavaScript.

===Examples of powerful R interactive visualization packages===

• ggplot2 – http://ggplot2.org

• ggvis – interactive plots extending the static ggplot2 charts, http://ggvis.rstudio.com

• rCharts – R interface to multiple JavaScript charting libraries, http://rcharts.io

• plotly – transforming ggplot2 charts into interactive plots, https://plot.ly/r

• googleVis – Google Charts using R, http://cran.r-project.org/web/packages/googleVis/vignettes/googleVis_examples.html

• HTMLWidgets
<blockquote>o leaflet – library for creating dynamic maps, supports panning and zooming, annotations, markers, polygons, etc. http://www.htmlwidgets.org/showcase_leaflet.html</blockquote>

<blockquote>o dygraphs – provides mechanism for charting time-series data, supports interactive navigation features including series/point highlighting, zooming, and panning, http://www.htmlwidgets.org/showcase_dygraphs.html</blockquote>

<blockquote>o networkD3 – library for creating D3 network graphs including force directed networks, Sankey diagrams, and Reingold-Tilford tree networks, http://www.htmlwidgets.org/showcase_networkD3.html</blockquote>

<blockquote>o DataTables – displays R matrices or data frames as interactive HTML tables that support filtering, pagination, and sorting, http://www.htmlwidgets.org/showcase_datatables.html</blockquote>

<blockquote>o Rthreejs – features 3D scatterplots and globes based on WebGL, http://www.htmlwidgets.org/showcase_threejs.html</blockquote>

• Other R graphic examples
<blockquote>o To write out plots out to file use:</blockquote>
# pdf() command all graphs are redirected to test.pdf. Also works with other common formats: jpeg, png, ps, tiff.
pdf("C:\\Users\\Dinov\\Desktop\\test.pdf"); plot(1:100, 1:100); dev.off()
# Generates Scalable Vector Graphics (SVG) that can be edited by vector graphics software
svg("test.svg"); plot(1:100, 1:100); dev.off()

===Paired ScatterPlots===

set.seed(100)
x <- matrix(runif(50), ncol=5, dimnames=list(letters[1:10], LETTERS[1:5]))
describe(x) # library("Hmisc")
plot(x[,1], x[,2], pch=20, col="red", main="Symbols and Labels")
text(x[,1]+0.03, x[,2], rownames(x))

<center>[[Image:SMHS_SciVisualization6.png|500px]] </center>

pairs(x)

<center>[[Image:SMHS_SciVisualization7.png|500px]] </center>

Another way to generate scatterplots is by using ggplot:

# library(ggplot2)
x <- sample(1:20, 20); y <- sample(1:20, 20); cat <- rep(c("A", "B", "C", "D"), 5)
#vs. cat <- rep(c("A", "B", "C", "D"), each=5)
plot.1 <- qplot(x, y, geom="point", size=5*x, color=cat, main="GGplot with Relative Dot Size and Color") + theme(legend.position = "topleft")
print(plot.1)

# Use Case-Studies: https://umich.instructure.com/courses/38100/files/folder/Case_Studies
# Case_03_MentalHealthServicesSurvey
# data1 <- read.table('https://umich.instructure.com/files/399128/download?download_frd=1&verifier=AG2e9QUKUm1jvDBpkX7D9jbEjKNc4irA0ECk0f7p', header=T)
head(data1)
attach(data1)
# library("Hmisc")
describe(data1)

plot(data1[,3], data1[,4], pch=20, col="red", main="Symbols and Labels")
# text(data1 [,3]+0.03, data1 [,4], rownames(data1))
plot.1 <- qplot(x, y, geom="point", size=5*x, color=cat, main="GGplot with Relative Dot Size and Color") + theme(legend.position = "topleft")
print(plot.1)

# redo plots using majorfundtype FacilityType Ownership Focus
# pairs(data1, na.action=na.omit)

<center>[[Image:SMHS_SciVisualization8.png|500px]] </center>

# Scatterplot with regression line. Use the “diamonds” dataset, which is a data frame with
# 53,940 rows and 10 variables ()
# describe(diamonds)

# Use Case-Studies: https://umich.instructure.com/courses/38100/files/folder/Case_Studies
# CaseStudy01_Divorce_YoungAdults
# data1 <- read.csv('https://umich.instructure.com/files/399118/download?download_frd=1&verifier=ESACv31KcyiHbkPZPuT8Oo4V7XzPtgTTbs6PQLTv', header=T)
attach(data1)
# plot variables: DIVYEAR momint dadint momclose depression livewithmom gethitched

set.seed(110)
# par(mfrow=c(1,2))
data.2 <- diamonds[sample(nrow(diamonds), 500), ]
plot.2 <- qplot(price, depth, data = data.2, geom = c("point", "smooth"), method = "lm")
plot.3 <- qplot(carat, price, data=data.2, geom=c("point", "smooth"), span=0.4)
print(plot.2); print(plot.3)

<center>[[Image:SMHS_SciVisualization9.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization10.png|500px]] </center>

===Barplots===

x <- matrix(runif(50), ncol=5, dimnames=list(letters[1:10], LETTERS[1:5]))
barplot(x[1:4,], ylim=c(0, max(x[1:4,])+0.3), beside=TRUE, legend.text = letters[1:4],
args.legend = list(x = "topleft"))
text(labels=round(as.vector(as.matrix(x[1:4,])),2), x=seq(1.5, 21, by=1) + sort(rep(c(0,1,2,3,4), 4)), y=as.vector(as.matrix(x[1:4,]))+0.1)

<center>[[Image:SMHS_SciVisualization11.png|500px]] </center>

# to put error bars on barplot:

# 10 rows (a, b, c, …):
bar <- barplot(m <- rowMeans(x) * 10, ylim=c(0, 10))
stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

# Case_04_ChildTrauma
# data1 <- read.table('https://umich.instructure.com/files/399129/download?download_frd=1&verifier=Hmv0YW2Kie5ZTV9CKBUNArSHR66f3GWSmVzZDBxc', header=T)
attach(data1)
head(x)
head(data1)
# plot data
data2 <- data1[,-5] # remove the 5th columns text
data1 <- data2[,-5] # remove the 6th columns text
# or data1 <- data1[,c(-5,-6)]

data2 <- as.data.frame(data1)
Blacks <- data2[which(data2$\$$race=="black"),]
Other <- data2[which(data2$\$$race=="other"),]
Hispanic <- data2[which(data2$\$$race=="hispanic"),]
White <- data2[which(data2$\$$race=="white"),]

A <- c(mean(Blacks$\$$age), mean(Blacks$\$$service))
#colnames(A) <- c("age "," service ")
B <- c(mean(Other$\$$age), mean(Other$\$$service))
C <- c(mean(Hispanic$\$$age), mean(Hispanic$\$$service))
D <- c(mean(White$\$$age), mean(White$\$$service))

x <- cbind(A, B, C, D)

bar <- barplot(x[1:2,], ylim=c(0, max(x[1:2,])+2.0), beside=TRUE,
legend.text = c("age","service") , args.legend = list(x = "right"))
text(labels=round(as.vector(as.matrix(x[1:2,])),2), x=seq(1.4, 21, by=1.5), #y=as.vector(as.matrix(x[1:2,]))+0.3)
y=11.5)

m <- x; stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

barplot(as.matrix(data1[1:4,]), ylim=c(0, max(data1[1:4,])+0.3), beside=TRUE, legend.text = data1[1:4,1], args.legend = list(x = "topleft"))
text(labels=round(as.vector(as.matrix(data1[1:4,])),2), x=seq(1.5, 21, by=1), y=as.vector(as.matrix(data1[1:4,]))+0.1)

<center>[[Image:SMHS_SciVisualization12.png|500px]] </center>

# Columns (A, B, C, D, E):
bar <- barplot(m <- colMeans(x) * 5, ylim=c(0, 5))
stdev <- sd(t(x))
arrows(bar, m, bar, m + stdev, length=0.15, angle = 90)

<center>[[Image:SMHS_SciVisualization13.png|500px]] </center>

===Histograms and Density Plots===

hist(x, freq=TRUE, breaks=10)

<center>[[Image:SMHS_SciVisualization14.png|500px]] </center>

plot(density(x), lwd = 10, col="green")

<center>[[Image:SMHS_SciVisualization15.png|500px]] </center>

===Pie Chart===

# first , “A”, and second, “B”, columns
par (mfrow=c(1,2))
pie(x[,1], col=rainbow(length(x[,1]), start=0.1, end=0.8), clockwise=TRUE)

pie(x[,1], col=rainbow(length(x[,1]), start=0.1, end=0.8), clockwise=TRUE)

pie(x[,2], col=rainbow(length(x[,2]), start=0.1, end=0.8), clockwise=TRUE)
legend("topleft", legend=row.names(x), cex=1.3, bty="n", pch=15, pt.cex=1.8, col=rainbow(length(x[,2]), start=0.1, end=0.8), ncol=1)

<center>[[Image:SMHS_SciVisualization16.png|500px]] </center>

You can export the data:
write.table(x, " ", "data.txt")
# copy-paste it in SOCR Pie chart to generate another Pie view of data

===Line Plots Using ggplot===

head(diamonds)

<center>
{| class="wikitable" style="text-align:center; " border="1"
|-
| ||Carat||Cut||Color||Clarity||Depth||Table||Price||X||Y||Z
|-
|1||0.23||Ideal||E||SI2||61.5||55||326||3.95||3.98||2.43
|-
|2||0.21||Premium||E||SI1||59.8||61||326||3.89||3.84||2.31
|-
|3||0.23||Good||E||VS1||56.9||65||237||4.05||4.07||2.31
|-
|4||0.29||Premium||I||VS2||62.4||58||334||4.2||4.23||2.63
|-
|5||0.31||Good||J||SI2||63.3||58||335||4.34||4.35||4.75
|-
|6||0.24||VeryGood||J||VVS2||62.8||57||336||3.94||3.96||2.48
|}
</center>

plot.2 <- ggplot(diamonds, aes(carat, price, group=cut, color=cut)) + geom_line()
print(plot.2)

<center>[[Image:SMHS_SciVisualization17.png|500px]] </center>

plot.2 <- ggplot(data1, aes(age, service, group=race, color=race)) + geom_line()
print(plot.2)

# Faceting plot (geometrically, faceting (or facetting) is the process of removing parts of a polygon, polyhedron or polytope, without creating any new vertices)
plot.3 <- ggplot(diamonds, aes(carat, price)) + geom_line(aes(color=cut), size=1) +
facet_wrap(~cut, ncol=1)
print(plot.3)

<center>[[Image:SMHS_SciVisualization18.png|500px]] </center>

===Barplots with ggplot===

plot.4 <- ggplot(diamonds, aes(cut, fill=cut)) + geom_bar() + facet_grid(. ~ clarity)
print(plot.4)

<center>[[Image:SMHS_SciVisualization19.png|500px]] </center>

New_var <- service+rnorm(1000, 0,1)
data1$\$$New_var <- int(New_var)
plot.4 <- ggplot(data1, aes(race, fill= traumatype)) + geom_bar() + facet_grid(. ~ New_var)
print(plot.4)

plot.4a <- ggplot(diamonds, aes(color, price/carat, fill=color)) + geom_boxplot()
print(plot.4a)

<center>[[Image:SMHS_SciVisualization20.png|500px]] </center>

===Jitter plot===

plot.5 <- ggplot(diamonds, aes(color, price/carat)) + geom_jitter(alpha = I(1 / 2), aes(color=color))
print(plot.5)

<center>[[Image:SMHS_SciVisualization21.png|500px]] </center>

===Density Plots===

plot.6 <- ggplot(diamonds, aes(carat, size=2)) + geom_density(aes(color = cut))
print(plot.6)

<center>[[Image:SMHS_SciVisualization22.png|500px]] </center>

plot.6 <- ggplot(data1, aes(age, size=2)) + geom_density(aes(color = traumatype))
print(plot.6)

plot.7 <- ggplot(diamonds, aes(carat, size=2)) + geom_density(aes(fill = color))
print(plot.7)

<center>[[Image:SMHS_SciVisualization23.png|500px]] </center>

plot.8 <- ggplot(diamonds, aes(x=carat, size=1)) + geom_histogram(aes(y = price), binwidth=0.2) + geom_density()
print(plot.8)

<center>[[Image:SMHS_SciVisualization24.png|500px]] </center>

plot.8a <- ggplot(diamonds, aes(x=carat, size=1)) + geom_histogram(aes(y = price), stat="identity") + geom_density()
print(plot.8a)

<center>[[Image:SMHS_SciVisualization25.png|500px]] </center>

===Heatmaps===

# Generating Dendogram Association Heatmap Plot (Genotype vs. Imaging phenotype)
# http://stat.ethz.ch/R-manual/R-patched/library/stats/html/heatmap.html
# http://www.ncbi.nlm.nih.gov/pmc/articles/PMC4005931/

AD_Associations_Data <- read.table("https://umich.instructure.com/files/330387/download?download_frd=1&verifier=gLk2ADgrLhXGeknI6mqIeJugi2ODr8RARsQlBUMe", header=TRUE, row.names=1, sep=",", dec=".")

MCI_Associations_Data <- read.table("https://umich.instructure.com/files/330390/download?download_frd=1&verifier=FczlJD6ISRPZhu69xvHuoZHx2c7gXX9YEvvPCTBG", header=TRUE, row.names=1, sep=",", dec=".")

NC_Associations_Data <- read.table("https://umich.instructure.com/files/330391/download?download_frd=1&verifier=i2BEtSpmpbrzQUPoA2ST06IzzcaenyVEHRepHSF3", header=TRUE, row.names=1, sep=",", dec=".")

require(graphics)
require(grDevices)
library(gplots)

AD_Data <- AD_Associations_Data
MCI_Data <- MCI_Associations_Data
NC_Data <- NC_Associations_Data

AD_mat <- as.matrix(AD_Data); class(AD_mat) <- "numeric"
MCI_mat <- as.matrix(MCI_Data); class(MCI_mat) <- "numeric"
NC_mat <- as.matrix(NC_Data); class(NC_mat) <- "numeric"

# set up the rol (rc) and column (cc) colors for each cohort
rcAD <- rainbow(nrow(AD_mat), start = 0, end = 1.0); ccAD<-rainbow(ncol(AD_mat), start = 0, end = 1.0)
rcMCI <- rainbow(nrow(MCI_mat), start = 0, end=1.0); ccMCI<-rainbow(ncol(MCI_mat),start=0,end=1.0)
rcNC <- rainbow(nrow(NC_mat), start = 0, end = 1.0); ccNC<-rainbow(ncol(NC_mat), start = 0, end = 1.0)

# set up 1x3 graph display - par (mfrow=c(1,3)) – does not work with ‘heatmap’
hvAD <- heatmap(AD_mat, col = cm.colors(256), scale = "column", RowSideColors = rcAD, ColSideColors = ccAD, margins = c(2,2), main="AD Cohort SNP-ROI_volume Association (p_values)")
hvMCI <- heatmap(MCI_mat, col = cm.colors(256), scale = "column", RowSideColors = rcMCI, ColSideColors = ccMCI, margins = c(2,2), main="MCI Cohort SNP-ROI_volume Association (p_values)")
hvNC <- heatmap(NC_mat, col = cm.colors(256), scale = "column", RowSideColors = rcNC, ColSideColors = ccNC, margins = c(2,2), main="NC Cohort SNP-ROI_volume Association (p_values)")

<center>[[Image:SMHS_SciVisualization26.png|500px]] </center>

# Alternatively, we can use the R package gplots
install.packages("gplots")
library(gplots)
## col dendrogram plotted and col reordering done.
# heatmap.2(AD_mat, keysize=2)
## A more decorative heatmap, with z-score scaling along columns
heatmap.2(AD_mat, col=cm.colors(255), scale="column", RowSideColors=rcAD, ColSideColors=ccAD, margin=c(8, 7), xlab="Imaging Biomarkers (ROI volume)", ylab= "Genetics Biomarkers (SNPs)", main="AD Associations Heatmap (SNP-Imaging)", tracecol="green", density="density")

<center>[[Image:SMHS_SciVisualization27.png|500px]] </center>

===Correlation Plots===

The corrplot package is a graphical display of a correlation matrix and confidence intervals, with some tools for matrix reordering. There are seven visualization methods (parameter method) in corrplot package, named "circle", "square", "ellipse", "number", "shade", "color", "pie".
# install.packages("corrplot")
library(corrplot)
NC_Associations_Data <- read.table("https://umich.instructure.com/files/330391/download?download_frd=1&verifier=i2BEtSpmpbrzQUPoA2ST06IzzcaenyVEHRepHSF3", header=TRUE, row.names=1, sep=",", dec=".")
M <- cor(NC_Associations_Data)

<center>[[Image:SMHS_SciVisualization28.png|500px]] </center>

===Hyperbolic Visualization===

• URL: http://socr.umich.edu/html/Navigators.html

• Tools:

<blockquote>o Java/Jar applet: http://socr.umich.edu/html/navigators/HW/jars/SOCR_HW_Viewer.jar</blockquote>

<blockquote>o JavaScript: http://socr.umich.edu/html/navigators/D3/SOCR_D3_Viewer.html (JSON)</blockquote>

• Data Format

<blockquote>o XML data: http://socr.umich.edu/html/navigators/HW/SOCR_HyperTree.xml</blockquote>

<blockquote>o JSON data: http://socr.umich.edu/html/navigators/D3/xml/SOCR_HyperTree.json</blockquote>

• D3 Visualization

<blockquote>o E:\Ivo.dir\Research\UMichigan\Education_Teaching_Curricula\2015_2016\HS_853_Fall_2015\Modules_docx\Tools\TreeViewer_JS</blockquote>

<blockquote>o treeJS.json</blockquote>

<blockquote>o flareD3.json</blockquote>

<center>[[Image:SMHS_SciVisualization29.png|300px]] </center>

<center>[[Image:SMHS_SciVisualization30.png|300px]] </center>

• URL: https://github.com/mbostock/d3/wiki/Gallery

• Source code: https://github.com/mbostock/d3

<center>[[Image:SMHS_SciVisualization31.png|500px]] </center>

===Motion Charts===

• Video: http://www.socr.ucla.edu/SOCR_MotionCharts/SOCR_HTML5_MotionChart_Video2.gif

• Java: http://www.socr.ucla.edu/SOCR_MotionCharts/

• HTML5: http://socr.umich.edu/HTML5/MotionChart/

• Activities: http://wiki.socr.umich.edu/index.php/SOCR_MotionCharts

<center>[[Image:SMHS_SciVisualization32.png|500px]] </center>

===1D/2D/3D signal/area/volume/surface/model/atlas visualization===

• 1D: (See R/SOCR Visualization tools above)

• 2D: http://imagej.nih.gov/ij/

• 3D: http://socr.umich.edu/HTML5/BrainViewer/

Supported File Formats:
Volumes (.nii / .nii.gz / .img&.hdr / .mgh / .mgz / .nrrd)
Shapes (.dx / .vtk / .stl / FreeSurfer)
Fibers (.trk)

<center>[[Image:SMHS_SciVisualization33.png|500px]] </center>

===Trees and Graphs===

• Trees/Hierarchies and general Graphs

# Install and load the APE package, needed for the phylogenetic tree rendering (as.phylo)
# install.packages("ape")
library("ape")

Load data

# Data: 02_Nof1_Data.csv
data.1 <- read.table("https://umich.instructure.com/files/330385/download?download_frd=1&verifier=DwJUGSd6t24dvK7uYmzA2aDyzlmsohyaK6P7jK0Q ", sep=",", header = TRUE)
head(data.1)

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
mydata1
|-
|||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0

|}
</center>

Clustering

hc = hclust(dist(data.1), 'ave')
# the agglomeration method can be specified "ward.D", "ward.D2", "single","complete", "average" (= UPGMA), "mcquitty" (= WPGMA),"median" (= WPGMC) or "centroid" (= UPGMC)

# (3) Plot clustering diagram
par (mfrow=c(1,1))
# very simple dendrogram
plot(hc)

<center>[[Image:SMHS_SciVisualization34.png|500px]] </center>

require(graphics)
(x <- identify(hc)) ## Terminate with 2nd mouse button !!
identify(hc, function(k) print(table(data.1[k,5])))

You can now cut the tree into branches. You can split the tree into 2 groups, by setting the number of cuts with the k=2 parameter, or by specifying height to cut the tree at (?cutree):

k an integer scalar or vector with the desired number of groups
h numeric scalar or vector with heights where the tree should be cut

cutree(hc, k = 2)
# alternatively specify the height, which is, the value of the criterion associated with the clustering method
# for the particular agglomeration.
cutree(hc, h= 50) # cut at h=50
table(cutree(hc, h= 50)) # cluster distribution
# To identify the number of cases for varying number of clusters we can combine calls to cutree and table
# in a call to sapply -- to see the sizes of the clusters for 2≤ k≤10 cluster-solutions:
# numbClusters=5;
myClusters = sapply(2:10,function(numbClusters)table(cutree(hc, numbClusters)))
names(myClusters) <- paste("Number of Clusters=", 2:10, sep = "")
myClusters
#To see which SubjectIDs are in which clusters:
groups.10 <- cutree(hc, k = 10)
sapply(unique(groups.10),function(g)data.1$\$$ID[groups.10 == g])
#To see which Treatments (Tx) are in which clusters:
groups.2 <- cutree(hc, k = 2)
sapply(unique(groups.2),function(g)data.1$\$$Tx[groups.2 == g])
# drill down deeper
table(groups.2, data.1$\$$Tx)
# For a small number of observations, we can often interpret the cluster solution directly by looking
# at the labels of the observations that are in each cluster.
# This is hard for larger data sets. To characterize clusters we can look at cluster summary statistics,
# like the median, of the variables that were used to perform the cluster analysis broken down
# by the groups that the cluster analysis identified.

The aggregate function will compute stats (e.g., median) on many variables simultaneously.

To look at the median values for the variables we've used in the cluster analysis, broken up by the cluster groups:

aggregate(data.1, list(groups.10),median) # may have to shrink data.1 prior to clustering!
# data.2 <- data.1[,-c(1,3)] # Remove ID and Tx variables?
aggregate(data.2, list(groups.2),median) # for only 2 clusters

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Group||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||14||16||0||20||-5||-0.040||2.995||3.275||0.275||41
|-
|2||2||16||15||1||25||0||0.025||3.280||3.360||0.360||104

|}
</center>

table(groups.2, data.1$\$$PhyAct)

# library("Hmisc")

describe(data.1$\$$PhyAct)

# It’s useful to add the numbers of observations in each group (aggregate returns a data frame,
# that can be manipulated)

df.2 <- aggregate(data.1, list(groups.2),median)

data.frame(Cluster= df.2[,1], Freq=as.vector(table(groups.2)), df.2[,-1])

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||Cluster||Freq||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct
|-
|1||1||570||14||16||0||20||-5||-0.040||2.995||3.275||0.275||41
|-
|2||2||330||16||15||1||25||0||0.025||3.280||3.360||0.360||104

|}
</center>

===Publications===

• This paper examines nasal and bronchial tissue cultures as appropriate in vitro models for the assessment of smoking-induced adverse effects in the respiratory system (doi: 10.1177/1091581814551647), using “hclust” package. No data.

• This paper classified subtypes of gastric cancer based on epidemiologic and histologic and gene expression data. These new classifications of gastric cancer have implications for improving our understanding of disease biology and identification of unique molecular drivers for each gastric cancer subtype (doi: 10.1158/1078-0432.CCR-10-2203).

Repeat the clustering

# using centroids and squared Euclidean distance
# cut the tree into 10 clusters and reconstruct the upper part of the tree from the cluster centers.
hc <- hclust(dist(data.1), "cen")
mem <- cutree(hc, k = 10)
cent <- NULL
for(k in 1:10){
cent <- rbind(cent, colMeans(data.1[mem == k, , drop = FALSE]))
}

hc1 <- hclust(dist(cent), method = "cen", members = table(mem))

opar <- par(mfrow = c(1, 2))
plot(hc, labels = FALSE, hang = -1, main = "Original Tree")
plot(hc1, hang = -1, main = "Re-start from 10 clusters")
par(opar)

<center>[[Image:SMHS_SciVisualization35.png|500px]] </center>

Identify subjects within each of the 10 classes

rect.hclust(hc, h=10)

# To save the cluster numbers to a new variable in the dataset, use the cutree function.
# data.1$\$$clusterID <- cutree(hc, 10)
data.1$\$$clusterID <- cutree(hc, 10)
head(data.1)

<center>
{| class="wikitable" style="text-align:center; width:35%" border="1"
|-
|||ID||Day||Tx||SelfEff||SelfEff25||WPSS||SocSuppt||PMss||PMss3||PhyAct||CluserID
|-
|1||1||1||1||33||8||0.97||5.00||4.03||1.03||53||1
|-
|2||1||2||1||33||8||-0.17||3.87||4.03||1.03||73||1
|-
|3||1||3||0||33||8||0.81||4.84||4.03||1.03||23||2
|-
|4||1||4||0||33||8||-0.41||3.62||4.03||1.03||36||2
|-
|5||1||5||1||33||8||0.59||4.62||4.03||1.03||21||2
|-
|6||1||6||1||33||8||-1.16||2.87||4.03||1.03||0||2

|}
</center>

Phylogenetic tree diagram

# library("ape")
plot(as.phylo(hc1), use.edge.length = TRUE, type = "fan")
plot(as.phylo(hc), use.edge.length = TRUE, type = "fan", tip.color = hsv(runif(15, 0.65, 0.95), 1, 1, 0.7), label.offset = 1, cex = log(data.1$\$$ID, 10), col = "red")

<center>[[Image:SMHS_SciVisualization36.png|500px]] </center>

<center>[[Image:SMHS_SciVisualization37.png|500px]] </center>

===Hands-on Activity (Health Behavior Risks)===

# load data CaseStudy09_HealthBehaviorRisks_Data
data.2 <- read.csv("https://umich.instructure.com/files/399182/download?download_frd=1 ", sep=",", header = TRUE)

# Classify the cases using these variables: "AGE_G" "SEX" "RACEGR3" "IMPEDUC" "IMPMRTL"
# "EMPLOY1" "INCOMG" "CVDINFR4" "CVDCRHD4" "CVDSTRK3" "DIABETE3" "RFSMOK3"
# "FRTLT1" "VEGLT1"
data.raw <- data.2[,-c(1,14,17)]

# Does the classification match either of these:
# TOTINDA (Leisure time physical activities per month, 1=Yes, 2=No, 9=Don’t know/Refused/Missing)
# RFDRHV4 (Heavy alcohol consumption, 1=No, 2=Yes, 9=Don’t know/Refused/Missing)

hc = hclust(dist(data.raw), 'ave')
# the agglomeration method can be specified "ward.D", "ward.D2", "single", "complete", "average" (= UPGMA), "mcquitty" (= WPGMA), "median" (= WPGMC) or "centroid" (= UPGMC)

# (3) Plot clustering diagram
par (mfrow=c(1,1))
# very simple dendrogram
plot(hc)

summary(data.2$\$$TOTINDA); summary(data.2$\$$RFDRHV4)

cutree(hc, k = 2)
# alternatively specify the height, which is, the value of the criterion associated with the
# clustering method for the particular agglomeration -- cutree(hc, h= 10)

table(cutree(hc, h= 10)) # cluster distribution

# To identify the number of cases for varying number of clusters we can combine calls to cutree and table
# in a call to sapply -- to see the sizes of the clusters for 2≤ k≤10 cluster-solutions:
# numbClusters=4;
myClusters = sapply(2:5,function(numbClusters)table(cutree(hc, numbClusters)))
names(myClusters) <- paste("Number of Clusters=", 2:5, sep = "")
myClusters

#To see which SubjectIDs are in which clusters:
table(cutree(hc, k=2))
groups.k.2 <- cutree(hc, k = 2)
sapply(unique(groups.k.2),function(g)data.2$\$$ID[groups.k.2 == g])

#To see which TOTINDA (Leisure time physical activities per month, 1=Yes, 2=No, 9=Don’t
# know/Refused/Missing) & whch RFDRHV4 are in which clusters:
groups.k.3 <- cutree(hc, k = 3)
sapply(unique(groups.k.3),function(g)data.2$\$$TOTINDA [groups.k.3 == g])
sapply(unique(groups.k.3),function(g)data.2$\$$RFDRHV4[groups.k.3 == g])

# Perhaps there are intrinsically 3 groups here e.g., 1, 2 and 9 …
groups.k.3 <- cutree(hc, k = 3)
sapply(unique(groups.k.3),function(g)data.2$\$$TOTINDA [groups.k.3 == g])
sapply(unique(groups.k.3),function(g)data.2$\$$RFDRHV4 [groups.k.3 == g])

# Note that there is quite a dependence between the outcome variables …
plot(data.2$\$$RFDRHV4, data.2$\$$TOTINDA)

# drill down deeper
table(groups.k.3, data.2$\$$RFDRHV4)

# To characterize clusters we can look at cluster summary statistics,
# like the median, of the variables that were used to perform the cluster analysis broken down
# by the groups that the cluster analysis identified. The aggregate function will compute stats
# (e.g., median) on many variables simultaneously. To look at the median values for the variables
# we've used in the cluster analysis, broken up by the cluster groups:
aggregate(data.2, list(groups.k.3),median)

==See Next==
<li> [[SMHS_SciVisualization_NetworkViz|Next See the Complex Network Visualization section]]</li>
<li> [[SMHS| Back to the Scientific Methods for Health Sciences EBook ToC]]/<li>

<hr>
* SOCR Home page: http://www.socr.umich.edu
{{translate|pageName=http://wiki.socr.umich.edu/index.php?title=SMHS_SciVisualization_SOCR_Excel_R_Charts}}