I am having a problem writing a function of a function in r. Specifically, I want to calculate the odds of a dice roll in Yahtzee, and when I use explicit parameters, I get a numeric value:
large_straight <- function(){
rolls <- sample(6, size = 5, replace = TRUE)
if(all(Numbers %in% c(rolls))) {
1
} else if (all(Numbers2 %in% c(rolls))) {
1
} else 0
}
sum(replicate(1000, large_straight()))/1000
returns a non-zero value,
but when I try to generalize, so that I can pass not just large straights but also other dice rolls:
my_roll_odds <- function(Size, FUN){
sum(replicate(Size, FUN))/Size
}
my_roll_odds(1000, large_straight())
I always get a return value of 0, and I have zero idea why. Any help would be greatly appreciated!
I think the function could not be evaluated correctly because of the nested calls. Here is a way with match.fun
my_roll_odds <- function(Size, FUN){
sum(replicate(Size, match.fun(FUN)()))/Size
}
my_roll_odds(1000, large_straight)
#[1] 0.029
my_roll_odds(1000, large_straight)
#[1] 0.037
Related
I need to write a computer program which would look for whether two functions have the same minima points for given parameters, so I wanted to write program which would look for this on some example functions, which minima I know. So I wrote a program, but I get an error 'result$hessian':$ operator is invalid for atomic vectors all the time. But for these given examples, the hessian should be positive, defined, and definitelly non atomic. I don't know whether algorithm get stuck at local minimum or something. Here is the code:
find_min <- function(f) {
n_starts <- 10
min_points <- rep(NA, n_starts)
success <- FALSE
for (i in 1:n_starts) {
result <- tryCatch(optim(par = runif(3, min = -100, max = 100), function(x) -f(x), method = "L-BFGS-B", lower = -100, upper = 100, hessian = TRUE),
error = function(e) {
success <- FALSE
})
if (!is.null(result$hessian) && is.matrix(result$hessian) && any(eigen(result$hessian)$values <= 0)) {
min_points[i] <- NA
success <- FALSE
}
if (is.null(result$hessian)) {
min_points[i] <- NA
success <- FALSE
}
if (is.na(result$par) || !is.numeric(result$par)) {
min_points[i] <- NA
success <- FALSE
}
min_points[i] <- result$par
success <- TRUE
}
if (any(!is.na(min_points))) {
return(min_points[which.min(sapply(min_points, f))])
} else {
return(NA)
}
}
# example functions
f1 <- function(x) {
x[1]^2 + x[2]^2 + x[3]^2
}
f2 <- function(x) {
x[1]^4 + x[2]^4 + x[3]^4
}
min1 <- find_min(f1)
min2 <- find_min(f2)
if (is.na(min1[2]) || is.na(min2[2])) {
print(min1[1])
print(min2[1])
} else if (all(min1[2] == min2[2])) {
print("The minimum points are the same.")
} else if (!all(min1[2] == min2[2])) {
print("The minimum points are different.")
I tried to make sure that hessian is not an atomic vector by trying to catch some errors. I tried to use different starting points in order to get function unstuck if it is stuck at local minima. I tried giving it different example equations. I tried checking the order of if's in hessian checking. Tried to check if is.atomic throws out something but it doesn't even want to compile that. Please help because nothing worked...
result$par are the 3 parameters that optim was initialised with each time; yet you were attempting to place those at a single location of numeric vector (min_points); this is invalid.
but it seems to be not what you say what you wish to do any way.
you are not seeking the min_points you are surely seeking the min_values (reached by whatever points)
i.e.
min_points[i] <- result$value
you can then end the function by returning the minimum of min_points directly.
...
min_points[i] <- result$value
success <- TRUE
}
min(min_points)
}
of course you would probably want to go back and rename min_points to min_vals or whatever you think is descriptive.
making these recommended changes and given your examples results in the following
> min1
[1] -30000
> min2
[1] -3e+08
I think I am misunderstanding some fundamental part of how 'for' loops and functions work. This function:
even.odd <- function(x) {
if (x != round(x)) {
y <- NA
} else if (x %% 2 == 0) {
y <- "even"
} else {
y <- "odd"
}
return(y)
}
works perfectly fine, returning "even", "odd", or "NA" given a number. However I am given two vectors :
test1 <- c(-1, 0, 2, 5)
test2 <- c(0, 2.7, 9.1)
and need to create a 'for' loop containing the even.odd function and test it using these vectors. I have read all the recommended reading/lecture notes, and tried for hours unsuccessfully to produce the desired result, using empty vectors, indexing new objects, just putting even.odd(num.vec). I'm not sure where I've gone so wrong.
We were given a starting point for the new function:
even.odd.vec <- function(num.vec) {
#write your code here
}
So far this is what I have come up with:
#creating intermediate function
intermediate <- function(num.vec) {
if (even.odd(num.vec) == "odd") {
return("odd")
} else if(even.odd(num.vec) == "even") {
return("even")
} else ifelse(is.na(num.vec), NA, "False")
}
#creating new desired function
even.odd.vec <- function(num.vec) {
for (i in seq_along(num.vec)) {
intermediate(num.vec)
print(intermediate(num.vec))
}
}
The intermediate function was the result of me running into various errors when trying to create a simpler body for even.odd.vec. But now when I try to use even.odd.vec with one of the test vectors I get this error:
the condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be used
I am very stuck at this point and dying to know how to make something like this work. I've had a lot of fun working on it but I think I'm digging myself into a hole and/or making things much more complicated than necessary. Any help is unbelievably appreciated as my professor is out of town and the TA seems overwhelmed.
There are definitely ways to do this without for loop but since you want to use a for loop for this exercise explicitly we can use even.odd function that works for a single number and create a new function which uses for loop and calls even.odd function for every element individually.
even.odd.vec <- function(x) {
result <- character(length = length(x))
for (i in seq_along(x)) {
result[i] <- even.odd(x[i])
}
return(result)
}
You can then pass vectors test1, test2 to this function.
even.odd.vec(test1)
#[1] "odd" "even" "even" "odd"
even.odd.vec(test2)
#[1] "even" NA NA
I'm trying to write a function that identifies if a number within a numerical vector is odd or even. The numerical vector has a length of 1000.
I know that the for loop works fine, and I just wanted to generalize it in the form of a function that takes a vector of any length
out<-vector()
f3<- function(arg){
for(i in 1:length(arg)){
if((arg[i]%%2==0)==TRUE){
out[i]<-1
}else{out[i]<-0
}
}
}
When run within a function, however, it just returns a NULL. Why is that, or what do I need to do to generalize the function work with any numerical vector?
As already mentioned by PKumar in the comments: Your function doesn't return anything, which means, the vector out exists only in the environment of your function.
To change this you can add return(out) to the end of your function. And you should also start your function with creating out before the loop. So your function would look like outlined below.
Note, that I assume you want to pass a vector of a certain length to your function, and get as a result a vector of the same length which contains 1 for even numbers and 0 for odd numbers. f3(c(1,1,2)) would return 0 0 1.
f3 <- function(arg){
out <- vector(length = length(arg), mode = "integer")
for(i in 1:length(arg)){
if((arg[i]%%2==0)==TRUE){ # note that arg[i]%%2==0 will suffice
out[i]<-1
} else {out[i]<-0
}
}
return(out) # calling out without return is enough and more inline with the tidyverse style guide
}
However, as also pointed out by sebastiann in the comments, some_vector %% 2 yields almost the same result. The difference is, that odd numbers yield 1 and even numbers 0. You can also put this into a function and subtract 1 from arg to reverse 0 and 1 :
f3 <- function(arg){
(arg-1) %% 2
}
A few thing to note about your code:
A function must return something
The logical if((arg[i]%%2==0)==TRUE) is redundant. if(arg[i]%%2==0) is enough, but wrong, because arg[i] does not exist.
the length(arg) is the length(1000) which, if ran, returns 1
You should change arg[i] with i and assign to i all the values from 1:1000, as follows:
R
out <-vector()
f3 <- function(arg){
for(i in 1:arg){
if(arg[i] %% 2 == 0){
out[i] <- 1
}
else{
out[i] <- 0
}
}
return(out)
}
f3(1000)
R beginner. Why doesn't this code return the number 3?
my_mean <- function(my_vector){
sum(my_vector)/length(my_vector)
my_mean
}
my_vector <- c(1, 3, 5)
my_mean
I'm not allowed to use mean(). Thanks
Returning a value by assigning to the function name is Visual Basic syntax. To my knowledge, no other language uses this technique.
If you want to return a value in R, use the return() statement:
mymean <- function(x)
{
val <- sum(x)/length(x)
return(val)
}
But there's a shorter way to achieve the same result. If R reaches the end of a function without an explicit return, it will return the value of the last expression it found.
mymean <- function(x)
{
val <- sum(x)/length(x)
val # value of last expression is returned
}
But this can be shortened further. The variable val is only used once, as the last statement in the function. So we could omit it entirely, and just return the computed value itself without storing it in a variable first:
mymean <- function(x)
{
sum(x)/length(x)
}
Problem solved. I made a mistake in the way I called the function. The call should be:
my_mean(c(1,3,5))
not:
my_vector <- c(1, 3, 5)
my_mean
I have a function like this dummy-one:
FUN <- function(x, parameter){
if (parameter == 1){
z <- DO SOMETHING WITH "x"}
if (parameter ==2){
z <- DO OTHER STUFF WITH "x"}
return(z)
}
Now, I would like to use the function on a dataset using apply.
The problem is, that apply(data,1,FUN(parameter=1))
wont work, as FUN doesn't know what "x" is.
Is there a way to tell apply to call FUN with "x" as the current row/col?
`
You want apply(data,1,FUN,parameter=1). Note the ... in the function definition:
> args(apply)
function (X, MARGIN, FUN, ...)
NULL
and the corresponding entry in the documentation:
...: optional arguments to ‘FUN’.
You can make an anonymous function within the call to apply so that FUN will know what "x" is:
apply(data, 1, function(x) FUN(x, parameter = 1))
See ?apply for examples at the bottom that use this method.
Here's a practical example of passing arguments using the ... object and *apply. It's slick, and this seemed like an easy example to explain the use. An important point to remember is when you define an argument as ... all calls to that function must have named arguments. (so R understands what you're trying to put where). For example, I could have called times <- fperform(longfunction, 10, noise = 5000) but leaving off noise = would have given me an error because it's being passed through ... My personal style is to name all of the arguments if a ... is used just to be safe.
You can see that the argument noise is being defined in the call to fperform(FUN = longfunction, ntimes = 10, noise = 5000) but isn't being used for another 2 levels with the call to diff <- rbind(c(x, runtime(FUN, ...))) and ultimately fun <- FUN(...)
# Made this to take up time
longfunction <- function(noise = 2500, ...) {
lapply(seq(noise), function(x) {
z <- noise * runif(x)
})
}
# Takes a function and clocks the runtime
runtime <- function(FUN, display = TRUE, ...) {
before <- Sys.time()
fun <- FUN(...)
after <- Sys.time()
if (isTRUE(display)) {
print(after-before)
}
else {
after-before
}
}
# Vectorizes runtime() to allow for multiple tests
fperform <- function(FUN, ntimes = 10, ...) {
out <- sapply(seq(ntimes), function(x) {
diff <- rbind(c(x, runtime(FUN, ...)))
})
}
times <- fperform(FUN = longfunction, ntimes = 10, noise = 5000)
avgtime <- mean(times[2,])
print(paste("Average Time difference of ", avgtime, " secs", sep=""))