Оптимизация R MICE вменения - PullRequest
Новая
       69

Оптимизация R MICE вменения

0 голосов
/ 15 февраля 2020

Я пытаюсь разобраться в ряде файлов данных, полученных из данных мирового банка, но первая проблема, с которой я столкнулся, это невероятное количество пропущенных точек данных. Я разбираюсь с концепцией множественного вменения и даже смог использовать ее в некоторой степени, но она далека от совершенства. Прежде всего, все точки данных, которые изначально присутствуют, являются строгими процентами, но вменение, похоже, не учитывает это. Я предположил, что если я увеличу количество вменений и количество итераций, ошибка будет dimini sh, но этот подход, похоже, занимает невероятное количество времени. Вот код, который я сейчас использую: 

require("tools")      #Load required packages
require("dplyr")
require("mice")


dataFileNames <- as.data.frame(file_path_sans_ext(list.files("Data/")))   #Extract file names
dataFileNames <- rename(dataFileNames,"fileName"='file_path_sans_ext(list.files("Data/"))') #Rename the column in the vector
dataFileNames$fileName <- as.character(dataFileNames$fileName)  #Convert into characters

Fetch_Data <- function(Filename){

  dataName <- paste("Data/",Filename,sep = "")

  rawData <- read.csv(unz(paste(dataName,".zip",sep = ""),paste(Filename,".csv",sep = "")),skip = 4,header = TRUE)
  dataName <- as.character(rawData[1,3])
  return(list(rawData,dataName))
  return(rawData)
}   #UDF 1: Fetch data from the csvs within the zip files




dataList <- list()  #Create an empty list to fill in

for(i in 1:nrow(dataFileNames)){
  dataList[[i]] <- assign(Fetch_Data(dataFileNames[i,1])[[2]],Fetch_Data(dataFileNames[i,1])[[1]])

}  #Fill in the list with data

FinalData <- bind_rows(dataList)  #Join all data by row

countryNames <- as.data.frame(unique(FinalData$Country.Name)) #List Country Names
countryNames <- rename(countryNames,List.of.Countries='unique(FinalData$Country.Name)')  #Rename header properly
indicatorNames <- as.data.frame(unique(FinalData$Indicator.Name))  #List Indicators
indicatorNames <- rename(indicatorNames,List.of.Indicators='unique(FinalData$Indicator.Name)')  #Rename header properly


binnedByCountry <- split(FinalData,FinalData$Country.Name)  #Create a list with data binned by country
binnedByVariable <- split(FinalData,FinalData$Indicator.Name) #Create a list with data binned by indicator


# binnedByCountry <- lapply(binnedByCountry, function(x)x[!(names(x) %in% c("Country.Name","Indicator.Code","Country.Code","X"))]) #Remove redundant columns
# binnedByVariable <- lapply(binnedByVariable, function(x)x[!(names(x) %in% c("Indicator.Name","Country.Code","Indicator.Code","X"))]) #Remove redundant column


Impute_Data <- function(dataValue,MAXITS,IMPS){
  imputation <- mice(dataValue, seed=1, maxit = MAXITS, m=IMPS)
  predM = imputation$predictorMatrix
  meth=imputation$method
  predM[,c("Country.Name")]=0
  predM[,c("Country.Code")]=0
  predM[,c("Indicator.Name")]=0
  predM[,c("Indicator.Code")]=0

  filledInData <- complete(imputation)
  return(filledInData)

}   #UDF 2:Impute data with MAXITS iterations and IMPS imputations

rm(list=setdiff(ls(),c("FinalData","Fetch_Data","binnedByCountry","binnedByVariable","Impute_Data")))  #Remove unwanted variables from global environment

Results <- Impute_Data(FinalData,1,1)

Когда я запустил функцию вменения для данных, отформатированных в виде списка, 

lapply(binnedByCountry,Impute_Data)

Это было относительно быстро, но остановилось между тем, когда он обнаружил слишком много пропущенных данных. Только после этого я добавил дополнительные аргументы MAXITS и IMPS. В настоящее время для каждой итерации все занимает около 15-20 минут, поэтому мне нужно оптимизировать код, прежде чем надеяться получить гораздо более представительный результат. С другой стороны, если есть дополнительные ограничения, которые я могу наложить на вменение мышей, это тоже будет приветствоваться. Моя конечная цель - запустить некоторые регрессионные тесты для полученных значений и извлечь из них определенные выводы. Любое предложение относительно того, как решить эту проблему, будет оценено.

...