(no subject)

[li li-13]

Dear all,
    Can anyone take a look at my program below?
There are two functions: f1 (lambda,z,p1) and f2(p1,cl, cu).
I fixed p1=0.15 for both functions. For any fixed value of lambda (between
0.01 and 0.99),
I solve f1(p1=0.15, lambda=lambda, z)=0 for the corresponding cl and cu
values.
Then I plug the calculated cl and cu back into the function f2.
Eventually, I want to find the lambda value and the corresponding cl and cu
values that would
make f2=0.1.
   The result of this program does not seem to match the answer I have. Can
some one give me
some hint? Thank you very much.
            Hannah



u1 <- -3

u2 <- 4


f1 <- function(lambda,z,p1){

lambda*(p1*exp(u1*z-u1^2/2)+(0.2-p1)*exp(u2*z-u2^2/2))-(1-lambda)*0.8}


f2 <- function(p1,cl, cu){

 0.8*(pnorm(cl)+(1-pnorm(cu)))/(0.8*(pnorm(cl)+(1-pnorm(cu)))+p1*(pnorm(cl-
u1)+(1-pnorm(cu-u1)))+(0.2-p1)*(pnorm(cl-u2)+(1-pnorm(cu-u2))))}


p1 <- 0.15


lam <- seq(0.01,0.99, by=0.001)

x1 <- numeric(length(lam))


for (i in 1:length(lam)){



cl <- uniroot(f1, lower =-10, upper = 0,

           tol = 1e-10,p1=p1,lambda=lam[i])$root


cu <- uniroot(f1, lower =0, upper = 10,

           tol = 1e-10,p1=p1,lambda=lam[i])$root



x1[i]<- f2(p1=p1, cl=cl, cu=cu) }



k <- 1

while(k<length(lam) && x1[k]<=0.1){

    k=k+1

  }

  k<-k-1;k



lower <- uniroot(f1, lower =-10, upper = 0,

           tol = 1e-10,p1=p1,lambda=lam[k])$root


upper <- uniroot(f1, lower =0, upper = 10,

           tol = 1e-10,p1=p1,lambda=lam[k])$root




res <- c(lower, upper)

        [[alternative HTML version deleted]]

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.

[stephen sefick-2]

Please include a meaningful 'Subject' because these conversations are
archived, and serve as a valuable help resource for the community.  I
don't believe I understand what you want.

Stephen

On 09/11/2011 03:32 PM, li li wrote:

> Dear all,
>      Can anyone take a look at my program below?
> There are two functions: f1 (lambda,z,p1) and f2(p1,cl, cu).
> I fixed p1=0.15 for both functions. For any fixed value of lambda (between
> 0.01 and 0.99),
> I solve f1(p1=0.15, lambda=lambda, z)=0 for the corresponding cl and cu
> values.
> Then I plug the calculated cl and cu back into the function f2.
> Eventually, I want to find the lambda value and the corresponding cl and cu
> values that would
> make f2=0.1.
>     The result of this program does not seem to match the answer I have. Can
> some one give me
> some hint? Thank you very much.
>              Hannah
>
>
>
> u1<- -3
>
> u2<- 4
>
>
> f1<- function(lambda,z,p1){
>
> lambda*(p1*exp(u1*z-u1^2/2)+(0.2-p1)*exp(u2*z-u2^2/2))-(1-lambda)*0.8}
>
>
> f2<- function(p1,cl, cu){
>
>   0.8*(pnorm(cl)+(1-pnorm(cu)))/(0.8*(pnorm(cl)+(1-pnorm(cu)))+p1*(pnorm(cl-
> u1)+(1-pnorm(cu-u1)))+(0.2-p1)*(pnorm(cl-u2)+(1-pnorm(cu-u2))))}
>
>
> p1<- 0.15
>
>
> lam<- seq(0.01,0.99, by=0.001)
>
> x1<- numeric(length(lam))
>
>
> for (i in 1:length(lam)){
>
>
>
> cl<- uniroot(f1, lower =-10, upper = 0,
>
>             tol = 1e-10,p1=p1,lambda=lam[i])$root
>
>
> cu<- uniroot(f1, lower =0, upper = 10,
>
>             tol = 1e-10,p1=p1,lambda=lam[i])$root
>
>
>
> x1[i]<- f2(p1=p1, cl=cl, cu=cu) }
>
>
>
> k<- 1
>
> while(k<length(lam)&&  x1[k]<=0.1){
>
>      k=k+1
>
>    }
>
>    k<-k-1;k
>
>
>
> lower<- uniroot(f1, lower =-10, upper = 0,
>
>             tol = 1e-10,p1=p1,lambda=lam[k])$root
>
>
> upper<- uniroot(f1, lower =0, upper = 10,
>
>             tol = 1e-10,p1=p1,lambda=lam[k])$root
>
>
>
>
> res<- c(lower, upper)
>
> [[alternative HTML version deleted]]
>
> ______________________________________________
> [hidden email] mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.

[Jean-Christophe BOUËTTÉ]

Hello,
you would get more answers if you code had proper indentation and comments.
Also, please provide a meaningful topic. You should also explain how
this is an R question and not just a "debug my code" request. What are
are you trying to achieve? Which of the numerous variables you
declared should we look at? What was the result you expected and what
did you get?

JC

2011/9/11 li li <[hidden email]>:

> Dear all,
>    Can anyone take a look at my program below?
> There are two functions: f1 (lambda,z,p1) and f2(p1,cl, cu).
> I fixed p1=0.15 for both functions. For any fixed value of lambda (between
> 0.01 and 0.99),
> I solve f1(p1=0.15, lambda=lambda, z)=0 for the corresponding cl and cu
> values.
> Then I plug the calculated cl and cu back into the function f2.
> Eventually, I want to find the lambda value and the corresponding cl and cu
> values that would
> make f2=0.1.
>   The result of this program does not seem to match the answer I have. Can
> some one give me
> some hint? Thank you very much.
>            Hannah
>
>
>
> u1 <- -3
>
> u2 <- 4
>
>
> f1 <- function(lambda,z,p1){
>
> lambda*(p1*exp(u1*z-u1^2/2)+(0.2-p1)*exp(u2*z-u2^2/2))-(1-lambda)*0.8}
>
>
> f2 <- function(p1,cl, cu){
>
>  0.8*(pnorm(cl)+(1-pnorm(cu)))/(0.8*(pnorm(cl)+(1-pnorm(cu)))+p1*(pnorm(cl-
> u1)+(1-pnorm(cu-u1)))+(0.2-p1)*(pnorm(cl-u2)+(1-pnorm(cu-u2))))}
>
>
> p1 <- 0.15
>
>
> lam <- seq(0.01,0.99, by=0.001)
>
> x1 <- numeric(length(lam))
>
>
> for (i in 1:length(lam)){
>
>
>
> cl <- uniroot(f1, lower =-10, upper = 0,
>
>           tol = 1e-10,p1=p1,lambda=lam[i])$root
>
>
> cu <- uniroot(f1, lower =0, upper = 10,
>
>           tol = 1e-10,p1=p1,lambda=lam[i])$root
>
>
>
> x1[i]<- f2(p1=p1, cl=cl, cu=cu) }
>
>
>
> k <- 1
>
> while(k<length(lam) && x1[k]<=0.1){
>
>    k=k+1
>
>  }
>
>  k<-k-1;k
>
>
>
> lower <- uniroot(f1, lower =-10, upper = 0,
>
>           tol = 1e-10,p1=p1,lambda=lam[k])$root
>
>
> upper <- uniroot(f1, lower =0, upper = 10,
>
>           tol = 1e-10,p1=p1,lambda=lam[k])$root
>
>
>
>
> res <- c(lower, upper)
>
>        [[alternative HTML version deleted]]
>
> ______________________________________________
> [hidden email] mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.

[Berend Hasselman]

li li-13 wrote

Dear all,
    Can anyone take a look at my program below?
There are two functions: f1 (lambda,z,p1) and f2(p1,cl, cu).
I fixed p1=0.15 for both functions. For any fixed value of lambda (between
0.01 and 0.99),
I solve f1(p1=0.15, lambda=lambda, z)=0 for the corresponding cl and cu
values.
Then I plug the calculated cl and cu back into the function f2.
Eventually, I want to find the lambda value and the corresponding cl and cu
values that would
make f2=0.1.
   The result of this program does not seem to match the answer I have. Can
some one give me
some hint? Thank you very much.
            Hannah



u1 <- -3

u2 <- 4


f1 <- function(lambda,z,p1){

lambda*(p1*exp(u1*z-u1^2/2)+(0.2-p1)*exp(u2*z-u2^2/2))-(1-lambda)*0.8}


f2 <- function(p1,cl, cu){

 0.8*(pnorm(cl)+(1-pnorm(cu)))/(0.8*(pnorm(cl)+(1-pnorm(cu)))+p1*(pnorm(cl-
u1)+(1-pnorm(cu-u1)))+(0.2-p1)*(pnorm(cl-u2)+(1-pnorm(cu-u2))))}


p1 <- 0.15


lam <- seq(0.01,0.99, by=0.001)

x1 <- numeric(length(lam))


for (i in 1:length(lam)){



cl <- uniroot(f1, lower =-10, upper = 0,

           tol = 1e-10,p1=p1,lambda=lam[i])$root


cu <- uniroot(f1, lower =0, upper = 10,

           tol = 1e-10,p1=p1,lambda=lam[i])$root



x1[i]<- f2(p1=p1, cl=cl, cu=cu) }



k <- 1

while(k<length(lam) && x1[k]<=0.1){

    k=k+1

  }

  k<-k-1;k

lower <- uniroot(f1, lower =-10, upper = 0,

           tol = 1e-10,p1=p1,lambda=lam[k])$root

upper <- uniroot(f1, lower =0, upper = 10,

           tol = 1e-10,p1=p1,lambda=lam[k])$root

res <- c(lower, upper)

You should follow the advice of the previous repliers: meaningful subject, properly formatted code and a clear description of what you expect and what you are getting.

Since I can't resist the temptation.

Method 1:
-----------

u1 <- -3
u2 <- 4

f1 <- function(lambda,z,p1){  lambda*(p1*exp(u1*z-u1^2/2)+(0.2-p1)*exp(u2*z-u2^2/2))-(1-lambda)*0.8 }

f2 <- function(p1,cl, cu){
    0.8*(pnorm(cl)+(1-pnorm(cu)))/(0.8*(pnorm(cl)+(1-pnorm(cu)))+p1*(pnorm(cl- u1)+
    (1-pnorm(cu-u1)))+(0.2-p1)*(pnorm(cl-u2)+(1-pnorm(cu-u2))))
}

p1 <- 0.15
lam <- seq(0.01,0.99, by=0.001)

df.c <- data.frame(cl=numeric(length(lam)),cu=numeric(length(lam)))

for (i in 1:length(lam)){
    cl <- uniroot(f1, lower =-10, upper = 0, tol = 1e-10,p1=p1,lambda=lam[i])$root
    cu <- uniroot(f1, lower =0, upper = 10,  tol = 1e-10,p1=p1,lambda=lam[i])$root
    df.c[i,"cl"] <- cl
    df.c[i,"cu"] <- cu
}

x1 <- f2(p1=p1,cl=df.c[,"cl"], cu=df.c[,"cu"])    
df.c[,"x1"] <- x1

df.c

# find the index for which the deviation from the target value 0.1 is smallest
x.minidx <- which.min(abs(x1-.1))
x.minidx
x1[x.minidx]

Method 2:
------------
But why so complicated? You want a lambda that makes f2 as close as possible to .1.

Define a target function  with one argument lambda

target <- function(lambda) {
    cl <- uniroot(f1, lower =-10, upper = 0, tol = 1e-10,p1=p1,lambda=lambda)$root
    cu <- uniroot(f1, lower =0, upper = 10,  tol = 1e-10,p1=p1,lambda=lambda)$root
    f2(p1=p1, cl=cl, cu=cu) - 0.1
}

and solve for lambda as follows

res <- uniroot(target, lower=0.01, upper=0.99)
res
lambda <- res$root

# Show some results

cl <- uniroot(f1, lower =-10, upper = 0, tol = 1e-10,p1=p1,lambda=lambda)$root
cu <- uniroot(f1, lower =0, upper = 10,  tol = 1e-10,p1=p1,lambda=lambda)$root
f2(p1=p1, cl=cl, cu=cu)

This is more accurate than Method 1.

/Berend