maple: plotting result of a numerical dsolve - plot

I have to solve a differential equation numerically; so to say:
diff(y(x), x)+x^2-15*x = 5
with the initial conditions:
inc := y(0) = 0
the solution is of course:
sol := dsolve({f, inc}, numeric);
which results in:
proc(x_rkf45) ... end
Now I want to plot y(x) for x=0..2 for instance.
What shoudl I do?
the code:
plot(sol(x), x = 0 .. 2);
does not work!
Warning, unable to evaluate the function to numeric values in the
region; see the plotting command's help page to ensure the calling
sequence is correct

Here are three different ways to do that.
The first is to use the DEtools[DEplot] command, which both solves and plots. It's input is the differential equation(s) and one or more sets of intitial conditions (as opposed to something that dsolve(...,numeric) returns).
The DEplot command has lots of options. You can turn off inclusion of the field plot, for example.
restart:
deq := diff(y(x), x)+x^2-15*x = 5:
ic := y(0) = 0:
DEtools[DEplot](deq, y(x), x=0..2, [ic]);
The next way is to call dsolve(...,numeric) as you did, and to pass what it returns to the plots:-odeplot command.
sol := dsolve({deq, ic}, numeric):
plots:-odeplot(sol, x=0..2);
Yet another way is to pass dsolve the additional output=listprocedure option so that it returns a list of procedures. Any of those can then be extracted and used to compute at a point or used by passing to the usual plot command.
sollist := dsolve({deq, ic}, numeric, output=listprocedure):
Y := eval(y(x),sollist):
Y(1.0);
12.1666666666667
plot( Y, 0..2 );
See the help pages for DEtools[DEplot], plots:-odeplot or plot,options for more details on customizing the resulting plots.
If you choose to go the odeplot way and also wish to include the field plot then you can augment the plot using plots:-display and plots:-fieldplot.

Related

Get the mapping from each element of input to the bin of the histogram in Julia

Matlab's [n,mapx] = histc(x, bin_edged) returns the counts of x in each bin as n and returns a map, which is the same length of x which is the bin index that each element of x was placed into.
I can do the same thing in Julia as follows:
Using StatsBase
x = rand(1000)
bin_e = 0:0.1:1
h = fit(Histogram, x, bin_e)
yx = map((z) -> findnext(z.<=h.edges[1],1),x) .- 1
Is this the "right way" to do this? It seem a bit kludgy.
Inspired by this python question you should be able to define a small function that delivers the desired mapping (modulo conventions):
binindices(edges, data) = searchsortedlast.(Ref(edges), data)
Note that the bin edges are sorted and we can use seachsortedlast to get the last bin edge smaller or equal than a datapoint. Broadcasting this over all of the data we obtain the mapping. Note that the Ref(edges) indicates that edges is a scalar under broadcasting (that means that the full array is considered in each call).
Although conceptionally identical to your solution, this approach is about 13x faster on my machine.
I filed an issue over at StatsBase.jl's github page suggesting to add this as a feature.
After looking through the code for Histogram.jl I found that they already included a function binindex. So this solution is probably the best:
x = 0:0.001:10
h1 = fit(Histogram,x,0:10,closed=left)
xmap1 = StatsBase.binindex.(Ref(h1), x)
h2 = fit(Histogram,x,0:10,closed=right)
xmap2 = StatsBase.binindex.(Ref(h2), x)
I stumbled across this question when I was trying to figure out how many occurrences of each value I had in a list of values. If each value is in its own bin (as for categorical data, or integer data with a small number of unique values), this is what one would be plotting in a histogram.
If that is what you want, then countmap() in StatBase package is just what you need.

R Legend Variable Substitution

I always desire to have my R code as flexible as possible; at present I have three (potentially more) curves to compare based on a parameter delta, but I don't want to hardcode the values of delta anywhere (or even how many values if I can avoid it).
I am trying to make a legend that involves both Greek and a variable substitution for the delta values, so each legend entry is of the form like 'delta = 0.01', where delta is Greek and 0.01 is determined by variable. Many different combinations of paste, substitute, bquote and expression have been tried, but always end up with some verbatim code leftover in the finished legend, OR fail to put 'delta' into symbolic form.
delta <- c(0.01,0.05,0.1)
plot(type="n", x=1:5, y=1:5) #the curves themselves are irrelevant
legend_text <- vector(length=length(delta)) #I don't think lists work either
for(i in 1:length(delta)){
legend_text[i] <- substitute(paste(delta,"=",D),list(D=delta[i]) )
}
legend(x="topleft", fill=rainbow(length(delta)), legend=legend_text)
Since legend=substitute(paste(delta,"=",D),list(D=delta[1]) works for a single entry, I've also tried doing a 'semi-hardcoded' version, fixing the length of delta:
legend(x="topleft", fill=rainbow(length(delta)),
legend=c(substitute(paste(delta,"=",A), list(A=delta[1])),
substitute(paste(delta,"=",B), list(B=delta[2])),
substitute(paste(delta,"=",C), list(C=delta[3])) )
)
but this has the same issues as before.
Is there a way I can do this, or do I need to change the code by hand with each update of delta?
Try using lapply() with as.expression() to generate your legend labels. Also use bquote to create your individual expressions
legend_text <- as.expression(lapply(delta, function(d) {
bquote(delta==.(d))
} ))
Note that with plotmath you need == to get an equals sign. Also no need for paste() since nothing is really a string here.

R: Call a pasted variable name and use it as position argument

I am trying to replace all values of r for which r<=10 with the value of the 1st observation in x (which is 1). This is just a very simplified example of what I am trying to do, so please do not question why I'm trying to do this in a complicated way because the full code is more complicated. The only thing I need help with is figuring out how to use the vector I created (p1) to replace r[p1] or equivalently r[c(1,2,3,4)] with x[ 1 ] (which is equal to 1). I can not write p1 explicitly because it will be generated in a loop (not shown in code).
x=c(1,2,3)
r=c(1,3,7,10,15)
assign(paste0("p", x[1]), which(r<=10))
p1
r[paste0("p", x[1])]=x[1]
In the code above, I tried using r[paste0("p", x[1])]=x[1] but this is the output I end up with
When instead I would like to see this output
Basically, I need to figure out a way to call p1 in this code r[??]=x[1] without explicitly typing p1.
I have included the full code I am attempting below in case context is needed.
##Creates a function to generate discrete random values from a specified pmf
##n is the number of random values you wish to generate
##x is a vector of discrete values (e.g. c(1,2,3))
##pmf is the associated pmf for the discrete values (e.g. c(.3,.2,.5))
r.dscrt.pmf=function(n,x,pmf){
set.seed(1)
##Generate n uniform random values from 0 to 1
r=runif(n)
high=0
low=0
for (i in 1:length(x)){
##High will establish the appropriate upper bound to consider
high=high+pmf[i]
if (i==1){
##Creates the variable p1 which contains the positions of all
##r less than or equal to the first value of pmf
assign(paste0("p", x[i]), which(r<=pmf[i]))
} else {
##Creates the variable p2,p3,p4,etc. which contains the positions of all
##r between the appropriate interval of high and low
assign(paste0("p", x[i]), which(r>low & r<=high))
}
##Low will establish the appropriate lower bound to consider
low=low+pmf[i]
}
for (i in 1:length(x)){
##Will loops to replace the values of r at the positions specified at
##p1,p2,p3,etc. with x[1],x[2],x[3],etc. respectively.
r[paste0("p", x[i])]=x[i]
}
##Returns the new r
r
}
##Example call of the function
r.dscrt.pmf(10,c(0,1,3),c(.3,.2,.5))
get is like assign, in that it lets you refer to variables by string instead of name.
r[get(paste0("p", x[1]))]=x[1]
But get is one of those "flags" of something that could be written in a much clearer and safer way.
Would this suit your needs?
ifelse(r<11, x[1], r)
[1] 1 1 1 1 15

Optimizing alpha and beta in negative log likehood sum for beta binomial distribution

I'm attempting to create sigma/summation function with the variables in my dataset that looks like this:
paste0("(choose(",zipdistrib$Leads[1],",",zipdistrib$Starts[1],")*beta(a+",zipdistrib$Starts[1],",b+",zipdistrib$Leads[1],"-",zipdistrib$Starts[1],")/beta(a,b))")
When I enter that code, I get
[1] "(choose(9,6)*beta(a+6,b+9-6)/beta(a,b))"
I want to create a sigma/summation function where a and b are unknown free-floating variables and the values of Leads[i] and Starts[i] are determined by the values for Leads and Starts for observation i in my dataset. I have tried using a sum function in conjunction with mapply and sapply to no avail. Currently, I am taking the tack of creating the function as a string using a for loop in conjunction with a paste0 command so that the only things that change are the values of the variables Leads and Starts. Then, I try coercing the result into a function. To my surprise, I can actually enter this code without creating a syntax error, but when I try optimize the function for variables a and b, I'm not having success.
Here's my attempt to create the function out of a string.
betafcn <- function (a,b) {
abfcnstring <-
for (i in 1:length(zipdistrib$Zip5))
toString(
paste0(" (choose(",zipdistrib$Leads[i],",",zipdistrib$Starts[i],")*beta(a+",zipdistrib$Starts[i],",b+",zipdistrib$Leads[i],"-",zipdistrib$Starts[i],")/beta(a,b))+")
)
as.function(
as.list(
substr(abfcnstring, 1, nchar(abfcnstring)-1)
)
)
}
Then when I try to optimize the function for a and b, I get the following:
optim(c(a=.03, b=100), betafcn(a,b))
## Error in as.function.default(x, envir) :
argument must have length at least 1
Is there a better way for me to compile a sigma from i=1 to length of dataset with mapply or lapply or some other *apply function? Or am I stuck using a dreaded for loop? And then once I create the function, how do I make sure that I can optimize for a and b?
Update
This is what my dataset would look like:
leads <-c(7,4,2)
sales <-c(3,1,0)
zipcodes <-factor(c("11111", "22222", "33333"))
zipleads <-data.frame(ZipCode=zipcodes, Leads=leads, Sales=sales)
zipleads
## ZipCode Leads Sales
# 1 11111 7 3
# 2 22222 4 1
# 3 33333 2 0
My goal is to create a function that would look something like this:
betafcn <-function (a,b) {
(choose(7,3)*beta(a+3,b+7-3)/beta(a,b))+
(choose(4,1)*beta(a+4,b+4-1)/beta(a,b))+
(choose(2,0)*beta(a+0,b+2-0)/beta(a,b))
}
The difference is that I would ideally like to replace the dataset values with any other possible vectors for Leads and Sales.
Since R vectorizes most of its operations by default, you can write an expression in terms of single values of a and b (which will automatically be recycled to the length of the data) and vectors of x and y (i.e., Leads and Sales); if you compute on the log scale, then you can use sum() (rather than prod()) to combine the results. Thus I think you're looking for something like:
betafcn <- function(a,b,x,y,log=FALSE) {
r <- lchoose(x,y)+lbeta(a+x,b+x-y)-lbeta(a,b)
if (log) r else exp(r)
}
Note that (1) optim() minimizes by default (2) if you're trying to optimize a likelihood you're better off optimizing the log-likelihood instead ...
Since all of the internal functions (+, lchoose, lbeta) are vectorized, you should be able to apply this across the whole data set via:
zipleads <- data.frame(Leads=c(7,4,2),Sales=c(3,1,0))
objfun <- function(p) { ## negative log-likelihood
-sum(betafcn(p[1],p[2],zipleads$Leads,zipleads$Sales,
log=TRUE))
}
objfun(c(1,1))
optim(fn=objfun,par=c(1,1))
I got crazy answers for this example (extremely large values of both shape parameters), but I think that's because it's awfully hard to fit a two-parameter model to three data points!
Since the shape parameters of the beta-binomial (which is what this appears to be) have to be positive, you might run into trouble with unconstrained optimization. You can use method="L-BFGS-B", lower=c(0,0) or optimize the parameters on the log scale ...
I thought your example was hopelessly complex. If you are going to attemp making a function by pasting character values, you first need to understand how to make a function body with an unevaluated expression, and after that basic task is understood, then you can elaborate ... if in fact it is necessary, noting BenBolker's suggestions.
choosefcn <- function (a,b) {}
txtxpr <- paste0("choose(",9,",",6,")" )
body(choosefcn) <- parse(text= txtxpr)
#----------
> betafcn
function (a, b)
choose(9, 6)
val1 <- "a"
val2 <- "b"
txtxpr <- paste0("choose(", val1, ",", val2, ")" )
body(choosefcn) <- parse(text= txtxpr)
#
choosefcn
#function (a, b)
#choose(a, b)
It also possible to configure the formal arguments separately with the formals<- function. See each of these help pages:
?formals
?body
?'function' # needs to be quoted

Adding an argument to a mathematical function

I'm trying to automate a process to produce interpolated geochemical maps.
I've created a loop that essentially starts at column #13 and loops through until #67.
However, part of the IDW code requires the header of the current column for the respective geochemical parameters to be mapped.
For instance; column #13's header is "Ag_ppm", so the original code read:
LogSr.idw = idw(log10("Ag_ppm") ~ 1 , locations=NGSA.SPDF, newdata=NGSA.grid,
maxdist=15000, nmin=4)
I've been able to obtain the header of the column in interest within each loop using (where i increases by 1 each loop; 13, 14, 15 etc.):
coln <- colnames(NGSA.df[i])
However, when I simply substitute the "Ag_ppm" to coln, the line fails with a given error. I've tried various approaches including paste, although everything still results in the same error.
LogSr.idw = idw(log10(coln) ~ 1, locations=NGSA.SPDF, newdata=NGSA.grid,
maxdist=15000, nmin=4)
Error in log10(coln) : non-numeric argument to mathematical function
Is there a reasonably simple approach using the current method?
It is surprising to me that log10("Ag_ppm") doesn't throw the same error, but I have often overcome this problem using get:
LogSr.idw = idw(log10(get(coln)) ~ 1, locations=NGSA.SPDF, newdata=NGSA.grid,
maxdist=15000, nmin=4)
In most situations, it is a good idea to think of an alternative to using get, but due the the formula (~) here, and the use of the newdata arguemtn, get might be the best solution.

Resources