Apologies if this is a dumb question- I am quite new to R and have been trying to teach myself. I've been trying to rewrite the following code using a map function instead of a for loop.
columnmean <- function(y){
nc <- ncol(y)
means <- numeric(nc)
for(i in 1:nc){
means[i] <- mean(y[, i])
}
means
}
columnmean(mtcars)
My code which uses map prints out means but it also adds the column names as well. How do I utilize map properly to avoid this? Should I be using imap or map2? Thanks!
columnmean1 <- function(y){
nc <- ncol(y)
means <- numeric(nc)
map(y, function (y) means <- mean(y) )
}
columnmean1(mtcars)
You can use map_dbl :
columnmean_map <- function(y){
purrr::map_dbl(y, mean)
}
You can also use summarise_all
columnmean_summarise <- function(y){
dplyr::summarise_all(y, mean)
}
Related
This code chunk creates a 10 objects based of length of alpha.
alpha <- seq(.1,1,by=.1)
for (i in 1:length(alpha)){
assign(paste0("list_ts_ses_tune", i),NULL)
}
How do I put each function into the new list_ts_ses_tune1 ... null objects I've created? Each function puts in a list, and works if I set list_ts_ses_tune1 <- lapply ...
for (i in 1:length(alpha))
{
list_ts_ses_tune[i] <- lapply(list_ts, function(x)
forecast::forecast(ses(x,h=24,alpha=alpha[i])))
list_ts_ses_tune[i] <- lapply(list_ts_ses_tune[i], "[", c("mean"))
}
Maybe this is a better way to do this? I need each individual output in a list of values.
Edit:
for (i in 1:length(alpha))
{
list_ts_ses_tune[[i]] <- lapply(list_ts[1:(length(list_ts)/2)],
function(x)
forecast::forecast(ses(x,h=24,alpha=alpha[i])))
list_ts_ses_tune[[i]] <- lapply(list_ts_ses_tune[[i]], "[", c("mean"))
}
We can use mget to return all the objects into a list
mget(ls(pattern = '^list_ts_ses_tune\\d+'))
Also, the NULL list can be created more easily instead of 10 objects in the global environment
list_ts_ses_tune <- vector('list', length(alpha))
Now, we can just use the OP's code
for (i in 1:length(alpha))
{
list_ts_ses_tune[[i]] <- lapply(list_ts, function(x)
forecast::forecast(ses(x,h=24,alpha=alpha[i])))
}
If we want to create a single data.frame
for(i in seq_along(alpha)) {
list_ts_ses_tune[[i]] <- data.frame(Mean = do.call(rbind, lapply(list_ts, function(x)
forecast::forecast(ses(x,h=24,alpha=alpha[i]))$mean)))
}
You could simply accomplish everything by doing:
library(forecast)
list_ts_ses_tune <- Map(function(x)
lapply(alpha, function(y)forecast(ses(x,h=24,alpha=y))['mean']), list_ts)
I am having issues returning output from a function I created in R when I use it in a loop. I am trying to combine the output form multiple MCMC models into one R object.
The function:
get_scrUN_output <- function(filename){
out <- filename
nam<-c("sigma","lam0","psi", "N")
nam<-match(nam,dimnames(out[[1]]$sims)[[2]])
out.lst<-mcmc.list(
as.mcmc(out[[1]]$sims[200001:300000,nam]),
as.mcmc(out[[2]]$sims[200001:300000,nam]),
as.mcmc(out[[3]]$sims[200001:300000,nam]))
s <- summary(out.lst)
gd <- gelman.diag(out.lst,multivariate = FALSE)
output_table <- rbind(as.data.frame(t(s$statistics)),
as.data.frame(t(s$quantiles)),
as.data.frame(t(gd$psrf)))
return(output_table) }
The code I use to create a list of RData mcmc outputs to run through the function:
scrUN.ET <- list.files(getwd(),"out.*ET.RData")
scrUN.lst <- as.vector(substring(scrUN.ET,1))
scrUN.lst <- str_sub(scrUN.lst, 1, str_length(scrUN.lst)-3)
>scrUN.lst
[1] "BBout11FL" "BBout11TL" "BBout12TL" "BBout13FL" "BBout13TL"
When I use the function on an individual output file, it works:
get_scrUN_output(BBout11FL)
sigma lam0 psi N
Mean 130.43594323 14.5319368 0.3361405211 335.8042733
SD 7.28386725 9.7311139 0.2743725813 274.6828277
Naive SE 0.01329846 0.0177665 0.0005009335 0.5014999
Time-series SE 1.28032869 1.3886577 0.0360607870 36.5692414
2.5% 118.37718370 0.6129902 0.0300165600 30.0000000
25% 124.29743884 5.7535456 0.0958156210 95.0000000
50% 130.40628214 15.1264454 0.2426328827 242.0000000
75% 135.99836262 19.9685209 0.5403864215 541.0000000
97.5% 145.11615201 34.9438198 0.9298185748 930.0000000
Point est. 1.59559993 4.4590599 1.0677998255 1.0678381
Upper C.I. 2.56854388 9.5792520 1.2186078069 1.2186933
But when I try to run all output files through the function using a loop I get a NULL output.
scrUN.output <- rbind(
for (i in seq_along(scrUN.lst)){
get_scrUN_output(get(scrUN.lst[i]))
}
)
>scrUN.output
NULL
Thanks!
The reason is you're rbind-ing nothing.
Here's a simplified example demonstrating what your code above is doing –– the for loop isn't assigning anything to a variable which is why you're getting NULL at the end.
xx <- rbind(
for(i in c(1,2)){
i
}
)
print(xx) # NULL
Try this instead:
scrUN.output <- list() # initialize a list
for (i in seq_along(scrUN.lst)){
# update the list contents
scrUN.output[[i]] <- get_scrUN_output(get(scrUN.lst[i]))
}
# finally, rbind eveything
scrUN.output <- do.call(rbind, scrUN.output)
Or better yet, use lapply:
scrUN.output <- lapply(scrUN.lst, get_scrUN_output)
scrUN.output <- do.call(rbind, scrUN.output)
I think this is what you're asking for. This is an edit of the final code section. Your were using rbind on nothing since nothing is being returned by the for-loop.
scrUN.output <- lapply(scrUN.lst, function(i) get_scrUN_output(get(i)))
scrUN.output <- do.call(rbind, scrUN.output)
scrUN.output
I have problems storing user defined functions in R list when they are put on it in a for loop.
I have to define some segment-specific functions based on some parameters, so I create functions and put them on a list looping through segments with for-loop. The problem is I get same function everywhere on a result list.
The code looks like this:
n <- 100
segmenty <- 1:n
segment_functions <- list()
for (i in segmenty){
segment_functions[[i]] <- function(){return(i)}
}
When i run the code what I get is the same function (last created in the loop) for all indexes:
## for all k
segment_functions[[k]]()
[1] 100
There is no problem when I put the functions on list manually e.g.
segment_functions[[1]] <- function(){return(1)}
segment_functions[[2]] <- function(){return(2)}
segment_functions[[3]] <- function(){return(3)}
works just fine.
I honsetly have no idea what's wrong. Could you help?
You need to use the force function to ensure that the evaluation of i is done during the assignment into the list:
n <- 100
segmenty <- 1:n
segment_functions <- list()
f <- function(i) { force(i); function() return(i) }
for (i in segmenty){
segment_functions[[i]] <- f(i)
}
I'd use lapply and capture i in a clousre of the wrapper:
segment_functions <- lapply(1:100, function(i) function() i)
I have a question with importing functions.
Say I have a R script named "functions" which looks like this:
mult <- function(x,y){
return(x*y)
}
divide <- function(x,y){
return(x/y)
}
Currently I am importing all functions in the script:
source(file="C:\\functions.R",echo=FALSE)
The problem is that the (actual) R script is getting very large.
Is there a way to import the "mult" function only?
I was looking at evalSource/insertSource but my code was not working:
insertSource("C:\\functions.R", functions="mult")
It looks like your code will work with a slight change: define an empty object for the function you want to load first, then use insertSource.
mult <- function(x) {0}
insertSource("C:\\functions.R", functions="mult")
mult
Which gives:
Object of class "functionWithTrace", from source
function (x, y)
{
return(x * y)
}
## (to see original from package, look at object#original)
The mult object has some additional information that I suppose is related to the original application for insertSource, but you could get rid of them with mult <- mult#.Data, which will set mult to the actual function body only.
Also, you might be interested in the modules project on github, which is trying to implement a lightweight version of R's package system to facilitate code reuse. Seems like that might be relevant, although I think you would have to split your functions into separate files in different subdirectories.
I ended up creating functions to do what you recommended.
This first group allows for multiple functions in one call:
LoadFunction <- function(file,...) {
dots <- match.call(expand.dots = FALSE)$...
dots <- sapply(dots, as.character)
output <- lapply(dots, function(x,file){eval(parse(text=paste(x," <- function(x) {0}",sep="")),envir = .GlobalEnv)
suppressMessages(insertSource(file, functions=x))
eval(parse(text=paste(x," <- ",x,"#.Data",sep="")),envir = .GlobalEnv) },file=file)
}
UnloadFunction <- function(...) {
dots <- match.call(expand.dots = FALSE)$...
dots <- sapply(dots, as.character)
output <- lapply(dots, function(x,file){eval(parse(text=paste("rm(",x,",envir = .GlobalEnv)",sep="")))},file=file)
}
They are called like this:
LoadFunction(file="C:\\functions.R",mult,divide)
UnloadFunction(mult,divide)
The second is only one function per call:
LoadFunction2 <- function(file,function_name) {
eval(parse(text=paste(function_name," <- function(x) {0}",sep="")),envir = .GlobalEnv)
suppressMessages(insertSource(file, functions=function_name))
eval(parse(text=paste(function_name," <- ",function_name,"#.Data",sep="")),envir = .GlobalEnv)
}
UnloadFunction2 <- function(function_name) {
eval(parse(text=paste("rm(",function_name,",envir = .GlobalEnv)",sep="")))
}
They are called like this:
LoadFunction2(file="C:\\functions.R","mult")
LoadFunction2(file="C:\\functions.R","divide")
UnloadFunction2("mult")
UnloadFunction2("divide")
I have created a function to call a function on each row in a dataset. I would like to have the output as a vector. As you can see below the function outputs the results to the screen, but I cannot figure out how to redirect the output to a vector that I can use outside the function.
n_markers <- nrow(data)
p_values <-rep(0, n_markers)
test_markers <- function()
{
for (i in 1:n_markers)
{
hets <- data[i, 2]
hom_1 <- data[i, 3]
hom_2 <- data[i, 4]
p_values[i] <- SNPHWE(hets, hom_1, hom_2)
}
return(p_values)
}
test_markers()
Did you just take this code from here? I worry that you didn't even try to figure it out on your own first, but hopefully I am wrong.
You might be overthinking this. Simply store the results of your function in a vector like you do with other functions:
stored_vector <- test_markers()
But, as mentioned in the comments, your function could probably be reduced to:
stored_vector <- sapply(1:nrow(data), function(i) SNPHWE(data[i,2],data[i,3],data[i,4]) )