r unlist.getElement

Posted 2021-05-23

train.res...p:
  CVstep1:
    cutoff:
    - -0.1112537
    - -0.1112537
  CVstep2:
    cutoff:
    - -1.2888784
    - -3.0321384
  CVstep3:
    cutoff:
    - 0.5899218
    - 0.5899218
  CVstep4:
    cutoff:
    - -1.2251295
    - -2.8220137
  CVstep5:
    cutoff:
    - -1.7074582
    - -3.8080564
  CVstep6:
    cutoff:
    - 0.367119
    - 0.367119
  CVstep7:
    cutoff:
    - -0.126039
    - -0.4391152
  CVstep8:
    cutoff:
    - -1.3587555
    - -3.4014447
  CVstep9:
    cutoff:
    - 0.4151302
    - 0.5459702
  CVstep10:
    cutoff:
    - -1.5434931
    - -3.5200994
  CVstep11:
    cutoff:
    - 0.611082
    - 0.0310714
  CVstep12:
    cutoff:
    - 0.0210271
    - 0.0210271
  CVstep13:
    cutoff:
    - 0.3783709
    - 0.3783709
  CVstep14:
    cutoff:
    - -1.3888039
    - -3.107564
  CVstep15:
    cutoff:
    - 0.4532732
    - 0.4532732
  CVstep16:
    cutoff:
    - -1.1081383
    - -2.573515
  CVstep17:
    cutoff:
    - .na.character
    - .na.character
  CVstep18:
    cutoff:
    - 0.3815772
    - 0.152388
  CVstep19:
    cutoff:
    - .na.character
    - .na.character
  CVstep20:
    cutoff:
    - -1.3425739
    - -3.1162008
  CVstep21:
    cutoff:
    - -1.0121899
    - -2.4753743
  allSamples:
    cutoff:
    - -1.4287511
    - -3.3009532

#' Recursive unlisting for a specific element
#' 
#' Retrieve a value (vector and matrix tested) from a list of list of list of ...
#' and return a dataframe. 
#'
#' @param mylist 
#' Your listlistlist... you want to delist
#' @param depth 
#' How many list-hierarchies do you want to unlist?
#' 
#' Example 1: 
#' 	You have a list of CrossValidation-steps and want to have the coefficients
#' 	in each step 
#' 		--> depth = 1
#' 		
#' Example 2: 
#' 	You have a list of different Models with CrossValidation-steps and want to have the coefficients
#' 	from each model in each CV-step
#' 		--> depth = 2
#' 	
#' @param which.element 
#' How is the element you want called? "coefNoZero", "cutoff", etc. 
#' @param save_depth 
#' Do not touch this. This is just that you get a bit nicer output 
#' (Not a list with the current depth but the data.frame you are interested in)
#'
#' @return
#' A data.frame 
#' @export
#'
#' @examples
#' ##load("exampleData_unlist.rda")
#' a <- yaml::yaml.load_file("a.yaml")
#' b <- a
#' b$trainScaled <- b$train.res...p
#' b_2 <- b
#' names(b_2) <- NULL
#' unlist.getElement(a, 2, "cutoff")
#' unlist.getElement(b, 2, "cutoff")
#' unlist.getElement(b_2, 2, "cutoff")
#' ## unlist.getElement(different.norm.models, 1, "coefNOzero")


unlist.getElement <- function(mylist, depth, which.element, save_depth=NA){
	if(is.na(save_depth)){
		depth <- depth -1
		save_depth <- depth
	}
	if(depth>=0){
		tmp.df <- NULL
		if(is.null(names(mylist))){
			iteration_vec <- 1:length(mylist)
		}else{
			iteration_vec <- names(mylist)
		}
		for(nameX in iteration_vec){
			# cat("\n\n")
			# print(paste0("depth"=depth, "  name"=nameX))
			tmp.return <- unlist.getElement(mylist[[nameX]]
									 , depth=depth-1
									 , which.element
									 ,save_depth)
			tmp.element <- tmp.return[[1]]
			tmp.return_finished <- tmp.return[[2]]
			if(tmp.return_finished == -1){ # Die returned values enthalten jetzt den gewuenschten Vektor+Namen
				if(is.null(tmp.df)){
					if(!is.null(tmp.element)){ 	# this is NOT tested but I hope it 
												# works.. The problem is, if the FIRST list element is not there
												# (NULL), then I get NULL
												# But maybe the rest of the lists elements HAVE values...
												# Maybe is this not a problem at all 
												# and it stops at the first "return" if it does not find any usefull values. 
						
						tmp.df <- data.frame(tmp.element, stringsAsFactors = FALSE)
						tmp.df$names <- rownames(tmp.df)
					}else{
						tmp.df <- data.frame(value=NA, names=NA)
						warning(paste0("In "), nameX, " depth=", depth, " : which.element was NULL")
					}
					colnames(tmp.df)[1] <- which.element
					if(nrow(tmp.df) == 0){
						tmp.df[1, ] <- NA
					}
					tmp.df <- cbind("new"=nameX, tmp.df)
					colnames(tmp.df)[1] <- paste0("L", depth)
				}else{
					if(!is.null(tmp.element) & !length(tmp.element)==0){ # 
						tmp.df_newpart <- data.frame(tmp.element, stringsAsFactors = FALSE)
						# the following if-else was previously: 
						# 	tmp.df_newpart$names <- names(tmp.element) # rownames(tmp.df_newpart) # changed 12.3.18 - hopefully this does not hurt anywhere else
						if(is.null(rownames(tmp.element))){
							if(is.null(names(tmp.element))){
								tmp.df_newpart$names <- paste0("placeholder_", 1:length(tmp.element))
							}else{
								tmp.df_newpart$names <- names(tmp.element) # rownames(tmp.df_newpart) # changed 12.3.18 - hopefully this does not hurt anywhere else
							}
						}else{
							tmp.df_newpart$names <- rownames(tmp.element) 
						}
					}else{ # this is only the case if in some step (after the first)
							# the element was NOT found.
						tmp.df_newpart <- data.frame(value=NA, names=NA)
						warning(paste0("In "), nameX, " depth=", depth, " : which.element was NULL")
					}
					colnames(tmp.df_newpart)[1] <- which.element
					if(nrow(tmp.df_newpart) == 0){
						tmp.df_newpart[1, ] <- NA
					}
					tmp.df_newpart <- cbind("new"=nameX, tmp.df_newpart)
					colnames(tmp.df_newpart)[1] <- paste0("L", depth)
					tmp.df <- rbind(tmp.df, tmp.df_newpart)
				}
			}else{ # sonst sind wir schon eine/mehrere Ebenen drueber
				new.withDepth <- cbind("new"=nameX, tmp.element)
				colnames(new.withDepth)[1] <- paste0("L", depth)
				if(is.null(tmp.df)){
					tmp.df <- new.withDepth
				}else{
					tmp.df <- rbind(tmp.df, new.withDepth)
				}
			}
		}
		rownames(tmp.df) <- NULL
	}else{
		return(list(mylist[[which.element]], -1))
	}
	
	if(depth == save_depth){
		return(tmp.df)
	}else{
		return(list(tmp.df, depth))
	}
}