2016-06-27 2 views
-1

저는 현재 두 개의 다른 모델에 맞는 모델 적합성을 계산하는 두 가지 기능을 가진 다음 코드를 가지고 있습니다. 차이는 + 로그 (V2) 모델에 추가 된 LM 기능에 2R : 두 모델에 대한 루프 만들기?

R 코드

dat <- data.frame(clicks = runif(30, 1, 100), v1 = runif(30, 1, 100), v2 = runif(30, 1, 100)) 
p0 <- 1 # number of parameters in lm() 
p1 <- 2 # number of parameters in lm() 
n <- nrow(dat) - 1 

## Model 1 Loop 
model1 <- function(x) { 
    fit <- lm(log(clicks) ~ log(v1), data = dat, subset = 1:x, model = FALSE) 
    pred <- predict(fit, newdata = dat[x+1, ]) 
    c(summary(fit)$r.squared) 
} 

## Model 1 Regression 
result_m1 <- t(sapply(p0:n, model1)) 
data.frame(result_m1) 

## Model 2 Loop 
model2 <- function(x) { 
    fit <- lm(log(clicks) ~ log(v1) + log(v2), data = dat, subset = 1:x, model = FALSE) 
    pred <- predict(fit, newdata = dat[x+1, ]) 
    c(summary(fit)$r.squared) 
} 

## Model 2 Regression 
result_m2 <- t(sapply(p1:n, model2)) 
data.frame(result_m2) 

질문 : 어떻게 든 함수를 만들 수 모든 모델에 대해 계산을 반복하는 대신 다른 모델에 대해서만 루프를 구현합니다.

나는 이것을 염두에두고 있지만 구현할 수 없었다. http://www.ats.ucla.edu/stat/r/pages/looping_strings.htm

+0

http://codereview.stackexchange.com에 속하기 때문에이 질문을 주제로 끝내기 위해 투표하고 있습니다. –

답변

0

사용 가능한 패키지에서 모델 선택 기능을 사용하여 쉽게 수행 할 수있는 기능을 재현하는 데 어떤 시점도 보이지 않습니다.

library(leaps) 
library(dplyr) 

b <- regsubsets(clicks ~ ., data=dat, nbest=10, nvmax=2) # carries out exhaustive model selection (10 best models; 2 maximum predictors) 

coef(b, 1:3) # returns coefficient for the 3 models in this case 
[[1]] 
(Intercept)   v1 
60.8067570 -0.2665699 

[[2]] 
(Intercept)   v2 
49.96974177 -0.05227489 

[[3]] 
(Intercept)   v1   v2 
62.02323816 -0.26422966 -0.02676747 


summary(b)$rsq #provide r.squared value for 3 models 
[1] 0.067952759 0.002366681 0.068568059 

예측을 실행하는 것은 다소 복잡합니다.

all.mods <- summary(b)$which[,-1] # gives logic output of predictors combination 
all.mods 
    v1 v2 
1 TRUE FALSE 
1 FALSE TRUE 
2 TRUE TRUE 

RHS <- lapply(seq(nrow(all.mods)), function(m) summary(b)$which[m,-1] %>% which %>% names %>% paste(., collapse="+")) 
RHS 
[[1]] 
[1] "v1" 

[[2]] 
[1] "v2" 

[[3]] 
[1] "v1+v2" 

lm.form <- lapply(RHS, function(m)parse(text=paste("lm(clicks ~", m, ", data=dat)"))) 
lm.mods <- lapply(lm.form, eval) # return list of all lm.mods generated 

는 lm.mods의 목록은 이후 new.data와 predict 사용할 수 있습니다.