In R, the function Arg applied to a complex returns an angle between -pi and +pi. For example :
Arg((1+i)^5) = -2.356... (-3*pi/4 radians)
Could I have a function returning the positive angle, even greater than +pi? For example, I would like to have :
"function"((1+i)^5) = 3.926... (5*pi/4 radians)
It seems Arg is not adaptable ; maybe some other function exits in some package ?
Thanks for any help.
5*pi/4 is the same as -3*pi/4. So you could do:
Arg_positive = function(complex) {
initial = Arg(complex)
ifelse(initial < 0,
initial + 2*pi,
initial)
}
Just take the remainder of the division to 2pi:
Arg((1+1i)^5) %% (2*pi)
#[1] 3.926991
You could create your own function to address this issue.
pos.arg <- function(num)
{
arg = Arg(num)
if (arg < 0)
arg <- arg + 2*pi
arg
}
x <- complex(length.out = 1, 1, 1)
y <- x^5
pos.arg(y)
[1] 3.926991
Related
I need to integrate the following function where there is a differentiation term inside. Unfortunately, that term is not easily differentiable.
Is this possible to do something like numerical integration to evaluate this in R?
You can assume 30,50,0.5,1,50,30 for l, tau, a, b, F and P respectively.
UPDATE: What I tried
InnerFunc4 <- function(t,x){digamma(gamma(a*t*(LF-LP)*b)/gamma(a*t))*(x-t)}
InnerIntegral4 <- Vectorize(function(x) { integrate(InnerFunc4, 1, x, x = x)$value})
integrate(InnerIntegral4, 30, 80)$value
It shows the following error:
Error in integrate(InnerFunc4, 1, x, x = x) : non-finite function value
UPDATE2:
InnerFunc4 <- function(t,L){digamma(gamma(a*t*(LF-LP)*b)/gamma(a*t))*(L-t)}
t_lower_bound = 0
t_upper_bound = 30
L_lower_bound = 30
L_upper_bound = 80
step_size = 0.5
integral = 0
t <- t_lower_bound + 0.5*step_size
while (t < t_upper_bound){
L = L_lower_bound + 0.5*step_size
while (L < L_upper_bound){
volume = InnerFunc4(t,L)*step_size**2
integral = integral + volume
L = L + step_size
}
t = t + step_size
}
Since It seems that your problem is only the derivative, you can get rid of it by means of partial integration:
Edit
Not applicable solution for lower integration bound 0.
I need to find evaluate the following function, including an integral, in R:
Probability density functions involving multiple variables, where u = t - y.
The problem I'm running into is that while the input variables of the function as a whole are x and t, the integral needs to be evaluated over the variable u = t - y. The functions f and m' both return values, but I don't know how to make it so that R evaluates the integral over this u rather than x or T.
I currently have the following, but this doesn't return the values I'm supposed to be getting, so I'm wondering if I did it properly?
Thank you in advance!
a = 3
b = 10
T = 2.6
mprime = function(x){
return (1/x)
}
f = function(x){
if (a <= x & x <= b){
return (1/(b-a))
}
else{
return (0)
}
}
toIntegrate = function(u){
return (f(u + x)*mprime(T-u))
}
solution = function (x, T){
return (f(T + x)) + (integrate(toIntegrate(T-y), 0, T))
}
solution(5,T)
There are a few errors in your code:
f and other functions you'll be using in your integration need to be vectorised, i.e. it should take a vector as an input and return a vector as an output.
toIntegrate uses x which is neither a global variable nor an argument.
return is a function, so only the expression between parentheses are returned. As a result, your integral would not be evaluated because your function would return f(T+x)
The first argument to integrate should be toIntegrate, not toIntegrate(T-y)
mprime will return infinity for u=t, so the limits may need to be adjusted.
a = 3
b = 10
t = 2.6
mprime = function(x){
return (1/x)
}
f = function(x){
ifelse(a <= x & x <= b,1/(b-a),0)
}
toIntegrate = function(u,x,t){
return (f(u + x)*mprime(t-u))
}
solution = function (x, t){
return(f(t + x) + integrate(toIntegrate, 0, t,x=x,t=t,stop.on.error = F)$value)
}
solution(5,T)
I am solving a task for my R online course. The task is to write a function, that solves the quadratic equation with the Lagrange resolvents, or:
x1<--p/2+sqrt((p/2)^2-q)
x2<--p/2-sqrt((p/2)^2-q)
1) If the arguments are non-numeric, the function should return an explained error (or why the error has happend). 2) If there are missing arguments, the function should return an explained error (different from the default). 3) If x1 and x2 are complex numbers (for example if p=-4 and q=7, then x1=2+i*1.73 and x2=2-i*1.73), the function should should also solve the equation instead of generating NaNs and return a warning message, that the numbers are complex. Maybe if I somehow cast it to as.complex, but I want this to be a special case and don't want to cast the basic formula.
My function looks like this:
quadraticEquation<-function(p,q){
if(!is.numeric(c(p,q)))stop("p and q are not numeric") #partly works
if(is.na(c(p,q)))stop("there are argument/s missing") #does not work
x1<--p/2+sqrt((p/2)^2-q)
x2<--p/2-sqrt((p/2)^2-q)
#x1<--p/2+sqrt(as.complex((p/2)^2-q)) works, but I want to perform this only in case the numbers are complex
#x2<--p/2-sqrt(as.complex((p/2)^2-q))
return (c(x1,x2))
}
When testing the function:
quadraticEquation(4,3) #basic case is working
quadraticEquation(TRUE,5) #non-numeric, however the if-statement is not executed, because it assumes that TRUE==1
quadraticEquation(-4,7) #complex number
1) how to write the function, so it assumes TRUE (without "") and anything that is non-numeric as non-numeric?
2) basic case, works.
3) how can I write the function, so it solves the equation and prints the complex numbers and also warns that the numbers are complex (warning())?
Something like this?
quadraticEquation <- function(p, q){
## ------------------------% chek the arguments %---------------------------##
if(
missing(p) | missing(q) # if any of arguments is
){ # missing - stop.
stop("[!] There are argument/s missing")
}
else if(
!is.numeric(p) | !is.numeric(q) | any(is.na(c(p, q))) # !is.numeric(c(1, T))
){ # returns TRUE - conver-
stop("[!] Argument/s p or/and q are not numeric") # tion to the same type
}
## --------------------% main part of the function %--------------------------##
r2 <- p^2 - 4*q # calculate r^2,
if(r2 < 0){ # if r2 < 0 (convert) it
warning("equation has complex roots") # to complex and warn
r2 <- as.complex(r2)
}
# return named roots
setNames(c(-1, 1) * sqrt(r2)/2 - p/2, c("x1", "x2"))
}
quadraticEquation() # No arguments provided
#Error in quadraticEquation() : [!] There are argument/s missing
quadraticEquation(p = 4) # Argument q is missing
#Error in quadraticEquation(p = 4) : [!] There are argument/s missing
quadraticEquation(p = TRUE, q = 7) # p is logical
#Error in quadraticEquation(p = TRUE, q = 7) :
#[!] Argument/s p or/and q are not numeric
quadraticEquation(p = NA, q = 7) # p is NA
#Error in quadraticEquation(p = NA, q = 7) :
#[!] Argument/s p or/and q are not numeric
quadraticEquation(p = 7, q = -4) # real roots
# x1 x2
#-7.5311289 0.5311289
quadraticEquation(p = -4, q = 7) # complex roots
# x1 x2
#2-1.732051i 2+1.732051i
#Warning message:
#In quadraticEquation(p = -4, q = 7) : equation has complex roots
When you write is.numeric(c(p, q)), R first evaluates c(p, q) before determining whether it is numeric or not. In particular if p = TRUE and q = 3, then c(p, q) is promoted to the higher type: c(1, 3).
Here is a vectorized solution, so if p and q are vectors instead of scalars the result is also a vector.
quadraticEquation <- function(p, q) {
if (missing(p)) {
stop("`p` is missing.")
}
if (missing(q)) {
stop("`q` is missing.")
}
if (!is.numeric(p)) {
stop("`p` is not numeric.")
}
if (!is.numeric(q)) {
stop("`q` is not numeric.")
}
if (anyNA(p)) {
stop("`p` contains NAs.")
}
if (anyNA(q)) {
stop("`q` contains NAs.")
}
R <- p^2 / 4 - q
if (min(R) < 0) {
R <- as.complex(R)
warning("Returning complex values.")
}
list(x1 = -p / 2 + sqrt(R),
x2 = -p / 2 - sqrt(R))
}
Also, you should never write x1<--p/2. Keep spaces around infix operators: x1 <- -p/2.
I am trying to compute the MISE of an estimator and for that i need to do the integral of :
(fp(x) - f(x))^2 where f(x) is exp(-x) and fp(x) is : sum_{i}^n { (1/n)*((K((x - X[i])/h))/h) }
The problem here is that X is a matrix, and i don't know how integrate this sum.
I've tried this :
Kgauss <- function(u) dnorm(u) #Gaussian kernel
func = function(x, n, h, X){ ((1/n) * sum(Kgauss((x-X[0:n])/h)/h) - exp(-x))^2 } # h, n are constants
vfunc = Vectorize(func)
integrate(vfunc, n = 3, K = Kgauss, h = 0.25, X = rexp(3), lower = 0, Inf)
But sadly it didn't work out. The big problem here is fp(x), it consists of the sum of multiple functions .
I hope you can help me with this one, I've been struggling for a while now.
Basically i want to make : integral((K(X1) + ... + K(Xn) - exp(-x))²)
You can define the n, h, and K outside the func and then have x as the only parameter:
n = 3; h = 0.25; X = rexp(3)
func = function(x){ ((1/n) * sum(dnorm((x-X[0:n])/h)/h) - exp(-x))^2 }
vfunc = function(x) { sapply(x, func)}
integrate(vfunc, lower = 0, Inf)
# 0.2070893 with absolute error < 1.7e-05
(I'm not sure that you even need to vectorize func. It's built with vectorized functions already.)
Is there any implementation of functionality in R, such that it is possible to get the next representable floating point number from a given floating point number. This would be similar to the nextafter function in the C standard library. Schemes such as number + .Machine$double.eps don't work in general.
No, but there are two ways you can make it:
Using C
If you want the exact functionality of the nextafter() function, you can write a C function that works as an interface to the function such that the following two constraints are met:
The function does not return a value. All work is accomplished as a "side effect" (changing the values of arguments).
All the arguments are pointers. Even scalars are vectors (of length one) in R.
That function should then be compiled as a shared library:
R CMD SHLIB foo.c
for UNIX-like OSs. The shared library can be called using dyn.load("foo.so"). You can then call the function from inside R using the .C() function
.C("foo", ...)
A more in depth treatment of calling C from R is here.
Using R
number + .Machine$double.eps is the way to go but you have to consider edge cases, such as if x - y < .Machine$double.eps or if x == y. I would write the function like this:
nextafter <- function(x, y){
# Appropriate type checking and bounds checking goes here
delta = y - x
if(x > 0){
factor = 2^floor(log2(x)) + ifelse(x >= 4, 1, 0)
} else if (x < 0) {
factor = 65
}
if (delta > .Machine$double.eps){
return(x + factor * .Machine$double.eps)
} else if (delta < .Machine$double.eps){
return(x - factor * .Machine$double.eps)
} else {
return(x)
}
}
Now, unlike C, if you want to check integers, you can do so in the same function but you need to change the increment based on the type.
UPDATE
The previous code did not perform as expected for numbers larger than 2. There is a factor that needs to be multiplied by the .Machine$double.eps to make it large enough to cause the numbers to be different. It is related to the nearest power of 2 plus one. You can get an idea of how this works with the below code:
n <- -100
factor <- vector('numeric', 100)
for(i in 1:n){
j = 0
while(TRUE){
j = j + 1
if(i - j * .Machine$double.eps != i) break()
}
factor[i] = j
}
If you prefer Rcpp:
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
double nextAfter(double x, double y) {
return nextafter(x, y);
}
Then in R:
sprintf("%.20f", 1)
#[1] "1.00000000000000000000"
sprintf("%.20f", nextAfter(1, 2))
#[1] "1.00000000000000022204"
I'm not sure if Christopher Louden's answer works for all values, but here's a pure R version of the classic approach (increments/decrements the integer bits). R does not make it easy to convert between doubles and integers, nor does it have a 64-bit integer type, so there's quite a lot of code for this.
doubleToRaw <- function(d) writeBin(d, raw());
rawToDouble <- function(r) readBin(r, numeric());
int64inc <- function(lo, hi) {
if (lo == 0xffffffff) { hi <- hi + 1; lo <- 0; } else { lo <- lo + 1; }
return(c(lo, hi));
}
int64dec <- function(lo, hi) {
if (lo == 0) { hi <- hi - 1; lo <- 0xffffffff; } else { lo <- lo - 1; }
return(c(lo, hi));
}
nextafter <- function(x, y) {
if (is.nan(x + y))
return(NaN);
if (x == y)
return(x);
if (x == 0)
return(sign(y) * rawToDouble(as.raw(c(0, 0, 0, 0, 0, 0, 0, 1))));
ints <- packBits(rawToBits(doubleToRaw(x)), "integer")
if ((y > x) == (x > 0))
ints <- int64inc(ints[1], ints[2])
else
ints <- int64dec(ints[1], ints[2]);
return(rawToDouble(packBits(intToBits(ints), "raw")))
}