I construct a user-function:
find.c <- function(q) { f <- function(c) {
(log(7.2 + 6 * c * q - 6) * q^6 * (1-q)^(6-6) * factorial(6) / factorial(6) / factorial(6-6)
+ log(7.2 + 6 * c * q - 5) * q^5 * (1-q)^(6-5) * factorial(6) / factorial(5) / factorial(6-5)
+ log(7.2 + 6 * c * q - 4) * q^4 * (1-q)^(6-4) * factorial(6) / factorial(4) / factorial(6-4)
+ log(7.2 + 6 * c * q - 3) * q^3 * (1-q)^(6-3) * factorial(6) / factorial(3) / factorial(6-3)
+ log(7.2 + 6 * c * q - 2) * q^2 * (1-q)^(6-2) * factorial(6) / factorial(2) / factorial(6-2)
+ log(7.2 + 6 * c * q - 1) * q^1 * (1-q)^(6-1) * factorial(6) / factorial(1) / factorial(6-1)
+ log(7.2 + 6 * c * q - 0) * q^0 * (1-q)^(6-0) * factorial(6) / factorial(0) / factorial(6-0)
- log(7.2)
)}
g <- uniroot(f, lower=0, upper=100, extendInt = "yes")[1]
g}
And I tried to plot:
plot(x = seq(0, 1 , 0.001), find.c(x))
then it gives me: "Error in uniroot(f, lower = 0, upper = 100, extendInt = "yes") :
f() values at end points not of opposite sign"
Also is ther any way I can use 'for' loop to simplify this function? I tried may way with for but function inside function makes very complicated.
I agree with #r2evans suggestion, but I think you can restructure this to be simpler without the nested function.
First, define f with both c= and q= as arguments:
f <- function(c,q) {
(log(7.2 + 6 * c * q - 6) * q^6 * (1-q)^(6-6) * factorial(6) / factorial(6) / factorial(6-6)
+ log(7.2 + 6 * c * q - 5) * q^5 * (1-q)^(6-5) * factorial(6) / factorial(5) / factorial(6-5)
+ log(7.2 + 6 * c * q - 4) * q^4 * (1-q)^(6-4) * factorial(6) / factorial(4) / factorial(6-4)
+ log(7.2 + 6 * c * q - 3) * q^3 * (1-q)^(6-3) * factorial(6) / factorial(3) / factorial(6-3)
+ log(7.2 + 6 * c * q - 2) * q^2 * (1-q)^(6-2) * factorial(6) / factorial(2) / factorial(6-2)
+ log(7.2 + 6 * c * q - 1) * q^1 * (1-q)^(6-1) * factorial(6) / factorial(1) / factorial(6-1)
+ log(7.2 + 6 * c * q - 0) * q^0 * (1-q)^(6-0) * factorial(6) / factorial(0) / factorial(6-0)
- log(7.2)
)}
Then loop over each of the q= values:
mapply(function(...) uniroot(...)[[1]],
list(f), q=seq(0,1,0.001), lower=0, upper=100, extendInt="yes")
# [1] 0.000000 1.076564 1.076460 1.076375 1.076291 1.076206 1.076122
# [8] 1.076037 1.075953 1.075868 1.075784 1.075699 1.075614 1.075530
# etc
Related
I am a) new to stackoverflow and b) an advanced beginner to R ;-)
i saw some bird artworks of Yeganeh with the associated functions in the web Drawing Birds in Flight With Mathematics and wanted to reproduce them in R to experiment a bit with colouring and so on.
However, while this one yielded a quite good result:
k <- 1:9830
X <- function(k) {
sin(pi * k / 20000) ^ 12 *
(0.5 * cos(31 * pi * k / 10000) ^ 16 *
sin(6 * pi * k / 10000) + (1 / 6 * sin(31 * pi * k / 10000)) ^ 20) +
3 * k / 20000 + cos(31 * pi * k / 10000) ^ 6 *
sin((pi / 2) * ((k - 10000) / 10000) ^ 7 - pi / 5)
}
Y <- function(k) {
-9 / 4 * cos(31 * pi * k / 10000) ^ 6 *
cos(pi / 2 * ((k - 10000) / 10000) ^ 7 - pi / 5) *
(2 / 3 + (sin(pi * k / 20000) * sin(3 * pi * k / 20000)) ^ 6) +
3 / 4 * cos(3 * pi * ((k - 10000) / 100000)) ^ 10 *
cos(9 * pi * ((k - 10000) / 100000)) ^ 10 *
cos(36 * pi * ((k - 10000) / 100000)) ^ 14 +
7 / 10 * ((k - 10000) / 10000) ^ 2
}
R <- function(k) {
sin(pi * k / 20000) ^ 10 *
(1 / 4 * cos(31 * pi * k / 10000 + 25 * pi / 32) ^ 20 +
1 / 20 * cos(31 * pi * k / 10000) ^ 2) +
1 / 30 * (3 / 2 - cos(62 * pi * k / 10000) ^ 2)
}
bird <- data.frame(x = X(k), y = Y(k), r = R(k))
library(tidyverse)
library(ggforce)
q <- ggplot() +
geom_circle(aes(x0 = x, y0 = y, r = r),
data = bird,
n = 30) +
coord_fixed() +
theme_void()
the following code yielded some weird result which should basically be related to the difference in the function. (x-A(k))+(y-B(k))=(R(k)) for the parrot below, whlie the bird above "simply" consisted of the k-th circle (X(k), Y(k)) and the radius of the k-th circle R(k)
k <- -10000:10000
A <- function(k) {
(3*k/20000)+(cos(37*pi*k/10000))*sin((k/10000)*(3*pi/5))+(9/7)*(cos(37*pi*k/10000))*(cos(pi*k/20000))*sin(pi*k/10000)
}
B <- function(k) {
(-5/4)*(cos(37*pi*k/10000))*cos((k/10000)*(3*pi/5))*(1+3*(cos(pi*k/20000)*cos(3*pi*k/20000)))+(2/3)*(cos(3*pi*k/200000)*cos(9*pi*k/200000)*cos(9*pi*k/100000))
}
R <- function(k) {
(1/32)+(1/15)*(sin(37*pi*k/10000))*((sin(pi*k/10000))+(3/2)*(cos(pi*k/20000)))
}
parrot <- data.frame(a = A(k), b = B(k), r = R(k))
q <- ggplot() +
geom_circle(aes(x0 = a, y0 = b, r = r),
data = parrot,
n=30) +
coord_fixed() +
theme_void()
q
Any help would be very much appreciated. Cartesian coords already applied as [explained here] (https://www.wikiwand.com/en/Hamid_Naderi_Yeganeh). From the visual point of view, it seems like the function is plotted properly but the "view" on it needs to be changed...
Thanks in advance!
I want to compute the following sequence using R, without loops, i.e. for cycles.
1 + (2/3) + ((2/3)*(4/5)) + ((2/3)*(4/5)*(6/7)) + ... + ((2/3)*(4/5)*...(20/21))
So far, I tried different approaches with a sequence as well as a while function, but could not came up with a suitable solution. Help would be highly appreciated.
We may use cumprod
v1 <- seq(2, 20, by = 2)
v2 <- seq(3, 21, by = 2)
1 + sum(cumprod(v1/v2))
[1] 4.945724
-manual calculation
1 + (2/3) + ((2/3)*(4/5)) + ((2/3)*(4/5)*(6/7)) + ((2/3)*(4/5)*(6/7) * (8/9)) + ((2/3)*(4/5)*(6/7) * (8/9) * (10/11)) + ((2/3)*(4/5)*(6/7) * (8/9) * (10/11) * (12/13)) + ((2/3)*(4/5)*(6/7) * (8/9) * (10/11) * (12/13) * (14/15)) + ((2/3)*(4/5)*(6/7) * (8/9) * (10/11) * (12/13) * (14/15) * (16/17)) + ((2/3)*(4/5)*(6/7) * (8/9) * (10/11) * (12/13) * (14/15) * (16/17) * (18/19)) + ((2/3)*(4/5)*(6/7) * (8/9) * (10/11) * (12/13) * (14/15) * (16/17) * (18/19) * (20/21))
[1] 4.945724
I've taken a few measurements of an LC circuit and I need to solve for both L and C based on that. How do I solve this?
2.675e6 = 1 / (2 * pi * sqrt(L * (C + 100e-9))
5.8e6 = 1 / (2 * pi * sqrt(L * C))
You need pencil and paper:
Equation #1
5.8e6 = 1 / (2 * pi * sqrt(L * C))
sqrt(L * C)= 1 / (2 * pi * 5.8e6 )
L*C = 1 / (2 * pi * 5.8e6 )^2
Equation #2
2.675e6 = 1 / (2 * pi * sqrt(L * (C + 100e-9))
sqrt(L * (C + 100e-9))= 1 / ( 2 *pi *2.675e6 )
L * (C + 100e-9) = 1 / ( 2 *pi *2.675e6 )^2
Subtract #1 from #2
L * (C + 100e-9) - L*C = 1 / ( 2 *pi *2.675e6)^2 - 1 / (2 * pi * 5.8e6 )^2
L * 100e-9 = 1 / ( 2 *pi *2.675e6)^2 - 1 / (2 * pi * 5.8e6 )^2
L = 1e7 * (1 / ( 2 *pi *2.675e6)^2 - 1 / (2 * pi * 5.8e6 )^2 )
and than from #1
C = ( 1 / (2 * pi * 5.8e6 )^2 ) / L
The nonlinear equation is following,A,B,C,D，E are know. I want to rearrange the formation of the equation. Let the X at the left of equation,and let other parameters all at the right of equation. such as X= A*B/D+E^2/C
Is there are some software to do this?such as R.
Try this -- ignore the warnings from that XML package that have started recently.
library(Ryacas)
A <- Sym("A")
B <- Sym("B")
C <- Sym("C")
D <- Sym("D")
E <- Sym("E")
X <- Sym("X")
Solve(E == A * B * (X + C) / (A + B * (X + C)) - A * B * (X + D + C) / (A + B * (X + D + C)), X)
giving:
expression(list(X == (root((2 * (E * A * B) + (2 * (E * B^2 *
C) + E * B^2 * D))^2 - 4 * (E * B^2 * (E * A^2 + (2 * (E *
A * B * C) + E * A * B * D) + (E * B^2 * C^2 + E * B^2 *
C * D) + A^2 * B * D)), 2) - (2 * (E * A * B) + (2 * (E *
B^2 * C) + E * B^2 * D)))/(2 * (E * B^2)), X == -(2 * (E *
A * B) + (2 * (E * B^2 * C) + E * B^2 * D) + root((2 * (E *
A * B) + (2 * (E * B^2 * C) + E * B^2 * D))^2 - 4 * (E *
B^2 * (E * A^2 + (2 * (E * A * B * C) + E * A * B * D) +
(E * B^2 * C^2 + E * B^2 * C * D) + A^2 * B * D)), 2))/(2 *
(E * B^2))))
An alternative to the above if you have specific values for A, B, C, D, E would be to numerically solve it using, for example, uniroot.
I have a function to use in R
TV <- function(v1,v2) {
write.csv(log(2 ^ (-1 / 2) * exp(-1 / 2) * beta(1 / 2, v1 / 2) / gamma(1 / 2)) - log(2 ^ (-1 / 2) * exp(-1 / 2) * beta(1 / 2, v2 / 2) / gamma(1 / 2)) + (v1 + 1) * digamma(v1 / 2 + 1 / 2) / 2 + (-1 - v2) * digamma(v2 / 2 + 1 / 2) / 2 + (-1 - v1) * digamma(v1 / 2) / 2 + (v2 + 1) * digamma(v2 / 2) / 2 + 0.5e0 * log(v1 / v2),"write.csv")
}
as you can see the input variables are v1 and v2.
if i give v1=1:10 and v2=1
i get single vector like this
result for v1=1:10 and v2=1.
what i need is a matrix output. for v1=1:10 to v2=1:10. i.e as 10x10 matrix.
how can i do it using R
Try this:
write.csv(outer(1:10, 1:10, FUN=function(v1,v2)log(2 ^ (-1 / 2) * exp(-1 / 2) * beta(1 / 2, v1 / 2) / gamma(1 / 2)) -
log(2 ^ (-1 / 2) * exp(-1 / 2) * beta(1 / 2, v2 / 2) / gamma(1 / 2)) + (v1 + 1) * digamma(v1 / 2 + 1 / 2) / 2 +
(-1 - v2) * digamma(v2 / 2 + 1 / 2) / 2 + (-1 - v1) * digamma(v1 / 2) / 2 + (v2 + 1) * digamma(v2 / 2) / 2 + 0.5e0 * log(v1 / v2)), 'write.csv')