Using Bootstrap estimation for a Spline model

58 views
Skip to first unread message

Pamela Villalba

unread,
Feb 12, 2019, 9:10:29 AM2/12/19
to breedR

Hello to all breedR users,

I'm trying to use a bootstrap estimation for a spline model. Because I want to estimate the s.e. for the model variances (given that the "em" method can't estimate them). Has anyone already tried to do this?

I’m using the globulus data from the package as an example, but I’m having problems with it.

Would someone be so kind to give me a hand with this?

Thanx,

Pamela

Facundo Muñoz

unread,
Feb 12, 2019, 10:11:10 AM2/12/19
to bre...@googlegroups.com

Dear Pamela,

have you checked the guide on bootstrap computation of heritability [1]?

You can easily adapt the function `sim_target()` in step 3 to recover the model variances (instead of the heritability as it is done in the guide).

I hope it helps.

Æ’acu.-



[1] https://github.com/famuvie/breedR/wiki/Heritability#case-3-using-bootstrap-estimation

--
Report issues at https://github.com/famuvie/breedR/issues
---
You received this message because you are subscribed to the Google Groups "breedR" group.
To unsubscribe from this group and stop receiving emails from it, send an email to breedr+un...@googlegroups.com.
To post to this group, send email to bre...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/breedr/99014698-e733-4db8-90e8-ba8d3e5c3e45%40googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

Pamela Villalba

unread,
Feb 12, 2019, 11:01:09 AM2/12/19
to breedR
Hello Facundo,
Yes. I've checked the guide and, with the example, it works really well. However, when I try to change the script for a spline model (see script below) it doesn't work (i.e. The script run but my results are NA).
I believe that my error is in the "resample_globulus" section but I can't find the problem. I believe that it's a silly problem but it's making me crazy that I can't find it.
Thank you so much for the quick response.
Pame


res<-remlf90(fixed  = phe_X ~ gg,
             genetic = list(model = 'add_animal', 
                            pedigree = globulus[,1:3],
                            id = 'self'),
             spatial = list(model = 'splines',
                         coord = globulus[, c('x','y')], 
                         n.knot=c(7,7)), 
             data = globulus,
             method = 'em')

resample_globulus <- function(N = 1, fit = res) {
dat <- breedR.sample.splines(
        fixed =  phe_X ~ gg,
        genetic = list(model = 'add_animal', 
                       pedigree = globulus[,1:3],
                       id = 'self',
                       var.ini = fit$var['genetic',1]),
        spatial = list(model = 'splines', 
                       coord = data[, c('x','y')],
                       n.knots = c(7,7), 
                       var.ini = fit$var['spatial',1]),
        residual.variance = fit$var['Residual', 1],
        N = nrow(model.frame(fit))
)
names(dat) <- gsub("rnd\\.", "", names(dat))
return(dat)
}  

sim_target<-function(dat = resample_globulus()){
  res<-suppressMessages(
    remlf90(fixed  = phe_X ~ gg, 
    genetic = list(model = 'add_animal', 
                   pedigree = globulus[,1:3],
                   id = 'self'),
    spatial = list(model = 'splines',
                   coord = globulus[, c('x','y')], 
                   n.knot=c(7,7)), 
    data = globulus))
  
  ans<-res$var[,"Estimated variances"]
  ans<-c(ans, h2 = unname (4*ans["genetic"]/(ans["genetic"]+ans["Residual"])))
  return(ans)
}

sim_target()

Facundo Muñoz

unread,
Feb 12, 2019, 3:00:04 PM2/12/19
to Pamela Villalba, breedR
Pamela,

Indeed, the sampling function is always `breedR.sample.phenotype()`.
Even if you are simulating a splines model, the splines are only a component of the model.

Also, note that in function sim_target() you need to fit the model using `data = dat` to fit the model
to the simulated data. Otherwise you will get always the same results.

Best
Æ’acu.-

----- Mail original -----
De: "Pamela Villalba" <pvill...@gmail.com>
À: "breedR" <bre...@googlegroups.com>
Envoyé: Mardi 12 Février 2019 17:01:09
Objet: Re: [breedR] Using Bootstrap estimation for a Spline model
> email to breedr+un...@googlegroups.com <javascript:>.
> To post to this group, send email to bre...@googlegroups.com <javascript:>
> .
> <https://groups.google.com/d/msgid/breedr/99014698-e733-4db8-90e8-ba8d3e5c3e45%40googlegroups.com?utm_medium=email&utm_source=footer>
> .
> For more options, visit https://groups.google.com/d/optout.
>
>

--
Report issues at https://github.com/famuvie/breedR/issues
---
You received this message because you are subscribed to the Google Groups "breedR" group.
To unsubscribe from this group and stop receiving emails from it, send an email to breedr+un...@googlegroups.com.
To post to this group, send email to bre...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/breedr/97c5895c-99bd-459d-b588-00299c197a65%40googlegroups.com.

Pamela Villalba

unread,
Mar 6, 2019, 5:23:06 PM3/6/19
to breedR

Hello Facundo,


Is it possible to simulate fixed effect values ​​such as genetic groups (gg in globulus dataset) with the "breedR.sample.phenotype ()" function of breedR?


Because I made the corresponding changes that you mentioned previously, but now I have found a new error and I do not know if it is possible to solve it. The error is within the fixed effects values ​​in the "dat" object. I show you the script and the error that I have next:


 

> dat <- breedR.sample.phenotype(

+         fixed =  phe_X ~ gg,

+         random = list(fam = list(nlevels = 63,

+                                 sigma2 = res$var['fam', 1])),

+         genetic = list(model = 'add_animal',

+                        pedigree = globulus[,1:3],

+                        id = 'self',

+                        var.ini = res$var['genetic',1]),

+         spatial = list(model = 'splines',

+                         coord = globulus[, c('x','y')],

+                         n.knots = c(7,7),

+                         var.ini = res$var['spatial',1]),

+         residual.variance = res$var['Residual', 1],

+         N = nrow(model.frame(res),

+                  method = 'em')

+ )

 

Error in X %*% fixed : requires numeric/complex matrix/vector arguments

 

Since I want to get the blue values ​​for each gg; I tried to include the fixed effect value (for the globulus dataset: 14 genetic groups) in the function as shown below:


 
> X=model.matrix(~-1+globulus$gg)
> dat <- breedR.sample.phenotype(
+   fixed = X,
+   random = list(bl = list(nlevels = 15,
+                           sigma2 = res$var['spatial', 1]),
+                 fam = list(nlevels = 63,
+                            sigma2 = res$var['genetic', 1])),
+   residual.variance = res$var['Residual', 1],
+   N = nrow(model.frame(res))
+ )
 
Error in X %*% fixed : non-conformable arguments
 

 

However, I still find an error in the fixed parameter. 

So it’s possible to simulate this type of fixed values with the "breedR.sample.phenotype ()" function? Especially if it isn’t a regression coefficient?

 

Thank you!!

Facundo Muñoz

unread,
Mar 11, 2019, 5:38:10 AM3/11/19
to bre...@googlegroups.com

Dear Pamela,

sorry for the late reply.

It is not possible to do it within the breedR.sample.phenotype() function, but it is very easy to work it around and do it manually. Indeed, this function is not fully complete, but is focused on the more complex terms.

The fixed argument in this function requires a (possibly named) numeric vector. Not a formula (as in your first example), nor a matrix (as in your second example). The numbers in this vectors are interpreted as regression coefficients of random uniform covariates. This is not what you want.

Furthermore, the syntax in your first example is not accurate: you wrote the genetic and sptaial arguments as they are for the fitting function remlf90(), not as they are for the simulator breedR.sample.phenotype(). See the help page.

So, the work around is :

  1. Simulate a dataset with only a global intercept in the fixed part and all the random components you need

  2. Manually add columns with categorical (factor) covariates (like genetic groups) to the dataset

  3. Manually modify the phenotype according to values of the categories

Here is an example:

library(breedR)
#> Loading required package: sp

## 1. Simulate dataset
dat <- breedR.sample.phenotype(
  fixed =  c(mu = 1),
  genetic = list(
    model = 'add_animal',
    Nparents = c(10, 10),
    sigma2_a = 1,
    check.factorial = FALSE
  ),
  spatial = list(
    model = 'splines',
    grid.size = c(10, 10),
    n.knots = c(7, 7),
    sigma2_s = 1
  ),
  residual.variance = 1
)

## Remove founders
dat <- dat[!is.na(dat$sire),]

## 2. Add categorical covariate
## assign categories randomly
dat$gg <- sample(factor(letters[1:14]), nrow(dat), replace = TRUE)

## 3. Modify phenotype according to categories
## vector of deviations from global mean for each category
gg_values <- setNames(rnorm(nlevels(dat$gg)), levels(dat$gg))
dat$phenotype <- dat$phenotype + gg_values[dat$gg]

I hope it helps

Æ’acu.-

​
Reply all
Reply to author
Forward
0 new messages