[R] How to vectorize this function

MacQueen, Don m@cqueen1 @end|ng |rom ||n|@gov
Thu Sep 20 19:56:22 CEST 2018


In addition to what the other said, if callM is a vector then an expression of the form
   if (callM <= call0)
is inappropriate. Objects inside the parentheses of   if()  should have length one. For example,

> if (1:5 < 3) 'a' else 'b'
[1] "a"
Warning message:
In if (1:5 < 3) "a" else "b" :
  the condition has length > 1 and only the first element will be used


instead of what you have:
         if(callM <= call0){
           sig <- 1/sqrt(T)*(sqrt(gamma + y) - sqrt(gamma - y))
         }else{
           sig <- 1/sqrt(T)*(sqrt(gamma + y) + sqrt(gamma - y))
        }

Here are a couple of (untested) possibilities:

  M.gt.0 <- callM > call0
  sig <- 1/sqrt(T)*(sqrt(gamma + y) - sqrt(gamma - y))
  sig[M.gt.0] <- (1/sqrt(T)*(sqrt(gamma + y) + sqrt(gamma - y)))[M.gt.0]

or

    sig <- 1/sqrt(T)*(sqrt(gamma + y)  + ifelse(callM <= call0, -1, 1) * sqrt(gamma - y))

incidentally, I would write
   sig <- (sqrt(gamma + y) - sqrt(gamma - y))/sqrt(T)
instead of
   sig <- 1/sqrt(T)*(sqrt(gamma + y) - sqrt(gamma - y))

--
Don MacQueen
Lawrence Livermore National Laboratory
7000 East Ave., L-627
Livermore, CA 94550
925-423-1062
Lab cell 925-724-7509
 
 

On 9/20/18, 8:08 AM, "R-help on behalf of Lynette Chang" <r-help-bounces using r-project.org on behalf of momtoomax using gmail.com> wrote:

    Hello everyone,
    
         I’ve a function with five input argument and one output number. 
    	  impVolC <- function(callM, K, T, F, r)
    
         I hope this function can take five vectors as input, then return one vector as output. My vectorization ran into problems with the nested if-else operation. As a result, I have to write another for loop to call this function. Can anyone suggest some methods to overcome it? I put my code below, thanks.
    
    impVolC <- function(callM, K, T, F, r){
    
    
     if(y >= 0){
         call0 <- K*exp(-r*T)*(exp(y)*polya(sqrt(2*y)) - 0.5)
         if(callM <= call0){
           sig <- 1/sqrt(T)*(sqrt(gamma + y) - sqrt(gamma - y))
         }else{
           sig <- 1/sqrt(T)*(sqrt(gamma + y) + sqrt(gamma - y))
         }
     }else{
         call0 <- K*exp(-r*T)*(exp(y)/2 - polya(-sqrt(-2*y)))
         if(callM <= call0){
           sig <- 1/sqrt(T)*(-sqrt(gamma + y) + sqrt(gamma - y))
         }else{
           sig <- 1/sqrt(T)*(sqrt(gamma + y) + sqrt(gamma - y))
         }
     }
     sig
    } 
    
    for(i in 1:length(call)){
     sigV[i] <- impVolC(callM = call[i], K = df$Strike[i], T = T, F = F, r = r_m)  
    }
    
    ______________________________________________
    R-help using r-project.org mailing list -- To UNSUBSCRIBE and more, see
    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.
    



More information about the R-help mailing list