Returning a Vector in R - r

Beginning R programmer here. I'm trying to run a function with the argument being the number of samples (user-defined) and the output being a vector of means of those samples.
Here is what I have so far, however, I only get one mean value returned. How do I alter the formula so I get a vector of the means that is variable on the number the user inputs?
Pop1 <- rnorm(500, mean = 0.5, sd = 0.2)
My_Func <- function(Samples) {
A <- sample(Pop1, size = 25, replace = TRUE)
for (i in 1:Samples) {
Means <- mean(A)
}
return(Means)
}

Using a for loop it can be like this. As #MrFlick mentioned, avoid assingning the loop to the same variable. Include it into the loop.
Pop1 <- rnorm(500, mean = 0.5, sd = 0.2)
My_Func <- function(Samples) {
Means = numeric(Samples)
for (i in 1:Samples) {
A <- sample(Pop1, size = 25, replace = TRUE)
Means[i] <- mean(A)
}
return(Means)
}

Related

How to call multiple distribution functions from different vectors into a function in R

Lets talk you through my workflow:
General idea
Based on data in a dataframe, select the appropriate distribution functions, combine them in all possible ways to get the mean of the combined distributions.
Starting position
I have a large data frame df. In there I have different variables var1, var2 and var3 in this example which contains data to select the appropriate distribution function.
I have several distribution functions per variable:
var1_distr1 <- pdqr::as_d(function(x)dnorm(x, mean = 3, sd = 1))
var1_distr2 <- pdqr::as_d(function(x)dnorm(x, mean = 6, sd = 1))
var1_distr3 <- pdqr::as_d(function(x)dnorm(x, mean = 2, sd = 2))
var2_distr1 <- pdqr::as_d(function(x)dnorm(x, mean = 5, sd = 3))
var2_distr2 <- pdqr::as_d(function(x)dnorm(x, mean = 3, sd = 1))
var2_distr3 <- pdqr::as_d(function(x)dnorm(x, mean = 4, sd = 2))
var3_distr1 <- pdqr::as_d(function(x)dnorm(x, mean = 4, sd = 1))
var3_distr2 <- pdqr::as_d(function(x)dnorm(x, mean = 5, sd = 1))
var3_distr3 <- pdqr::as_d(function(x)dnorm(x, mean = 7, sd = 2))
Select the right distribution
Using an if_else on each of the vars I generate the appropriate distribution per case in a new vector. The if_else looks like this for var1 and has the same appearance for all vars:
df$distr_var1 <- if_else(df$info < 0, "var1_distr1",
if_else(df$info > 0 & df$info < 100, "var1_distr2", "var1_distr3")
This results in the following df:
df <- data.frame(distr_var1 = c("var1_distr1", "var1_distr3", "var1_distr1", "var1_distr2", "var1_distr2", "var1_distr1", "var1_distr3"),
distr_var2 = c("var2_distr2", "var2_distr1", "var2_distr2", "var2_distr1", "var2_distr3", "var2_distr3", "var2_distr1"),
distr_var3 = c("var3_distr2", "var3_distr3", "var3_distr1", "var3_distr1", "var3_distr2", "var3_distr3", "var3_distr1"))
Combine distribution functions
To combine distribution functions in a new proportional distribution function I have created this function based on this question:
foo <- function(...){
#set x values
x <- seq(1, 10, by = 1)
#create y values
y <- 1L
for (fun in list(...)) y <- y * fun(x)
#create new PDF
p <- data.frame(x,y)
pdqr::new_d(p, type = "continuous")
}
And I have stored the PDFs in a list:
PDFS <- list(var1_distr1 = var1_distr1, var1_distr2 = var1_distr2, var1_distr3 = var1_distr3,
var2_distr1 = var2_distr1, var2_distr2 = var2_distr2, var2_distr3 = var2_distr3,
var3_distr1 = var3_distr1, var3_distr2 = var3_distr2, var3_distr3 = var3_distr3)
I would like to use the function foo in the df to generate proportional distributions for all combinations of distributions given in the df. So, for each case, a the following combinations: var1_var2, var1_var3, var2_var3, var1_var2_var3.
Calculate mean over distributions
If I want to calculate a mean over the distributions individually, I can do this:
means <- sapply(PDFS, pdqr::summ_mean)
df$mean_var1 <- means[df$distr_var1]
Or:
df$mean_var2 <- sapply(mget(df$distr_var2), pdqr::summ_mean)
Both approaches work fine. But on the combinations var1_var2, var1_var3, var2_var3, var1_var2_var3 I have not found a suitable approach, but tried these:
df$var1_var2_mean <- sapply(foo(mget(mapply(PDFS, sapply, df$distr_var1, df$distr_var2))), pdqr::summ_mean)
I tried to overcome not calling functions by using a list, but things seem to get too complicated / nested to work nicely...
Question
How to select the appropriate distributions given in distr_var1, distr_var2 and distr_var3, combined them using foo and calculate the mean using pdqr::summ_mean?
I'm happy with all comments, also on the workflow in general
A foreach loop works for me:
df$var1_var2_mean <- foreach(i = 1:nrow(df), .combine = c) %do% {
A <- as.name(df$var1[i])
B <- as.name(df$var2[i])
mean <- summ_mean(foo(get(A),get(B)))
}
And, for each combination I need to do this. At least I got it working...

Repeat loop with if-condition doesn't work

I want to reorder a vector with 250 values and I am using sample, repeat and if in order to do so:
x <- rnorm(200, mean = 0.06, sd = 0.20)
x$ret_coef = 1 + returns,
X$ret = cumprod(ret_coef) - 1
reorder1 <- function(x){
repeat{
temp <- tibble(
ret= sample(x$ret, 200)
)
if(sum(temp$ret[200],temp$ret[180])<0) break
}
}
Unfortunately, the new vector never fullfills the if-condition.
I figured it out:
its important to set replace = TRUE:
sample(x$ret, 200, replace=TRUE)
It worked afterwards!

How to create a dsicrete probability distribution function from a discretised probability mass function

So I used the 'actuar' package in R to discretise a continuous gamma cdf, returning a probability mass function.
Attempting to turn the probability mass function I generated into a cumulative distribution function:
disc.gamma.cdf <- function(y)
{
values <- discretize(pgamma(x, 20, 0.2),
from = 0, to = 300, method = "rounding")
result <- sum(values[0:y])
return(result)
}
But when I wish to sum the discrete.gamma.cdf over a certain range of values, I am returned with an error:
i <- 0:4
sum(disc.gamma.cdf(i))
Warning message:
In 0:y : numerical expression has 5 elements: only the first used
Not that great with R, so any assistance would be appreciated.
You have it almost right. The main thing to remember is that R array indexes start from 1, and that a function will not automatically work on arrays, it has to be vectorised.
So, with two changes your code is right:
disc.gamma.cdf <- function(y)
{
values <- discretize(pgamma(x, 20, 0.2),
from = 0, to = 300, method = "rounding")
result <- sum(values[1:y]) # From 1 not 0
return(result)
}
i <- 1:5
sum( sapply(i, disc.gamma.cdf) )
sapply(i, disc.gamma.cdf) calls the function along each of the elemnts of i, and then you sum it.
If you want a vectorised version of your code, you can do this:
disc.gamma.cdf <- function(y)
{
values <- discretize(pgamma(x, 20, 0.2),
from = 0, to = 300, method = "rounding")
cumsum(values)[y] # last expression is returned anyway
}
i <- 1:5
sum( disc.gamma.cdf(i) )
The function cumsum calculates all possible sums, and now you can just subset that by a vector.

Simulate 5000 samples of size 5 from a normal distribution with mean 5 and standard deviation 3

I am trying to simulate 5000 samples of size 5 from a normal distribution with mean 5 and standard deviation 3. I want to then compute the mean of each sample and make a histogram of the sample means
My current code is not giving me an error but I don't think it's right:
nrSamples = 5000
e <- list(mode="vector",length=nrSamples)
for (i in 1:nrSamples) {
e[[i]] <- rnorm(n = 5, mean = 5, sd = 3)
}
sample_means <- matrix(NA, 5000,1)
for (i in 1:5000){
sample_means[i] <- mean(e[[i]])
}
Any idea on how to tackle this? I am very very new to R!
You don't need a list in this case. It is a common mistake of new R users to use lists excessively.
observations <- matrix(rnorm(25000, mean=5, sd=3), 5000, 5)
means <- rowMeans(observations)
Now means is a vector of 5000 elements.
You can actually do this without for loops. replicate can be used to create the 5000 samples. Then use sapply to return the mean of each sample. Wrap the sapply call in hist() to get the histogram of means.
dat = replicate(5000, rnorm(5,5,3), simplify=FALSE)
hist(sapply(dat, mean))
Or, if you want to save the means:
sample.means = sapply(dat,mean)
hist(sample.means)
I think your code is giving valid results. list(mode="vector",length=nrSamples) isn't doing what I think you intended (run it in the console and see what happens), but it works out because the first two list elements get overwritten in the loop.
Although there's no need to use loops here, just for illustration here are two modified versions of your code using loops:
# 1. Store random samples in a list
e <- vector("list", nrSamples)
for (i in 1:nrSamples) {
e[[i]] <- rnorm(n = 5, mean = 5, sd = 3)
}
sample_means = rep(NA, nrSamples)
for (i in 1:nrSamples){
sample_means[i] <- mean(e[[i]])
}
# 2. Store random samples in a matrix
e <- matrix(rep(NA, 5000*5), nrow=5)
for (i in 1:nrSamples) {
e[,i] <- rnorm(n = 5, mean = 5, sd = 3)
}
sample_means = rep(NA, nrSamples)
for (i in 1:nrSamples){
sample_means[i] <- mean(e[, i])
}
Your code is fine (see below), but I would suggest you try the following:
yourlist <- lapply(1:nrSamples, function(x) rnorm(n=5, mean = 5, sd = 3 ))
yourmeans <- sapply(yourlist, mean)
Here, for each element of the sequence 1, 2, 3, ... nrSamples that I supply as the first argument, lapply executes an function with the given element of the sequence as argument (i.e. x). The function that I have supplied does not depend on x, however, so it is just replicated 5000 times, and the output is stored in a list (this is what lapply does). It is an easy way to avoid loops in situations like these. Needless to say, you could also just run
yourmeans <- sapply(1:nrSamples, function(x) mean(rnorm(n=5, mean = 5, sd = 3)))
Apart from the means, the latter does not store your results though, which may not be what you want. Also note that I call sapply to return a vector, which you can then use to plot your histogram, using e.g. hist(yourmeans).
To show that your code is fine, consider the following:
set.seed(42)
nrSamples = 5000
e <- list(mode="vector",length=nrSamples)
for (i in 1:nrSamples) {
e[[i]] <- rnorm(n = 5, mean = 5, sd = 3)
}
sample_means <- matrix(NA, 5000,1)
for (i in 1:5000){
sample_means[i] <- mean(e[[i]])
}
set.seed(42)
yourlist <- lapply(1:nrSamples, function(x) rnorm(n=5, mean = 5, sd = 3 ))
yourmeans <- sapply(yourlist, mean)
all.equal(as.vector(sample_means), yourmeans)
[1] TRUE
Here, I set the seed to the random number generator to make sure that the random numbers are the same. As you see, your code works fine, though as others have pointed out, loops can easily be avoided.

Replacing a rolling average for loop with apply in R

I want to test the correlations between moving averages of varying lengths and a dependent variable. I've written a for loop that gets the job done but obviously for loops are not the ideal solution. I was wondering if someone could give me some pointers on how to replace the functionality of this for loop with apply as a more elegant solution? I've provided code and test data.
library(zoo)
# a function that calculates the correlation between moving averages for
different lengths of window
# the input functions are "independent": the variable over which to apply the
moving function
# "dependent": the output column, "startLength": the shortest window length,
"endLength" the longest window length
# "functionType": the function to apply (mean, sd, etc.)
MovingAverageCorrelation <- function(indepedent, depedent, startLength, endLength, functionType) {
# declare an matrix for the different rolling functions and a correlation vector
avgMat <- matrix(nrow = length(depedent), ncol = (endLength-startLength+1))
corVector <- rep(NA, ncol(avgMat))
# run the rollapply function over the data and calculate the corresponding correlations
for (i in startLength:endLength) {
avgMat[, i] <- rollapply(indepedent, width = i, FUN = functionType,
na.rm = T, fill = NA, align = "right")
corVector[i] <- cor(avgMat[, i], depedent, use = "complete.obs")
}
return(corVector)
}
# set test data
set.seed(100)
indVector <- runif(1000)
depVector <- runif(1000)
# run the function over the data
cor <- MovingAverageCorrelation(indVector, depVector, 1, 100, "mean")
Thanks!
Try sapply:
sapply(1:100, function(i) cor(rollapplyr(indVector, i, mean, na.rm = TRUE, fill = NA),
depVector, use = "complete.obs"))
If there are no NAs in your inputs this would work and is substantially faster:
sapply(1:100, function(i) cor(rollmeanr(indVector, i, fill = NA), depVector, use = "comp"))

Resources