Оценка различий с повторной выборкой из большого набора данных - PullRequest
Новая
       25

Оценка различий с повторной выборкой из большого набора данных

0 голосов
/ 27 декабря 2018

У меня есть большой набор данных, для которого нужно выполнить оценку различий.Учитывая природу набора данных, мои знаменатели t-статистики завышены, а коэффициент (тайно) статистически значим.Я хочу пошагово сократить количество элементов в базе данных, и для каждого шага повторять выборку большое количество раз и переоценивать каждый раз коэффициент взаимодействия и стандартные ошибки.

Затем я хочу принятьвсе средние оценки и стандартная ошибка и нанесите их на график, чтобы показать, в какой точке (если есть) они статистически не отличаются от нуля.

Мой код следует на игрушечном примере.

  • Я не уверен, что это самый эффективный способ решения проблемы
  • Я не могу получить и, таким образом, построить доверительный интервал
  • Я не уверен, что выборка является репрезентативной, учитываясуществование разных групп.

Пример игрушки (Creds Torres-Reyna - 2015) 

library(foreign)
library(dplyr)
library(ggplot2)


df_0 <- NULL
for (i in 1:length(seq(5,nrow(mydata)-1,5))){
 index <- seq(5,nrow(mydata),5)[i]
 df_1 <- NULL
 for (j in 1:10){

  mydata_temp <- mydata[sample(nrow(mydata), index), ]    

  didreg = lm(y ~ treated + time + did, data = mydata_temp)
  out <- summary(didreg)
  new_line <- c(out$coefficients[,1][4], out$coefficients[,2][4], index)
  new_line <- data.frame(t(new_line))
  names(new_line) <- c("c","s","i")
  df_1 <- rbind(df_1,new_line)
  }
 df_0 <- rbind(df_0,df_1)
}

df_0 <- df_0 %>% group_by(i) %>% summarise(coefficient <- mean(c, na.rm = T),
                                          standard_error <- mean(s, na.rm = T)) 

names(df_0) <- c("i","c","s")
View(df_0)

Ответы [ 2 ]

0 голосов
/ 27 декабря 2018

Рассмотрим следующий рефакторинг кода с использованием базовых функций R: within, %in%, вложенный lapply, setNames, aggregate и do.call.Этот подход позволяет избежать вызова rbind в цикле и компактно переписывать код без постоянного использования ссылок на столбцы $. 

library(foreign)

mydata = read.dta("http://dss.princeton.edu/training/Panel101.dta")

mydata <- within(mydata, {
  time <- ifelse(year >= 1994, 1, 0)
  treated <- ifelse(country %in% c("E", "F", "G"), 1, 0)
  did <- time * treated
})

# OUTER LIST OF DATA FRAMES
df_0_list <- lapply(1:length(seq(5,nrow(mydata)-1,5)), function(i) {      
  index <- seq(5,nrow(mydata),5)[i]

  # INNER LIST OF DATA FRAMES  
  df_1_list <- lapply(1:100, function(j) {        
    mydata_temp <- mydata[sample(nrow(mydata), index), ]    

    didreg <- lm(y ~ treated + time + did, data = mydata_temp)
    out <- summary(didreg)
    new_line <- c(out$coefficients[,1][4], out$coefficients[,2][4], index)
    new_line <- setNames(data.frame(t(new_line)), c("c","s","i"))
  })

  # APPEND ALL INNER DFS
  df <- do.call(rbind, df_1_list)
  return(df)
})

# APPEND ALL OUTER DFS
df_0 <- do.call(rbind, df_0_list)

# AGGREGATE WITH NEW COLUMNS
df_0 <- within(aggregate(cbind(c, s) ~ i, df_0, function(x) mean(x, na.rm=TRUE)), { 
               upper = c + s 
               lower = c - s 
        })

# RUN PLOT
within(df_0, {
  plot(i, c, ylim=c(min(c)-5000000000, max(c)+5000000000), type = "l",
       cex.lab=0.75, cex.axis=0.75, cex.main=0.75, cex.sub=0.75)
  polygon(c(i, rev(i)), c(lower, rev(upper)),
          col = "grey75", border = FALSE)
  lines(i, c, lwd = 2)
})

Plot Output

0 голосов
/ 27 декабря 2018

В итоге я решил это так: это самый эффективный способ? 

library(foreign)
library(dplyr)

mydata = read.dta("http://dss.princeton.edu/training/Panel101.dta")
mydata$time = ifelse(mydata$year >= 1994, 1, 0)
mydata$treated = ifelse(mydata$country == "E" |
                      mydata$country == "F" |
                      mydata$country == "G", 1, 0)
mydata$did = mydata$time * mydata$treated


df_0 <- NULL
for (i in 1:length(seq(5,nrow(mydata)-1,5))){
  index <- seq(5,nrow(mydata),5)[i]
  df_1 <- NULL
  for (j in 1:100){

    mydata_temp <- mydata[sample(nrow(mydata), index), ]    

    didreg = lm(y ~ treated + time + did, data = mydata_temp)
    out <- summary(didreg)
    new_line <- c(out$coefficients[,1][4], out$coefficients[,2][4], index)
    new_line <- data.frame(t(new_line))
    names(new_line) <- c("c","s","i")
    df_1 <- rbind(df_1,new_line)
  }
  df_0 <- rbind(df_0,df_1)
}

df_0 <- df_0 %>% group_by(i) %>% summarise(c = mean(c, na.rm = T), s = 
mean(s, na.rm = T))
df_0 <- df_0 %>% group_by(i) %>% mutate(upper = c+s, lower = c-s)

df <- df_0
plot(df$i, df$c, ylim=c(min(df_0$c)-5000000000, max(df_0$c)+5000000000), type = "l")

polygon(c(df$i,rev(df$i)),c(df$lower,rev(df$upper)),col = "grey75", border = FALSE)
lines(df$i, df$c, lwd = 2)
...