Follow

Keep Up to Date with the Most Important News

By pressing the Subscribe button, you confirm that you have read and are agreeing to our Privacy Policy and Terms of Use
Contact

Problem with mutating in dplyr a big function with nested functions using the case_when in R

I have a function that computes the binomial tree of call or put option found here.I made them all one one function that contain all the other functions described in the link such as :


Binomial_Call = function(S0, K, r, Ti, sigma,N) {
  delta_t=Ti/N
  
  q_prob = function(r, delta_t, sigma) {
    u = exp(sigma*sqrt(delta_t))
    d = exp(-sigma*sqrt(delta_t))
    return((exp(r*delta_t) - d)/(u-d))
  }
  q = q_prob(r=r, delta_t=delta_t, sigma=sigma)
  build_stock_tree = function(S0, sigma, delta_t, N) {
    tree = matrix(0, nrow=N+1, ncol=N+1)
    U = exp(sigma*sqrt(delta_t))
    D = exp(-sigma*sqrt(delta_t))
    for (i in 1:(N+1)) {
      for (j in 1:i) {
        tree[i, j] = S0 * U^(j-1) * D^((i-1)-(j-1))
      }  }
    return(tree)
  }
  tree = build_stock_tree(S0=S0, sigma=sigma, delta_t=delta_t, N=N)
  value_binomial_option = function(tree, sigma, delta_t, r, K) {
    q_prob = function(r, delta_t, sigma) {
      u = exp(sigma*sqrt(delta_t))
      d = exp(-sigma*sqrt(delta_t))
      return((exp(r*delta_t) - d)/(u-d))
    }
    q = q_prob(r, delta_t, sigma)
    option_tree = matrix(0, nrow=nrow(tree), ncol=ncol(tree))
    option_tree[nrow(option_tree),] = pmax(tree[nrow(tree),] - K, 0)
    for (i in (nrow(tree)-1):1) {
      for(j in 1:i) {
        option_tree[i,j]=((1-q)*option_tree[i+1,j] + q*option_tree[i+1,j+1])/exp(r*delta_t)
      }
    }
    return(option_tree)
  }
  option = value_binomial_option(tree, sigma=sigma, delta_t=Ti/N, r=r, K=K)
  #return(list(q=q, stock=tree, option=option, price=option[1,1]))
  price=option[1,1]
  print(price)
}

Now I have a data frame :

stock   = rep(42,4)
strike  = rep(40,4)
risk    = rep(0.1)
time    = rep(0.25)
sigma   = rep(0.2)
N       = rep(60,4)
option  = c(rep(c("C","P"),2)) 
Asset   = c(rep("FTSE",2),"FACEBOOK","TWITTER")
data = tibble(stock,strike,risk,time,sigma,N,option,Asset);data
 A tibble: 4 × 8
  stock strike  risk  time sigma     N option Asset   
  <dbl>  <dbl> <dbl> <dbl> <dbl> <dbl> <chr>  <chr>   
1    42     40   0.1  0.25   0.2    60 C      FTSE    
2    42     40   0.1  0.25   0.2    60 P      FTSE    
3    42     40   0.1  0.25   0.2    60 C      FACEBOOK
4    42     40   0.1  0.25   0.2    60 P      TWITTER 

When I try to implement the function in mutate:

MEDevel.com: Open-source for Healthcare and Education

Collecting and validating open-source software for healthcare, education, enterprise, development, medical imaging, medical records, and digital pathology.

Visit Medevel

data%>%
  mutate(price = case_when(Asset != "FTSE" & option == "C" ~ Binomial_Call(stock,strike,risk,time,sigma,N)))

I receive the following error:

Error in mutate():

! Problem while computing `price = case_when(...)`.
Caused by error in `tree[i, j] <- S0 * U^(j - 1) * D^((i - 1) - (j - 1))`:
! number of items to replace is not a multiple of replacement length
Run `rlang::last_error()` to see where the error occurred.
Warning message:
Problem while computing `price = case_when(...)`.
ℹ numerical expression has 4 elements: only the first used 

why ? Why Is that happening ?

>Solution :

The function seems to be not vectorized. So we may use rowwise

library(dplyr)
data %>%
   rowwise %>%
    mutate(price = case_when(Asset != "FTSE" & option == "C" ~
       Binomial_Call(stock,strike,risk,time,sigma,N))) %>% 
   ungroup
# A tibble: 4 × 9
  stock strike  risk  time sigma     N option Asset    price
  <dbl>  <dbl> <dbl> <dbl> <dbl> <dbl> <chr>  <chr>    <dbl>
1    42     40   0.1  0.25   0.2    60 C      FTSE     NA   
2    42     40   0.1  0.25   0.2    60 P      FTSE     NA   
3    42     40   0.1  0.25   0.2    60 C      FACEBOOK  3.53
4    42     40   0.1  0.25   0.2    60 P      TWITTER  NA   
Add a comment

Leave a Reply

Keep Up to Date with the Most Important News

By pressing the Subscribe button, you confirm that you have read and are agreeing to our Privacy Policy and Terms of Use

Discover more from Dev solutions

Subscribe now to keep reading and get access to the full archive.

Continue reading