如何使用迭代方法计算产品模型的分位数?

时间:2015-02-10 12:40:47

标签: product

我有一个独立的随机变量,函数为f1(x)f2(x)

我已经计算了两个命名函数的概率密度函数(pdf)和累积分布函数(cdf)。

我的问题是我想用R中的Newton Raphson方法计算上述两个函数的分位数?

pdf1= pdf of f1(x)

pdf2=pdf of f2(x)

cdf1= cdf of f1(x)

cdf2= cdf of f2(x)

因此,对于不同的x值,我想迭代地计算两个方程(f1(x)f2(x))的分位数。

1 个答案:

答案 0 :(得分:1)

最后,我成功地使用Newton Raphson方法找到了产品模型的分位数。这是R脚本。

 # | ------------------------------------------------------------------------------------------------------------------------------------------
    # | The CDF and PDF functions for product models. My original data is well fitted to Persoan Type-3
    # | From the diffination  of Quantiles we set our F(x) and derivatives of F(x) as follow:
    # | Q(p)= { x:Pr(X<=x)=p } or equivalently ;  Q(p)= { x:Pr(X<=x)- p =0 } --------- > (1)
    # | CDF1 = F1(x) ---------------------------------------------------------------- >> (2) 
    # | CDF2 = F2(x) ---------------------------------------------------------------- >> (3) 
    # | PDF1 = f1(x) ---------------------------------------------------------------- >> (4)
    # | PDF2 = f2(x) ---------------------------------------------------------------- >> (5)
    # | Using the above five  model equations I  want to calculate quantils for the given probability values.
    # | This lead Us to Newton-Raphson algorithm ;(Newton Method leads to the recurrence)  
    # | # | Qx+1 = X[k]- F(x)-prob/F'(x) ------------------------------------------------- >>> (6)
    # | Where ;;
    # | F(x)  = F1(x) *F2(x) - prob = 0 ,,,,,  the CDF function -------------------- >>> (7)
    # | F'(x) = f1(x)*F2(x) + f2(x)*F1(x) ,,,,, the PDF function ------------------ >>>> (8)
    # | prob=c(0.5,0.65,0.70,0.75,0.80,0.85,0.90,0.95,0.998,0.999)
    # | 
    # | -----------------------------------------------------------------------------------------------------------------------------------------
    rm(list=ls())
    Sys.setenv(LANGUAGE="en")  # to set languege from Polish to English
    setwd("C:/Users/sdebele/Desktop/From_oldcomp/Old_Computer/Seasonal_APP/Data/Data_Winter&Summer")
    options(digits=3)
    # | -----------------------------------------------------------------------------------------------------------------------
    # | --------------------------------------------------------------------------------->
    # | --------------------------------------------------------------------------------->
    # | -------------------------------------------------------------------------------------------------------------------------
    Fx=function(x) # Equation (7) # ! Evaluate function at old estimate
    {

      require(PearsonDS)
      return(ppearsonIII(x,shape= 1.467206 , location = 10.4508367, scale=48.77482)*
               ppearsonIII(x,shape= 1.006451 , location = 9.43  ,  scale= 28.68731));
    }
    dFx=function(x) # Equation (8) # ! Evaluate derivative at old estimate
    {
      require(PearsonDS) 
      return((dpearsonIII(x,shape= 1.467206 , location = 10.4508367, scale=48.77482))*
               (ppearsonIII(x,shape= 1.006451 , location = 9.43  ,  scale= 28.68731)) +
               (dpearsonIII(x,shape= 1.006451 , location = 9.43  ,  scale= 28.68731))*
               ppearsonIII(x,shape= 1.467206 , location = 10.4508367, scale=48.77482));
    }
    # | ------------------------------------------------------------------------------------------------------------------------------------
    # |Defining Parameters for Newton-Raphson algorithm and while loop 
    # | 
    # | --------------------------------------------------------------------------------------------------------------------------------------
    prob=c(0.5,0.65,0.75,0.80,0.85,0.90,0.95,0.99,0.998,0.999)
    par(mfrow=c(1,2))
    par("lwd"=2)
    curve(dFx,from=9,to=300,col="red",lwd=2);
    Harasiuki.x=curve(Fx,from=9,to=300,col="blue",lwd=2);
    xx=Harasiuki.x$x
    write.table(xx, "Harasiuki.x.txt", sep="\t")
    start<-locator(n=1)$x;
    col=rainbow(20)
    x.new<-NULL;
    x.new<-cbind(x.new,start);
    n=1;
    niter=1 ; #  ! Number of iterations
    niter_max = 100; #  ! Maximum of iterations allowed
    # | --------------------------------------------------------------------------------------------------------------------------
    # | Here we start calculating quantiles  
    # | 
    # | -----------------------------------------------------------------------------------------------------------------------
    for( i in 1:length(prob))
    {
      options(digits=3)
      while(niter < niter_max)

      {

        Fx=function(x) # Equation (7) # ! Evaluate function at old estimate
        {

          require(PearsonDS)
          return((ppearsonIII(x,shape= 1.467206 , location = 10.4508367, scale=48.77482)*
                    ppearsonIII(x,shape= 1.006451 , location = 9.43  ,  scale= 28.68731))-prob[i]);
        }
        dFx=function(x) # Equation (8) # ! Evaluate derivative at old estimate
        {
          require(PearsonDS) 
          return((dpearsonIII(x,shape= 1.467206 , location = 10.4508367, scale=48.77482))*
                   (ppearsonIII(x,shape= 1.006451 , location = 9.43  ,  scale= 28.68731)) +
                   (dpearsonIII(x,shape= 1.006451 , location = 9.43  ,  scale= 28.68731))*
                   ppearsonIII(x,shape= 1.467206 , location = 10.4508367, scale=48.77482));
        }
        # | -------------------------------------------------------------------------------------------------------------------------------------
        # | A function of the Newton-Raphson algorithm to calculate quantiles of product model
        # | Description : Applies the Newton-Raphson algorithm to find x such that Qx+1 = X[k]- F(x)/F'(x) == 0.
        # | Returns the value of x at which Qx+1 = X[k]- F(x)/F'(x) == 0.
        # | --------------------------------------------------------------------------------------------------------------------------------
        Newton.Raphson <-function(Fx,dFx,x) # Equation (6)
        {

          if (abs(dFx(x))<10*.Machine$double.eps)
          {
            return (x);
          } else
          {
            return(x-Fx(x)/dFx(x)); # ! Calculate new estimate
          }
        }
        n=n+1
        x.new<-c(x.new,Newton.Raphson(Fx,dFx,x.new[n-1]));
        abline(a=Fx(x.new[n])-dFx(x.new[n])*x.new[n],b=dFx(x.new[n]),col=col[n-1]);
        if(abs(x.new[n]-x.new[n-1])<100*.Machine$double.eps) break;
        niter = niter+1 ;
        # | ============================================================================================================================
        Sys.sleep(1)
      }
      # | ============================================================================================================================
      print(paste("============================================= Probability",prob[i],"========================================="))  
      print(paste("doing step======>",i,"=====number of iteration====>",niter,"====Probability====>",prob[i],"===Quantile=====>",round(x.new,digits=3)))

      x.new<-cbind(round(x.new,digits=3));  

      # x.new<-cbind(x.new);

    }