Related
I want to minimize this function with constraint
The step is I need to find t(i) that optimize (minimize) the E(TC)
Here are my codes for n=3 and want to minimize E(TC) with the optimum t(i) ,i =1,2,3. Note that t(1) must equal to zero, and with constraint t(2)<t(3)<T
OptExp<-function(te){
mu=0.001299059
sigm=0.00006375925
D=80
K=500
F=0.7
T=40
Po=-0.0208801593
mu=0.001299059
n=3
t=as.vector(n,mode="numeric")
P1=as.vector(n,mode="numeric")
P2=as.vector(n,mode="numeric")
Pt1=as.vector(n,mode="numeric")
Pt2=as.vector(n,mode="numeric")
for (i in 2:(n)){
t[1]=0
t[i]=te[i-1]}
for (i in 1:n){
if(i!=n){
P1[i]=Po*exp((mu+(sigm^2)/2)*t[i])*D*(t[i+1]-t[i])
P2[i]=(1/2)*Po*exp((mu+(sigm^2)/2)*t[i])*F*D*(t[i+1]-t[i])^2}
else {
P1[i]=Po*exp((mu+(sigm^2)/2)*t[i])*D*(T-t[i])
P2[i]=(1/2)*Po*exp((mu+(sigm^2)/2)*t[i])*F*D*(T-t[i])^2}}
Pt1=sum(P1)
Pt2=sum(P2)
E=n*K+Pt1+Pt2
#constraint
if (t[3]<T & t[1]<t[2] & t[2]<t[3]){
return(E)}
}
optmz=optim(c(3,5),fn=OptExp)
But the result is
Error in optim(c(3, 5), fn = OptExp) :
objective function in optim evaluates to length 0 not 1
Anyone knows what is wrong from my code?
*ps: I also try with consrtOptim
n=2
t=as.vector(n,mode="numeric")
t[1]=0
OptExp<-function(te){
mu=0.001299059
sigm=0.00006375925
D=80
K=500
F=0.7
T=40
Po=-0.0208801593
mu=0.001299059
P1=as.vector(n,mode="numeric")
P2=as.vector(n,mode="numeric")
Pt1=as.vector(n,mode="numeric")
Pt2=as.vector(n,mode="numeric")
for (i in 2:(n)){
t[1]=0
t[i]=te[i-1]}
for (i in 1:n){
if(i!=n){
P1[i]=Po*exp((mu+(sigm^2)/2)*t[i])*D*(t[i+1]-t[i])
P2[i]=(1/2)*Po*exp((mu+(sigm^2)/2)*t[i])*F*D*(t[i+1]-t[i])^2}
else {
P1[i]=Po*exp((mu+(sigm^2)/2)*t[i])*D*(T-t[i])
P2[i]=(1/2)*Po*exp((mu+(sigm^2)/2)*t[i])*F*D*(T-t[i])^2}}
Pt1=sum(P1)
Pt2=sum(P2)
E=n*K+Pt1+Pt2
return(E)
}
lb=t[n-1]
u1=cbind(c(1,-1));u1
c1=c(lb,-40)
init=c(3)
value<-constrOptim(init,f=OptExp,ui=u1,ci=c1,grad=NULL)
note that the constraint for n=2 is t(1)=0<t(2)<T=40
and it returns
one-dimensional optimization by Nelder-Mead is unreliable:
use "Brent" or optimize() directly
Just simply following the instructions in the error messages (no thinking required) leads to:
value<-constrOptim(init,f=OptExp,ui=u1,ci=c1,grad=NULL,
method="Brent",lower=0,upper=40)
and
OptExp<-function(te,...){
For more than one t use method="Nelder-Mead" (or better BFGS)
I need to find peaks in a time series data, but the result needs to be equal to the result of the findpeaks function in MATLAB, with the argument 'MinPeakWidth" set to 10. I have already tried a lot of functions in order to achieve this: pracma::findpeaks, fluoR::find_peaks, splus2R::peaks, IDPmisc::peaks (this one has one argument regarding peak width, but the result is not the same). I have already looked in other functions as well, including packages for chromatography and spectoscropy analysis in bioconductor. Beyond that, I have tried the functions (and little alterations) from this other question in stackoverflow: Finding local maxima and minima
The findpeaks function in MATLAB is used for finding local maximas and has the following charcateristics:
Find the local maxima. The peaks are output in order of occurrence. The first sample is not included despite being the maximum. For the flat peak, the function returns only the point with lowest index.
The explanation for the "MinPeakWidth' argument in MATLAB web site is
Minimum peak width, specified as the comma-separated pair consisting of 'MinPeakWidth' and a positive real scalar. Use this argument to select only those peaks that have widths of at least 'MinPeakWidth'.
If you specify a location vector, x, then 'MinPeakWidth' must be expressed in terms of x. If x is a datetime array, then specify 'MinPeakWidth' as a duration scalar or as a numeric scalar expressed in days.
If you specify a sample rate, Fs, then 'MinPeakWidth' must be expressed in units of time.
If you specify neither x nor Fs, then 'MinPeakWidth' must be expressed in units of samples.
Data Types: double | single | duration
This is the data:
valores <- tibble::tibble(V1 = c(
0.04386573, 0.06169861, 0.03743560, 0.04512523, 0.04517977, 0.02927114, 0.04224937, 0.06596527, 2.15621006, 0.02547804, 0.03134409, 0.02867694,
0.08251871, 0.03252856, 0.06901365, 0.03201109, 0.04214851, 0.04679828, 0.04076178, 0.03922274, 1.65163662, 0.03630282, 0.04146608, 0.02618668,
0.04845364, 0.03202031, 0.03699149, 0.02811389, 0.03354410, 0.02975296, 0.03378896, 0.04440788, 0.46503730, 0.06128226, 0.01934736, 0.02055138,
0.04233819, 0.03398005, 0.02528630, 0.03694652, 0.02888223, 0.03463824, 0.04380172, 0.03297124, 0.04850558, 0.04579087, 1.48031231, 0.03735059,
0.04192204, 0.05789367, 0.03819694, 0.03344671, 0.05867103, 0.02590745, 0.05405133, 0.04941912, 0.63658824, 0.03134409, 0.04151859, 0.03502503,
0.02182294, 0.15397702, 0.02455722, 0.02775277, 0.04596132, 0.03900906, 0.03383408, 0.03517160, 0.02927114, 0.03888822, 0.03077891, 0.04236406,
0.05663730, 0.03619537, 0.04294887, 0.03497815, 0.03995837, 0.04374904, 0.03922274, 0.03596561, 0.03157820, 0.26390591, 0.06596527, 0.04050374,
0.02888223, 0.03824380, 0.05459656, 0.02969611, 0.86277224, 0.02385613, 0.03888451, 0.06496997, 0.03930725, 0.02931837, 0.06021005, 0.03330982,
0.02649659, 0.06600261, 0.02854480, 0.03691669, 0.06584168, 0.02076757, 0.02624355, 0.03679596, 0.03377049, 0.03590172, 0.03694652, 0.03575540,
0.02532416, 0.02818711, 0.04565318, 0.03252856, 0.04121822, 0.03147210, 0.05002047, 0.03809792, 0.02802299, 0.03399243, 0.03466543, 0.02829443,
0.03339476, 0.02129232, 0.03103367, 0.05071605, 0.03590172, 0.04386435, 0.03297124, 0.04323263, 0.03506247, 0.06225121, 0.02862442, 0.02862442,
0.06032925, 0.04400082, 0.03765090, 0.03477973, 0.02024540, 0.03564245, 0.05199116, 0.03699149, 0.03506247, 0.02129232, 0.02389752, 0.04996414,
0.04281258, 0.02587514, 0.03079668, 0.03895791, 0.02639014, 0.07333564, 0.02639014, 0.04074970, 0.04346211, 0.06032925, 0.03506247, 0.04950545,
0.04133673, 0.03835127, 0.02616212, 0.03399243, 0.02962473, 0.04800780, 0.03517160, 0.04105323, 0.03649472, 0.03000509, 0.05367187, 0.03858981,
0.03684529, 0.02941408, 0.04733265, 0.02590745, 0.02389752, 0.02385495, 0.03649472, 0.02508245, 0.02649659, 0.03152265, 0.02906310, 0.04950545,
0.03497815, 0.04374904, 0.03610649, 0.03799523, 0.02912771, 0.03694652, 0.05105353, 0.03000509, 0.02902378, 0.06425520, 0.05660319, 0.03065341,
0.04449069, 0.03638436, 0.02582273, 0.03753463, 0.02756006, 0.07215131, 0.02418869, 0.03431030, 0.04474425, 0.42589279, 0.02879489, 0.02872819,
0.02512494, 0.02450022, 0.03416346, 0.04560013, 1.40417366, 0.04784363, 0.04950545, 0.04685682, 0.03346052, 0.03255004, 0.07296053, 0.04491526,
0.02910482, 0.05448995, 0.01934736, 0.02195528, 0.03506247, 0.03157064, 0.03504810, 0.03754736, 0.03301058, 0.06886929, 0.03994190, 0.05130644,
0.21007323, 0.05630628, 0.02893721, 0.03683226, 0.03825290, 0.02494987, 0.02633410, 0.02721408, 0.03798986, 0.33473991, 0.04236406, 0.02389752,
0.03562747, 0.04662421, 0.02373767, 0.04918125, 0.04478894, 0.02418869, 0.03511514, 0.02871556, 0.05586166, 0.49014922, 0.03406339, 0.84823093,
0.03416346, 0.08729506, 0.03147210, 0.02889640, 0.06181828, 0.04940672, 0.03666858, 0.03019139, 0.03919279, 0.04864613, 0.03720420, 0.04726722,
0.04141298, 0.02862442, 0.29112744, 0.03964319, 0.05657445, 0.03930888, 0.04400082, 0.02722065, 0.03451685, 0.02911419, 0.02831578, 0.04001334,
0.05130644, 0.03134409, 0.03408579, 0.03232126, 0.03624218, 0.04708792, 0.06291741, 0.05663730, 0.03813209, 0.70582932, 0.04149421, 0.03607614,
0.03201109, 0.02055138, 0.03727305, 0.03182562, 0.02987404, 0.04142461, 0.03433624, 0.04264550, 0.02875086, 0.05797661, 0.04248705, 0.04476514))
From the data above, I obtain 22 peaks using pracma::findpeaks function with the code bellow:
picos_r <- pracma::findpeaks(-valores$V1, minpeakdistance = 10)
Using the MATLAB function
picos_matlab = findpeaks(-dado_r, 'MinPeakWidth', 10);
I obtain 11 peaks, as the following:
picos_matlab <- c(-0.02547804, -0.02618668, -0.01934736, -0.02182294, -0.0245572200000000, -0.0202454, -0.02385495, -0.01934736, -0.02373767, -0.02862442, -0.02722065)
I used pracma::findpeaks because it has already given an equal result in another part of the function that I am writting. I have already tried to change the code of the pracma::findpeaks, but with little success.
The package cardidates contains a heuristic peak hunting algorithm that can somewhat be fine-tuned using parameters xmax, minpeak and mincut. It was designed for a special problem, but may also used for other things. Here an example:
library("cardidates")
p <- peakwindow(valores$V1)
plot(p) # detects 14 peaks
p <- peakwindow(valores$V1, minpeak=0.18)
plot(p) # detects 11 peaks
Details are described in the package vignette and in https://doi.org/10.1007/s00442-007-0783-2
Another option is to run a smoother before peak detection.
I'm not sure what your test case is: -valores$V1, valores$V1, or -dado_r (what is that)?
I think pracma::findpeaks() does quite well if you do:
x <- valores$V1
P <- pracma::findpeaks(x,
minpeakdistance = 10, minpeakheight = sd(x))
plot(x, type = 'l', col = 4)
grid()
points(P[,2], P[, 1], pch=20, col = 2)
It finds 11 peaks that stick out while four or five others are too near to be counted. All the smaller ones (standard deviation) are being ignored.
I am trying to evaluate strings within a for loop within an R script using JuliaCall::julia_eval. While I was able to accomplish this in R using the deSolve package, I am running into issues when converting the code to one that is compatible with Julia. The base code for the correctly functioning R deSolve code is shown below.
library(deSolve)
library(dplyr)
Combine <- c(" - 1*0.4545*(H2O2^1) - 1*27000000*(`$OH`^1)*(H2O2^1)", " - 1*3100000000*(`1,4-dioxane`^1)*(`$OH`^1)",
" - 1*33000*(TOC^1)*(`$OH`^1)", "2*0.4545*(H2O2^1) - 1*3100000000*(`1,4-dioxane`^1)*(`$OH`^1) - 1*33000*(TOC^1)*(`$OH`^1) - 1*27000000*(`$OH`^1)*(H2O2^1) - 1*8500000*(`$OH`^1)*(`HCO3-`^1) - 1*390000000*(`$OH`^1)*(`CO3 2-`^1)",
" - 1*8500000*(`$OH`^1)*(`HCO3-`^1)", " - 1*390000000*(`$OH`^1)*(`CO3 2-`^1)"
)
time <- seq(from=0, to=0.01, by = 1E-4)
State <- c(H2O2 = 0.000294117647058824, `1,4-dioxane` = 0.00000113494,
TOC = 0, `$OH` = 0, `HCO3-` = 0.003766104, `CO3 2-` = 0.0000167638711956647)
ODEcreater2 <- function(t, state, parameters){
with(as.list(c(state)),{
for (i in 1:6) { #
dY[i] <- eval(parse(text=Combine[i]))}
return(list(dY))
} )}
out1<- ode(y = state, times = time, func = ODEcreater2, parms = NULL)
I am trying to use replicate the code and run it in Julia to improve the speed of the ODE solver by using diffeqr vs. deSolve. Unfortunately, I am running into evaluating the string/expression within a for loop in julia_call.
library(diffeqr)
diffeqr::diffeq_setup()
library(JuliaCall)
julia <- julia_setup()
ODEcreater <- JuliaCall::julia_eval("
function (dY,t,state)
for i in 1:6
dY[i] = eval(Meta.parse(:Combine[i]))
end
end")
tspan <- list(1E-6, 1E-3)
sol = diffeqr::ode.solve(ODEcreater,state,tspan, abstol=1e-8, reltol=1e-8)
Does anyone have any insight into the best way to evaluate the strings within the for loop? I have been investigating metaexpressions on the JuliaLang website but am still lost.
As mentioned in the duplicate question https://stackoverflow.com/a/58766919/1544203 , building the string and then doing
sprintf("function f(du,u,p,t)\n%s\nend", paste(Combine, collapse="\n"))
from the R side builds a single string which matches the format that works. This is also optimal since it excludes any extra function calls from the generated function.
from julia docs:
parse(str; raise=true, depwarn=true)
Parse the expression string greedily, returning a single expression. An error is thrown if there are additional
characters after the first expression. If raise is true (default), syntax errors will raise an error; otherwise, parse
will return an expression that will raise an error upon evaluation. If depwarn is false, deprecation warnings will be
suppressed.
julia> Meta.parse("x = 3")
:(x = 3)
so, Meta.parse accepts a string and returns an expression. this should evaluate correctly:
eval(Meta.parse(Combine[i]))
one problem i see is the use of non-valid julia variable names, like $OH
I am with this doubt, but honestly I do not know if the solution really exists in R.
I have a graph x/y, and I want to draw two straight lines, (1) from the x-axis to the data, and another (2) from the y-axis to the data. Line 1, I have the value of it, would be the tertile of my data. The question is, how to find the exact point at which the line intersects the given and plot by following the y-axis?
I have already tried, by the position of the x-axis, to use the same position for y. This even works for some data, but not all (since the values do not always match).
Here is my example
ob<-c(77.89824, 170.36929, 90.88129, 141.22368, 174.07871,
106.51393, 94.32576, 85.31712, 78.95808, 222.30143, 115.25760,
85.84704, 165.33504, 72.06912, 38.94912, 90.88129, 167.18976,
125.85600, 141.22367, 104.65922, 131.95009, 81.07777,
64.12032,130.36032, 89.29152, 65.97504, 40.27392, 64.38529,
113.40288)
tm<-c(38.94912, 40.27392, 64.12032, 64.38529, 65.97504, 72.06912,
77.89824, 78.95808, 81.07777, 85.31712, 85.84704, 89.29152,
90.88129, 94.32576, 104.65922, 106.51393, 113.40288, 115.25760,
125.85600, 130.36032, 131.95009, 141.22367, 141.22368, 165.33504,
167.18976, 170.36929, 174.07871)
bs<-c(0.96523390, 0.93066061, 0.89634466, 0.86213300, 0.82769878,
0.79311455, 0.75831596, 0.72311471, 0.68800759, 0.65245482,
0.61700818, 0.58163643, 0.51021060, 0.47393336, 0.43788203,
0.40203755, 0.36614804, 0.33059801, 0.29408090, 0.25820874,
0.22265365, 0.18803136, 0.15444785, 0.11931985, 0.08411248,
0.05098459, 0.01957279)
prc<-c(0.956974397, 0.914559074, 0.872836231, 0.831624652,
0.790544222, 0.749700646, 0.709038330, 0.668364230, 0.628275180,
0.588180704, 0.548730882, 0.509909531, 0.433282681, 0.395329802,
0.358306283, 0.322222487, 0.286868665, 0.252670119, 0.218461386,
0.185847964, 0.154593177, 0.125303855, 0.098121311, 0.071199383,
0.046104574, 0.024746731, 0.007529233)
plot(tm,bs,type="l",col="red")
lines(tm,prc,col="black")
tinf<-quantile(ob,prob=1/3)
tsup<-quantile(ob,prob=2/3)
idxinf<-which(tm>=(tinf-5) & tm<=(tinf+5))
infgrafico<-mean(prc[idxinf])
idxsup<-which(tm>=(tsup-5) & tm<=(tsup+5))
supgrafico<-mean(prc[idxsup])
segments(tinf,0.03, tinf,infgrafico,col='black',lty=3,lwd=1)
segments(min(tm),infgrafico,
tinf,infgrafico,col='black',lty=3,lwd=1)
text(tinf,cex=1,y=0,col="black",font=2,"T1")
segments(tsup,0.03, tsup,supgrafico,col='black',lty=3,lwd=1)
segments(min(tm),supgrafico,
tsup,supgrafico,col='black',lty=3,lwd=1)
text(tsup,cex=1,y=0,col="black",font=2,"T2")
But this is it, sometimes the values are not corresponding and are not found, causing the straight lines do not cross in the value of the data. And yes, I would need something more automated as possible, as I have to save those values on a table, and could not do it on the hand / trial and error one by one.
Thanks!
EDITED AFTER ONE ANSWER
TavoGLC or who wants, can you help in one more think? I have problems in some cases of my data.
tm <-c (54.05184, 67.29985, 70.86991, 78.42816, 80.84780, 80.54784, 80.81280, 81.8774, 89.82144, 89.82144, 90.81314, 90.35136, 92.20607, 92.47104, 97.50528, 97.77025, 99.09504, 99.88993, 100.41985, 100.94976, 101.74465, 102.27456, 105.45408 , 105.71905, 116.05248, 118.43713, 122.94144, 125.06112, NA)
prc <-c (0.9454304, 0.9604309, 0.9604309, 0.9608306, 0.9608306, 0.9608309, 0.9608309, 0.9608309, 0.9604309, 0.9605930, , 0.4163839, 0.3624935, 0.3041409, 0.2327866, 0.1079731, NA)
tercil <-89.821
plot (tm, prc, type = "l")
abline (v = 89.821, col = "red")
Considering that the line ('' abline (h = ...) '') has a very large range of location, when I do the procedure of "MakeLineCoords" obtaining values of "2.627424", not agreeing with my data (max=1). I have a series of tm and prc data of [360,181,29], this example above is one of the errors I have cut. But if you want I can send you the complete test data.
This is the adaptation I made to work here.
yTinf = array (NA, c (360,181,29))
xTinf = array (NA, c (360,181,29))
for (i in 1: 360) {
for (j in 1: 181)
for (k in 1:29)
yTinf [i, j, k] <- tercil [i, j, k]
xTinf [i, j, k] <- MakeLineCoords (prc [i, j,], tm [i, j,], yTinf [i, j, k])
}}}
Even so, it presents some values greater than 1 and some extrapolated, in the order of 2000 and 3000. Which from what I realized, it would be due to the above problem, where xTinf contains some correct values.
Thank you so much!
You just have to create a function that finds the closest point in the data and make an interpolation from that point.
MakeLineCoords <- function(Xvals,Yvals,targetPoint) {
x <- vector(mode="numeric", length=length(Yvals))
for(k in 1:length(Xvals)){
x[k]<-(Yvals[k]-targetPoint)^2
}
mL=which.min(x)
xVal=Xvals[mL]+(targetPoint-Yvals[mL])*((Xvals[mL+1]-Xvals[mL])/(Yvals[mL+1]-Yvals[mL]))
return(xVal)
}
Then you can define a target value to be found and create the coordinates for the lines in the plot.
yTarget<-0.25
xTarget<-MakeLineCoords(tm,bs,yTarget)
plot(tm,bs,type="l",col="red")
segments(xTarget,0.0,xTarget,yTarget,col='black',lty=3,lwd=1)
segments(min(tm),yTarget,xTarget,yTarget,col='black',lty=3,lwd=1)
By using your example data i get the following. Hope it helps
tinf<-quantile(ob,prob=1/3)
yTarget<-tinf
xTarget<-MakeLineCoords(bs,tm,yTarget)
plot(tm,bs,type="l",col="red")
segments(yTarget,0.0,yTarget,xTarget,col='black',lty=3,lwd=1)
segments(min(tm),xTarget,yTarget,xTarget,col='black',lty=3,lwd=1)
I'm writing a function in R to take a number and perform an operation on every row of the matrix. Each matrix should have 50 elements, ncol(x) is 50. Here's the calculation I'm performing
function(v1,v2){
a <- sum(v1*v2)
b <- sqrt(sum(v1*v1))* sqrt(sum(v2*v2))
return(a/b)
}
Here's a sample of my data:
the 0.41800 0.249680 -0.41242 0.121700 0.345270 -0.044457 -0.49688 -0.178620 -0.00066023 -0.656600 0.278430 -0.14767 -0.55677 0.14658 -0.0095095
. 0.15164 0.301770 -0.16763 0.176840 0.317190 0.339730 -0.43478 -0.310860 -0.44999000 -0.294860 0.166080 0.11963 -0.41328 -0.42353 0.5986800
of 0.70853 0.570880 -0.47160 0.180480 0.544490 0.726030 0.18157 -0.523930 0.10381000 -0.175660 0.078852 -0.36216 -0.11829 -0.83336 0.1191700
to 0.68047 -0.039263 0.30186 -0.177920 0.429620 0.032246 -0.41376 0.132280 -0.29847000 -0.085253 0.171180 0.22419 -0.10046 -0.43653 0.3341800
and 0.26818 0.143460 -0.27877 0.016257 0.113840 0.699230 -0.51332 -0.473680 -0.33075000 -0.138340 0.270200 0.30938 -0.45012 -0.41270 -0.0993200
in 0.33042 0.249950 -0.60874 0.109230 0.036372 0.151000 -0.55083 -0.074239 -0.09230700 -0.328210 0.095980 -0.82269 -0.36717 -0.67009 0.4290900`
Here's what I'm trying to write, it's pretty straightforward:
function(w,m) {
r=matrix(nrow=nrow(m),ncol=2)
for(i in 1:(nrow(m)-1)) {
r[i,1]=cosineSim(m[w,],m[i,])
}
r=sort(r,decending=TRUE)
return (r)
}
1)Create a new matrix with the same columns and rows as matrix m.
2)Loop through m-1 rows.
3)Each row, use cosineSim to compute the cosine similarity of the current vector (row) of the loop.
4)Once the end of the loop is finished, sort and return r which is the array holding the result.
The problem is that the algorithm seems to enter an infinite loop.
I need this to work for a project and would very much appreciate any help.
Thanks to the suggestion of TMin, I was able to realize the problem in my code. Also I figured out that it's not stuck in an infinite loop, rather scanning ~20M elements and taking a long time doing it.