Running TryCatch within future_apply

[JohnnyStochastic]

Simple question a bit out of my league.

Running a large MICE operation within TryCatch and trying to parallel the process

I am local- live and work in the Presidio. I do a bit of programming in R and have recently used the Future package for a script that I update results quarterly. It is a large MICE imputation routine. I tried future-apply on a small sample and it worked well-impressive. On a larger file not so much.

I have attached the script, if you can take a look and let me know how to make it work.

This is the error:
in ...future.FUN(...future.X_jj, ...) : no loop for break/next, jumping to top level

Here is the script:
library(data.table)
library(tidyverse)
library(caret)
library(mice)

MulImp2a <- function(dat) {
  testdat <- dat %>%
    mutate(
      Gender = as.factor(Gender),
      AgeBracket4 = as.factor(AgeBracket4),
      RUS_Code = as.factor(RUS_Code),
      Income = as.factor(Income),
      Ethnic = as.factor(Ethnic),
      Education = as.factor(Education),
      EdNew=as.factor(EdNew),
      Marital = as.factor(Marital),
      Children = as.factor(Children),
      Own_Rent = as.factor(Own_Rent)
    )
  #  Zip=as.factor(Zip),
  # State=as.factor(State),
  # County=as.factor(County))
  
  init <- mice(testdat, maxit = 0)
  meth <- init$method
  predM <- init$predictorMatrix
  
  
  predM[, c("LALCONSUMERID")] <- 0
  predM[, c("Zip_Code")] <- 0
  predM[, c("Age_Code")] <- 0
  predM[, c("Age_Othot_Bracket")] <- 0
  predM[, c("Age_L2_Bracket")] <- 0
  # predM[, c("Agez")] <- 0
  predM[, c("State")] <- 0
  predM[, c("Geocode_Full")] <- 0
  predM[, c("Bdate")] <- 0
  # predM[, c("Ed2")] <- 0
  predM[,c("Education")]<-0
  predM[, c("Gvar")] <- 0
  # predM[, c("Label")] <- 0
  # predM[,c("Social_Ranking_Index_by_Individual")]<-0
  #  predM[,c("Likely_Income_Ranking_by_Area")]<-0
  
  meth[c("Gender")] <- ""
  meth[c("AgeBracket4")] <- ""
  meth[c("Ethnic")] <- ""
  meth[c("Marital")] <- ""
  meth[c("RUS_Code")] <- ""
  meth[c("Income")] <- ""
  meth[c("Children")] <- ""
  meth[c("EdNew")] <- ""
  meth[c("Own_Rent")] <- ""
  meth[c("Social_Ranking_Index_by_Area")]<-""
  meth[c("Likely_Educational_Attainment_Ranking_by_Area")]<-""
  #  meth[c("Number_Of_Persons_In_Unit")]=""
  #  meth[c("Number_Of_Adults")]=""
  # meth[c("Inferred_HH_Rank")]=""
  
  meth[c("Income")] <- "polyreg"
  meth[c("Own_Rent")] <- "logreg"
  meth[c("Marital")] <- "logreg"
  meth[c("Children")] <- "logreg"
  meth[c("EdNew")] <- "polyreg"
  
  set.seed(555)
  
  imputed <- mice(testdat, method = meth, predictorMatrix = predM, m = 1)
  
  imputed <- mice::complete(imputed)
}

basepath <- "/data/customers/l2/data/commercial/24Q4/"
Vfdir <- file.path(basepath, "voter")
Cfdir <- file.path(basepath, "raw")
ComFileList <- list.files(file.path(basepath, "raw"), full.names = TRUE) #DS server
VotFileList <- list.files(file.path(basepath,"voter"),full.names=TRUE) #DS server

GrabVf <- c(
"LALVOTERID",
"Voters_Age",
"Voters_BirthDate"
)

GrabCom <- c("Individual_Id", "Lalvoterid", "Geocode_Full", "RUS_Code", "State", "Gender", "Inferred_Age", "Marital_Status", "Ethnic_Group", "Homeowner_Probability_Model", "Presence_Of_Children_in_HH", "Education_of_Person", "Estimated_Income_Code", "Zip_Code","BirthDate","Census_Tract","Census_Block","Census_Block_Group",
"Social_Ranking_Index_by_Individual",
"Social_Ranking_Index_by_Area",
"Likely_Income_Ranking_by_Area",
"Likely_Educational_Attainment_Ranking_by_Area")

GrabImp <- c(
"LALCONSUMERID", "Gender", "AgeBracket2", "RUS_Code", "Income", "Ethnic","Ethnic2",
"Education", "Marital", "Children", "Own_Rent", "Zip_Code", "State", "Geocode_Full", "Age_Inferred", "Age_Code", "Age_Othot_Bracket", "Age_L2_Bracket", "AgeBracket4","Bdate",
"Social_Ranking_Index_by_Individual",
"Social_Ranking_Index_by_Area",
"Likely_Income_Ranking_by_Area",
"Likely_Educational_Attainment_Ranking_by_Area","EdNew")

Cdat <- fread(ComFileList[2], colClasses = c("Geocode_Full" = "character", "Zip_Code" = "character"), na.strings = c("", NA), select = GrabCom)
Vdat <- fread(VotFileList[2], select = GrabVf)
setnames(Cdat, "Lalvoterid", "LALVOTERID")
Cdat <- Vdat[Cdat, on = "LALVOTERID"]

total<- Cdat %>%
  .[, Age_Inferred := fifelse(is.na(Voters_Age) == TRUE, Inferred_Age, Voters_Age)] %>%
  .[, Bdate := fifelse(is.na(Voters_Age)==TRUE, BirthDate,Voters_BirthDate) ] %>% 
  
  .[Age_Inferred < 51, ] %>%
  
  # .[(Age_Inferred > 0 & Age_Inferred < 51), ] %>% Exclude 0/NoAge from calculation
  
  .[, Gender := fcase(Gender == "F", "Female", Gender == "M", "Male")] %>%
  .[, LALCONSUMERID := paste0("L2C", State, Individual_Id)] %>%
  .[, RUS_Code := fcase(RUS_Code == "S", "Suburban", RUS_Code == "R", "Rural", RUS_Code == "U", "Urban")] %>%
  .[, Marital := recode(Marital_Status,
                        `M` = "Married",
                        `A` = "Married",
                        `S` = "Single",
                        `B` = "Single"
  )] %>%
  .[, Own_Rent := fifelse(Homeowner_Probability_Model == "H" | Homeowner_Probability_Model == "9", "Own", fifelse(Homeowner_Probability_Model == "R", "Rent", NA_character_))] %>%
  .[, Children := fifelse(Presence_Of_Children_in_HH == "Y", "Yes", fifelse(Presence_Of_Children_in_HH == "N", "No", NA_character_))] %>%
  # dfcf$Age_Bracket <- ifelse(dfcf$Inferred_Age<23,"18-22",ifelse(dfcf$Inferred_Age<29,"23-28",ifelse(dfcf$Inferred_Age<34,"29-33",ifelse(dfcf$Inferred_Age<39,"34-38",ifelse(dfcf$Inferred_Age<45,"39-44","44plus")))))
  .[, Ethnic := recode(Ethnic_Group,
                       `A` = "EastAsian",
                       `C` = "SouthAsian",
                       `E` = "Caucasian",
                       `F` = "AfAm",
                       `I` = "MiddleEastern",
                       `J` = "MiddleEastern",
                       `M` = "MiddleEastern",
                       `N` = "NativeAmerican",
                       `O` = "AsianAmerican",
                       `P` = "PacificIslander",
                       `S` = "Caucasian",
                       `T` = "Other",
                       `W` = "Caucasian",
                       `Y` = "Hispanic"
  )] %>%
  .[, Education := recode(Education_of_Person,
                          `1` = "Some High School",
                          `2` = "High School",
                          `3` = "Vocational School",
                          `4` = "Some College",
                          `5` = "Completed College",
                          `6` = "Graduate School"
  )] %>%
  .[, Income := recode(Estimated_Income_Code,
                       "A" = "Less than $20,000",
                       "B" = "Less than $20,000",
                       "C" = "Less than $20,000",
                       "D" = "$20,000 to $34,999",
                       "E" = "$20,000 to $34,999",
                       "F" = "$20,000 to $34,999",
                       "G" = "$35,000 to $49,999",
                       "H" = "$35,000 to $49,999",
                       "I" = "$35,000 to $49,999",
                       "J" = "$50,000 to $74,999",
                       "K" = "$50,000 to $74,999",
                       "L" = "$50,000 to $74,999",
                       "M" = "$50,000 to $74,999",
                       "N" = "$75,000 to $99,999",
                       "N" = "$75,000 to $99,999",
                       "O" = "$100,000 to $149,999",
                       "P" = "$150,000 to $174,999",
                       "Q" = "$175,000 to $199,999",
                       "R" = "$200,000 to $249,999",
                       "S" = "$250,000 plus"
  )] %>%
  .[, AgeBracket2 := fifelse(Age_Inferred < 22, "18-21", fifelse(Age_Inferred < 27, "22-26", fifelse(Age_Inferred < 33, "27-32", fifelse(Age_Inferred < 38, "33-37", fifelse(Age_Inferred < 43, "38-42", "43plus")))))] %>%
  .[, Age_Code := fifelse(Age_Inferred < 18, 9, fifelse(Age_Inferred < 22, 1, fifelse(Age_Inferred < 27, 2, fifelse(
    Age_Inferred < 33, 3, fifelse(Age_Inferred < 38, 4, fifelse(Age_Inferred < 43, 5, fifelse(Age_Inferred < 48, 6, fifelse(Age_Inferred < 51, 7, fifelse(Age_Inferred > 50, 8, 9)))))
  ))))] %>%
  .[, Age_Othot_Bracket := fcase(
    Age_Inferred < 18, "No Age",
    Age_Inferred < 22, "18-21",
    Age_Inferred < 27, "22-26",
    Age_Inferred < 33, "27-32",
    Age_Inferred < 38, "33-37",
    Age_Inferred < 43, "38-42",
    Age_Inferred < 48, "43-47",
    Age_Inferred < 51, "48-50",
    Age_Inferred > 50, "No Age"
  )] %>%
  .[, Age_L2_Bracket := fcase(
    Age_Inferred < 18, "No Age",
    Age_Inferred < 25, "18-24",
    Age_Inferred < 30, "25-29",
    Age_Inferred < 35, "30-34",
    Age_Inferred < 40, "35-39",
    Age_Inferred < 45, "40-44",
    Age_Inferred < 50, "45-49",
    Age_Inferred < 55, "50-54",
    Age_Inferred > 55, "No Age"
  )] %>%
  # .[, AgeBracket4 := fcase(Age_Inferred < 18, NA_character_, Age_Inferred < 21, "18-20", Age_Inferred < 24, "21-23", Age_Inferred < 27, "24-26", Age_Inferred < 30, "27-29", Age_Inferred < 33, "30-32", Age_Inferred < 36, "33-35", Age_Inferred < 39, "36-38", Age_Inferred < 45, "39-44", Age_Inferred > 44, "45Plus")] %>%
  .[, AgeBracket4 := fcase(Age_Inferred < 21, "18-20", Age_Inferred < 24, "21-23", Age_Inferred < 27, "24-26", Age_Inferred < 30, "27-29", Age_Inferred < 33, "30-32", Age_Inferred < 36, "33-35", Age_Inferred < 39, "36-38", Age_Inferred < 45, "39-44", Age_Inferred > 44, "45Plus")] %>%
  
  .[, StateCounty := str_sub(Geocode_Full, 1, 5)] %>%
  .[,Ethnic2 := recode(Ethnic,
                       `MiddleEastern` = "Other",
                       `EastAsian` = "Asian",
                       `SouthAsian` = "Asian",
                       `AsianAmerican` = "Asian",
                       `PacificIslander` = "Asian",
                       `NativeAmerican` = "Other")] %>%
  .[,EdNew := recode(Education,
                     `Completed College` ="CollegePlus", 
                     `Graduate School` = "CollegePlus",
                     `High School` = "CollegeLess",
                     `Some High School`="CollegeLess", 
                     `Vocational School`="Vocational")]

total <- total[, ..GrabImp]
total$Gvar<-str_sub(total$Geocode_Full,1,11) # 11-Census Tract, 12-Block Group, 15-Block
dfimp <- split(total, f = total$Gvar)

library(future)
library(future.apply)
plan(multisession)
options(future.globals.maxSize = 1000 * 1024^2) #memory adjustment - might be a problem

#parallel

testskip <- vector(mode = "list", length <- length(dfimp))

testskip<-future_lapply(dfimp,function(x){
  dfnew<-as.data.frame(x)
  skip_to_next <- FALSE
  
  tryCatch(tmp<- MulImp2a(dfnew), error = function(e) {
    skip_to_next <<- TRUE
  })
  
  if (skip_to_next) {
    next
  }
  print(length(dfimp))
  tmp
})

dfImpStore1 <- rbindlist(testskip)

testoutdir<-"/data/home/rstudio/EdAttainOutput"
fwrite(dfImpStore1,paste0(testoutdir,"/","Implied",unique(dfImpStore1$State),".csv"))

#END OF PROGRAM

[HenrikBengtsson]

Hi there. Could please edit your comment to use so called fenced code blocks. See https://docs.github.com/en/get-started/writing-on-github/working-with-advanced-formatting/creating-and-highlighting-code-blocks#fenced-code-blocks for what that is.

[JohnnyStochastic]

Hi Henrik,
Thanks for responding quickly. I think this is what you are requesting, I think.

edparallel.md

[HenrikBengtsson]

I was actually asking you to click edit in your comment and add special surround backticks for you code block. That will make your code readable. It's worth learning because that's a de facto standard in lots of places, not just GitHub.

[JohnnyStochastic]

ok will do that- just not familiar with that. I have NOT included the data file or access to the data that is input into the file. Thanks for your patience. Offer for coffee or tea on the table.

[JohnnyStochastic]

Should have spent a bit more time researching, easy fix. Thanks Henrik, This is a very easy package to employ and it works really well on all platforms.