Derivative in InfinitePolynomialRing - sage

I am attempting to take a derivative of an element in the class InfinitePolynomialRing. Some digging led me to the following way to do this:
X.<p> = InfinitePolynomialRing(QQ)
f= p[3]
f.derivative(f.variables()[f.variables().index(p[3])])
So my polynomial is just p_3 and I wish to take it's derivative with respect to p_3. However upon doing so I get the following error:
TypeError: provided variable is not in same ring as self
Even more bizarre is that the derivative with respect to any other variable works well:
X.<p> = InfinitePolynomialRing(QQ)
f=p[1]
f.derivative(f.variables()[f.variables().index(p[1])])
Gives me 1, the error only arises for p_3 and I cannot seem to figure out why.

Related

How can I optimize the expected value of a function in R?

I have derived a survival function for a system of components (ignore the details of how this system is setup) and I am trying to maximize its expected, or more specifically, maximizing the expected value of the function:
surv_func = function(x,mu) = {(exp(-(x/(mu))^(1/3))*((1-exp(-(4/3)*x^(3/2)))+exp(-(-(4/3)*x^(3/2)))))*exp(-(x/(3-mu))^(1/3))}
and I am supposed (since the pdf including my tasks gives a hint about it) to use the function
optimize()
and the expected value for a function can be computed with
# Computes expected value of a the function "function"
E <- integrate(function, 0, Inf)
but my function depends on x and mu. The expected value could (obviously) be computed if the integral had no mu but instead only depended on x. For those interested, the mu comes from the fact that one of the components has a Weibull-distribution with parameters (1/3,mu) and the 3-mu comes from that has a Weibull-distribution with parameters (1/3,lambda). In the task there is a constraint mu + lambda = 3, so I tought substituting the lambda-parameter in the second Weibull-distribution with lambda = 3 - mu and trying to maximize this problem would yield not only mu, but also lambda.
If I try to, just for the sake of learing about R, compute the expected value using the code below (in the console window), it just gives me the following:
> E <- integrate(surv_func,0,Inf)
Error in (function (x, mu) : argument "mu" is missing, with no default
I am new to R and seem to be a little bit "slow" at learning. How can I approach this problem?

Weird R behavior with indexing function arrays

I'm having some unexpected behaviour in R with function arrays, and I've reduced the problem to a minimal working example:
theory = c(function(p) p)
i = 1
posterior = function(p) theory[[i]](p)
i = 2
posterior(0)
Which gives me an error saying the subscript i is out of bounds.
So I guess that i is somehow being used as a "free" variable in the definition of posterior so it gets updated when I redefine i. Oddly enough, this works:
theory = c(function(p) p)
i = 1
posterior = theory[[i]]
i = 2
posterior(0)
How can I avoid this? Note that not redefining i is not an option, as this stuff is going in a for loop where i is the index.
The reason that this doesn't work is that you redefine i = 2, and then you are out of bounds of theory, which contains a single element. The function is evaluated lazily, so that it only executes theory[[i]] when the function is called, at which point i equals 2.
You can read some more about lazy evaluation here.

Error when fitting a beta distribution: the function mle failed to estimate the parameters with error code 100

I'm trying to use fitdist () function from the fitdistrplus package to fit my data to different distributions. Let's say that my data looks like:
x = c (1.300000, 1.220000, 1.160000, 1.300000, 1.380000, 1.240000,
1.150000, 1.180000, 1.350000, 1.290000, 1.150000, 1.240000,
1.150000, 1.120000, 1.260000, 1.120000, 1.460000, 1.310000,
1.270000, 1.260000, 1.270000, 1.180000, 1.290000, 1.120000,
1.310000, 1.120000, 1.220000, 1.160000, 1.460000, 1.410000,
1.250000, 1.200000, 1.180000, 1.830000, 1.670000, 1.130000,
1.150000, 1.170000, 1.190000, 1.380000, 1.160000, 1.120000,
1.280000, 1.180000, 1.170000, 1.410000, 1.550000, 1.170000,
1.298701, 1.123595, 1.098901, 1.123595, 1.110000, 1.420000,
1.360000, 1.290000, 1.230000, 1.270000, 1.190000, 1.180000,
1.298701, 1.136364, 1.098901, 1.123595, 1.316900, 1.281800,
1.239400, 1.216989, 1.785077, 1.250800, 1.370000)
Next, if i run fitdist (x, "gamma") everything is fine, but if I use fitdist (x, "beta") instead I get the following error:
Error in start.arg.default(data10, distr = distname) :
values must be in [0-1] to fit a beta distribution
Ok, so I'm not native english but as far as I understand this method requires data to be in the range [0,1], so I scale it by using x_scaled = (x-min(x))/max(x). This gives me a vector with values in that range that perfectly correlates the original vector x.
Because of x_scaled is of class matrix, I convert into a numeric vector using as.numeric(). And then fit the model with fitdist(x_scale,"beta").
This time I get the following error:
Error in fitdist(x_scale, "beta") :
the function mle failed to estimate the parameters, with the error code 100
So after that I've been doing some search engine queries but I don't find anything useful. Does anybody ave an idea of whats going on wrong here? Thank you
By reading into the source code, it can be found that the default estimation method of fitdist is mle, which will call mledist from the same package, which will construct a negative log-likelihood for the distribution you have chosen and use optim or constrOptim to numerically minimize it. If there is anything wrong with the numerical optimization process, you get the error message you've got.
It seems like the error occurs because when x_scaled contains 0 or 1, there will be some problem in calculating the negative log-likelihood for beta distribution, so the numerical optimization method will simply broke. One dirty trick is to let x_scaled <- (x - min(x) + 0.001) / (max(x) - min(x) + 0.002), so there is no 0 nor 1 in x_scaled, and fitdist will work.

Estimate parameters of Frechet distribution using mmedist or fitdist(with mme) error

I'm relatively new in R and I would appreciated if you could take a look at the following code. I'm trying to estimate the shape parameter of the Frechet distribution (or inverse weibull) using mmedist (I tried also the fitdist that calls for mmedist) but it seems that I get the following error :
Error in mmedist(data, distname, start = start, fix.arg = fix.arg, ...) :
the empirical moment function must be defined.
The code that I use is the below:
require(actuar)
library(fitdistrplus)
library(MASS)
#values
n=100
scale = 1
shape=3
# simulate a sample
data_fre = rinvweibull(n, shape, scale)
memp=minvweibull(c(1,2), shape=3, rate=1, scale=1)
# estimating the parameters
para_lm = mmedist(data_fre,"invweibull",start=c(shape=3,scale=1),order=c(1,2),memp = "memp")
Please note that I tried many times en-changing the code in order to see if my mistake was in syntax but I always get the same error.
I'm aware of the paradigm in the documentation. I've tried that as well but with no luck. Please note that in order for the method to work the order of the moment must be smaller than the shape parameter (i.e. shape).
The example is the following:
require(actuar)
#simulate a sample
x4 <- rpareto(1000, 6, 2)
#empirical raw moment
memp <- function(x, order)
ifelse(order == 1, mean(x), sum(x^order)/length(x))
#fit
mmedist(x4, "pareto", order=c(1, 2), memp="memp",
start=c(shape=10, scale=10), lower=1, upper=Inf)
Thank you in advance for any help.
You will need to make non-trivial changes to the source of mmedist -- I recommend that you copy out the code, and make your own function foo_mmedist.
The first change you need to make is on line 94 of mmedist:
if (!exists("memp", mode = "function"))
That line checks whether "memp" is a function that exists, as opposed to whether the argument that you have actually passed exists as a function.
if (!exists(as.character(expression(memp)), mode = "function"))
The second, as I have already noted, relates to the fact that the optim routine actually calls funobj which calls DIFF2, which calls (see line 112) the user-supplied memp function, minvweibull in your case with two arguments -- obs, which resolves to data and order, but since minvweibull does not take data as the first argument, this fails.
This is expected, as the help page tells you:
memp A function implementing empirical moments, raw or centered but
has to be consistent with distr argument. This function must have
two arguments : as a first one the numeric vector of the data and as a
second the order of the moment returned by the function.
How can you fix this? Pass the function moment from the moments package. Here is complete code (assuming that you have made the change above, and created a new function called foo_mmedist):
# values
n = 100
scale = 1
shape = 3
# simulate a sample
data_fre = rinvweibull(n, shape, scale)
# estimating the parameters
para_lm = foo_mmedist(data_fre, "invweibull",
start= c(shape=5,scale=2), order=c(1, 2), memp = moment)
You can check that optimization has occurred as expected:
> para_lm$estimate
shape scale
2.490816 1.004128
Note however, that this actually reduces to a crude way of doing overdetermined method of moments, and am not sure that this is theoretically appropriate.

Nonlinear regression in R shows error

I am using the R function nlsLM from the package minpack.LM and I have the following error.
I generate my own signal with noise, so I know all parameters, which I'am trying to find doing regression analysis using the same function, I've used to generate signal.
The problem is, that nlsLM function runs fine, and it even could find right parameters values, but at last, when it finds them, error appear like this:
It. 23, RSS = 14.4698, Par. = 42.6727 0.78112 1 65.2211 15.6065 1
It. 24, RSS = 14.4698, Par. = 42.671 0.781102 1 65.2212 15.6069 1
Error in stats:::nlsModel(formula, mf, start, wts) :
singular gradient matrix at initial parameter estimates
And I do not know what to do.
Please explain what it could be, and how I could solve it!
Additional information:
#This is how i generate my signal (it is convolution of gaussian with exp(-kt)
set.seed(100)
Yexp=sim_str_exp(error=10)
time=Yexp[[1]]
y=Yexp[[2]]
dataset_nls=data.frame(time,y)
start=c(tau1=.5,beta1=.5,exp_A1=.5,gaus_pos=.5,gaus_width=.5,gaus_A=0.5)
lower=c(tau1=0.01,beta1=0.01,exp_A1=0.01,gaus_pos=0.01,gaus_width=0.01,gaus_A=0.01)
upper=c(tau1=100,beta1=1,exp_A1=1,gaus_pos=100,gaus_width=850,gaus_A=1)
#here i do fitting
FIT=nlsLM(y ~ str_exp_model(time,tau1,beta1,exp_A1,gaus_pos,gaus_width,gaus_A),data=dataset_nls,start=start,lower=lower,upper=upper,trace=TRUE,algorithm="LM",na.action=na.pass,control=nls.lm.control(maxiter=200,nprint=1))
#Model_function
str_exp_model<-function(time, tau1,beta1,exp_A1,gaus_pos,gaus_width,gaus_A){
F_gen_V<-vector(length=length(time))
F_gaus_V=vector(length=length(time))
F_exp_V=vector(length=length(time))
for (i in 1:length(time)) {
F_gaus_V[i]=gaus_A*exp(-2.77*((i-gaus_pos)/gaus_width)^2)
F_exp_V[i]=exp_A1*exp(-1*(i/tau1)^beta1)
}
convolve(F_gaus_V, F_exp_V,FALSE)
}
function for signal generation
sim_str_exp<- function(num_points=512,time_scale=512,tau1=45,beta1=.80,exp_A1=1,gaus_pos=65,
gaus_width=15, gaus_A=1,Y0=0, error=2.0, show_graph=TRUE, norm="False"){
F_gen_V<-vector(length=num_points)
time_gen_V<-vector(length=num_points)
F_gaus_V=vector(length=num_points)
F_exp_V=vector(length=num_points)
ts=time_scale/num_points
sigma=vector(length=num_points)
for (i in 1:num_points) {
F_gaus_V[i]=gaus_A*exp(-2.77*((i*ts-gaus_pos)/gaus_width)^2)
F_exp_V[i]=exp_A1*exp(-1*(i*ts/tau1)^beta1)
time_gen_V[i]=i*ts
}
F_gen_V<-(convolve(F_gaus_V, F_exp_V,FALSE))+Y0
if(norm==TRUE){
F_gen_V=F_gen_V/max(F_gen_V)}
else{;}
error_V=runif(512,-1*error, error)
for(i in 1:num_points){
F_gen_V[i]=error_V[i]/100*F_gen_V[i]+F_gen_V[i]
sigma[i]=(error_V[i]/100*F_gen_V[i])
}
RETURN=list(time=time_gen_V,y=F_gen_V,sigma=sigma)
if (show_graph==TRUE){
plot(RETURN[[1]],RETURN[[2]], type="l", main="Generated signal with noise",xlab="time, pixel",ylab="Intensity");}
else {;}
return(RETURN)
}
You haven't shown us sim_str_exp, so this example isn't fully reproducible, but I'm going to take a guess here. You say "I generate my own signal with noise", but you use Yexp=sim_str_exp(error=0) to generate the data, so it looks like you're not in fact adding any noise. (Also, your reported RSS at the last step is 1.37e-28 ...)
My guess is that you're running into a problem documented in ?nls, which is that nls() doesn't work well when there is zero noise. This is not documented in ?nlsLM, but I wouldn't be surprised if it held there too.
For convenience, here is the section I'm referring to from ?nls:
Do not use ‘nls’ on artificial "zero-residual" data.
The ‘nls’ function uses a relative-offset convergence criterion
that compares the numerical imprecision at the current parameter
estimates to the residual sum-of-squares. This performs well on
data of the form
y = f(x, theta) + eps
(with ‘var(eps) > 0’). It fails to indicate convergence on data
of the form
y = f(x, theta)
because the criterion amounts to comparing two components of the
round-off error. If you wish to test ‘nls’ on artificial data
please add a noise component, as shown in the example below.
If my hypothesis is correct then you should be able to get a fit without errors if you set the noise amplitude greater than zero.

Resources