I have proposed my own model and now am trying to implement it using R, I have got stuck on how to find the observed matrix applying my formula i have use glm() to fit logistic model with penalty term, using binary data set x1, x2, x3 ,y (all binary 0,1) fit1 if the glm() model def.new is the penalise deviance.
X.tilde <- as.matrix(x) # n*p matrix of the data set
W <- Diagonal(length(y), weights) # n*n diagonal matrix of the weights
qq <- exp(fit1$fitted.values)/(1 + exp(fit1$fitted.values)) # n*1 vector (pi=probability of the logistic model )
cc <- t(1 - qq) # n*1 vector
gg <- (dev.new) * t(dev.new) # p*p matrix
ff <- (X.tilde) %*% t(X.tilde) # n*n matrix
pp <- exp(fit1$coefficients)/(1 + exp(fit1$coefficients)) # p*1 matrix
ss <- t(1/(1 + exp(fit1$coefficients))) # p*1 vector
aa <- t(X.tilde) %*% qq %*% cc %*% W %*% (X.tilde) # p*p matrix
firstP <- (aa + (pp * ss)) # p*p matrix
info.mat <- firstP+gg # p*p matrix
info.mat <- as.matrix(info.mat)
this code returns the following error
Error in e1 + Matrix(e2) :
Matrices must have same number of rows for arithmetic
As in my theory the dimension is fine by when I implement its not correct
any help?
r
Related
I am able to change the coefficients of my linear model. Then i want to compare the results of my "new" model with the new coefficients, but R is not calculating the results with the new coefficients.
As you can see in my following example the summary of my models fit and fit1 are excactly the same, though results like multiple R-squared should or fitted values should change.
set.seed(2157010) #forgot set.
x1 <- 1998:2011
x2 <- x1 + rnorm(length(x1))
y <- 3*x2 + rnorm(length(x1)) #you had x, not x1 or x2
fit <- lm( y ~ x1 + x2)
# view original coefficients
coef(fit)
# generate second function for comparing results
fit1 <- fit
# replace coefficients with new values, use whole name which is coefficients:
fit1$coefficients[2:3] <- c(5, 1)
# view new coefficents
coef(fit1)
# Comparing
summary(fit)
summary(fit1)
Thanks in advance
It might be easier to compute the multiple R^2 yourself with the substituted parameters.
mult_r2 <- function(beta, y, X) {
tot_ss <- var(y) * (length(y) - 1)
rss <- sum((y - X %*% beta)^2)
1 - rss/tot_ss
}
(or, more compactly, following the comments, you could compute p <- X %*% beta; (cor(y,beta))^2)
mult_r2(coef(fit), y = model.response(model.frame(fit)), X = model.matrix(fit))
## 0.9931179, matches summary()
Now with new coefficients:
new_coef <- coef(fit)
new_coef[2:3] <- c(5,1)
mult_r2(new_coef, y = model.response(model.frame(fit)), X = model.matrix(fit))
## [1] -343917
That last result seems pretty wild, but the substituted coefficients are very different from the true least-squares coeffs, and negative R^2 is possible when the model is bad enough ...
As a sanity check for later goals, I am trying to understand how components of an lme object are related. I am trying to evaluate the score functions at the MLEs obtained from a lme object created using gamm to check that they are equal to zero. I've provided a minimal working example. My score functions were obtained from equation (7) in https://arxiv.org/pdf/1612.04911.pdf.
library(lme4)
library(mgcv)
library(lasso2) # for Prostate data set
data(Prostate)
model = gamm(lpsa ~lcavol + s(lweight), data=Prostate)$lme
Here I compute the objects needed to evaluate the score functions
X = model.matrix(formula(model), data=model$data)
YminXbeta = c(model$data$y - X %*% fixed.effects(model))
varcomps = VarCorr(model)
varcomps = as.numeric(varcomps[nrow(varcomps) - (1:0),1])
Sigmainv = solve(extract.lme.cov2(model, data=model$data)$V)
Sigmainvsq = Sigmainv %*% Sigmainv
ZVZT = (model$data$Xr %*% (getVarCov(model,
type='random.effects')/varcomps[1]) %*% t(model$data$Xr))
SigmainvZVZT = Sigmainv %*% ZVZT
SigmainvZVZTsq = SigmainvZVZT %*% SigmainvZVZT
Now I evaluate the scores at the MLEs
# the scores
# the score for the mean parameter
sbeta = t(X) %*% Sigmainv %*% YminXbeta
# [,1]
# X(Intercept) 5.329071e-14
# Xlcavol 1.190159e-13
# Xs(lweight)Fx1 -1.110223e-15
# the score for the error variance parameter
ssigmasq = (-sum(diag(Sigmainv)) + YminXbeta %*% Sigmainvsq %*%
YminXbeta)/2
# 3.664974e-08
# the score for the random effect parameter
stausq = (-sum(diag(SigmainvZVZT)) + YminXbeta %*% SigmainvZVZT
%*% Sigmainv %*% YminXbeta)/2
# -7.507903
Note that the random effects variance component is close to zero
varcomps[1] # 2.665509e-09
but I'm not sure that would make the derivative nonzero.
Why is the score function for the variance component term not close to zero? Am I making a mistake or misunderstand what the objects in the lme object are?
My first question here. This problem have stolen days from my life. I know, it's not that important, but at the same time: I need to know! I know there are many good formulas for making regression. But when I try to do it using good-old arithmetic just to get the hangs of it, I get ridiculous answers on beta.
Beta vector is supposed to be (X'X)^(-1)X'y (where X is the matrix of regressors and y the vector of answers). I'll give one example (and that it's not suitable for OLS is irrelevant - I just want b:s here):
X <- matrix(1:10)
y <- matrix(2:11)
b <- (t(X) %*% X)^(-1) %*% t(X) %*% y
Which gives b = 1.142857, while summary(lm(y~X)) gives beta = 1 and an intercept of 1. I add a constant to X to get an intercept: X <-cbind(X,1) and the results I get is b = (2.324675,14.5) which doesn't make sense at all. What am I doing wrong here?
There are two problems here. The first is a problem of notation. The power of -1 in the formula actually indicates a matrix inverse. That is calculated with solve in R and not with ^-1, which indicates element-wise reciprocals.
Then, you need to create a design matrix that actually contains an intercept.
X <- matrix(1:10)
y <- matrix(2:11)^2
coef(lm(y~X))
#(Intercept) X
# -21 13
X <- cbind(1, X)
solve(t(X) %*% X) %*% t(X) %*% y
# [,1]
#[1,] -21
#[2,] 13
Obviously, you should not actually do this matrix inversion in real world applications (and R's lm doesn't do it).
The issue is with using ^(-1) for the inverse. It doesn't work like that for Matrices. solve is used to get the inverse of a matrix: https://www.statmethods.net/advstats/matrix.html
# use solve
b <- solve(t(X) %*% X) %*% t(X) %*% y
# fit model without intercept
m <- lm(y~-1+X)
summary(m)
# same coefficients
b
m$coefficients
# with intercept
X2 <- cbind(rep(1, 10), X)
b2 <- solve(t(X2) %*% X2) %*% t(X2) %*% y
m2 <- lm(y~+X)
summary(m2)
b2
m2$coefficients
X <- cbind(1, matrix(1:10))
b<-solve(t(X)%*%X)%*%t(X)%*%y
https://www.rdocumentation.org/packages/Matrix/versions/0.3-26/topics/solve.Matrix
I am fitting a linear mixed effects model using lme4:
library(lme4)
data(Orthodont)
dent <- Orthodont
d.test <- lmer(distance ~ age + (1|Subject), data=dent)
If we say generically Y = X * B + Z * d + e is the form of a linear mixed effects model, then I am trying to get Var(Y) = Z * Var(d) * Z^t + Var(e) from the results of the model.
Is the following formulation the right way to do this?
k <- table(dent$Subject)[1]
vars <- VarCorr(d.test)
v <- as.data.frame(vars)
sigma <- attr(vars, "sc")
s.tech <- diag(v$vcov[1], nrow=k)
icc <- v$vcov[1]/sum(v$vcov)
s.tech[upper.tri(s.tech)] <- icc
s.tech[lower.tri(s.tech)] <- icc
sI <- diag(sigma^2, nrow=length(dent$age))
var.b <- kronecker(diag(1, nrow=length(dent$age)/k), s.tech)
var.y <- sI + var.b
I think this is a simple question, but I can't find anywhere code for doing this, so I'm asking if I'm doing it right.
You can do this a bit more easily if you know about getME(), which is a general purpose extract-bits-of-a-lmer-fit function. In particular, you can extract the transposed Z matrix (getME(.,"Zt")) and the transposed Lambda matrix - the Lambda matrix is the Cholesky factor of the scaled variance-covariance matrix of the conditional models (BLUPs); in your notation, Var(d) is the residual variance times the cross-product of Lambda.
The answer cited here is pretty good but the answer below is slightly more general (it should work for any lmer fit).
Fit model:
library(lme4)
data(Orthodont,package="nlme")
d.test <- lmer(distance ~ age + (1|Subject), data=Orthodont)
Extract components:
var.d <- crossprod(getME(d.test,"Lambdat"))
Zt <- getME(d.test,"Zt")
vr <- sigma(d.test)^2
Combine them:
var.b <- vr*(t(Zt) %*% var.d %*% Zt)
sI <- vr * Diagonal(nrow(Orthodont))
var.y <- var.b + sI
A picture:
image(var.y)
I'm trying to reproduce Figure 3.2 from the book Introduction to Statistical Learning. Figure describes 3D plot of the residual sum of squares (RSS) on the Advertising data, using Sales as the response and TV as the predictor variable for a number of values for $\beta_0$ and $\beta_1$.
My code is pasted below:
# Read data from URL
data <- read.csv("http://www-bcf.usc.edu/~gareth/ISL/Advertising.csv")
# Extract TV variable
X <- data[, 2]
# Prediction variable with ones in the first column
X <- cbind(1, X)
# Prediction variable
y <- data$Sales
# Define function for RSS
MyRss <- function(beta0, beta1) {
b <- c(beta0, beta1)
rss <- t(y - X %*% b) %*% (y - X %*% b)
return(rss)
}
Now I calculate RSS value for each combination of $\beta_0$ and $\beta_1$ and plot it with persp() function:
b0 <- seq(5, 9, 0.01)
b1 <- seq(0.03, 0.06, 0.001)
z <- outer(b0, b1, function(x,y) mapply(MyRss, x, y))
persp(x = b0, y = b1, z = z)
The derived plot is pasted below:
I don't know where my code fails. Thanks in advance for any pointers.