I have a small issue with a polynomial:
z²+alpha1*z + alpha2 = 0
I need to fins the values of alpha1 and alpha2 wihtin the roots of |z| < 1. Is there any program in R or Matlab able to do it?
the thing is that the alpha values are not known. I need to find the allowed area where the roots of the polynomial are <= |1|
#Jonel_R, your problem can be solved analytically.
First I'll rename your variables to make it easier to type. I'll also use some notation abuse...
We want to find the values (a, b) such that the roots of z^2 + a z + b == 0 satisfy the property |z|<=1.
The roots are given by (-a +- sqrt(d))/2, where d = a^2 - 4b
There are 3 possibilities. Two real distinct roots, one real root or two complex conjugate roots.
The middle case happens when d = 0, i. e., b = a^2 / 4. This is a parabola in the a vs. b plane. Not all points in this parabola generate polynomials whose root satisfy |z|<=1, however. The root, is this case, is simply -a/2, so we mus add the condition -1 <= a/2 <=1, i. e., -2 <= a <= 2.
Now let's consider the first case. The points in the a vs. b plae that generate polynomials with two distinct real roots lie below the parabola, i. e., they must satisfy b < a^2/4. The additional condition is that |z| = |(-a +- sqrt(d))/2| <= 1.
The condition can be written as -1 <= (-a +- sqrt(d))/2 <= 1, where +- means both roots must satisfy the condition. Working this out we get:
a-2 <= sqrt(d) <= a+2 & a-2 <= -sqrt(d) <= a+2
Since both sqrt(d) and -sqrt(d) must lie in the interval [a-2, a+2], and d > 0, then this interval must contain zero in its interior. This means -2 < a < 2.
The conditions can be joined as:
a-2 <= -sqrt(d) < 0 < sqrt(d) <= a+2
Squaring gives:
(a-2)^2 >= d & d <= (a+2)^2
d <= a^2 - 4a + 4 & d <= a^2 + 4a + 4
-4b <= -4a + 4 & -4b <= +4a + 4
b >= a-1 & b >= -a-1
This means that b must be located above the lines b = a-1 and b=-a-1. Also, a must be in [-2,2]. And, of course, we must have b < a^2/4. Wow...
Now the last case: complex roots. This is easier. Since d < 0, the roots are -a/2 +- i * sqrt(-d)/2. The absolute value of this is a^2/4 - d/4. This equals b, simply. So the condition is b <= 1, and, as always, b lying above that parabola.
That's it... Quite interesting problem. :-)
You can try the following test function: It'll plot the points with real roots in blue and complex roots in red.
test <- function(x=2, n=10000)
{
plot(c(-x,x), c(-x,x), type="n")
plot(function(a) (a^2)/4, from=-x, to=x, add=T)
plot(function(a) a-1, from=-x, to=x, add=T)
plot(function(a) -a-1, from=-x, to=x, add=T)
a <- runif(n, -x, x)
b <- runif(n, -x, x)
for( i in 1:n )
{
if( all(abs(polyroot(c(b[i],a[i],1))) <= 1) )
{
col <- ifelse(b[i] < 0.25*a[i]^2, "blue", "red")
points(a[i], b[i], pch=".", col=col)
}
}
}
BTW: the syntax for polyroot is polyroot(c(C, B, A)) gives the roots of Ax^2 + Bx + C. I believe #agstudy response got it wrong.
Similar to matlab solution in R ,
polyroot(c(1,alpha1,alpha2))
EDIT here a method to get the values of alpha graphically, it can be used to get intution about the plausible values. The idea here is :
choose a range of aplha1
choose a range of alpha2
for each combination of alpha1 and alpha2, compute the roots. Compute the module (||), if > 1 we remove it.
we get a grid of values with 4 column: alpha1,alpha2,norm1,norm2 where All the norms are <1
I plot alpha1 versus alpha2 to get regions...
So the code
## I choose alpha1 in interavl [-1,1]
alpha1 <- seq(-1, 1, length=200)
## I choose alpha2 in interavl [-2,2]
alpha2 <- seq(-2, 2, length=200)
dat <- expand.grid(data.frame(alpha1,alpha2))
## for each combination of (alpha1,alpha2)
## i compute the module of the roots
## I replace |roots|> 1 by NA
ll <- apply(dat,1,function(x) {
rr =Mod(polyroot(c(1,x['alpha1'],x['alpha2'])))
res <- ifelse(rr>1,NA,rr)
if (length(res)==1) res <- rep(res,2)
if (length(res)==0) res <- rep(NA,2)
else res
})
dat <- na.omit(cbind(dat,t(ll)))
## finally i plot the result
library(lattice)
xyplot(alpha2~alpha1,data=dat)
In matlab:
roots(1,alpha1,alpha2)
see http://www.mathworks.se/help/matlab/ref/roots.html
Related
Suppose I have a function with a kink. I want to derive a kink point, which in this case is 0.314. I tried optim but it does not work.
Here is an example. In general, I want to derive c. Of course, I could use brute force, but it is slow.
# function with a kink
f <- function(x, c){
(x >= 0 & x < c) * 0 + (x >= c & x <=1) * (sin(3*(x-c))) +
(x < 0 | x > 1) * 100
}
# plot
x_vec <- seq(0, 1, .01)
plot(x_vec, f(x_vec, c = pi/10), "l")
# does not work
optim(.4, f, c = pi/10)
This function has no unique minimum.
Here, a trick is to transform this function a little bit, so that its kink becomes a unique minimum.
g <- function (x, c) f(x, c) - x
x_vec <- seq(0, 1, 0.01)
plot(x_vec, g(x_vec, c = pi/10), type = "l")
# now works
optim(0.4, g, c = pi/10, method = "BFGS")
#$par
#[1] 0.3140978
#
#$value
#[1] -0.3140978
#
#$counts
#function gradient
# 34 5
#
#$convergence
#[1] 0
#
#$message
#NULL
Note:
In mathematics, if we want to find something, we have to first define it precisely. So what is a "kink" exactly? In this example, you refer to the parameter c = pi / 10. But what is it in general? Without a clear definition, there is no algorithm/function to get it.
I am trying to create a function that performs the sign test. The function should take in vector x and median m and returns a p-value defined by min(1, 2*min(P{N ≤ i}, P{N ≥ i})), where N~Bin(n, 0.5), n is the amount of values which are not equal to m, and i is the amount of values in n which are smaller than m.
Here's what I've gotten so far:
test<-function(x,m) {
n<-length(x[x!=m])
i<-length(n[n<m])
min(1,c(pbinom(q=i,size=n,p=0.5),1-pbinom(q=i,size=n,p=0.5)))
}
However, when I test it out with given values, it gives the wrong answer:
test(x=1:3, m=2)
[1] 0.25
test(x = 1:5, m = 2)
[1] 0.0625
The right answers should be 1 and 0.625. I don't know which step I have done wrong.
You're on the right track: Aside from two minor errors you made (forgot the factor 2, problem in your calculation of i: Note that in your script, n is an integer, not a vector!), there's a more subtle but important error in your calculation of the third term inside the min:
We have
1 - P(N<=i) = P(N<i) which is different from P(N<=i) for discrete-valued probability distributions (like the binomial distribution).
You can fix this by subtracting a tiny value eps from i in the last term and using the approximation P(N <= i-eps) ≈ P(N < i):
test <- function(x , m){
# amount of entries that are not m
n <- sum(x!=m)
# amoutn of entries that are smaller than m
i <- sum(x<m)
eps = 1e-10
min(1,
2*pbinom(q=i,size=n,p=0.5),
# to get P(N >= i), we need 1 - P(N < I), not 1 - P(N <= i)
2*(1-pbinom(q=i-eps,size=n,p=0.5))
)
}
I want to create random sequences for the variables a, b, c, d, e and f with the length of 6000 under specific conditions.
I want to randomly draw from a discrete uniform distribution between 10 and 40 for every sequence, but under the following condition:
a = f < (a+b)/2 < e < c < b < d
Does anyone know how I would code that?
The conditions are somewhat ad-hoc. A hit and miss approach which draws random vectors until the conditions are satisfied could work (though it might not be optimal). Something like:
randvect <- function(){
v <- sample(10:40,5)
while(any(c(v[1] >= v[2],
mean(v[1:2]) >= v[5],
v[5] >= v[3],
v[3] >= v[2],
v[2] >= v[4]))){
v <- sample(10:40,5)
}
v
}
For example,
> randvect()
[1] 16 26 25 36 23
(I don't bother with f since it is the same as a).
To get 6000:
vects <- replicate(6000,randvect())
With all the misses in the hit and miss, that takes about 30 seconds to evaluate on my machine.
This question isn’t really well defined, as there are different implementations that result in different distributions. For instance, taking the condition b=d. The latter is the most natural interpretation, but the most computationally expensive. You can improve it by randomly taking b and d, and then if b > d, then switch b and d. I think this logic can be extended to e,c,b,d: randomly choose four numbers between 10 and 40, then assign e to be the smallest, c the second smallest, etc. I think this will produce the same distribution as the “throw out” method, but I’m not sure. So to get e,c,b, and d:
numbers = sort(sample(10:40,4,replace = TRUE))
e = numbers[1]
c = numbers[2]
b = numbers[3]
d = numbers[4]
I'm still thinking about what to do with a, however.
John Coleman's answer will get there, and is may be a better way to randomly sample, but could potentially take a long time depending on what your allowable space is.
Another option to figure out the allowable space, and sample starting with a.
a has to be between 10 and 34 (to leave room for e, c, b, and d)
the average of a and b has to be =< (b - 2) and < 37. This means b has to be 5 or more than a, and less than 39
a + 4 < b < min((37 * 2) - a, 39)
The rest are a bit more straightforward. These can be wrapped into a function.
I'm going to use data.table more for looking at the results at the end. Also I'm using the function resample described in help(sample) to handle cases where there is only a single value to sample.
library(data.table)
resample <- function(x, ...) x[sample.int(length(x), ...)]
funky <- function() {
a <- resample(10:34, 1)
f <- a
b <- resample((a + 5):min(((37 * 2) - a + 1), 39), 1)
e <- resample(ceiling((a+b)/2 + 0.1):min(38, b - 2), 1)
c <- resample((e + 1):(b - 1), 1)
d <- resample((b + 1):40, 1)
c(a, b, c, d, e, f)
}
A few issues found by trial and error. In e, the 0.1 is added so that if the average is currently an integer, it gets increased by 1, but if the value is X.5 it will get rounded up to X + 1.
dat <- data.table(t(replicate(10000, funky())))
setnames(dat, c("a", "b", "c", "d", "e", "f"))
The following will return all rows that fail the tests in the original question. A few iterations with 10k samples and it doesn't look like anything is failing.
dat[!(a == f &
f < ((a + b) / 2) &
((a + b) / 2) < e &
e < c &
c < b &
b < d)]
I would like to generate N random positive integers that sum to M. I would like the random positive integers to be selected around a fairly normal distribution whose mean is M/N, with a small standard deviation (is it possible to set this as a constraint?).
Finally, how would you generalize the answer to generate N random positive numbers (not just integers)?
I found other relevant questions, but couldn't determine how to apply their answers to this context:
https://stats.stackexchange.com/questions/59096/generate-three-random-numbers-that-sum-to-1-in-r
Generate 3 random number that sum to 1 in R
R - random approximate normal distribution of integers with predefined total
Normalize.
rand_vect <- function(N, M, sd = 1, pos.only = TRUE) {
vec <- rnorm(N, M/N, sd)
if (abs(sum(vec)) < 0.01) vec <- vec + 1
vec <- round(vec / sum(vec) * M)
deviation <- M - sum(vec)
for (. in seq_len(abs(deviation))) {
vec[i] <- vec[i <- sample(N, 1)] + sign(deviation)
}
if (pos.only) while (any(vec < 0)) {
negs <- vec < 0
pos <- vec > 0
vec[negs][i] <- vec[negs][i <- sample(sum(negs), 1)] + 1
vec[pos][i] <- vec[pos ][i <- sample(sum(pos ), 1)] - 1
}
vec
}
For a continuous version, simply use:
rand_vect_cont <- function(N, M, sd = 1) {
vec <- rnorm(N, M/N, sd)
vec / sum(vec) * M
}
Examples
rand_vect(3, 50)
# [1] 17 16 17
rand_vect(10, 10, pos.only = FALSE)
# [1] 0 2 3 2 0 0 -1 2 1 1
rand_vect(10, 5, pos.only = TRUE)
# [1] 0 0 0 0 2 0 0 1 2 0
rand_vect_cont(3, 10)
# [1] 2.832636 3.722558 3.444806
rand_vect(10, -1, pos.only = FALSE)
# [1] -1 -1 1 -2 2 1 1 0 -1 -1
Just came up with an algorithm to generate N random numbers greater or equal to k whose sum is S, in an uniformly distributed manner. I hope it will be of use here!
First, generate N-1 random numbers between k and S - k(N-1), inclusive. Sort them in descending order. Then, for all xi, with i <= N-2, apply x'i = xi - xi+1 + k, and x'N-1 = xN-1 (use two buffers). The Nth number is just S minus the sum of all the obtained quantities. This has the advantage of giving the same probability for all the possible combinations. If you want positive integers, k = 0 (or maybe 1?). If you want reals, use the same method with a continuous RNG. If your numbers are to be integer, you may care about whether they can or can't be equal to k. Best wishes!
Explanation: by taking out one of the numbers, all the combinations of values which allow a valid Nth number form a simplex when represented in (N-1)-space, which lies at one vertex of a (N-1)-cube (the (N-1)-cube described by the random values range). After generating them, we have to map all points in the N-cube to points in the simplex. For that purpose, I have used one method of triangulation which involves all possible permutations of coordinates in descending order. By sorting the values, we are mapping all (N-1)! simplices to only one of them. We also have to translate and scale the numbers vector so that all coordinates lie in [0, 1], by subtracting k and dividing the result by S - kN. Let us name the new coordinates yi.
Then we apply the transformation by multiplying the inverse matrix of the original basis, something like this:
/ 1 1 1 \ / 1 -1 0 \
B = | 0 1 1 |, B^-1 = | 0 1 -1 |, Y' = B^-1 Y
\ 0 0 1 / \ 0 0 1 /
Which gives y'i = yi - yi+1. When we rescale the coordinates, we get:
x'i = y'i(S - kN) + k = yi(S - kN) - yi+1(S - kN) + k = (xi - k) - (xi+1 - k) + k = xi - xi+1 + k, hence the above formula. This is applied to all elements except the last one.
Finally, we should take into account the distortion that this transformation introduces into the probability distribution. Actually, and please correct me if I'm wrong, the transformation applied to the first simplex to obtain the second should not alter the probability distribution. Here is the proof.
The probability increase at any point is the increase in the volume of a local region around that point as the size of the region tends to zero, divided by the total volume increase of the simplex. In this case, the two volumes are the same (just take the determinants of the basis vectors). The probability distribution will be the same if the linear increase of the region volume is always equal to 1. We can calculate it as the determinant of the transpose matrix of the derivative of a transformed vector V' = B-1 V with respect to V, which, of course, is B-1.
Calculation of this determinant is quite straightforward, and it gives 1, which means that the points are not distorted in any way that would make some of them more likely to appear than others.
I figured out what I believe to be a much simpler solution. You first generate random integers from your minimum to maximum range, count them up and then make a vector of the counts (including zeros).
Note that this solution may include zeros even if the minimum value is greater than zero.
Hope this helps future r people with this problem :)
rand.vect.with.total <- function(min, max, total) {
# generate random numbers
x <- sample(min:max, total, replace=TRUE)
# count numbers
sum.x <- table(x)
# convert count to index position
out = vector()
for (i in 1:length(min:max)) {
out[i] <- sum.x[as.character(i)]
}
out[is.na(out)] <- 0
return(out)
}
rand.vect.with.total(0, 3, 5)
# [1] 3 1 1 0
rand.vect.with.total(1, 5, 10)
#[1] 4 1 3 0 2
I would like to generate N random positive integers that sum to M. I would like the random positive integers to be selected around a fairly normal distribution whose mean is M/N, with a small standard deviation (is it possible to set this as a constraint?).
Finally, how would you generalize the answer to generate N random positive numbers (not just integers)?
I found other relevant questions, but couldn't determine how to apply their answers to this context:
https://stats.stackexchange.com/questions/59096/generate-three-random-numbers-that-sum-to-1-in-r
Generate 3 random number that sum to 1 in R
R - random approximate normal distribution of integers with predefined total
Normalize.
rand_vect <- function(N, M, sd = 1, pos.only = TRUE) {
vec <- rnorm(N, M/N, sd)
if (abs(sum(vec)) < 0.01) vec <- vec + 1
vec <- round(vec / sum(vec) * M)
deviation <- M - sum(vec)
for (. in seq_len(abs(deviation))) {
vec[i] <- vec[i <- sample(N, 1)] + sign(deviation)
}
if (pos.only) while (any(vec < 0)) {
negs <- vec < 0
pos <- vec > 0
vec[negs][i] <- vec[negs][i <- sample(sum(negs), 1)] + 1
vec[pos][i] <- vec[pos ][i <- sample(sum(pos ), 1)] - 1
}
vec
}
For a continuous version, simply use:
rand_vect_cont <- function(N, M, sd = 1) {
vec <- rnorm(N, M/N, sd)
vec / sum(vec) * M
}
Examples
rand_vect(3, 50)
# [1] 17 16 17
rand_vect(10, 10, pos.only = FALSE)
# [1] 0 2 3 2 0 0 -1 2 1 1
rand_vect(10, 5, pos.only = TRUE)
# [1] 0 0 0 0 2 0 0 1 2 0
rand_vect_cont(3, 10)
# [1] 2.832636 3.722558 3.444806
rand_vect(10, -1, pos.only = FALSE)
# [1] -1 -1 1 -2 2 1 1 0 -1 -1
Just came up with an algorithm to generate N random numbers greater or equal to k whose sum is S, in an uniformly distributed manner. I hope it will be of use here!
First, generate N-1 random numbers between k and S - k(N-1), inclusive. Sort them in descending order. Then, for all xi, with i <= N-2, apply x'i = xi - xi+1 + k, and x'N-1 = xN-1 (use two buffers). The Nth number is just S minus the sum of all the obtained quantities. This has the advantage of giving the same probability for all the possible combinations. If you want positive integers, k = 0 (or maybe 1?). If you want reals, use the same method with a continuous RNG. If your numbers are to be integer, you may care about whether they can or can't be equal to k. Best wishes!
Explanation: by taking out one of the numbers, all the combinations of values which allow a valid Nth number form a simplex when represented in (N-1)-space, which lies at one vertex of a (N-1)-cube (the (N-1)-cube described by the random values range). After generating them, we have to map all points in the N-cube to points in the simplex. For that purpose, I have used one method of triangulation which involves all possible permutations of coordinates in descending order. By sorting the values, we are mapping all (N-1)! simplices to only one of them. We also have to translate and scale the numbers vector so that all coordinates lie in [0, 1], by subtracting k and dividing the result by S - kN. Let us name the new coordinates yi.
Then we apply the transformation by multiplying the inverse matrix of the original basis, something like this:
/ 1 1 1 \ / 1 -1 0 \
B = | 0 1 1 |, B^-1 = | 0 1 -1 |, Y' = B^-1 Y
\ 0 0 1 / \ 0 0 1 /
Which gives y'i = yi - yi+1. When we rescale the coordinates, we get:
x'i = y'i(S - kN) + k = yi(S - kN) - yi+1(S - kN) + k = (xi - k) - (xi+1 - k) + k = xi - xi+1 + k, hence the above formula. This is applied to all elements except the last one.
Finally, we should take into account the distortion that this transformation introduces into the probability distribution. Actually, and please correct me if I'm wrong, the transformation applied to the first simplex to obtain the second should not alter the probability distribution. Here is the proof.
The probability increase at any point is the increase in the volume of a local region around that point as the size of the region tends to zero, divided by the total volume increase of the simplex. In this case, the two volumes are the same (just take the determinants of the basis vectors). The probability distribution will be the same if the linear increase of the region volume is always equal to 1. We can calculate it as the determinant of the transpose matrix of the derivative of a transformed vector V' = B-1 V with respect to V, which, of course, is B-1.
Calculation of this determinant is quite straightforward, and it gives 1, which means that the points are not distorted in any way that would make some of them more likely to appear than others.
I figured out what I believe to be a much simpler solution. You first generate random integers from your minimum to maximum range, count them up and then make a vector of the counts (including zeros).
Note that this solution may include zeros even if the minimum value is greater than zero.
Hope this helps future r people with this problem :)
rand.vect.with.total <- function(min, max, total) {
# generate random numbers
x <- sample(min:max, total, replace=TRUE)
# count numbers
sum.x <- table(x)
# convert count to index position
out = vector()
for (i in 1:length(min:max)) {
out[i] <- sum.x[as.character(i)]
}
out[is.na(out)] <- 0
return(out)
}
rand.vect.with.total(0, 3, 5)
# [1] 3 1 1 0
rand.vect.with.total(1, 5, 10)
#[1] 4 1 3 0 2