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
Related
So I implemented a function that calculates the value of the gamma function. and when I try to multiply f5(a) with a numeric I receive the error : Error in result * f5(a) : non-numeric argument to binary operator and if I instead use result * gamma(a) which is the predefined function it works just fine. It seems like it won't let me do any arithmetic operation with f5 even though it returns the same result as gamma
f5 <- function(a)
{
f <- function(x)
x^(a-1)*exp(-x)
integrate(f, 0, Inf)
}
f6 <- function(a)
{
if (a < 0)
print("a is negative")
else if (a%%1 == 0)
return (factorial(a-1))
else
{
result <- 1
while (a > 1)
{
result <- result * (a - 1)
a <- a - 1
}
result <- result * f5(a)
result
}
}
gamma(0.3)
f5(0.3)
f6(0.3)
This is because of the class of object that gets returned from f5().
class(f5(0.3))
[1] "integrate"
This is a named list object, and you can call the specific value from it:
names(f5(a))
[1] "value" "abs.error" "subdivisions" "message" "call"
You want the value component. Modifying f6() to the code below makes it work:
f6 <- function(a){
if (a < 0){
print("a is negative")
}else if (a%%1 == 0){
return (factorial(a-1))
}else{
result <- 1
while (a > 1){
result <- result * (a - 1)
a <- a - 1
}
result <- result * f5(a)$value
result
}
}
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) )
}
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.
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.
I am a beginner in R. Here's the formula I'm trying to code to find the lambda that maximizes the log likelihood of some bigrams. When the bigrams are not found, the P_b (bigram) function fails, but the P_u (unigram) function should provide the unigram result (lambda = 0).
It works for bigrams that are found. When they're not found, tho, I only get numeric(0), not the unigram result.
p.mix <- function(w2, w1) {
(1-lambda) * uni.dfrm$prob[uni.dfrm$token==w2] + lambda * p.bi(w2,w1)
}
The p.bi() function looks complicated because of the indexing so I'm reluctant to post it but it does work when the bigrams are found. It just looks up the count of times w' appears after w and divides it by the times w appears, but I have to go through another vector of vocabulary words so it looks ugly.
When w' is never found occurring after w, instead of a zero count, there's no row at all, which is what apparently causes the numeric(0) result. That's what the mixed model is supposed to solve, but I can't get it to work. Any ideas how this can work?
You can add a test for the case where w2 is numeric(0) for example :
p.mix <- function(w2, w1) {
if(length(w2)>0){
res <- (1-lambda) * uni.dfrm$prob[uni.dfrm$token==w2] +
lambda * p.bi(w2,w1)
}else res <- 0
res
}
EDIT
p.mix <- function(w2, w1) {
if(length(w2) && length(uni.dfrm$prob[uni.dfrm$token==w2]) > 0)
(1-lambda) * uni.dfrm$prob[uni.dfrm$token==w2] + lambda * p.bi(w2,w1)
else 0
}