एक गैर-रैखिक मॉडल के साथ एक समूह चर के प्रभाव का परीक्षण कैसे करें?


15

मेरे पास एक गैर-रैखिक मॉडल में एक समूह चर के उपयोग के संबंध में एक प्रश्न है। चूंकि nls () फ़ंक्शन फ़ैक्टर चर के लिए अनुमति नहीं देता है, मैं यह पता लगाने के लिए संघर्ष कर रहा हूं कि क्या कोई मॉडल फिट पर एक कारक के प्रभाव का परीक्षण कर सकता है। मैंने नीचे एक उदाहरण शामिल किया है जहां मैं अलग-अलग विकास उपचारों के लिए "मौसमीकृत वॉन बर्टलान्फी" वृद्धि मॉडल को फिट करना चाहता हूं (जो आमतौर पर मछली के विकास के लिए लागू होता है)। मैं झील के प्रभाव का परीक्षण करना चाहूंगा जहां मछली बढ़ी और साथ ही दिए गए भोजन (केवल एक कृत्रिम उदाहरण)। मैं इस समस्या के समाधान के बारे में परिचित हूं - चेन एट अल द्वारा उल्लिखित एफ-टेस्ट की तुलना करने वाले मॉडल बनाम जमा किए गए डेटा के लिए फिट बैठता है। (1992) (ARSS - "वर्गों के अवशिष्ट योग का विश्लेषण")। दूसरे शब्दों में, नीचे दिए गए उदाहरण के लिए,

यहाँ छवि विवरण दर्ज करें

मुझे लगता है कि वहाँ एक आसान तरीका आर में यह कर रहा हूँ आर (रोम) का उपयोग कर, लेकिन मैं समस्याओं में चल रहा हूँ। सबसे पहले, एक समूहीकरण चर का उपयोग करके, अलग-अलग मॉडल की मेरी फिटिंग के साथ स्वतंत्रता की डिग्री अधिक है। दूसरा, मैं चर समूहों को घोंसला बनाने में असमर्थ हूं - मैं नहीं देखता कि मेरी समस्या कहां है। Nlme या अन्य तरीकों का उपयोग करने में किसी भी मदद की बहुत सराहना की जाती है। नीचे मेरे कृत्रिम उदाहरण के लिए कोड है:

###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
)

संदर्भ: चेन, वाई।, जैक्सन, डीए और हार्वे, एचएच, 1992। मॉडलिंग फिश ग्रोथ डेटा में वॉन बर्टलान्फी और बहुपद कार्यों की तुलना। 49, 6: 1228-1235।

जवाबों:


6

X1,...,XpYf

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

εN(0,σ2)fBmBL1L0

असत्यापित मॉडल स्पष्ट रूप से स्तरीकृत मॉडल का एक सबमॉडल है, इसलिए संभावना अनुपात परीक्षण यह देखने के लिए उपयुक्त है कि क्या बड़ा मॉडल अतिरिक्त जटिलता के लायक है - परीक्षण सांख्यिकीय

λ=2(एल1-एल0)

λχ2पी-पी=पी(-1)पीχ2


क्या आप मी अलग मॉडल को फिट करने का सुझाव दे रहे हैं, प्रत्येक L1 = SUM (LL_i, i से 1 m) से लॉग संभावना की राशि लिखें और फिर संभावना के साथ आगे बढ़ें? इसके अलावा, L0 एक मॉडल है जिसमें प्रश्नवाचक श्रेणीबद्ध भविष्यवक्ता है (उदाहरण के लिए m-1 डमी चर के साथ)?
B_Miner

L0BB

आपके सुझाव के लिए धन्यवाद मैक्रो। यह उस दिशा में लगता है जो मैंने पहले ही किया है - हालांकि आप एफ-टेस्ट के बजाय संभावना की तुलना करने का सुझाव देते हैं। मेरे उदाहरण में, एफ-परीक्षण एकल फिट अवशेषों की तुलना भी करता है जो प्रत्येक श्रेणीबद्ध भविष्यवक्ता के स्तर पर लागू होने वाले कई फिटों से प्राप्त अवशेषों के योग से होता है। मुझे लगता है कि मैं सोच रहा था कि क्या कोई एक मॉडल में कई मॉडल फिट करने के बजाय एक मिश्रित मॉडल के भीतर ऐसा कर सकता है। इसके अलावा, क्या ऐसी रणनीति नेस्टेड फैक्टर परीक्षण के लिए अनुमति देगी?
बॉक्स

मुझे नहीं लगता कि आप मॉडल की तुलना करने के लिए कई मॉडल फिट करने में सक्षम होंगे। इसके अलावा, हाँ, संभावित कारकों के परीक्षण के लिए संभावना अनुपात परीक्षण का उपयोग किया जा सकता है।
मैक्रों

2

मैंने पाया कि अपने समीकरण में केवल सच्चे / झूठे वैक्टर को गुणा करके nls () के साथ श्रेणीबद्ध चर को कोड करना संभव है। उदाहरण:

# 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))
हमारी साइट का प्रयोग करके, आप स्वीकार करते हैं कि आपने हमारी Cookie Policy और निजता नीति को पढ़ और समझा लिया है।
Licensed under cc by-sa 3.0 with attribution required.