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)
Given an n*2 data matrix X I'd like to calculate the bivariate empirical cdf for each observation, i.e. for each i in 1:n, return the percentage of observations with 1st element not greater than X[i,1] and 2nd element not greater than X[i,2].
Because of the nested search involved it gets terribly slow for n ~ 100k, even after porting it to Fortran. Does anyone know if there's a better way of handling sample sizes like this?
Edit: I believe this problem is similar (in terms of complexity) to finding Kendall's tau, which is of order O(n^2). In that case Knight (1966) has an algorithm to reduce it to O(n log(n)). Just wondering if there's any O(n*log(n)) algorithm for finding bivariate ecdf already out there.
Edit 2: This is the code I have in Fortran, as requested. This is called in R in the usual way, so the R code is omitted here. The code is meant for arbitrary dimensions, but for the specific thing I'm doing a bivariate one is good enough.
! Calculates multivariate empirical cdf for each point
! n: number of observations
! d: dimension (>=2)
! umat: data matrix
! outvec: vector of ecdf
subroutine mecdf(n,d,umat,outvec)
implicit none
integer :: n, d, i, j, k, tempsum
double precision, dimension(n) :: outvec
double precision, dimension(n,d) :: umat
logical :: flag
do i = 1,n
tempsum = 0
do j = 1,n
flag = .true.
do k = 1,d
if (umat(i,k) < umat(j,k)) then
flag = .false.
exit
end if
end do
if (flag) then
tempsum = tempsum + 1
end if
end do
outvec(i) = real(tempsum)/n
end do
return
end subroutine
I think my first effort was not really an ecdf, although it did map the points to the interval [0,1] The example, a 25 x 2 matrix generated with:
#M <- matrix(runif(100), ncol=2)
M <-
structure(c(0.0468267474789172, 0.296053855214268, 0.205678076483309,
0.467400068417192, 0.968577065737918, 0.435642971657217, 0.929023026255891,
0.038406387437135, 0.304360694251955, 0.964778139721602, 0.534192910650745,
0.741682186257094, 0.0848641532938927, 0.405901980120689, 0.957696850644425,
0.384813814423978, 0.639882878866047, 0.231505588628352, 0.271994129288942,
0.786155494628474, 0.349499785574153, 0.279077709652483, 0.206662984099239,
0.777465222170576, 0.705439242534339, 0.643429880728945, 0.887209519045427,
0.0794123203959316, 0.849177583120763, 0.704594585578889, 0.736909110797569,
0.503158083418384, 0.49449566937983, 0.408533290959895, 0.236613316927105,
0.297427259152755, 0.0677345870062709, 0.623845702270046, 0.139933609170839,
0.740499466424808, 0.628097783308476, 0.678438259987161, 0.186680511338636,
0.339367639739066, 0.373212536331266, 0.976724133593962, 0.94558056560345,
0.610417427960783, 0.887977657606825, 0.663434249348938, 0.447939050383866,
0.755168803501874, 0.478974275058135, 0.737040047068149, 0.429466919740662,
0.0021107573993504, 0.697435079608113, 0.444197302218527, 0.108997165458277,
0.856855363817886, 0.891898229718208, 0.93553287582472, 0.991948011796921,
0.630414301762357, 0.0604106825776398, 0.908968194155023, 0.0398679254576564,
0.251426834380254, 0.235532913124189, 0.392070295521989, 0.530511683085933,
0.319339724024758, 0.534880011575297, 0.92030712752603, 0.138276003766805,
0.213625695323572, 0.407931711757556, 0.605797187192366, 0.424798395251855,
0.471233424032107, 0.0105366336647421, 0.625802840106189, 0.524665891425684,
0.0375960320234299, 0.54812005511485, 0.0105806747451425, 0.438266788609326,
0.791981092421338, 0.363821814302355, 0.157931488472968, 0.47945317090489,
0.906797411618754, 0.762243523262441, 0.258681379957125, 0.308056800393388,
0.91944490163587, 0.412255838746205, 0.347220918396488, 0.68236422073096,
0.559149842709303), .Dim = c(50L, 2L))
So the task is to do a single summation of a two-part logical test on N items which I suspect is O(N*3). It might be marginally faster if implemented in Rcpp, but these are vectorized operations.
# Wrong: ecdf2d <- function(m,i,j) { ord <- rank(m[ , 1]^2+m[ , 2]^2)
# ord[i]/nrow(m)} # scales to [0,1] interval
ecdf2d.v2 <- function(obj, x, y) sum( obj[,1] < x & obj[,2] < y)/nrow(obj)
I have the image and the vector
a = imread('Lena.tiff');
v = [0,2,5,8,10,12,15,20,25];
and this M-file
function y = Funks(I, gama, c)
[m n] = size(I);
for i=1:m
for j=1:n
J(i, j) = (I(i, j) ^ gama) * c;
end
end
y = J;
imshow(y);
when I'm trying to do this:
f = Funks(a,v,2)
I am getting this error:
??? Error using ==> mpower
Integers can only be combined with integers of the same class, or scalar doubles.
Error in ==> Funks at 5
J(i, j) = (I(i, j) ^ gama) * c;
Can anybody help me, with this please?
The error is caused because you're trying to raise a number to a vector power. Translated (i.e. replacing formal arguments with actual arguments in the function call), it would be something like:
J(i, j) = (a(i, j) ^ [0,2,5,8,10,12,15,20,25]) * 2
Element-wise power .^ won't work either, because you'll try to "stuck" a vector into a scalar container.
Later edit: If you want to apply each gamma to your image, maybe this loop is more intuitive (though not the most efficient):
a = imread('Lena.tiff'); % Pics or GTFO
v = [0,2,5,8,10,12,15,20,25]; % Gamma (ar)ray -- this will burn any picture
f = cell(1, numel(v)); % Prepare container for your results
for k=1:numel(v)
f{k} = Funks(a, v(k), 2); % Save result from your function
end;
% (Afterwards you use cell array f for further processing)
Or you may take a look at the other (more efficient if maybe not clearer) solutions posted here.
Later(er?) edit: If your tiff file is CYMK, then the result of imread is a MxNx4 color matrix, which must be handled differently than usual (because it 3-dimensional).
There are two ways I would follow:
1) arrayfun
results = arrayfun(#(i) I(:).^gama(i)*c,1:numel(gama),'UniformOutput',false);
J = cellfun(#(x) reshape(x,size(I)),results,'UniformOutput',false);
2) bsxfun
results = bsxfun(#power,I(:),gama)*c;
results = num2cell(results,1);
J = cellfun(#(x) reshape(x,size(I)),results,'UniformOutput',false);
What you're trying to do makes no sense mathematically. You're trying to assign a vector to a number. Your problem is not the MATLAB programming, it's in the definition of what you're trying to do.
If you're trying to produce several images J, each of which corresponds to a certain gamma applied to the image, you should do it as follows:
function J = Funks(I, gama, c)
[m n] = size(I);
% get the number of images to produce
k = length(gama);
% Pre-allocate the output
J = zeros(m,n,k);
for i=1:m
for j=1:n
J(i, j, :) = (I(i, j) .^ gama) * c;
end
end
In the end you will get images J(:,:,1), J(:,:,2), etc.
If this is not what you want to do, then figure out your equations first.
n<-NULL
acr<-NULL
while((is.numeric(n)==F) & (acr<0 ¦acr>1)){
print("enter a positive integer and the average cancellation rate you want")
try(n<-scan(what=integer(),nmax=1), silent=TRUE);
try(acr<-scan(what=double(),nmax=1), silent=TRUE)
}
I would want the users of my program to enter a positive integer which I store in "n" and the second
entry which I keep in "acr" is a probability so it lies between 0 and 1.
(I don't want it to be exacly 0 or 1, though it could be according to probability theory).
So I want the user to keep on doing the entry until they are able to enter a positive integer for "n" and a probability value between 0 and 1 for "acr".(using while with the AND, OR operators)
However, I am having a problem with the while statement/loop. I have tried all other possibilities such as the one below, but it still doesn't work.
while(is.numeric(n)==F & acr<0 ¦acr>1)
AGAIN:question 2
There is a problem with what=double() also in the scan function, I think.
I know that, for example, 0.5 is a double data type in other programming languages but
I cannot figure it out in R(I don't know what it is called in R).
what is the difference between integer() and double() in R? (I am not familiar with double)
I would be highly appreciative to anyone who could come to my aid.
many thanks to all.
Isaac Owusu
This following example should work. Please be aware that is.integer()
"does not test if ‘x’ contains
integer numbers! For that, use
‘round’, as in the function
‘is.wholenumber(x)’ in the examples"
(see help(is.integer)).
For that reason, I first define a new function is.wholenumber().
is.wholenumber <- function(x, tol = .Machine$double.eps^0.5){
abs(x - round(x)) < tol
}
n <- NULL
acr <- NULL
stay.in.loop <- TRUE
while(stay.in.loop){
print("Please insert n and acr!")
n <- readline("Insert n: ")
acr <- readline("Insert acr: ")
n <- as.numeric(n)
acr <- as.numeric(acr)
## stay.in.loop is true IF any of the expressions is NOT TRUE
stay.in.loop <- !(is.wholenumber(n) & ((0 < acr) & (acr < 1)))
}
NULL may be a bad initialization here, as its comparison does not give a regular boolean. Since the condition is that n should be positive, try this:
n <- -2
acr <- -2
while((n<=0) | (acr<0) | (acr>1)) {
print("enter a positive integer and the average cancellation rate you want")
try(n<-scan(what=integer(),nmax=1), silent=TRUE);
try(acr<-scan(what=double(),nmax=1), silent=TRUE);
}
In the below snippet, please explain starting with the first "for" loop what is happening and why. Why is 0 added, why is 1 added in the second loop. What is going on in the "if" statement under bigi. Finally explain the modPow method. Thank you in advance for meaningful replies.
public static boolean isPrimitive(BigInteger m, BigInteger n) {
BigInteger bigi, vectorint;
Vector<BigInteger> v = new Vector<BigInteger>(m.intValue());
int i;
for (i=0;i<m.intValue();i++)
v.add(new BigInteger("0"));
for (i=1;i<m.intValue();i++)
{
bigi = new BigInteger("" + i);
if (m.gcd(bigi).intValue() == 1)
v.setElementAt(new BigInteger("1"), n.modPow(bigi,m).intValue());
}
for (i=0;i<m.intValue();i++)
{
bigi = new BigInteger("" + i);
if (m.gcd(bigi).intValue() == 1)
{
vectorint = v.elementAt(bigi.intValue());
if ( vectorint.intValue() == 0)
i = m.intValue() + 1;
}
}
if (i == m.intValue() + 2)
return false;
else
return true;
}
Treat the vector as a list of booleans, with one boolean for each number 0 to m. When you view it that way, it becomes obvious that each value is set to 0 to initialize it to false, and then set to 1 later to set it to true.
The last for loop is testing all the booleans. If any of them are 0 (indicating false), then the function returns false. If all are true, then the function returns true.
Explaining the if statement you asked about would require explaining what a primitive root mod n is, which is the whole point of the function. I think if your goal is to understand this program, you should first understand what it implements. If you read Wikipedia's article on it, you'll see this in the first paragraph:
In modular arithmetic, a branch of
number theory, a primitive root modulo
n is any number g with the property
that any number coprime to n is
congruent to a power of g (mod n).
That is, if g is a primitive root (mod
n), then for every integer a that has
gcd(a, n) = 1, there is an integer k
such that gk ≡ a (mod n). k is called
the index of a. That is, g is a
generator of the multiplicative group
of integers modulo n.
The function modPow implements modular exponentiation. Once you understand how to find a primitive root mod n, you'll understand it.
Perhaps the final piece of the puzzle for you is to know that two numbers are coprime if their greatest common divisor is 1. And so you see these checks in the algorithm you pasted.
Bonus link: This paper has some nice background, including how to test for primitive roots near the end.