Finding peaks with minimum peak width in R - similar to MATLAB function - r

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.

Related

R - graphics cross lines

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)

Reproduce OxMetrics' ARFIMA model in R

I am working to reproduce some results from OxMetrics (Ox Professional version 7.10) in R, but I am having a hard time figuring out exactly I get the right specification in R. I do not expect to get identical estimates, but somewhat similar estimates should be possible (see below for estimates from OxMetrics and from R).
Can anyone here help me figuring out how I do what OxMetrics does in R?
I've tried using forecast::arfima, forecast::Arima, fracdiff::fracdiff, and arfima::arfima So far I came closest with the latter.
Below is data and code,
The blow results is from is from OxMetrics ARFIMA(2,0,2) model estimated using Maximum likelihood and from R using arfima from the arfima package (code blow the longer data string).
OxMetrics R (using arfima()]
AR 1.41763 1.78547
AR -0.51606 -0.79782
MA -0.89892 -0.08406
MA 0.30821 0.48083
Constant -0.09382 -0.09423
y <- c(-0.0527281830620101, -0.0483283435220523,
-0.0761110069836706, -0.0425588714546148,
-0.0629789511239869, -0.118944956578757,
-0.156545103342326, -0.138106089421937,
-0.107335059908618, -0.145013381825552,
-0.100753517322066, -0.0987268545186417,
-0.0454663306471916, -0.0404439816954447,
-0.110574863632305, -0.0933955365797221,
-0.0915045759209185, -0.110397691370645,
-0.0944201704700927, -0.121257467376357,
-0.109785472344257, -0.0890776818684245,
-0.0554059943242384, -0.0700566531543618,
-0.0366694695635905, -0.0687369752462432,
-0.0651380598746858, -0.134224646388692,
-0.0670924768348229, -0.0835771023087037,
-0.0709997877276756, -0.116003735777656,
-0.0794873243023737, -0.067057402058551,
-0.0698663891865543, -0.0511133873895728,
-0.0513203609998669, -0.0894001277309737,
-0.0398284483421012, -0.0514468502511471,
-0.0599700163953942, -0.0661889418696937,
-0.079516218903545, -0.0685966077135509,
-0.0861445337428064, -0.0923966209966709,
-0.133444703431511, -0.131567692883267,
-0.127157375630663, -0.136327904368355,
-0.102133208996487, -0.109453799095327,
-0.103333580486325, -0.0982528240902063,
-0.139243862997714, -0.112067682286408,
-0.0741501704478233, -0.0885574830826608,
-0.0819203358523941, -0.0891168040724528,
-0.0331415164887199, -0.038039022334333,
0.000471320939768205, -0.0250547289467331,
-0.0411983586070352, -0.0463752713008887,
-0.0184870766950889, -0.0318185253129144,
-0.0623828610377037, -0.0718563679309012,
-0.0635702270765757, -0.0929728977267059,
-0.0894248292570765, -0.0919046741661464,
-0.0844700793317346, -0.112800098282505,
-0.141344968548085, -0.127965917566584,
-0.143980868315393, -0.154901662762077,
-0.130634570152671, -0.150417664726561,
-0.163723312802416, -0.146099566906346,
-0.14837251795191, -0.144887288973472,
-0.14232221415307, -0.142825446351853,
-0.158838097005599, -0.14340614330986,
-0.118935233992604, -0.109627188482776,
-0.120889714109902, -0.119484146944083,
-0.0950435556738212, -0.134667374330086,
-0.155051119642286, -0.134094795193097,
-0.128627607285988, -0.133954472488274,
-0.119286541395138, -0.135714339904381,
-0.0903767618937357, -0.109592987693797,
-0.0770998518949151, -0.108375176935532,
-0.136901231908067, -0.0856673865524131,
-0.108854388315838, -0.0708359081737591,
-0.106961434062811, -0.0429126711978416,
-0.0550592121225453, -0.0715845951018634,
-0.0509376225313689, -0.0570175197192393,
-0.0724229547086495, -0.0867303057832318,
-0.089712447506396, -0.125158029708487,
-0.122260116350003, -0.0905629436620448,
-0.090357598491857, -0.097173095034008,
-0.0674973361276239, -0.12411935716644,
-0.0957789729967162, -0.088838044599159,
-0.110065127067576, -0.108172925482296)
# install.packages(c("arfima"), dependencies = TRUE)
# library(arfima)
arfima::arfima(y, order = c(2, 0, 2))

The solution is to set the second parameter in the numeach option to 0, i.e
arfima::arfima(y, order = c(2, 0, 2), numeach = c(2, 0))
this controls the the number of starts for the fractional parameter.

Using inttrap and diff to get the length of a curve in Scilab

How can you get the length of the curve down below between 0 and 4*pi? The commands you should use are inttrap and diff. Here is what I have now:
t=linspace(0,4*%pi)
x=(4+sin(a*t)).*cos(3*t)
y=(4+sin(a*t)).*sin(3*t)
z=cos(3*t)
xx=diff(x)
yy=diff(y)
zz=diff(z)
aid=sqrt(xx^2+yy^2+zz^2)
length=inttrap([t],aid)
Getting error message, the last step is not right.

The reason for error message is that t and aid have different sizes. And that is because diff returns a vector with 1 entry fewer than the input. You can see how it works on an example: diff([3 1 5]) is [-2 4].
To fix this, use t(1:$-1), which omits the last entry of t. That is,
len = inttrap(t(1:$-1), aid)
(Please don't use length, which is a function name in Scilab.)
Another problem you have is that diff is just differences, not a derivative. To get the derivative, you need to divide by the step size, which in your case is t(2)-t(1).
Also, the syntax xx^2 is deprecated for elementwise power; use xx.^2 instead
t = linspace(0,4*%pi)
a = 1
x = (4+sin(a*t)).*cos(3*t)
y = (4+sin(a*t)).*sin(3*t)
z = cos(3*t)
step = t(2)-t(1)
xx = diff(x)/step
xy = diff(y)/step
xz = diff(z)/step
aid = sqrt(xx.^2+yy.^2+zz.^2)
len = inttrap(t(1:$-1), aid)

How can I get the value of this: product of (36^20-10000-i)/(36^20-i) when 0<i<10000?

I have to solve this:
www.wolframalpha.com/input/?i=product+(36^20-10000-i)%2F(36^20-i)%2C+i%3D0+to+1000000
, but the precision and computing time isn't enough. The best what I can solve is something like this: www.wolframalpha.com/input/?i=product+(36^5-10000-i)%2F(36^5-i)%2C+i%3D0+to+10000. I tried octave, but I'm newbie - the precision is bad.
The real problem behind the scenes:
I have a folder, with 10k files. The filename length is 20. The filename can contain uppercase char and number (thats 36). If I guess the filenames randomly (but never the same filename), what is the probability, that I dont hit any of the files after 1 million tries? (I know the file length is 20 and the used chars set)

Since i and even 10000+i are very small against 36^20=1.33674945388437e+31, even for i=10^6,
(36^20-10000-i)/(36^20-i)
=
(1-36^(-20)*(10000+i))/(1-36^(-20)*i)
is approximatively
1-36^(-20)*(10000+i-i)-36^(-40)*((10000+i)*i+i*i)
so the product for 10000 trials is
(1-36^(-20)*10000)^10000-(1-36^(-20)*10000)^9999*36^(-40)*10000^3
and the first term is about
exp(-36^(-20)*10^8) approx 1-7.48083342838978e-24,
the second is smaller 36^(-20)*10^8*(36^(-20)*10^4), and thus very small against the difference of 1 and the first term.
So the probability to hit an existing name is about 7.5*10^(-24).
For one million trials, nothing fundamental changes, only the power goes from 10^4 to 10^6 in
(1-36^(-20)*10000)^(10^6) approx 1-7.5*10^(-22)
so the probability to hit an existing filename is 100 times greater, but still essentially zero.
(enter Dr. Evil mode "one hundred billion ...")

Step 1: Simplify. When you're dividing a base to two different exponents, it's equal to the base raised to the difference of the exponents.
36^((20-10000-i)-(20-i)) = 36^(20-10000-i-20+i) = 36^10000
Step 1.5: Are you sure you're doing this right...?
Step 2: Realize this is going to be an enormous number, thousands of digits long.
Step 3: Use bc
$ bc
bc 1.06.95
Copyright 1991-1994, 1997, 1998, 2000, 2004, 2006 Free Software Foundation, Inc.
This is free software with ABSOLUTELY NO WARRANTY.
For details type 'warranty'.
36 ^ 10000
10592724396465553293085964452355445372969547823180171662872578059926\
96965911156849726207995688696363971580116588495264745415705767590893\
59900510534469588593053483482165044260338330279081478644076100645786\
99518840101487576866246095691788864386117382025967878499058855300489\
50946198489642917381262139909472914651440633506677357537369688375760\
90809440854763075012377414728771166205920636516277274073378199983331\
21444724275689426565782276032900420128046178416657151304900957497113\
51003984733153614959228590178788289544944296012159503030481409860125\
33716728092552367945381750481571255339264340936778611288799019269907\
39772516413442059762468001101693542210768066860298995372410073656878\
94289388087465159162077915079035608496531563838174605404321056838673\
52441003169720358821279147737643966950348948520149730835050332123606\
89212671641622293458295380143404774948380239883913431139871662869494\
95290213986738670843442524426623450403597181001293133499452545401820\
17262290776738798005327671960325012046990733842023592947435406895184\
07815980826485476732355209038460322004708884531310406332474490804778\
64204725680450234083427792775954133354328642751589614917084081472964\
30063919512934808668915373335047810847896652626741635465735307411093\
09248374332108959843325665728646081775081004611996518733703528436832\
87343198060662488623297128466146285053625407691961243679126688490501\
26173810509771787526942174139897963785480857355467755075823511068516\
19123453273441830897208890719301609708533455548147471134684407022646\
77837849922614701739362575811233937121473889442501732850475984131074\
21114019737821498890616338768204598344961798534009367698642682988704\
16964659113881270767876908447164491216660728471246068179473179290926\
53753940210265469450107856835628576809195867931822620898576362380959\
79811398872111906947849882882856758531688152228108651632627992998593\
47223966318806868814438523728163188406589912297750361695559443822343\
37067366105854365542370272400805664750964150758142996084854197451796\
03548519965249252394087402450556263884832489496207206838873868857399\
71258741971109839078626760253904250006111155245664463774582816484684\
63400226991785916989854747468535631241108531664255041599839752666294\
56133982123521178895752965516293160690140818004784374285782408712469\
54585840576657719294652554027701618393948299092685297407227531005392\
44136753953436752789396632926027172964423016766745569044080448944185\
09662376943457869533302845153322126643106635172663023070693594715984\
31724793172619932441551956176171732915113474684456206521846432798526\
09254763456220355161512305176683650500195733410760018080454692563986\
84860774050448534202384117470698549816646402867793210944955991954392\
91722473644586861426020074310599506467652233294951378820107072683010\
76435958492852576173332346352189973765310198395976176326452261843160\
80148026925354650701804978604996448356399698684699393833963795882606\
79284346670836258720490922109985220476393408343042807081948760410036\
73678552136599550920755387932606881570043110023341156159298187164621\
74842498276859940148561646737268550117802886031885759279336154407130\
40199998475047937086487952541092607974273669600977885264062013384585\
60312894079779502818429474594396899411162889037130293221971001344199\
57662859074190586262682709089801277674302972657717180512574487476375\
80994303339933384280671262475655135369506440889954894936645055133396\
04971480762876995822403308842668486240929103882378516037251122089981\
61249774516540323592368086295637896140801827763454850565169652630581\
56564425766032348264975487224260809625939782814597163718919732113352\
54578030181570534443470425556949981715500693522750384226768556933499\
49435817245205007794674083355182585197479738189251213260308094796246\
30544086029335471680163883480696301374560280547080159244636863977942\
34255666120128428779314839993192068840831717567852927924750254908924\
80235513895944597147656119157630296038394351287685501450426411433513\
90333561621235113193415832258840004435880998570844577577719494374906\
86865410267396224917712428470751764331416807484911412609171386758086\
67509694075757311732905653891462991205048067414481346484032618047696\
56176718125419217359165790771186522894378891669629142249673170937737\
51669923940500459381461811904679450756904652789903853315824772924464\
07586000184628778892765093959627396611710511603101300097267121006070\
19037168076882441146900024504164643115754041237858914217956591400428\
14467164942117593151622872084092991344244301573658944062350801861474\
96506818748733120914404220597893803307249931687086305562201948123352\
19013931826817742177890492972010613465940416265721821517304639423797\
83129414812517711573440735179526091508051887322618873723396313733004\
17472101266008105069867014946809105507231545076197631224188091332456\
85494088517409107101567716960563001814316420587665765052683848597425\
81606277573175472898591926920326277548603068631324433589179866919418\
36874547290421606040529720204948400492386733174781990394338080787559\
98325330078787388399464698713712846740142188786396387696120895799228\
82149743850419539967091428320428137701996653506791586726040041552042\
00164477040306205624725154712925597908895979089038543917806090126636\
49286952224289736664281572387818066756135750204986843426310840867953\
08244576344152481908380892823424714641838638205136270794218799662318\
02312538016377619427724632815335868118416354770438998955854349671358\
34145335459321914261321268649353889586599921061703279036490301734015\
75857430764891521822317463590163602136974458533417461530769605440486\
19156005631580767040142718793761745322846880168818051670012849374214\
67910825814171828104972853193262287243306804340454947714146714521911\
13602346295651754716969111471070278361740059601372353683507657976326\
44443711145007513849329101858958143786567531517590685469151484156959\
96912137396097141284956622360273186582615116898048553374372599349758\
43768899454973597534496137278250716698051359496585136596313413087485\
89198907910160363713445490366156021476879999625404274399638947258628\
19292167902372046012076775917786885230419063784381357367039430918083\
04988788382460260602071768816169165570659907030359246968435659363782\
45251729413267313116139930432655546022183957164703287368012116905745\
52695140205645562604071167842389257021594764165025083186272100946095\
89381432697549819299485316443138312071908859736798677765810586723434\
99658470099872030260776663357017095699639875038159921204762522112012\
70224041171484398234662775042239692298344964054231274075167487427687\
25801258757052371726391930399972818485280560800931024292462715894087\
36486777309273856997540889349306706064818578846306170015315861030258\
11677786336562917293543958637484515649414498384310517523037198319615\
57534396344917429451181994240791078967381960558768132745618282625660\
90785276728272093095015337724093281375722296016206787820771538207642\
53071848145272761680716125401409721562164153732503096808454337779056\
76756424827810623113750975599561642475316577612207869427294216416433\
90033975202122888045635520700190355748641461994576715227564547337455\
76727882392881391550825367242829434940904083110243675282922051863910\
85448557563169533219573765976474422602096118304954935470955805881587\
47106158031536127606457197472160340824946689761463632693449764672649\
04915606062134932760210249883202666439500845359706374058134200230898\
12889755931913455616027074354679029874000514981266148322307978807186\
77823559657108447188633027870165615153863839951694439399890764197075\
42521194327906278620400505048337449007325111689476086148785202727165\
15602863704969431988844410540131734553303910644298703394123062026517\
21321559550442576160479071737329771081335125291424234784133267496330\
35114037702071414202303080283587447856140360596721983204410842769678\
41549790342335100169665209438669121051711487205950160390767880407555\
01819886988018242088933477682997127986448980898936381418582161494234\
70582314802040717267946195408678236312795834495185035636045460961012\
14900239125200771946401472949036272204107043380890850080775721046035\
79340956543404075042033018733104228911171456011370593134686342699687\
63888857280243458058347567045863669245250925643557243286388972298132\
32016447430896577834331840573110013441406712695106001159379217144307\
27634991676472550745763857622080063554309599806975384120057774620700\
19821456068398358384213707715014484595413708214263182709404085183862\
84249012022046073525893904084860562562551872792193344042745306368127\
24031208834081135667460055605789484356810898711121572634639484541972\
35776517354621529231821522641110014957749314852732683216297297572985\
07505549131333908623998794654087769704320554463599751878882539607065\
70205070472068447798490399438967300018714192096990682920697144890230\
08418378555118804560893364696255249665357198904477225095365677208064\
55820243385970277952346346984418936816616927891637344815984463042630\
76929192247760457616259934821895211246688284028434467528292387292269\
61008116833909513747078992305708257055230791376350073260937402377382\
93199821488586819677747386920318928395493914745195682537290193930027\
95920610914952871903102416469569231594739343523860212988199812033319\
34274853337656960892656141336883200045770857884889004923388868840455\
67475180430839563156250199364560005819107646040331772452518181081560\
40567282891453104368902289436128561593891846423981522708502059086937\
80767168552502843682318129675623315654799318713113471462774667295589\
55478109142198455694260570772017903895032691742644617842061261512228\
17496984121425845593097876747500000896350847962823658432533892429692\
25349721716148552065897322706831397144054574043029104502315389368599\
38721093983715389459028016415122092283280489516339731008392195098479\
50023210728363291982514479347998408261634962058160387942424752362447\
76773211783656961717046973033866178128314056451468303051981228037639\
35271921765070805756965588639498380457036634198040221961237588598345\
31579956309613186832074613428420644253351086584569300437065464275201\
27309376738114186278437254335828256066824346541163130634115023467788\
58976637410777419919961873322787769792060768407763048615110878623880\
97915065846627224448774351049705849745463144103380379043372662745480\
17364084394145599580258842129432311341470748494266869639444789443367\
46995010158408457460194724161594045167887473956033680511170903571004\
13828560097835225247400499787631259727992706012426523905320809751984\
92550596319126488292801022213221860871125092665115835822215376993464\
36985953061005036810125924255692393773785146362251137203112425560043\
21220694275093259998206216244665259808607128127709254251105267819157\
24876524880477959973988344931418664629107455969275883517450236619675\
19909970846053080153329974043839853315391831622324148190306765801881\
47680540156503098091248094867009962416797626991602188144638560161122\
55526396274492637966932490900403111041864538884879861935139373716944\
81676653083165133769530661052690871112607693655310710109003013123608\
06572909177567626077267939276825693216864660497481268003082442496644\
17985431120565263665249374135767878094343818984126783502496841048531\
08497305398415036085821242994413180237403408769669912613368565097866\
05581247977918971942859737843550323282431233031628629451639765806865\
09744384816333238548436781826438628834399764250104133924447927137253\
13827310761991113410988948647822281327067208552174770882890792167868\
10034577717615770363921135450822946992866594105344623671790034485331\
97430071801783074648454387849184489935649322537738939361048200675874\
94291581315407063434780919933446824428534080015825042904903155265853\
79429475053780330688827677041047159659795296809733848901937867117403\
46031471050649694689551477170411875164170587523638687443594373618957\
15983142166332946057820517759736388035173704906538539015628611202572\
01790025211778031676784893084481047634903841950933371445596231678286\
89591442141608816660311489134115769154478400403524302196927588676245\
89430028766244884380392984005463729853876562602183160740649816144985\
67428138979390777313865011304035553656715756782239075085902454332775\
50351757358265499657079170476759072984991824841374177877847287525866\
50129475794909572490758834118568686590292882069896523841347169545872\
70076343995187534074477042611974105066487757756177953407618365213305\
86413993994576598683006510468733839687060971772864045546649337478994\
23083060632294502212599750859056417367356191744560085653085517103243\
96824783829185340999261754709574456735530919338719015941407596941598\
99593032437074680064401854056560817228764314319027703935695744892748\
24898423274332823790584968728779966351745394831631345084582512446186\
46769185419002312352841602438036567930096964216360732797580673745550\
00480647999979963788053018885460749951655871215383379538703892643881\
39396382964363370588383792276463404004445321486691376627739792159717\
88002344966726140135670367927342989576027415657841531123266095983543\
96992372541367313866392399569837183874633769600879163141380668441967\
04413121644527264878276892839489690261373869027654353645522203326921\
66631948200719438281124876158323400066191593006770458651049588422323\
14250898798281647316239746443304389131907018760693562525297296830814\
54093797459690146074556895402411502357986402965065988304516182203140\
71230346071282215620349440290186317240947960340799647807498036485168\
21828740936280733194896533090435412973143050238839473079030288519001\
04956062142708971413253251707808833734288541044786039255581803382825\
44633893652319221803856742291850901900695918407714701307300531918398\
65994676056810057621085233857787541973993754422331768782069962088209\
01979211433114275083440655570545025984793903365896477194157465933820\
16971445403969503023718089776726575731213280700946319104887528563409\
24393857692631684650129370176580574535573731991613379128250606531163\
98339548698002841552091128798745996101478536813498098761335154630828\
03472029300568934688988240184297641635074086008428652924089094355132\
74158350650635994357008023991220503165305293939298726905802670953959\
74687317661778641839126202159986275882937302937908530970607239009849\
23848115874701136100065494691978095705876879069486829768289888882975\
98998377203165430037994150935771185648572459615886679622356334448159\
96925224960244983155537376593984669583296143308310314704959395448411\
71978896821615782548214650116327904414112227988046322553245265021790\
69542321909579306907013771210805883803953587012737658451439458883263\
87640981171512065387314808093618502579610340906202311933906767822485\
94504249150445722433272564349098788322464892911136918025312169992850\
67514006779842500541688184888417085127659053403960061409252790409108\
93814863818951222845131127137831138422980630936661364749536354430129\
65886009787050382438691041024619242556997677945815375701911984739809\
15100479866087593224710715530390668549022881089423988622013431572603\
59238334920325468012737729213502313337508873289445003080471754192008\
03750514239014954575745629288564264490198803082622812461013998601043\
58208804373815976132017266037606373897266974996771935882580861385983\
62463674265103066800129498303951212409554057591321675481737669495462\
17347010862766598798694599810891054000903708859645901121958786977860\
42617558214916148167530305325679160902935806974747716225885181333708\
44750017393892649664686087678152934636861073335069008529000881685462\
71976547782910581539362973082619632714447642571084003324070083455631\
57763298170442755089939490660691771447337511691584803646413509830863\
54401022591001105987140738285441702444087463818234694891791196099435\
74471449996668489274742548359428935868012179561933913150380861280429\
30326802425977142091654193356989661935324429921190499181786509003404\
01596989165831248551581989990716614080948264090885901424420205462365\
89215453479632192544710026261032889069381981077024032140011643905343\
891534124566431071042824673625295228660308296372490260709376
Step 4: Ouch. Thousands of digits, though.

It appears that you are trying to evaluate this formula,
((N - m)! * (N - k)!) / ((N - m - k)! * N!)
where N = 36^20, m = 10^6, k = 10^4, and the notation x! means "the factorial of x".
Because you are taking factorials of such large numbers (all of the same order of magnitude as 36^20), Stirling's approximation -- http://mathworld.wolfram.com/StirlingsApproximation.html -- will be very accurate, and in your calculation you will be able to cancel out many of the terms, resulting in four terms that look like n^(n+1/2), which you can then reduce to three terms that look like p^(n+1/2) where p is very close to 1 and n is very large. I think in fact the base numbers are so close to 1 that you might use the approximation x for ln(1+x). (A closer approximation of ln(1+x) is possible by taking additional terms from the series ln(1+x) = x - (x^2)/2 + (x^3)/3 - (x^4)/4 + ... .)
This might be a good question for https://math.stackexchange.com/, as it seems the first thing you need to do is to find a more easily computed formula than you have.

Multivariate Optimization keeps returning same initial values

I have the code
INJ.1<-"I01 I02 I03 I04 I05
2.78E+02 1.82E+03 3.62E+02 2.90E+02 7.73E+02
7.92E+02 1.21E+03 9.33E+02 6.32E+02 5.10E+02
2.30E+03 7.54E+02 9.60E+02 6.29E+02 1.05E+03
3.61E+03 3.05E+02 7.77E+02 5.87E+02 1.02E+03
3.89E+02 1.35E+03 7.66E+02 4.00E+02 7.43E+02
1.31E+03 1.63E+03 8.95E+02 3.85E+02 1.10E+02
1.39E+03 1.16E+03 9.07E+02 4.99E+02 2.48E+02
1.94E+03 1.09E+03 8.34E+02 5.22E+02 2.48E+02
2.04E+03 1.11E+03 7.85E+02 2.67E+02 4.27E+02
1.06E+03 1.36E+03 8.80E+02 6.13E+02 7.16E+02
1.40E+03 1.29E+03 8.65E+02 6.17E+02 9.79E+02
1.20E+03 1.68E+03 6.78E+02 6.10E+02 9.30E+02
1.45E+03 1.49E+03 7.66E+02 3.81E+02 1.07E+03
1.16E+03 1.58E+03 1.09E+03 5.33E+02 8.38E+02
1.33E+03 1.38E+03 9.10E+02 6.29E+02 8.80E+02
"
INJ<-as.matrix(read.table(text=INJ.1, header=T))
PRD.1<-"P01
981.32019
1062.5702
1439.7673
1694.0723
1085.1016
1243.6089
1191.5941
1302.2167
1333.5266
1242.0212
1342.6954
1371.2767
1394.1171
1400.7926
1373.1791
"
PRD<-as.matrix(read.table(text=PRD.1, header=T))
tao=as.matrix(c(1,1,1,1,1))
lambda=as.matrix(c(0.0251879,0.1599486,0.1812318,0.2626731,0.3355733,0.3221295,-1.3343501))
i.dash=matrix(ncol=ncol(INJ), nrow=(nrow(INJ)))
fn1 <- function (tao){
for (i in 1:ncol(INJ))
for (j in 1:nrow (INJ))
temp=0
for (k in 1:j)
i.dash[j,i]=(1/tao[i])*exp((k-j)/tao[i])*INJ[k,i]+i.dash[j,i]
target = abs(700-sum(colSums(i.dash)))
}
ini=c(1, 1, 1, 1, 1)
ans1<-optim(par=ini,fn1,hessian=TRUE)
I need to optimize the values of tao as shown in the function. The code keeps giving the same initial values in in addition to that I noticed that the matrix calculation inside the function fn1 wasn't done. I have more than one question in addition to the main question which is how can I solve this case to achieve the min of o target:
Can we issue non calculation commands inside the function for example: assigning and creating matrices, vectors operations and manipulations..etc?
Are these changes going to be available after we exit the function?
In my case I am using the parameters values in some calculation firstly to prepare the objective function and then I do the optimization on them is that an acceptable approach in R?
I would like some one to give me as much as a starting point to start optimizing this function.

Resources