---
title: "Activity scores"
author: "Pharmacogenetic dose modelling, the authors"
date: "2022-09-27"
output:
  word_document: default
  html_document: default
  pdf_document: default
editor_options: 
  markdown: 
    wrap: 72
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
source("preproc.R")

library(ggplot2)
library(rstan)
options(mc.cores = 4)
rstan_options(auto_write = TRUE)

```

This markdown contains the script to produce **Supplementary File 2**.

## Preliminary exploration of data

In the figure below, estimated dose adjustments were plotted as a
function of phenotype, coded in expression grades of equal intervals
from the PM to the UM phenotypes.

```{r plot_equi_levels, echo = FALSE, fig.cap = "Estimated dose adjustments, equally spaced phenotypic groups "}
cypsel$weights <- cypsel$Size / sum(cypsel$Size) * nrow(cypsel)
ggplot(cypsel, aes(x = round(Activity), y = Adjustment, color = Class)) +
	geom_boxplot(aes(group = Activity), outlier.size = 0, show.legend=F) + 
	geom_line(aes(group = StudyID), alpha = 0.4) + 
	geom_smooth(aes(group = 1, weight = weights), 
	            colour = "#000000", fill="#D0D0D0", size=1, 
	            method = "lm", formula = y~poly(x,3), show.legend = F) + 
	geom_point(aes(size = Size), shape = 1) +
	scale_y_continuous("Adjustment (in %)") + 
	scale_size_continuous("Size") + 
  xlab("Equally spaced activity scores") +
  scale_x_continuous(labels = c("", "PM", "IM", "", "RM", "UM", "")) +
  theme_classic(base_size = 16)
```

Several properties of the data are apparent from this plot. First, some
substances appear not to be metabolized by CYP2C19. One study on
mianserine (by Dahl et al. 1994) provides an adjustment that strongly
contradicts physiological expectations, increasing dose by about 45% in
PMs instead of decreasing. Second, the fitted line is a cubic
polynomial, and shows the effect to be almost linear. Third, the spread
upwards of the observations seems to be too large.

In the following, we address these problems in a series of steps. First,
we will estimate mean dose adjustments in each allelic phenotype
separately to compute activity scores from the data. In this
computation, we excluded data from substances that appear not to be
metabolized by CYP2C19 (mianserine, maprotiline, fluoxetine and
fluvoxamine). Second, we will test the linearity of the effect of these
activity scores on dose adjustments by adding quadratic and cubic
polynomials. Finally, we will evaluate the need of a logarithmic
transformation of the data.

## Activity scores

We first looked at the activity scores as may be estimated from these
data by fitting a model where phenotypes are qualitative levels of a
single factor, using studies as a random effect (to adjust for possible
systematic differences in adjustment levels). This amounts to estimating
the mean adjustements in each allelic group after allowing for random
effects and possible other confounders.

To estimate activity scores, we fix the EM group to zero, and set the
effect of the IM group to -1 (as this group has one \*2 allele). Note
that the base and scale of a measure scale must be chosen by convention.
We based the scale to the IM group because there are more data in this
group than in the PM and RM groups. To weight individual studies
appropriately, we estimate variance components of the variability within
and between studies,

$$adjustment_i = phenotype_i + study_{j[i]} + \epsilon_i, i=1,\dots,N, j=1,\dots,M$$
$$study_j \sim N(0, \sigma_{studies}),$$ where $i$ indexes the $N$
datapoints and $j$ the $M$ studies.

In this and all subsequent models, we face the problem of weighting
datapoints by the amount of information provided by the sample size of
the original studies. Since only information on sample size is provided
in most studies, we assumed equal within-datapoints variance and
modelled the variance of the datapoints as normally distributed with two
variance components,

$$\epsilon_i \sim N(0, \sigma^2_w/n_i + \sigma^2_b), i=1,\dots,N,$$\
where $\epsilon_i$ is the residual error, $n_i$ is the known number of
observations in the datapoint in the $i^{th}$ sample, and $\sigma^2_w$
and $\sigma^2_b$ are the within-datapoint and between-datapoint
variances to be estimated from the data (this model is specified in
levels.stan and levels_cov.stan).

```{r actscores }
#get rid of EM measurements and keep only putative substrates
cypx <- filter(cyp, Phenotype != "EM" & Selection == TRUE & Status == "OK")

#identify substances for which we have estimates for all allelic phenotypes
substances <- cypx %>% select(StudyID, Substance, Phenotype) %>% 
  group_by(Substance, Phenotype) %>% 
  summarize(count = n_distinct(Phenotype)) %>% 
  summarize(countphens = sum(count)) %>% filter(countphens > 3)

#restrict the analysis to these substances
cypx <- semi_join(cypx, substances, by = "Substance")

#create a dummy variable for levels of phenotype as factor
phen <- cypx$StudyID
phen[cypx$Phenotype == "IM"] <- 1
phen[cypx$Phenotype == "PM"] <- 2
phen[cypx$Phenotype == "RM"] <- 3
phen[cypx$Phenotype == "UM"] <- 4

#create indicator variable for studies included in dataset
studyID <- cypx$StudyID
counter = 1
for (i in 2:nrow(cypx)) {
  if (cypx$StudyID[i-1] != cypx$StudyID[i]) 
    counter <- counter + 1
  studyID[i] <- counter
}

#set up variables for stan
dat <- list(
  N = nrow(cypx),
  Q = 4,
  M = max(studyID),
  
  Adjustment = cypx$Adjustment,
  Phenotype = phen,
  Study = studyID,
  nobs = cypx$Size
)
dat$logsigmaloc <- 4
dat$logsigmascale <- 0.25
bayesfit <- stan("levels.stan", data = dat, seed = 142, iter = 2000)
```
```{r actscores_output, message = FALSE }
# display estimates of activity scores computed relative to IM
cf = select(as.data.frame(bayesfit), matches("phenotypes"))
ActScoreIM <- cf[,1] * -1
ActScore <- list()
ActScore$EM <- 0
ActScore$IM <- -1 
ActScore$PM <- cf[,2] / ActScoreIM
ActScore$RM <- cf[,3] / ActScoreIM
ActScore$UM <- cf[,4] / ActScoreIM
ActScore$star17 <- (ActScore$RM * 2 + ActScore$UM) / 4
ActScore <- as.data.frame(ActScore)
Scores <- sapply(ActScore, median, simplify = "array")
Scores <- rbind(Scores, sapply(ActScore, quantile, 
                               probs = 0.05, simplify = "array"))
Scores <- rbind(Scores, sapply(ActScore, quantile, 
                               probs = 0.95, simplify = "array"))
row.names(Scores) <- c("median", "5% lower", "95% upper")
print(Scores, digits = 3)
rm(ActScoreIM)
rm(ActScore)
```

This analysis shows that, by setting EM to zero and IM (genotype
\*1/\*null) to -1, PM (genotype \*null/\*null) has an approximate score
of -2, RM (genotype \*1/\*17) of 1, and UM (genotype \*17/\*17) of 1.8.
The credibility intervals are wide, however; these results are broadly
consistent with current assumptions on CYP2C19 activity scores.

### Methods to define allelic phenotypes

Studies varied in the way they defined the phenotypic groups. Old
studies used phenotyping substrates and only discriminated between PM
and EM. The PM determined by phenotyping corresponds to the a genotype
consisting of homozygous alleles with zero CYP2C19 enzyme activity
(\*null/\*null). The IM group consists of one active and one inactive
allele (\*1/\*null) of CYP2C19, but in the IM group, the majority of the
(older) studies (n=28) pooled data from individuals that might have been
carriers of the \*17 allele, because the studies performed before the
identification of CYP2C19\*17 in the year 2006 did not discriminate
\*17/\*null from \*1/\*null genotypes. One study pooled the PM genotype
(homozygous \*2 carriers) into the IM group (Islam et al. 2022). The RM
group is defined as genotype \*1/\*17, some studies did not discriminate
between the UM and RM groups and pooled possible carriers of the
homozygous \*17 genotype into one group. The table below shows the
number of such studies for substrates where we have data for all
phenotypic groups.

```{r allph_table }
phgroups <- select(cypx, matches("^(I|R).*\\d$")) %>% sapply(sum) %>% print()
```

As one can see, the estimation of the IM phenotype might be affected by
pooling \*17 homozygous carriers in the IM group. The number of studies
with pooling from other groups may be too small to be able to estimate
the effects of pooling. It turns out that it is possible to fit models
only to estimate effects of defining the IM and RM phenotypes while
pooling \*17 homozygous carriers in these groups.

We therefore repeated the analysis with these two confounders.

```{r actscores_covs }

covs <- as.matrix(select(cypx, IM_17, RM_1717))
dat$Covariates <- covs
dat$K <- ncol(covs)
bayesfit <- stan("levels_covs.stan", data = dat, seed = 142, iter = 2000)
print(bayesfit, par = "covcoefs")

# display estimates of activity scores computed relative to IM
cf = select(as.data.frame(bayesfit), matches("phenotypes"))
ActScoreIM <- cf[,1] * -1
ActScore <- list()
ActScore$EM <- 0
ActScore$IM <- -1 
ActScore$PM <- cf[,2] / ActScoreIM
ActScore$RM <- cf[,3] / ActScoreIM
ActScore$UM <- cf[,4] / ActScoreIM
ActScore$star17 <- (ActScore$RM * 2 + ActScore$UM) / 4
ActScore <- as.data.frame(ActScore)
Scores <- sapply(ActScore, median, simplify = "array")
Scores <- rbind(Scores, sapply(ActScore, quantile, 
                               probs = 0.05, simplify = "array"))
Scores <- rbind(Scores, sapply(ActScore, quantile, 
                               probs = 0.95, simplify = "array"))
row.names(Scores) <- c("median", "5% lower", "95% upper")
print(Scores, digits = 3)
```

The outcome of this analysis is that the effects of the phenotype
definitions are not significant with the exception of the effect of
pooling homozygous \*17 alleles in to the RM group. As one may expect,
studies pooling homozygous \*17 carriers into the RM group overestimate
its effects; the large value of this overestimation, 38%, is the
difference between these studies and those that do not pool (the studies
that pool are small and average an adjusted dose of 156% while those
that do not pool give 115%). However, the credibility intervals of this
effect are enormous.

We therefore opted to define activity scores after excluding studies
that pooled the \*17 homozygous carriers into the RM group, and verify
deviations from linearity by testing a different slope for the \*17
carriers in the dataset as a whole. In sum, this gives activity scores
of -2, -1, 0.8, and 1.6 for the PM, IM, RM, and UM phenotypic groups.

```{r actscores_subset }
#create a dummy variable for levels of phenotype as factor
cypx <- filter(cypx, RM_1717 == 0)
phen <- cypx$StudyID
phen[cypx$Phenotype == "IM"] <- 1
phen[cypx$Phenotype == "PM"] <- 2
phen[cypx$Phenotype == "RM"] <- 3
phen[cypx$Phenotype == "UM"] <- 4

#create indicator variable for studies included in dataset
studyID <- cypx$StudyID
counter = 1
for (i in 2:nrow(cypx)) {
  if (cypx$StudyID[i-1] != cypx$StudyID[i]) 
    counter <- counter + 1
  studyID[i] <- counter
}

#set up variables for stan
dat <- list(
  N = nrow(cypx),
  Q = 4,
  M = max(studyID),
  
  Adjustment = cypx$Adjustment,
  Phenotype = phen,
  Study = studyID,
  nobs = cypx$Size
)
dat$logsigmaloc <- 4
dat$logsigmascale <- 0.25
bayesfit <- stan("levels.stan", data = dat, seed = 142, iter = 2000)

# display estimates of activity scores computed relative to IM
cf = select(as.data.frame(bayesfit), matches("phenotypes"))
ActScoreIM <- cf[,1] * -1
ActScore <- list()
ActScore$EM <- 0
ActScore$IM <- -1 
ActScore$PM <- cf[,2] / ActScoreIM
ActScore$RM <- cf[,3] / ActScoreIM
ActScore$UM <- cf[,4] / ActScoreIM
ActScore$star17 <- (ActScore$RM * 2 + ActScore$UM) / 4
ActScore <- as.data.frame(ActScore)
Scores <- sapply(ActScore, median, simplify = "array")
Scores <- rbind(Scores, sapply(ActScore, quantile, 
                               probs = 0.05, simplify = "array"))
Scores <- rbind(Scores, sapply(ActScore, quantile, 
                               probs = 0.95, simplify = "array"))
row.names(Scores) <- c("median", "5% lower", "95% upper")
print(Scores, digits = 3)
rm(ActScoreIM)
rm(ActScore)
```

## Formally testing linearity

To verify linearity of activity scores we turned to a model of
adjustment as a function of activity scores. We followed the following
strategy:

-   we omitted the constant term, so that the label-relative EM dose is
    adjusted to itself (zero change)
-   we added random effects of activity for substances, but no random
    effect for the intercept, to constrain the effect of activity scores
    to pass through zero at the EM group;
-   we coded the activity scores as -2 (PM), -1 (IM), 0.8 (RM), and 1.6
    (UM) following the results of the previous section.

The basic model is
$$ adjustment_i = activity\_score + study_{j[i]} + \epsilon_i, i=1,\dots,N, j=1,\dots,M$$
$$study \sim N(0, \sigma_{studies})$$ The residual variance of the
$\epsilon_i$ is modelled as before (this model is specified in
lmact_covs.stan).

### Test for different scores \*17 and \*null

Here, we test that the slope of the RM and UM phenotypes differs from
the slope of the IM and PM phenotypes with the activity scores given
above.

```{r star17slope }
#get rid of EM measurements and keep only putative substrates
cypsel <- filter(cyp, Phenotype != "EM" & Selection == TRUE & Status == "OK")

#define a different slope for *17 carriers
covs <- as.matrix(cypsel %>% 
    transmute(star17 = Activity * (Phenotype == "RM" | Phenotype == "UM")))

#create indicator variable for studies included in dataset
studyID <- cypsel$StudyID
counter = 1
for (i in 2:nrow(cypsel)) {
  if (cypsel$StudyID[i-1] != cypsel$StudyID[i]) 
    counter <- counter + 1
  studyID[i] <- counter
}

#set up variables for stan
dat <- list(
  N = nrow(cypsel),
  K = ncol(covs),
  M = max(studyID),
  
  Adjustment = cypsel$Adjustment,
  Activity = cypsel$Activity,
  Covariates = covs,
  Study = studyID,
  nobs = cypsel$Size
)
dat$logsigmaloc <- 4
dat$logsigmascale <- 0.25
star17fit <- stan("lmact_covs.stan", data = dat, seed = 142, iter = 2000)
print(star17fit, par = "covcoefs")

```

The minor difference in the slope of activity (given by covcoefs[1]) is
now too small to be detectable in this model.

### Nonlinearity

We now evaluate these scores by fitting a model with quadratic and cubic
terms, to test for deviations from non-linearity. First, the model with
cubic effects:

```{r test_nonlinear3 }
#get rid of EM measurements and keep only putative substrates
cypsel <- filter(cyp, Phenotype != "EM" & Selection == TRUE & Status == "OK")

#define quandratic and cubic effects, and add homozygous *17 in RM as confounder
covs <- as.matrix(cypsel %>% transmute(quadratic = Activity^2, cubic=Activity^3, 
                                       RM_1717 = RM_1717))

#create indicator variable for studies included in dataset
studyID <- cypsel$StudyID
counter = 1
for (i in 2:nrow(cypsel)) {
  if (cypsel$StudyID[i-1] != cypsel$StudyID[i]) 
    counter <- counter + 1
  studyID[i] <- counter
}

#set up variables for stan
dat <- list(
  N = nrow(cypsel),
  K = ncol(covs),
  M = max(studyID),
  
  Adjustment = cypsel$Adjustment,
  Activity = cypsel$Activity,
  Covariates = covs,
  Study = studyID,
  nobs = cypsel$Size
)
dat$logsigmaloc <- 4
dat$logsigmascale <- 0.25
nonlin3 <- stan("lmact_covs.stan", data = dat, seed = 142, iter = 2000)
print(nonlin3, par = "covcoefs")
```

The cubic effect is covcoefs[2] (in this analysis, we also adjust for
pooling homozygous \*17 in the RM group, which gives covcoefs[3]). Now
the quadratic effects:

```{r test_nonlinear1 }
#define quandratic and cubic effects, and add homozygous *17 in RM as confounder
covs <- as.matrix(cypsel %>% 
                transmute(quadratic = Activity^2, RM_1717 = RM_1717))

#create indicator variable for studies included in dataset
studyID <- cypsel$StudyID
counter = 1
for (i in 2:nrow(cypsel)) {
  if (cypsel$StudyID[i-1] != cypsel$StudyID[i]) 
    counter <- counter + 1
  studyID[i] <- counter
}

#set up variables for stan
dat <- list(
  N = nrow(cypsel),
  K = ncol(covs),
  M = max(studyID),
  
  Adjustment = cypsel$Adjustment,
  Activity = cypsel$Activity,
  Covariates = covs,
  Study = studyID,
  nobs = cypsel$Size
)
dat$logsigmaloc <- 4
dat$logsigmascale <- 0.25
nonlin2 <- stan("lmact_covs.stan", data = dat, seed = 142, iter = 2000)
print(nonlin2, par = "covcoefs")

```

The quadratic effect is covcoefs[1] (covcoefs[2] is again the pooling of
the homozygous \*17 within the RM group). None of these nonlinear terms
are significant. We therefore accept the activity scores we defined
above.

Here is the boxplot of the data, this time with the new activity score
and the polynomial fit.

```{r plot_activity_levels, echo = FALSE, fig.cap = "Adjustments phenotypic groups with activity scores " }
cypsel$weights <- cypsel$Size / sum(cypsel$Size) * nrow(cypsel)
ggplot(cypsel, aes(x = Activity, y = Adjustment, color = Class)) +
	geom_boxplot(aes(group = Activity), outlier.size = 0, show.legend=F) + 
	geom_line(aes(group = StudyID), alpha = 0.4) + 
	geom_smooth(aes(group = 1, weight = weights), 
	            colour = "#000000", fill="#D0D0D0", size=1, 
	            method = "lm", formula = y~poly(x,3), show.legend = F) + 
	geom_point(aes(size = Size), shape = 1) +
	scale_y_continuous("Adjustment (in %)") + 
	scale_size_continuous("Size") + 
  xlab("Activity scores") +
  scale_x_continuous(breaks = c(-2, -1, 0, 0.8, 1.6)) + 
  theme_classic(base_size = 16)
```

As one can see, the polynomial predictor gives now a linear fit, showing
the non-linear terms to be redundant.

## Log transformation

When considering a log-transformation of the adjustments, we obtain an
effect that is no longer linear for equally spaced activity scores. The
plot below reports both the linear (in black) and cubic polynomial fit,
showing the latter to deviate from the linear fit.

```{r plot_log_actest_now, echo = FALSE, message = FALSE , fig.cap = "Fitted line: black: original data, color: log-transformed data" }
cypsel$weights <- cypsel$Size / sum(cypsel$Size) * nrow(cypsel)
ggplot(filter(cypsel, Phenotype != "EM"), aes(x = Activity, 
                                 y = log(Adjustment), color = Class)) +
	geom_boxplot(aes(group = Phenotype), outlier.size = 0, show.legend=F) + 
	geom_line(aes(group = StudyID), alpha = 0.4) + 
	geom_smooth(aes(group = 1, weight = weights), 
	            colour = "#CF6060", fill="#D0D0D0", size=1, 
	            method = "lm", formula = y~poly(x,3), se = F, show.legend = F) + 
	geom_smooth(aes(group = 1, weight = weights), 
	            colour = "#000000", fill="#D0D0D0", size=1, 
	            method = "lm", formula = y~poly(x,1), se = F, show.legend = F) + 
	geom_point(aes(size = Size), shape = 1) +
	scale_y_continuous("Log adjustment (in %)") + 
	scale_size_continuous("Sample size") + 
  xlab("Activity scores") +
  scale_x_continuous(breaks = c(-2, -1, 0, 0.8, 1.6)) + 
  theme_classic(base_size = 16)

```

This plots shows that the log transform would not be appropriate in this
dataset.

## Effects of studies

### Coding EMs by pooling oher phenotypes

In some studies, the EM allelic group was defined while pooling within
it other alleles, the \*2 or the \*17:

```{r emph}
phgroups <- filter(studies, Status == "OK") %>% 
  select(matches("^EM.*\\d$")) %>% sapply(sum) %>% print()
```

This pooling affects all other phenotypic groups, because the EM
estimate is the reference point in the original studies, affecting all
other phenotypes at once. We therefore investigated the effects of EM
pooling on the estimated effects of activity scores (not on the
estimates of individual phenotypic groups as in a previous section. In
this analysis, we also adjust for pooling homozygous \*17 in the RM
group).

```{r EM_Bayes}
#get rid of EM measurements and keep only putative substrates
cypsel <- filter(cyp, Phenotype != "EM" & Selection == TRUE & Status == "OK")

#EM_2 not estimable, too few data
covs <- as.matrix(select(cypsel, EM_17xAct2, EM_17xAct17, EM_2xAct2, RM_1717))

#create indicator variable for studies included in dataset
studyID <- cypsel$StudyID
counter = 1
for (i in 2:nrow(cypsel)) {
  if (cypsel$StudyID[i-1] != cypsel$StudyID[i]) 
    counter <- counter + 1
  studyID[i] <- counter
}

#set up variables for stan
dat <- list(
  N = nrow(cypsel),
  K = ncol(covs),
  M = max(studyID),
  
  Adjustment = cypsel$Adjustment,
  Activity = cypsel$Activity,
  Covariates = covs,
  Study = studyID,
  nobs = cypsel$Size
)
dat$logsigmaloc <- 4
dat$logsigmascale <- 0.25
EMfit <- stan("lmact_covs.stan", data = dat, seed = 142, iter = 2000)

print(EMfit, par = c("covcoefs", "sigma_within", "sigma_betw"))

```

Pooling heterozygous \*2 in the EM group (which happened in the old
phenotyping studies that pooled all genotypes other than \*null/\*null
into one group of EM) appears to have no effect on estimate of activity
scores. Instead, the pooling of \*17 carriers in the EM group (=\*1/\*17
or \*17/\*17), which happened in the older studies that genotyped for
the \*null alleles but not for \*17 alleles, leads to smaller effects of
activity scores on adjustments in the UM phenotype. However, these
effects fail to reach significance.

### Pharmacokinetic parameters

We also tested parameters of the study design that might affect the
estimation of the CYP2C19 phenotype from pharmacokinetic data. One
parameter consisted of the pharmacokinetic measurement used to estimate
the dose adjustments. Some studies (usually performed in healthy
participants as pharmacokinetic study) used AUC or Clearance, other
studies (usually in patients and at naturalistic conditions) used Css,
the dose corrected plasma concentration at steady state. We therefore
tested the influence of the pharmacokinetic parameter given in the
studies and the participants (healthy versus patients).

```{r params_plot, echo = FALSE  }
cypsel$weights <- (cypsel$Size / sum(cypsel$Size)) * nrow(cypsel)
ggplot(cypsel, aes(x = Activity, y = Adjustment, color = Parameter)) +
    geom_boxplot(aes(group = Activity), outlier.size = 0, show.legend=F) + 
    geom_line(aes(group = StudyID), alpha = 0.4, color = "gray") + 
    geom_smooth(aes(color = Parameter, weight = weights), 
                fill="#D0D0D0", size=1, method = "lm", 
                formula = y~poly(x,1), se=F, show.legend = T) + 
    geom_point(aes(size = Size), shape = 1) +
    scale_y_continuous("Adjustment (in %)") + 
    scale_size_continuous("Size") + 
    xlab("Activity scores") +
    scale_x_continuous(labels = c("PM", "IM", "", "RM", "UM")) +
    theme_classic(base_size = 16)
```

This plot suggests a slight effect of these parameters on the slope. Css
appears to overestimate the allelic effect relative to both Auc and Cl.

We repeat the fit with a Bayesian model to weight the observations by
the estimated components of the residuals.

```{r params_Bayes}
#get rid of EM measurements and keep only putative substrates
cypsel <- filter(cyp, Phenotype != "EM" & Selection == TRUE & Status == "OK")

#covariates
covs <- as.matrix(cypsel %>% 
          mutate(Auc = Activity * (Parameter == "Auc"), 
                 Cl = Activity * (Parameter == "Cl")) %>% 
            select(RM_1717, Auc, Cl))

#create indicator variable for studies included in dataset
studyID <- cypsel$StudyID
counter = 1
for (i in 2:nrow(cypsel)) {
  if (cypsel$StudyID[i-1] != cypsel$StudyID[i]) 
    counter <- counter + 1
  studyID[i] <- counter
}

#set up data for stan
dat <- list(
  N = nrow(cypsel),
  K = ncol(covs),
  M = max(studyID),
  
  Adjustment = cypsel$Adjustment,
  Activity = cypsel$Activity,
  Covariates = covs,
  Study = studyID,
  nobs = cypsel$Size
)
dat$logsigmaloc <- 4
dat$logsigmascale <- 0.25
paramfit <- stan("lmact_covs.stan", data = dat, seed = 142, iter = 2000)
print(paramfit, par = "covcoefs")

```

(In the printout, covcoefs[1] is the effect of RM pooling, covcoefs[2]
of Auc relative to Css and covcoefs[3] of Cl). The model shows the slope
of Css to be larger than in the other methods by 6-8%. This is a
relatively small effect, and indeed it fails to reach significance.

We decided against including this parameter in the final model not only
because it is small, but also because this estimate may be biased by the
confounder given by previous knowledge that the CYP2C19 effect is
present and large. This may have been an incentive to conduct large
studies in clinical samples.

### Single/multiple studies (dosage)

Pharmacokinetic parameters were determined in some studies with single
and in some studies with multiple doses. This variable is almost the
same as studies conducted on patients or healthy volunteers, which
cannot be studies separately.

It would not be expected for single and multiple dose methods to
influence the magnitude of the CYP2C19 pathway coefficient, but its
precision. Hence, we modified the model and tested a heteroscedastic
variance within studies depending on study type, single or multiple
dose. The model for the residual errors replaces the variance within
$\sigma^2_w$ with $\sigma^2_k$,
$$\epsilon_i \sim N(0, \sigma^2_k/n_i + \sigma^2_b), k=1,2$$ where $k$
indexes single and multiple dose, and $i$ indexes the datapoints as
before, $i = 1, 2, \dots, N$. We keep the adjustment fo RM pooling in
the model.

```{r sd_ms_Bayes}
#get rid of EM measurements and keep only putative substrates
cypsel <- filter(cyp, Phenotype != "EM" & Selection == TRUE & Status == "OK")

#covariates
covs <- as.matrix(cypsel %>% mutate(Auc = Activity * (Parameter == "Auc")) %>% 
                    select(RM_1717))

#create indicator variable for studies included in dataset
studyID <- cypsel$StudyID
counter = 1
for (i in 2:nrow(cypsel)) {
  if (cypsel$StudyID[i-1] != cypsel$StudyID[i]) 
    counter <- counter + 1
  studyID[i] <- counter
}

#set up data for stan
dat <- list(
  N = nrow(cypsel),
  K = ncol(covs),
  M = max(studyID),
  
  Adjustment = cypsel$Adjustment,
  Activity = cypsel$Activity,
  Covariates = covs,
  Study = studyID,
  nobs = cypsel$Size,
  sigmaidx = as.integer(cypsel$Dosage == "SD") + 1
)
dat$logsigmaloc <- 4
dat$logsigmascale <- 0.25
sdfit <- stan("lmact_covs_wghtex.stan", data = dat, seed = 142, iter = 2000)
print(sdfit, par = c("covcoefs", "sigma_within", "sigma_betw"))

```

As expected, there was smaller variability in the studies with single
dose (sigma_within[2]) than in those with multiple dose
(sigma_within[1]). However, the credibility intervals largely
overlapped. Importantly, studies with single dose are more expensive;
only small studies are available with single dose.

It is worth noting that there was an association between single/multiple
dose and the the pharmacokinetic method:

```{r sd_Auc_fit, echo = FALSE}
table(cypsel$Dosage, cypsel$Parameter)
```

Hence, the heteroscedastic model of this section also considers
modelling effects of parameters on variance rather than mean activity
scores.

## Conclusion

In conclusion, we should add in the model the effects of pooling both
\*17 alleles in the RM group. The effects of \*17 carriers in the EM or
IM groups and of AUC/single or multiple studies are so small they may be
neglected. As shown in the figures below, residuals are larger in the PM
and UM group, but this may be expected given that the sample sizes are
smaller (this aspect is already taken care of by the model of the
residuals). Note also the symmetry of the residuals, confirming that a
log transformation of adjustments is not necessary. The random effect of
studies shows here reasonable homogeneity.

```{r plot_resid, echo=FALSE }
plot_mikado_res(sdfit)
```

```{r plot_randstudies  }
hist(as.data.frame(sdfit) %>% select(matches("^studies")) %>% 
       map_df(median) %>% as.matrix(), 
     xlab = "studies", main = "Random effect of studies", 
     breaks = 8)
```

```{r plot_iterv, echo=FALSE, fig.cap="estimates and confidence intervals, residual dispersion"}
bayesplot::mcmc_intervals(sdfit, regex_pars = "^sigma_")
```

```{r plot_disp , fig.cap="In blue, estimated within datapoint standard deviation of single dose studies, in red, the multiple dose studies, plotted as a function of datapoint sample size. Jitter was added to identify samples."}
disp <- as.data.frame(sdfit) %>% select(matches("dispersion")) %>% map_dbl(median) %>% as.matrix()
plot(disp + runif(nrow(cypsel)) ~ log(cypsel$Size), pch = "o", col = ifelse(cypsel$Dosage == "SD", "blue", "red"))
```
