[R] Running the Loop

[arun]

Hi Katherine,Not sure if this helps.  I was able to the result after making up some additional conditions into your function.

fun1 <- function(x){
    lst1 <- lapply(seq(n-1),function(i){
         with(x,if(maturity_period >D[i] & maturity_period <D[i+1]){
            data.frame(N1=paste(curve,T[i],sep="_"),N2=paste(curve,T[i+1],sep="_"),PV1=mtm*root,PV2=(mtm)*(1-root))
                                }
           else if(maturity_period < D[i]) {
             data.frame(N1=paste(curve,T[i],sep="_"),N2=paste(curve,T[i],sep="_"),PV1=mtm,PV2=0)
                        }
          else if(maturity_period >D[i+1]) {
            data.frame(N1=paste(curve,T[i],sep="_"),N2=paste(curve,T[i],sep="_"),PV1=0,PV2=mtm)
                        }
                   )
                }
                )
    dat2 <- cbind(id=x$id,do.call(rbind,lst1))
            indx <- with(dat2,PV1!=0 & PV2!=0)  
    dat2New<- if(!any(indx)){
      dat2[1,]
        }
        else dat2[indx,]
    colnames(dat2New)[-1] <-paste0(paste0("Risk_factor",rep(1:2,2)),rep(c("","_mtm"),each=2))
        dat2New
       }             

 ddply(dat,.(id),fun1)
#  id Risk_factor1 Risk_factor2 Risk_factor1_mtm Risk_factor2_mtm
#1  1       USD_1m       USD_1m             1000                0
#2  2       USD_3m       USD_6m             2000             8000
#3  3      USD_12m      USD_5yr            74000            26000

A.K.







On Tuesday, February 4, 2014 7:22 AM, Katherine Gobin <katherine_gobin at yahoo.com> wrote:
Dear R forum,

I have following data.frames

dat = data.frame(id = c(1:3), root = c(0.10, 0.20, 0.74), maturity_period = c(20, 155, 428), mtm = c(1000, 10000, 100000), curve = c("USD", "USD", "USD"))


> dat
  id root maturity_period   mtm curve
1  1 0.10              20 1e+03   USD
2  2 0.20             155 1e+04   USD
3  3 0.74             428 1e+05   USD

standard_tenors = data.frame(T = c("1m", "3m", "6m", "12m", "5yr"), D = c(30, 91, 182, 365, 1825))


> standard_tenors
    T    D
1  1m   30
2  3m   91
3  6m  182
4 12m  365
5 5yr 1825

# .................................................................................................................

library(plyr)


T = standard_tenors$T

D = standard_tenors$D
n = length(standard_tenors$T)


mtm_split_function = function(maturity_period, curve, root, mtm)

{

for(i in 1:(n-1))
{
if (maturity_period < D[i])


{
N1 = paste(curve, T[i], sep ="_")
N2 = paste(curve, T[i], sep ="_")
PV1 = mtm
PV2 = 0
}else

if (maturity_period > D[i] & maturity_period < D[i+1])

{
N1 = paste(curve, T[i], sep ="_")
N2 = paste(curve, T[1+1], sep ="_")
PV1 = (mtm)*root
PV2 = (mtm)*(1-root)
}else

if (maturity_period > D[i+1])
{
N1 = paste(curve, T[i], sep ="_")
N2 = paste(curve, T[i], sep ="_")
PV1 = 0
PV2 = mtm
}

}


return(data.frame(Risk_factor1 = N1, Risk_factor2 = N2, Risk_factor1_mtm = PV1,
Risk_factor2_mtm = PV2))
}

# .....................................................................................................................

splitted_mtm <- ddply(.data = dat, .variables = "id",
                .fun=function(x) mtm_split_function(maturity_period = x$maturity_period, curve = x$curve, root = x$root, mtm = x$mtm))

# OUTPUT I am getting

  id Risk_factor1 Risk_factor2 Risk_factor1_mtm Risk_factor2_mtm
1  1      USD_12m      USD_12m             1000                0
2  2      USD_12m      USD_12m            10000                0
3  3      USD_12m       USD_3m            74000            26000




# My PROBLEM

However, My OUTPUT should be  

  id Risk_factor1 Risk_factor2 Risk_factor1_mtm Risk_factor2_mtm
1  1      USD_1m       USD_1m             1000                0
2  2      USD_3m       USD_6m             2000             8000
3  3      USD_12m      USD_5yr           74000            26000

Kindly guide

With warm regards

Katherine
    [[alternative HTML version deleted]]

______________________________________________
R-help at r-project.org 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.