vaBSgreeks <- function(S0, K, r, d, tau, vol, opt){
    F0  <- S0*exp((r-d)*tau)
    d_2 <- ( d_1 <- (log(F0/K) + vol^2/2*tau)/(vol*sqrt(tau)) ) - vol*sqrt(tau)
    if(opt==0){
        value   <-  S0*exp(-d*tau)*stats::pnorm( d_1,0,1)-K*exp(-r*tau)*stats::pnorm(d_2,0,1)
        delta   <-  exp(-d*tau)*stats::pnorm( d_1,0,1)
        gamma   <- (1/sqrt(2*pi)*exp(-d_1^2/2))/(S0*vol*sqrt(tau))*exp(-d*tau)
        vega    <- S0*sqrt(tau)*(1/sqrt(2*pi)*exp(-d_1^2/2))*exp(-d*tau)
        vomma   <- vega*d_1*d_2/vol
        theta   <- -S0*(1/sqrt(2*pi)*exp(-d_1^2/2))*vol*exp(-d*tau)/(2*sqrt(tau))+
                                    d*S0*stats::pnorm(d_1,0,1)*exp(-d*tau)-r*K*exp(-r*tau)*stats::pnorm(d_2,0,1)
        rho     <- K*tau*exp(-r*tau)*stats::pnorm(d_2,0,1)
        rhoQ    <- -tau*exp(-d*tau)*S0*stats::pnorm(d_1,0,1)
        lambda  <- delta*S0/value
    }else if(opt==1){
        value   <- -S0*exp(-d*tau)*stats::pnorm(-d_1,0,1)+K*exp(-r*tau)*stats::pnorm(-d_2,0,1)
        delta   <- -exp(-d*tau)*stats::pnorm(-d_1,0,1)
        gamma   <- (1/sqrt(2*pi)*exp(-d_1^2/2))/(S0*vol*sqrt(tau))*exp(-d*tau)
        vega    <- S0*sqrt(tau)*(1/sqrt(2*pi)*exp(-d_1^2/2))*exp(-d*tau)
        vomma   <- vega*d_1*d_2/vol
        theta   <- -S0*(1/sqrt(2*pi)*exp(-d_1^2/2))*vol*exp(-d*tau)/(2*sqrt(tau))-
                                    d*S0*stats::pnorm(-d_1,0,1)*exp(-d*tau)+r*K*exp(-r*tau)*stats::pnorm(-d_2,0,1)
        rho     <- -K*tau*exp(-r*tau)*stats::pnorm(-d_2,0,1)
        rhoQ    <- tau*exp(-d*tau)*S0*stats::pnorm(-d_1,0,1)
        lambda  <- delta*S0/value
    }else{
        stop("opt=0 means CALL; opt=1 means PUT")
    }
    return(cbind(value,delta,lambda,gamma,vega,vomma,theta,rho,rhoQ))
}



Kind regards,--  
Dominykas Grigonis


On Tuesday, 5 November 2013 at 14:42, Oleg Mubarakshin wrote:

> Vishnu,
>  
> calculation the Greeks for Eur options has very easy code
> if you need just the Greeks calculation - you can use my function for it:
>  
> # Function calculates option premium and sensitivities,
> # setting b = r we get Black and Scholes' stock option model, b = r-q we get  
> Merton's stock option
> # model with continuous dividend yield q, b = 0 we get Black's futures  
> option model, and b = r-rf
> # we get Garman and Kohlhagen's currency option model with foreign interest  
> rate rf
> GreeksBSM <- function(name="delta", type="p", S=100, K=98, T=0.25, b=0.02,  
> r=0.05, v=0.15) {
>  
> c.type <- c("premium", "delta", "vega", "theta", "rho", "gamma", "vanna",  
> "volga")
>  
> {# check input params
>  
> if(type == "c" | type == "C") {
> i <- 1
> } else {
> if(type == "p" | type == "P") {
> i <- -1
> } else {
> err <- "Type out of c(c, p)"
> return(list(err=err, value=NA))
> }
> }
>  
> if(!(name %in% c.type)) {
> err <- "Name out of c(premium, delta, vega, theta, rho, gamma, vanna,  
> volga)"
> return(list(err=err, value=NA))
> }
>  
> if(S <= 0) {
> err <- "S must have a positive value"
> return(list(err=err, value=NA))
> }
>  
> if(K <= 0) {
> err <- "K must have a positive value"
> return(list(err=err, value=NA))
> }
>  
> if(T <= 0) {
> err <- "T must have a positive value"
> return(list(err=err, value=NA))
> }
>  
> if(v <= 0) {
> err <- "v must have a positive value"
> return(list(err=err, value=NA))
> }
>  
> }
>  
> q <- r - b
> d1 <- (log(S/K) + (r - q + v*v/2) * T)/(v * sqrt(T))
> d2 <- d1 - v * sqrt(T)
>  
> if(name == "premium") {
> out <- i * (S * exp(-q*T) * pnorm(i*d1) - K * exp(-r*T) * pnorm(i*d2))
> return(list(err=0, value=out))
> #GBSOption(TypeFlag=type, S=S, X=K, Time=T, r=r, b=b, sigma=v)@price
> }
>  
> if(name == "delta") {
> out <- i*exp(-q*T) * pnorm(i*d1)
> return(list(err=0, value=out))
> #GBSGreeks(Selection="delta", TypeFlag=type, S=S, X=K, Time=T, r=r, b=b,  
> sigma=v)
> }
>  
> if(name == "vega") {
> out <- S * exp(-q*T) * dnorm(d1) * sqrt(T)
> return(list(err=0, value=out))
> #GBSGreeks(Selection="vega", TypeFlag=type, S=S, X=K, Time=T, r=r, b=b,  
> sigma=v)
> }
>  
> if(name == "theta") {
> out <- -exp(-q*T) * S*dnorm(d1)*v/(2*sqrt(T)) -  
> i*r*K*exp(-r*T)*pnorm(i*d2) +
> i*q*S*exp(-q*T)*pnorm(i*d1)
> return(list(err=0, value=out))
> #GBSGreeks(Selection="theta", TypeFlag=type, S=S, X=K, Time=T, r=r, b=b,  
> sigma=v)
> }
>  
> if(name == "rho") {
> out <- i*K * T * exp(-r*T) * pnorm(i*d2)
> return(list(err=0, value=out))
> #GBSGreeks(Selection="rho", TypeFlag=type, S=S, X=K, Time=T, r=r, b=b,  
> sigma=v)
> }
>  
> if(name == "gamma") {
> out <- exp(-q*T) * dnorm(d1)/(S*v*sqrt(T))
> return(list(err=0, value=out))
> #GBSGreeks(Selection="gamma", TypeFlag=type, S=S, X=K, Time=T, r=r, b=b,  
> sigma=v)
> }
>  
> if(name == "vanna") {
> out <- -exp(-q*T) * dnorm(d1) * d2/v
> return(list(err=0, value=out))
> }
>  
> if(name == "volga") {
> out <- S * exp(-q*T) * dnorm(d1) * sqrt(T) * (d1*d2)/v
> return(list(err=0, value=out))
> }
>  
> }
>  
>  
>  
> Oleg
>  
> -----Исходное сообщение-----  
> From: Vishnu B
> Sent: Tuesday, November 05, 2013 5:48 PM
> To: r-sig-finance@r-project.org (mailto:r-sig-finance@r-project.org)
> Subject: [R-SIG-Finance] European options in r3
>  
> Hi,
>  
> Is there any package that works with r3.0.2 that can calculate option Greeks  
> for European options?
>  
> Thanks
> Vishnu
>  
> Sent from my iPhone
> _______________________________________________
> R-SIG-Finance@r-project.org (mailto:R-SIG-Finance@r-project.org) mailing list
> https://stat.ethz.ch/mailman/listinfo/r-sig-finance
> -- Subscriber-posting only. If you want to post, subscribe first.
> -- Also note that this is not the r-help list where general R questions  
> should go.
>  
> _______________________________________________
> R-SIG-Finance@r-project.org (mailto:R-SIG-Finance@r-project.org) mailing list
> https://stat.ethz.ch/mailman/listinfo/r-sig-finance
> -- Subscriber-posting only. If you want to post, subscribe first.
> -- Also note that this is not the r-help list where general R questions should go.
>  
>  



	[[alternative HTML version deleted]]

