compute an integration - r

Here is my integrand()
integrand<-function(x,vecC)
{
as.numeric((2/(b-a))*vecC%*%as.matrix(cos((x-hat.a)
*(seq(0,N-1,length=N)*pi/(b-a)))))
}
it can produce the value. For example, for
a<-1
b<-10
vecC<-t(as.matrix(rnorm(80)))
hat.a<--1.2
N<-80
I get
> integrand(1.4,vecC)
[1] -0.3635195
but I met problem when I run the following code for integration
> integrate(function(x){integrand(x,vecC)},upper = 3.4,lower = 1)$value
and the error message is
Error in integrate(function(x) { :
evaluation of function gave a result of wrong length
In addition: Warning message:
In (x - hat.a) * (seq(0, N - 1, length = N) * pi/(b - a)) :
longer object length is not a multiple of shorter object length

If you read the help page for integrate you will see that the function passed to integrate should return a vector.
So the solution to your error is to use Vectorize like this
Define your function separately as
f <- function(x){integrand(x,vecC)}
Now define a vectorized version of this function like so
fv <- Vectorize(f,"x")
and then
integrate(fv,upper = 3.4,lower = 1)$value
will give you a result.

Related

Evaluating an integral in R multiple times

I am trying to integrate the next function with respect x
integrand <- function(x) {
f1 <- pnorm((1/sqrt(u/x))*( sqrt((t*u*v)/x) - sqrt(x/(t*u*v)) ))}
where,
v=10
u=5
However, I need to integrate considering different values of t, so tried defining a sequence of values as:
t=seq(0,100,0.1)
And used the sapply function as:
data=sapply(t, function(x) integrate(integrand, lower = 0 , upper = 10000)$value )
I got these errors:
Error in integrate(integrand, lower = 0, upper = 10000) :
evaluation of function gave a result of wrong length
In addition: Warning messages:
1: In (t * u * v)/x : longer object length is not a multiple of shorter object length
2: In x/(t * u * v) : longer object length is not a multiple of shorter object length
3: In (1/sqrt(u/x)) * (sqrt((t * u * v)/x) - sqrt(x/(t * u * v))) :
longer object length is not a multiple of shorter object length
I haven't had any luck.
I would greatly appreciate any help.
Regards!
You can still use sapply like so:
sapply(t, function(t) {
integrate(function(x) {
pnorm((1/sqrt(u/x))*( sqrt((t*u*v)/x) - sqrt(x/(t*u*v)) ))
}, lower = 0, upper = 1000)$value
})
Output
[1] 0.000000 5.416577 10.251273 15.146418 20.084907 25.049283 ...
A previous post have a similar problem with an specific solution here
the code would result as:
t=seq(0,100,0.1)
fu<- list()
int<- numeric()
for(i in 1:length(t))
{
fu[[i]] = function(x){
f1 <- pnorm((1/sqrt(u/x))*( sqrt((t[i]*u*v)/x) - sqrt(x/(t[i]*u*v)) ));
}
int[i] = integrate(h[[i]], lower=0, upper=1000)$value
}
int

R: error when trying to write an equivalent function n choose k

I'm taking the class of introduction for R programming.
we were asked to write a function that will be the same as n choose k:
choose(n, k)
we were asked to check if the function works by running n = 200, k = 50.
I wrote the following code:
select_k <- function(n, k){
sr <- c(log10(log10((factorial(n-1)/factorial(k-1)*factorial(n-k-2)))*(n/k)))
return(sr)
}
as select_k is supposed to be the " n choose k".
my function works with values such as: 100 choose 25, but it doesn't work with greater values, like n = 200, k = = 50.
select_k( n = 200, k = 50)
[1] NaN
Warning message:
In factorial(n) : value out of range in 'gammafn'
I have no idea what else can be done to fix that.
This doesn't work for larger n because factorial(n) is too big:
> factorial(199)
[1] Inf
Warning message:
In factorial(199) : value out of range in 'gammafn'
This should return 200, but the computer only sees that you are trying to divide Inf by Inf:
> factorial(200)/factorial(199)
[1] NaN
Warning messages:
1: In factorial(200) : value out of range in 'gammafn'
2: In factorial(199) : value out of range in 'gammafn'
Obviously a lot of the multiplications in "n choose k" cancel out, so you'll need to avoid using regular factorial and only multiply the numbers that don't cancel out (?prod might be useful for you). Or (probably better) use the log version lfactorial to avoid running into numbers your computer can't store.
Edit: Added lfactorial recommendation from #MrFlick's comment
Have a look at this {
a <- function(n, k) {
exp(lgamma(n+1) - lgamma(n - k + 1) - lgamma(k + 1) )
}

Specify the calling function for an error message in R

I'm working on an R package where the same input-checking functions are called by multiple "actual" functions that are exported to users. If I use a simple stop() call, the error message is going to say that an error occurred in the input-checking function, which is not that useful...
I thought I'd get around this by wrapping the call to the input-checking function inside a tryCatch(), and then handling the error in the outer function. This does mostly what I want, but doesn't quite give the output that I'd like. The closest I've come is the following:
f <- function(i) {
tryCatch({
check_input(i)
}, error = function(e) stop("in f: ", e$message, call. = FALSE)
)
}
check_input <- function(i) {
if(i < 0)
stop("i is negative, value given was ", i)
}
f(-1)
# Error: in f: i is negative, value given was -1
Ideally, I'd like the error message to be
Error in f: i is negative, value given was -1
, which would be the case if stop were called within f() instead of check_input().
Here's how you can grab the name of the function from the call stack and paste it in to the error message
f <- function(i) {
check_input(i)
}
g <- function(i) {
check_input(i)
}
check_input <- function(i, from=deparse(sys.calls()[[sys.nframe()-1]][[1]])) {
getmsg <- function(m) ifelse(!is.null(from), paste0("in ", from, ": ", m), m)
if(i < 0)
stop(getmsg(paste0("i is negative, value given was ", i)), call. = FALSE)
}
f(-1)
# Error: in f: i is negative, value given was -1
g(-1)
# Error: in g: i is negative, value given was -1
You could also call check_input(i, from="otherfunction") to show whatever function name you want or check_input(i, from=NULL) to suppress the function name.

R : "argument is missing, with no default "

I am running the following code to minimize a function thanks to optim() in R but I have the following message : "argument "h" is missing, with no default".
I checked on previous messages where it is said that it is often a comma before a parenthesis, but does not seem to be the case in my code.
Could you please help me to understand what to do ? Thank you very much.
Here is the code :
A<-function(t,k,h,s){
out<-exp((h-(s*s/(2*k*k)))*(B(t,k)-t)-(s*s/(4*k))*(B(t,k)^2))
return(out)
}
B<-function(t, k){
out<-(1-exp(-k*t))/k
return(out)
}
P<-function(a, b, r){
out<-a*exp(-b*r)
return(out)
}
somme<-function(k,h,s){
out<-(P(A(1,k,h,s), B(1,k), -0.002)-1.0021)^2+(P(A(2,k,h,s), B(2,k), -0.0016)-1.0036)^2+(P(A(3,k,h,s), B(3,k), -0.001)-1.0038)^2+(P(A(4,k,h,s), B(4,k), -0.0002)-1.002)^2+(P(A(5,k,h,s), B(5,k), 0.00077)-0.9976)^2+(P(A(6,k,h,s), B(6,k), 0.0019)-0.9901)^2+(P(A(7,k,h,s), B(7,k), 0.0031)-0.9796)^2+(P(A(8,k,h,s), B(8,k), 0.0044)-0.9655)^2+(P(A(9,k,h,s), B(9,k), 0.0056)-0.9494)^2+(P(A(10,k,h,s), B(10,k), 0.0067)-0.9317)^2
return(out)
}
init<-c(k=0,h=0,s=0)
result<-optim(par=init, fn=somme)
result
The documentation in help("optim") says (emphasis added by me):
fn
A function to be minimized (or maximized), with first argument the
vector of parameters over which minimization is to take place. It
should return a scalar result.
Thus, this works:
somme <- function(par){
k <- par[[1]]
h <- par[[2]]
s <- par[[3]]
out <- (P(A(1,k,h,s), B(1,k), -0.002)-1.0021)^2+
(P(A(2,k,h,s), B(2,k), -0.0016)-1.0036)^2+
(P(A(3,k,h,s), B(3,k), -0.001)-1.0038)^2+
(P(A(4,k,h,s), B(4,k), -0.0002)-1.002)^2+
(P(A(5,k,h,s), B(5,k), 0.00077)-0.9976)^2+
(P(A(6,k,h,s), B(6,k), 0.0019)-0.9901)^2+
(P(A(7,k,h,s), B(7,k), 0.0031)-0.9796)^2+
(P(A(8,k,h,s), B(8,k), 0.0044)-0.9655)^2+
(P(A(9,k,h,s), B(9,k), 0.0056)-0.9494)^2+
(P(A(10,k,h,s), B(10,k), 0.0067)-0.9317)^2
return(out)
}
init <- c(k = 1, h = 1, s = 1)
result <- optim(par = init, fn = somme)
PS: You seem to be a masochist who likes excessive typing.

R: "Subscript out of bounds" error on function

I continue to get an error on my function, possibly I'm overlooking something simple. I cannot run the code without getting an error when applying the function.
k.nn <- function(k,p1,p) {
k > 0
K <-length(k)
p=matrix()
for (i in p) {
matrix <- cbind(p,p1[1],p1[2])
d <- sqrt((matrix[,1]-matrix[,3])^2+(matrix[,2]-matrix[,4])^2)
}
##use the sort function to find the smallest distance from 1:k and return all nearest k values
sort.d <- function(x) { #implement bubble sort
N=length(x)
N>0
c=class(x)
for (n in length(x):2) { #distinguish the last term in the vector, name it, much be of x length, consists an error of length 1. Error if you compute n in length(x):1, cover length of 1
if(length(x)<2)
return(x)
for (m in 1:(n - 1)) { #distinguish the first term in the vector, name it
if(x[m]>x[m + 1]) { #begin comparing each term to neighboring term
swap<-x[m]
x[m]<-x[m + 1]
x[m + 1]<-swap
}
}
}
return(x)
}
sorted=sort.d(d)
for (n in k){
print(sorted[1:k])}
}
p=matrix(c(6.9,7.6,7.1,.4,6.2,1.8,2.5,2.3,5.7,6.9,.9,4.4,5.2,1.9,.6,7.4,1.2,6.6,3.3,4.9),nrow=10,ncol=2) #given matrix
p1=c(6,6)
k=3 nn.3=k.nn(k,p1,p)
print(nn.3)
There's a missing carriage return or ";" in the penultimate line that is throwing an error. If you remove tha last line so that you can use traceback() it tells you that k.nn throws a " subscript out of bounds" error when a matrix index is 4.
Debugging 101 tells you to put in print functions to see where the function fails and putting in a print after
c=class(x) ; print(c)
... ives you a result, but putting another one in the sort.d function does not get executed. Looking at the code upstream from that point we see:
d <- sqrt((matrix[,1]-matrix[,3])^2+(matrix[,2]-matrix[,4])^2)
So looking at the function and the matrix you have given, ... my guess is that you passed a two-column matrix to a function that expected a four-column argument.

Resources