Come testare l'effetto di una variabile di raggruppamento con un modello non lineare?


15

Ho una domanda sull'uso di una variabile di raggruppamento in un modello non lineare. Poiché la funzione nls () non consente le variabili fattoriali, ho avuto difficoltà a capire se si può testare l'effetto di un fattore sull'adattamento del modello. Di seguito ho incluso un esempio in cui voglio adattare un modello di crescita "stagionato di von Bertalanffy" a diversi trattamenti di crescita (più comunemente applicati alla crescita dei pesci). Vorrei testare l'effetto del lago dove crescevano i pesci e il cibo dato (solo un esempio artificiale). Conosco una soluzione a questo problema: applicare un test F confrontando i modelli adattati a dati aggregati e adattamenti separati, come indicato da Chen et al. (1992) (ARSS - "Analisi della somma residua dei quadrati"). In altre parole, per l'esempio seguente,

inserisci qui la descrizione dell'immagine

Immagino che ci sia un modo più semplice per farlo in R usando nlme (), ma sto incontrando dei problemi. Innanzitutto, usando una variabile di raggruppamento, i gradi di libertà sono più alti di quelli che ottengo con il mio adattamento di modelli separati. Secondo, non sono in grado di annidare le variabili di raggruppamento - non vedo dove sia il mio problema. Qualsiasi aiuto nell'uso di nlme o di altri metodi è molto apprezzato. Di seguito è riportato il codice per il mio esempio artificiale:

###seasonalized von Bertalanffy growth model
soVBGF <- function(S.inf, k, age, age.0, age.s, c){
    S.inf * (1-exp(-k*((age-age.0)+(c*sin(2*pi*(age-age.s))/2*pi)-(c*sin(2*pi*(age.0-age.s))/2*pi))))
}

###Make artificial data
food <- c("corn", "corn", "wheat", "wheat")
lake <- c("king", "queen", "king", "queen")

#cornking, cornqueen, wheatking, wheatqueen
S.inf <- c(140, 140, 130, 130)
k <- c(0.5, 0.6, 0.8, 0.9)
age.0 <- c(-0.1, -0.05, -0.12, -0.052)
age.s <- c(0.5, 0.5, 0.5, 0.5)
cs <- c(0.05, 0.1, 0.05, 0.1)

PARS <- data.frame(food=food, lake=lake, S.inf=S.inf, k=k, age.0=age.0, age.s=age.s, c=cs)

#make data
set.seed(3)
db <- c()
PCH <- NaN*seq(4)
COL <- NaN*seq(4)
for(i in seq(4)){
    age <- runif(min=0.2, max=5, 100)
    age <- age[order(age)]
    size <- soVBGF(PARS$S.inf[i], PARS$k[i], age, PARS$age.0[i], PARS$age.s[i], PARS$c[i]) + rnorm(length(age), sd=3)
	PCH[i] <- c(1,2)[which(levels(PARS$food) == PARS$food[i])]
	COL[i] <- c(2,3)[which(levels(PARS$lake) == PARS$lake[i])]
	db <- rbind(db, data.frame(age=age, size=size, food=PARS$food[i], lake=PARS$lake[i], pch=PCH[i], col=COL[i]))
}

#visualize data
plot(db$size ~ db$age, col=db$col, pch=db$pch)
legend("bottomright", legend=paste(PARS$food, PARS$lake), col=COL, pch=PCH)


###fit growth model
library(nlme)

starting.values <- c(S.inf=140, k=0.5, c=0.1, age.0=0, age.s=0)

#fit to pooled data ("small model")
fit0 <- nls(size ~ soVBGF(S.inf, k, age, age.0, age.s, c), 
  data=db,
  start=starting.values
)
summary(fit0)

#fit to each lake separatly ("large model")
fit.king <- nls(size ~ soVBGF(S.inf, k, age, age.0, age.s, c), 
  data=db,
  start=starting.values,
  subset=db$lake=="king"
)
summary(fit.king)

fit.queen <- nls(size ~ soVBGF(S.inf, k, age, age.0, age.s, c), 
  data=db,
  start=starting.values,
  subset=db$lake=="queen"
)
summary(fit.queen)


#analysis of residual sum of squares (F-test)
resid.small <- resid(fit0)
resid.big <- c(resid(fit.king),resid(fit.queen))
df.small <- summary(fit0)$df
df.big <- summary(fit.king)$df+summary(fit.queen)$df

F.value <- ((sum(resid.small^2)-sum(resid.big^2))/(df.big[1]-df.small[1])) / (sum(resid.big^2)/(df.big[2]))
P.value <- pf(F.value , (df.big[1]-df.small[1]), df.big[2], lower.tail = FALSE)
F.value; P.value


###plot models
plot(db$size ~ db$age, col=db$col, pch=db$pch)
legend("bottomright", legend=paste(PARS$food, PARS$lake), col=COL, pch=PCH)
legend("topleft", legend=c("soVGBF pooled", "soVGBF king", "soVGBF queen"), col=c(1,2,3), lwd=2)

#plot "small" model (pooled data)
tmp <- data.frame(age=seq(min(db$age), max(db$age),,100))
pred <- predict(fit0, tmp)
lines(tmp$age, pred, col=1, lwd=2)

#plot "large" model (seperate fits)
tmp <- data.frame(age=seq(min(db$age), max(db$age),,100), lake="king")
pred <- predict(fit.king, tmp)
lines(tmp$age, pred, col=2, lwd=2)
tmp <- data.frame(age=seq(min(db$age), max(db$age),,100), lake="queen")
pred <- predict(fit.queen, tmp)
lines(tmp$age, pred, col=3, lwd=2)



###Can this be done in one step using a grouping variable?
#with "lake" as grouping variable
starting.values <- c(S.inf=140, k=0.5, c=0.1, age.0=0, age.s=0)
fit1 <- nlme(model = size ~ soVBGF(S.inf, k, age, age.0, age.s, c), 
  data=db,
  fixed = S.inf + k + c + age.0 + age.s ~ 1,
  group = ~ lake,
  start=starting.values
)
summary(fit1)

#similar residuals to the seperatly fitted models
sum(resid(fit.king)^2+resid(fit.queen)^2)
sum(resid(fit1)^2)

#but different degrees of freedom? (10 vs. 21?)
summary(fit.king)$df+summary(fit.queen)$df
AIC(fit1, fit0)


###I would also like to nest my grouping factors. This doesn't work...
#with "lake" and "food" as grouping variables
starting.values <- c(S.inf=140, k=0.5, c=0.1, age.0=0, age.s=0)
fit2 <- nlme(model = size ~ soVBGF(S.inf, k, age, age.0, age.s, c), 
  data=db,
  fixed = S.inf + k + c + age.0 + age.s ~ 1,
  group = ~ lake/food,
  start=starting.values
)

Riferimento: Chen, Y., Jackson, DA e Harvey, HH, 1992. Un confronto tra von Bertalanffy e le funzioni polinomiali nella modellizzazione dei dati sulla crescita dei pesci. 49, 6: 1228-1235.

Risposte:


6

È possibile stratificare in base ai valori del predittore categorico e confrontare gli accoppiamenti. Per esempio si supponga di avere predittori continui e variabile dipendente . Credo che nls () fornisca la stima della massima verosimiglianza di tale cheX1,...,XpYf

Y=f(X1,...,Xp)+ε

dove ed è parametrizzato in qualche modo non lineare (vedere la helpfile NLS). Supponiamo di avere un predittore categorico con livelli e stratificare i dati in base ai valori di e adattare il modello all'interno di ciascuno strato. Poiché si tratta di sottoinsiemi disgiunti di dati, la probabilità logaritmica per il modello stratificato, è la somma della verosimiglianza all'interno di ciascuno strato, che può essere estratta da un modello nls usando la funzione logLik (è anche possibile ottenere la verosimiglianza logaritmica) dal modello non stratificato, , usando logLik).ε~N(0,σ2)fBmBL1L0

Il modello non stratificato è chiaramente un sottomodello del modello stratificato, quindi il test del rapporto di verosimiglianza è appropriato per vedere se il modello più grande vale la complessità aggiunta - la statistica del test è

λ=2(L1-L0)

λχ2mp-p=p(m-1)pχ2


Stai suggerendo di adattare m modelli separati, sommare la probabilità di registro da ogni L1 = SOMMA (LL_i, i da 1 a m) e quindi procedere con la probabilità? Inoltre, L0 è un modello con il predittore categorico in questione incluso (ad esempio con variabili fittizie m-1)?
B_Miner,

L0BB

Grazie per il tuo suggerimento Macro. Questo sembra essere nella direzione di ciò che ho già fatto, sebbene tu suggerisca un confronto della probabilità piuttosto che il test F. Nel mio esempio, il test F confronta anche i singoli residui di adattamento con la somma dei residui di vari adattamenti applicati a ciascun livello predittivo categorico. Immagino che mi stavo chiedendo se uno può fare questo all'interno di un modello misto in un solo passaggio piuttosto che adattarsi a più modelli. Inoltre, una tale strategia consentirebbe il test dei fattori nidificati?
Marc nella scatola

Non credo che sarai in grado di aggirare diversi modelli per confrontare i modelli. Inoltre, sì, il test del rapporto di verosimiglianza può essere utilizzato per verificare la presenza di fattori nidificati.
Macro

2

Ho scoperto che è possibile codificare le variabili categoriali con nls (), semplicemente moltiplicando i vettori vero / falso nella propria equazione. Esempio:

# null model (no difference between groups; all have the same coefficients)
nls.null <- nls(formula = percent_on_cells ~ vmax*(Time/(Time+km)),
            data = mehg,
            start = list(vmax = 0.6, km = 10))

# alternative model (each group has different coefficients)
nls.alt <- nls(formula = percent_on_cells ~ 
              as.numeric(DOC==0)*(vmax1)*(Time/(Time+(km1))) 
            + as.numeric(DOC==1)*(vmax2)*(Time/(Time+(km2)))
            + as.numeric(DOC==10)*(vmax3)*(Time/(Time+(km3)))
            + as.numeric(DOC==100)*(vmax4)*(Time/(Time+(km4))),
            data = mehg, 
            start = list(vmax1=0.63, km1=3.6, 
                         vmax2=0.64, km2=3.6, 
                         vmax3=0.50, km3=3.2,
                         vmax4= 0.40, km4=9.7))
Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.