R/generate_reordered_results.R

In kmorrisongr/ksmthesis: Kyle's Thesis Code

# ---------------------------
# generate_reordered_results.R
# Convert seed_results from
# 	[[seed]][[method]] to
#	[[method]][[seed]].
# NOTE: Chose [[seed]][[method]]
#	in the first place
#	for better parallelization.
# ---------------------------
# Necessary functions
# ---------------------------

# NOTE: jank, does not fully allow for arbitrary colnames

#' reorder_method_results
#'
#' @export
reorder_method_results = function(m_idx, dims, seeds, seed_results, colheaders=c("score", "p_value", "effect_size", "effs_new_groups")){
	# seed_results[[s_idx]] wrap_analyze[[m_idx]] analyze_method[[1:4]]

	get_method_results = function(s_idx, m_idx, seed_results, do_permute, want_permute){
		if (do_permute){
			if (want_permute){
				return(seed_results[[s_idx]]$avg_permuted_methods_results[[m_idx]])

			} else {
				return(seed_results[[s_idx]]$methods_results[[m_idx]])
			}

		} else {
			return(seed_results[[s_idx]][[m_idx]])
		}
	}

	if (is.null(globals_list$do_permute) || !globals_list$do_permute){
		method_results = lapply(1:length(seeds), get_method_results,
					m_idx, seed_results, FALSE, FALSE)

	} else {
		method_results = lapply(1:length(seeds), get_method_results,
					m_idx, seed_results, TRUE, FALSE)

		permuted_method_results = lapply(1:length(seeds), get_method_results,
						 m_idx, seed_results, TRUE, TRUE)

		# equivalent to mapply(rbind, method_results[[1]], method_results[[2]], etc. for all seeds)
		permuted_method_results = fccu_mapply_evil("rbind", permuted_method_results,
							   other_args_str="SIMPLIFY=FALSE")
		names(permuted_method_results) = colheaders
	}

	# equivalent to mapply(rbind, method_results[[1]], method_results[[2]], etc. for all seeds)
	method_results = fccu_mapply_evil("rbind", method_results, other_args_str="SIMPLIFY=FALSE")
	names(method_results) = colheaders

	gc()

	if (is.null(globals_list$do_permute) || !globals_list$do_permute){
		return(method_results)
	}

	return(list(method_results=method_results, permuted_method_results=permuted_method_results))
}


# ---------------------------
# WRAPPER FOR IT ALL
# ---------------------------

#' generate_method_results
#'
#' @export
generate_method_results = function(methods, method_names, dims, seeds, seed_results, results_dir, melt_results, doplot){
	if (melt_results){
		r_m_r_expr = expression(
			reorder_method_results(m_idx, dims, seeds, seed_results)
		)

		cat("Melting results...\n")
		if (dopar){
			method_results = foreach(m_idx=1:length(methods), .export=c("globals_list"), .packages=c("ksmthesis"), .inorder=FALSE) %dopar% { return(eval(r_m_r_expr)) }

		} else {
			method_results = foreach(m_idx=1:length(methods)) %do% { return(eval(r_m_r_expr)) }
		}

		names(method_results) = method_names[1:length(methods)]
		save(method_results, file=paste(results_dir, "method_results", sep=''))

	} else if (doplot){
		load(paste(results_dir, "method_results", sep=''))
	}

	return(method_results)
}