Function with no argument

> inch.to.cm <- function(){
+   cm <- 1*2.54
+   cat(cm)
+ }
> inch.to.cm()
2.54

Function with argument

> inch.to.cm <- function(inch){
+   cm <- inch*2.54
+   cat(inch,"inch is equal to",cm,"cm\n")
+ }
> inch.to.cm(2)
2 inch is equal to 5.08 cm
> inch.to.cm(4)
4 inch is equal to 10.16 cm

Default value

To set some default value for the arguments when no argument values are assigned in function-

> inch.to.cm <- function(inch=1){
+   cm <- inch*2.54
+   cat(inch,"inch is equal to",cm,"cm\n")
+ }

Here we have used inch=1 as defualt value. Now if we use the function with no arguments we will still get an answer for the default value-

> inch.to.cm()
1 inch is equal to 2.54 cm

If we run the function without () we will see the code behind it-

> inch.to.cm
function(inch=1){
  cm <- inch*2.54
  cat(inch,"inch is equal to",cm,"cm\n")
}

Take strings as input

The substitute function with as.character can be used to take the given argument as a character in a variable for further usage -

> sf <- function(name){
+   name <- as.character(substitute(name))
+   return(paste0("Hello ",name,"!"))
+ }
> sf(Himel)
[1] "Hello Himel!"
> class(sf(Himel))
[1] "character"

To know about different printing methods visit here.

Extras: Difference between quote and substitute -

> f <- function(arg) {
+   list(quote = quote(arg), 
+        substitute = substitute(arg), 
+        argument = arg)
+ }
> 
> value <- 90
> f(arg=value)
$quote
arg

$substitute
value

$argument
[1] 90

Source

Get help with your R and Statistics assignments.

Return

If you want something further usable in return from the function then use return-

> inch.to.cm <- function(inch=1){
+   cm <- inch*2.54
+   return(cm)
+ }

The output of the function will give us a value in [1] so that can be used for further calculations and assignments-

> inch.to.cm(2)
[1] 5.08
> inch.to.cm(2)*2 + inch.to.cm(5)
[1] 22.86

Return multiple results

An example function to find the area and circumference of a circle from the given value of radius-

> area.cir <- function(r){
+   area <- pi*r**2
+   circum <- 2*pi*r
+   return(c(area = area, circumference = circum))
+ }

Now let’s use the function-

> area.cir(2)
         area circumference 
     12.56637      12.56637 

Let’s calculate it for multiple radius-

> x <- c(4,6,15,30)
> area.cir(x)
         area1          area2          area3          area4 circumference1 
      50.26548      113.09734      706.85835     2827.43339       25.13274 
circumference2 circumference3 circumference4 
      37.69911       94.24778      188.49556 

Using list

The result shown is so messy and pretty unusable. So let’s use list instead of c in return-

> area.cir <- function(r){
+   area <- pi*r**2
+   circum <- 2*pi*r
+   return(list(area = area, circumference = circum))
+ }
> x <- c(4,6,15,30)
> area.cir(x)
$area
[1]   50.26548  113.09734  706.85835 2827.43339

$circumference
[1]  25.13274  37.69911  94.24778 188.49556

Now the areas can be called using area.cir(x)$area or area.cir(x)[[1]] and similarly for circumference.

> area.cir(x)$area[3]  # 3rd output from area
[1] 706.8583

Using data frame

Data frame can also be used instead of list to make the result more understandable-

> area.cir <- function(r){
+   area <- pi*r**2
+   circum <- 2*pi*r
+   return(data.frame(Radius = r, Area = area, Circumference = circum))
+ }
> x <- c(4,6,15,30)
> area.cir(x)
  Radius       Area Circumference
1      4   50.26548      25.13274
2      6  113.09734      37.69911
3     15  706.85835      94.24778
4     30 2827.43339     188.49556
> res <- area.cir(x)
> res$Area
[1]   50.26548  113.09734  706.85835 2827.43339

Using plot

> area.cir <- function(r){
+   area <- pi*r**2
+   circum <- 2*pi*r
+   return(plot(r, area, 
+               xlab="Radius", ylab="Area"))
+ }
> x <- c(4,6,15,20,27,30)
> area.cir(x)

local vs global variables

Local variables are those inside the function or local environment. These cannot be called outside of the function-

> cm <- 10
> inch.to.cm <- function(inch=1){
+   cm <- inch*2.54
+   return(cm)
+ }
> inch.to.cm()
[1] 2.54
> cm
[1] 10

In the example cm variable is called. But the value is not from the function. The value assigned to cm before the function was called here, which is global.

Changes global variables from inside the function ( <- vs. <<- )

In the above example we’ve seen that the value of cm wasn’t changed. We can use <<- to change any variables value of the preceding scope from inside the function -

> cm <- 10
> inch.to.cm <- function(inch=1){
+   cm <<- inch*2.54
+   return(cm)
+ }
> inch.to.cm()
[1] 2.54
> cm
[1] 2.54

So now the variable’s value of the global environment’s has changed. Details on this can be found in this stackover flow answer https://stackoverflow.com/questions/32623856/difference-between-and?noredirect=1&lq=1

Here is a code that utilizes while loop to find prime factors -

> prime_factors_Loop <- function(x){
+   factors = c()
+   i = 2
+   while(x >= i){
+     if(! x %% i) {
+       factors <- c(factors, i)
+       x <- x/i
+       i <- i - 1
+     }
+     i <- i + 1
+   }
+   return(factors)
+ }
> prime_factors_Loop(2364)
[1]   2   2   3 197

Invisible

If you don’t want to load a output after calculation, and only to assign, then use invisible() instead of return().

> trial_func_ret <- function(x){
+   res <- mean(x)
+   return(res)
+ }
> 
> trial_func_inv <- function(x){
+   res <- mean(x)
+   invisible(res)
+ }
> 
> vals <- c(4,5,2,6,9)
> trial_func_ret(x = vals)
[1] 5.2
> trial_func_inv(x = vals)

The returned result can only be shown after assigning to an object:

> a <- trial_func_inv(x = vals)
> a
[1] 5.2

Types of functions

There are mainly three types of function:

  • Primitive Functions
  • Infix Functions
  • Replacement Functions

Primitive functions

To see the available primitive function in R -

> names(methods:::.BasicFunsList)
  [1] "$"                    "$<-"                  "["                   
  [4] "[<-"                  "[["                   "[[<-"                
  [7] "%*%"                  "xtfrm"                "c"                   
 [10] "all"                  "any"                  "sum"                 
 [13] "prod"                 "max"                  "min"                 
 [16] "range"                "is.matrix"            ">="                  
 [19] "cosh"                 "cummax"               "dimnames<-"          
 [22] "as.raw"               "log2"                 "tan"                 
 [25] "dim"                  "as.logical"           "^"                   
 [28] "is.finite"            "sinh"                 "log10"               
 [31] "as.numeric"           "dim<-"                "is.array"            
 [34] "tanpi"                "gamma"                "atan"                
 [37] "as.integer"           "Arg"                  "signif"              
 [40] "cumprod"              "cos"                  "length"              
 [43] "!="                   "digamma"              "exp"                 
 [46] "floor"                "acos"                 "seq.int"             
 [49] "abs"                  "length<-"             "sqrt"                
 [52] "!"                    "acosh"                "is.nan"              
 [55] "Re"                   "tanh"                 "names"               
 [58] "cospi"                "&"                    "anyNA"               
 [61] "trunc"                "cummin"               "levels<-"            
 [64] "*"                    "Mod"                  "|"                   
 [67] "names<-"              "+"                    "log"                 
 [70] "lgamma"               "as.complex"           "asinh"               
 [73] "-"                    "sin"                  "/"                   
 [76] "as.environment"       "<="                   "as.double"           
 [79] "is.infinite"          "is.numeric"           "rep"                 
 [82] "round"                "sinpi"                "dimnames"            
 [85] "asin"                 "as.character"         "%/%"                 
 [88] "is.na"                "<"                    ">"                   
 [91] "Im"                   "%%"                   "trigamma"            
 [94] "=="                   "cumsum"               "atanh"               
 [97] "sign"                 "ceiling"              "Conj"                
[100] "as.call"              "log1p"                "expm1"               
[103] "("                    ":"                    "="                   
[106] "@"                    "{"                    "~"                   
[109] "&&"                   ".C"                   "baseenv"             
[112] "quote"                "::"                   "<-"                  
[115] "is.name"              "if"                   "||"                  
[118] "attr<-"               "untracemem"           ".cache_class"        
[121] "substitute"           "interactive"          "is.call"             
[124] "switch"               "function"             "is.single"           
[127] "is.null"              "is.language"          "is.pairlist"         
[130] ".External.graphics"   "globalenv"            "class<-"             
[133] ".Primitive"           "is.logical"           "enc2utf8"            
[136] "UseMethod"            ".subset"              "proc.time"           
[139] "enc2native"           "repeat"               ":::"                 
[142] "<<-"                  "@<-"                  "missing"             
[145] "nargs"                "isS4"                 ".isMethodsDispatchOn"
[148] "forceAndCall"         ".primTrace"           "storage.mode<-"      
[151] ".Call"                "unclass"              "gc.time"             
[154] ".subset2"             "environment<-"        "emptyenv"            
[157] "seq_len"              ".External2"           "is.symbol"           
[160] "class"                "on.exit"              "is.raw"              
[163] "for"                  "is.complex"           "list"                
[166] "invisible"            "is.character"         "oldClass<-"          
[169] "is.environment"       "attributes"           "break"               
[172] "return"               "attr"                 "tracemem"            
[175] "next"                 ".Call.graphics"       "standardGeneric"     
[178] "is.atomic"            "retracemem"           "expression"          
[181] "is.expression"        "call"                 "is.object"           
[184] "pos.to.env"           "attributes<-"         ".primUntrace"        
[187] "...length"            ".External"            "oldClass"            
[190] ".Internal"            ".Fortran"             "browser"             
[193] "is.double"            ".class2"              "while"               
[196] "nzchar"               "is.list"              "lazyLoadDBfetch"     
[199] "...elt"               "...names"             "is.integer"          
[202] "is.function"          "is.recursive"         "seq_along"           
[205] "unlist"               "as.vector"            "lengths"             

For example sum is a primitive function -

> sum
function (..., na.rm = FALSE)  .Primitive("sum")

We can see it by the word .Primitive("sum") in the output.

Check if a function is primitive -

> is.primitive(mean)
[1] FALSE
> is.primitive(sum)
[1] TRUE
> is.primitive(is.primitive)
[1] FALSE
> is.primitive(is.integer)
[1] TRUE

Primitive functions has the type = “builtin” -

> typeof(sum)
[1] "builtin"

Whereas -

> typeof(mean)
[1] "closure"

Infix functions or operators

Infix functions are those functions in which the function name comes in between its arguments, and hence have two arguments. R comes with a number of built-in infix operators such as :, ::, :::, $, @, ^, *, /, +, -, >, >=, <, <=, ==, !=, !, &, &&, |, ||, ~, <-, and <<-. One can create his own infix functions that start and end with %. The name of an infix function is more flexible as it can contain any sequence of characters except %. There are some predefined infix operators in R programming. Source

Examples:

  • %% - Remainder operator
  • %/% - Integer Division
  • %*% - Matrix multiplication
  • %o% - Outer Product
  • %x% - Kronecker product
  • %in% - Matching Operator

You can create your own infix function Source -

> # number in between two values
> "%><%"  <- function(x, rng) x > rng[1]  & x < rng[2]
> 
> # number in between two values including those
> "%>=<%" <- function(x, rng) x >= rng[1] & x <= rng[2]
> 
> x = 1:7
> x
[1] 1 2 3 4 5 6 7
> x[x %><% c(2,5)]
[1] 3 4
> x[x %>=<% c(2,5)]
[1] 2 3 4 5

Replacement functions

Replacement functions modify their arguments in place(modifying an R object usually creates a copy). The name of replacement functions are always succeeded by <. They must have arguments named x and value, and return the modified object.

> "replace_last<-" <- function(x, value)
+ {
+   x[length(x)] = value
+   x
+ }

Run the function as: replace_last(x) <- value

> x <- 1:6
> x
[1] 1 2 3 4 5 6
> replace_last(x) <- 999   
> # it will replace the last value as defined in the function
> print(x)
[1]   1   2   3   4   5 999

Find more discussion on this in here.

Obtain the source code of function in R

Non-primitive functions case

Source1
Source2
Source3
For many generic functions the function body is quite short, for example -

> mean
function (x, ...) 
UseMethod("mean")
<bytecode: 0x00000273f1d64500>
<environment: namespace:base>

The presence of UseMethod indicates this is a generic function. To see what methods are available we can use methods() -

> methods(mean)
[1] mean.Date     mean.default  mean.difftime mean.POSIXct  mean.POSIXlt 
[6] mean.quosure*
see '?methods' for accessing help and source code

Non-visible functions are asterisked.

To read the non-visible functions we can utilize the getAnywhere() function -

> getAnywhere(mean.quosure)
A single object matching 'mean.quosure' was found
It was found in the following places
  registered S3 method for mean from namespace rlang
  namespace:rlang
with value

function (x, na.rm = TRUE, ...) 
{
    abort_quosure_op("Summary", "mean")
}
<bytecode: 0x00000273f4559930>
<environment: namespace:rlang>

It can also be used for others -

> getAnywhere(mean.default)
A single object matching 'mean.default' was found
It was found in the following places
  package:base
  registered S3 method for mean from namespace base
  namespace:base
with value

function (x, trim = 0, na.rm = FALSE, ...) 
{
    if (!is.numeric(x) && !is.complex(x) && !is.logical(x)) {
        warning("argument is not numeric or logical: returning NA")
        return(NA_real_)
    }
    if (isTRUE(na.rm)) 
        x <- x[!is.na(x)]
    if (!is.numeric(trim) || length(trim) != 1L) 
        stop("'trim' must be numeric of length one")
    n <- length(x)
    if (trim > 0 && n) {
        if (is.complex(x)) 
            stop("trimmed means are not defined for complex data")
        if (anyNA(x)) 
            return(NA_real_)
        if (trim >= 0.5) 
            return(stats::median(x, na.rm = FALSE))
        lo <- floor(n * trim) + 1
        hi <- n + 1 - lo
        x <- sort.int(x, partial = unique(c(lo, hi)))[lo:hi]
    }
    .Internal(mean(x))
}
<bytecode: 0x00000273f18dbd30>
<environment: namespace:base>
> getAnywhere(Filter)
A single object matching 'Filter' was found
It was found in the following places
  package:base
  namespace:base
with value

function (f, x) 
{
    f <- match.fun(f)
    ind <- as.logical(unlist(lapply(x, f)))
    x[which(ind)]
}
<bytecode: 0x00000273f11d63d0>
<environment: namespace:base>

getS3method function can be used too -

> getS3method(f = "mean", class = "default")
function (x, trim = 0, na.rm = FALSE, ...) 
{
    if (!is.numeric(x) && !is.complex(x) && !is.logical(x)) {
        warning("argument is not numeric or logical: returning NA")
        return(NA_real_)
    }
    if (isTRUE(na.rm)) 
        x <- x[!is.na(x)]
    if (!is.numeric(trim) || length(trim) != 1L) 
        stop("'trim' must be numeric of length one")
    n <- length(x)
    if (trim > 0 && n) {
        if (is.complex(x)) 
            stop("trimmed means are not defined for complex data")
        if (anyNA(x)) 
            return(NA_real_)
        if (trim >= 0.5) 
            return(stats::median(x, na.rm = FALSE))
        lo <- floor(n * trim) + 1
        hi <- n + 1 - lo
        x <- sort.int(x, partial = unique(c(lo, hi)))[lo:hi]
    }
    .Internal(mean(x))
}
<bytecode: 0x00000273f18dbd30>
<environment: namespace:base>

Another easy way is to use the body function if you know the class of the function -

> body(mean.default)
{
    if (!is.numeric(x) && !is.complex(x) && !is.logical(x)) {
        warning("argument is not numeric or logical: returning NA")
        return(NA_real_)
    }
    if (isTRUE(na.rm)) 
        x <- x[!is.na(x)]
    if (!is.numeric(trim) || length(trim) != 1L) 
        stop("'trim' must be numeric of length one")
    n <- length(x)
    if (trim > 0 && n) {
        if (is.complex(x)) 
            stop("trimmed means are not defined for complex data")
        if (anyNA(x)) 
            return(NA_real_)
        if (trim >= 0.5) 
            return(stats::median(x, na.rm = FALSE))
        lo <- floor(n * trim) + 1
        hi <- n + 1 - lo
        x <- sort.int(x, partial = unique(c(lo, hi)))[lo:hi]
    }
    .Internal(mean(x))
}

Arguments can be obtained using -

> args(mean.default)
function (x, trim = 0, na.rm = FALSE, ...) 
NULL

If you use edit(), a prompt will open up with the functions code -

> edit(lm.fit)

SO MUCH TO LEARN, SO LITTLE TIME :-)

LS0tCnRpdGxlOiAiRnVuY3Rpb24iCmF1dGhvcjogIk1EIEFIU0FOVUwgSVNMQU0iCm91dHB1dDoKICBodG1sX2RvY3VtZW50OgogICAgdG9jOiB5ZXMKICAgIHRvY19mbG9hdDogeWVzCiAgICB0b2NfZGVwdGg6IDQKICAgIHRoZW1lOiBjZXJ1bGVhbgogICAgY29kZV9kb3dubG9hZDogeWVzCi0tLQoKCmBgYHtyLCBpbmNsdWRlPUZBTFNFfQprbml0cjo6b3B0c19jaHVuayRzZXQoCiAgY29tbWVudCA9ICIiLCBwcm9tcHQgPSBUUlVFCikKYGBgCgotLS0KCiMjIEZ1bmN0aW9uIHdpdGggbm8gYXJndW1lbnQgCgpgYGB7cn0KaW5jaC50by5jbSA8LSBmdW5jdGlvbigpewogIGNtIDwtIDEqMi41NAogIGNhdChjbSkKfQppbmNoLnRvLmNtKCkKYGBgCgojIyBGdW5jdGlvbiB3aXRoIGFyZ3VtZW50IApgYGB7cn0KaW5jaC50by5jbSA8LSBmdW5jdGlvbihpbmNoKXsKICBjbSA8LSBpbmNoKjIuNTQKICBjYXQoaW5jaCwiaW5jaCBpcyBlcXVhbCB0byIsY20sImNtXG4iKQp9CmluY2gudG8uY20oMikKaW5jaC50by5jbSg0KQpgYGAKCiMjIERlZmF1bHQgdmFsdWUKVG8gc2V0IHNvbWUgZGVmYXVsdCB2YWx1ZSBmb3IgdGhlIGFyZ3VtZW50cyB3aGVuIG5vIGFyZ3VtZW50IHZhbHVlcyBhcmUgYXNzaWduZWQgaW4gZnVuY3Rpb24tCmBgYHtyfQppbmNoLnRvLmNtIDwtIGZ1bmN0aW9uKGluY2g9MSl7CiAgY20gPC0gaW5jaCoyLjU0CiAgY2F0KGluY2gsImluY2ggaXMgZXF1YWwgdG8iLGNtLCJjbVxuIikKfQpgYGAKCkhlcmUgd2UgaGF2ZSB1c2VkIGluY2g9MSBhcyBkZWZ1YWx0IHZhbHVlLiBOb3cgaWYgd2UgdXNlIHRoZSBmdW5jdGlvbiB3aXRoIG5vIGFyZ3VtZW50cyB3ZSB3aWxsIHN0aWxsIGdldCBhbiBhbnN3ZXIgZm9yIHRoZSBkZWZhdWx0IHZhbHVlLQpgYGB7cn0KaW5jaC50by5jbSgpCmBgYAoKLS0tCgpJZiB3ZSBydW4gdGhlIGZ1bmN0aW9uIHdpdGhvdXQgKCkgd2Ugd2lsbCBzZWUgdGhlIGNvZGUgYmVoaW5kIGl0LQpgYGB7cn0KaW5jaC50by5jbQpgYGAKCgojIyBUYWtlIHN0cmluZ3MgYXMgaW5wdXQgCgpUaGUgc3Vic3RpdHV0ZSBmdW5jdGlvbiB3aXRoIGFzLmNoYXJhY3RlciBjYW4gYmUgdXNlZCB0byB0YWtlIHRoZSBnaXZlbiBhcmd1bWVudCBhcyBhIGNoYXJhY3RlciBpbiBhIHZhcmlhYmxlIGZvciBmdXJ0aGVyIHVzYWdlIC0gCmBgYHtyfQpzZiA8LSBmdW5jdGlvbihuYW1lKXsKICBuYW1lIDwtIGFzLmNoYXJhY3RlcihzdWJzdGl0dXRlKG5hbWUpKQogIHJldHVybihwYXN0ZTAoIkhlbGxvICIsbmFtZSwiISIpKQp9CnNmKEhpbWVsKQpjbGFzcyhzZihIaW1lbCkpCmBgYApUbyBrbm93IGFib3V0IGRpZmZlcmVudCBwcmludGluZyBtZXRob2RzIHZpc2l0IFtoZXJlXShodHRwczovL3JwdWJzLmNvbS9NZEFoc2FudWwvcHJpbnRpbmcpLgoKX19FeHRyYXM6X18gRGlmZmVyZW5jZSBiZXR3ZWVuIHF1b3RlIGFuZCBzdWJzdGl0dXRlIC0gCgpgYGB7cn0KZiA8LSBmdW5jdGlvbihhcmcpIHsKICBsaXN0KHF1b3RlID0gcXVvdGUoYXJnKSwgCiAgICAgICBzdWJzdGl0dXRlID0gc3Vic3RpdHV0ZShhcmcpLCAKICAgICAgIGFyZ3VtZW50ID0gYXJnKQp9Cgp2YWx1ZSA8LSA5MApmKGFyZz12YWx1ZSkKYGBgCgpbU291cmNlXShodHRwczovL3N0YWNrb3ZlcmZsb3cuY29tL3F1ZXN0aW9ucy80NjgzNDY1NS93aGF0cy10aGUtZGlmZmVyZW5jZS1iZXR3ZWVuLXN1YnN0aXR1dGUtYW5kLXF1b3RlLWluLXIpCgpHZXQgaGVscCB3aXRoIHlvdXIgW1IgYW5kIFN0YXRpc3RpY3MgYXNzaWdubWVudHNdKGh0dHBzOi8vd3d3LmhvbWV3b3JraGVscG9ubGluZS5uZXQgIlN0YXRpc3RpY3MgcHJvZ3JhbW1pbmcgaGVscCIpLgoKIyMgUmV0dXJuey50YWJzZXQgLnRhYnNldC1mYWRlIC50YWJzZXQtcGlsbHN9CgpJZiB5b3Ugd2FudCBzb21ldGhpbmcgZnVydGhlciB1c2FibGUgaW4gcmV0dXJuIGZyb20gdGhlIGZ1bmN0aW9uIHRoZW4gdXNlIGByZXR1cm5gLQpgYGB7cn0KaW5jaC50by5jbSA8LSBmdW5jdGlvbihpbmNoPTEpewogIGNtIDwtIGluY2gqMi41NAogIHJldHVybihjbSkKfQpgYGAKClRoZSBvdXRwdXQgb2YgdGhlIGZ1bmN0aW9uIHdpbGwgZ2l2ZSB1cyBhIHZhbHVlIGluIFsxXSBzbyB0aGF0IGNhbiBiZSB1c2VkIGZvciBmdXJ0aGVyIGNhbGN1bGF0aW9ucyBhbmQgYXNzaWdubWVudHMtCmBgYHtyfQppbmNoLnRvLmNtKDIpCmluY2gudG8uY20oMikqMiArIGluY2gudG8uY20oNSkKYGBgCgotLS0KCiMjIyBSZXR1cm4gbXVsdGlwbGUgcmVzdWx0cwpBbiBleGFtcGxlIGZ1bmN0aW9uIHRvIGZpbmQgdGhlIGFyZWEgYW5kIGNpcmN1bWZlcmVuY2Ugb2YgYSBjaXJjbGUgZnJvbSB0aGUgZ2l2ZW4gdmFsdWUgb2YgcmFkaXVzLQpgYGB7cn0KYXJlYS5jaXIgPC0gZnVuY3Rpb24ocil7CiAgYXJlYSA8LSBwaSpyKioyCiAgY2lyY3VtIDwtIDIqcGkqcgogIHJldHVybihjKGFyZWEgPSBhcmVhLCBjaXJjdW1mZXJlbmNlID0gY2lyY3VtKSkKfQpgYGAKCk5vdyBsZXQncyB1c2UgdGhlIGZ1bmN0aW9uLQpgYGB7cn0KYXJlYS5jaXIoMikKYGBgCgpMZXQncyBjYWxjdWxhdGUgaXQgZm9yIG11bHRpcGxlIHJhZGl1cy0KYGBge3J9CnggPC0gYyg0LDYsMTUsMzApCmFyZWEuY2lyKHgpCmBgYAoKIyMjIFVzaW5nIGxpc3QKVGhlIHJlc3VsdCBzaG93biBpcyBzbyBtZXNzeSBhbmQgcHJldHR5IHVudXNhYmxlLiBTbyBsZXQncyB1c2UgbGlzdCBpbnN0ZWFkIG9mIGMgaW4gcmV0dXJuLQpgYGB7cn0KYXJlYS5jaXIgPC0gZnVuY3Rpb24ocil7CiAgYXJlYSA8LSBwaSpyKioyCiAgY2lyY3VtIDwtIDIqcGkqcgogIHJldHVybihsaXN0KGFyZWEgPSBhcmVhLCBjaXJjdW1mZXJlbmNlID0gY2lyY3VtKSkKfQp4IDwtIGMoNCw2LDE1LDMwKQphcmVhLmNpcih4KQpgYGAKTm93IHRoZSBhcmVhcyBjYW4gYmUgY2FsbGVkIHVzaW5nIGBhcmVhLmNpcih4KSRhcmVhYCBvciBgYXJlYS5jaXIoeClbWzFdXWAgYW5kIHNpbWlsYXJseSBmb3IgY2lyY3VtZmVyZW5jZS4gCmBgYHtyfQphcmVhLmNpcih4KSRhcmVhWzNdICAjIDNyZCBvdXRwdXQgZnJvbSBhcmVhCmBgYAoKIyMjIFVzaW5nIGRhdGEgZnJhbWUKCkRhdGEgZnJhbWUgY2FuIGFsc28gYmUgdXNlZCBpbnN0ZWFkIG9mIGxpc3QgdG8gbWFrZSB0aGUgcmVzdWx0IG1vcmUgdW5kZXJzdGFuZGFibGUtCmBgYHtyfQphcmVhLmNpciA8LSBmdW5jdGlvbihyKXsKICBhcmVhIDwtIHBpKnIqKjIKICBjaXJjdW0gPC0gMipwaSpyCiAgcmV0dXJuKGRhdGEuZnJhbWUoUmFkaXVzID0gciwgQXJlYSA9IGFyZWEsIENpcmN1bWZlcmVuY2UgPSBjaXJjdW0pKQp9CnggPC0gYyg0LDYsMTUsMzApCmFyZWEuY2lyKHgpCmBgYAoKCmBgYHtyfQpyZXMgPC0gYXJlYS5jaXIoeCkKcmVzJEFyZWEKYGBgCgojIyMgVXNpbmcgcGxvdApgYGB7cn0KYXJlYS5jaXIgPC0gZnVuY3Rpb24ocil7CiAgYXJlYSA8LSBwaSpyKioyCiAgY2lyY3VtIDwtIDIqcGkqcgogIHJldHVybihwbG90KHIsIGFyZWEsIAogICAgICAgICAgICAgIHhsYWI9IlJhZGl1cyIsIHlsYWI9IkFyZWEiKSkKfQp4IDwtIGMoNCw2LDE1LDIwLDI3LDMwKQphcmVhLmNpcih4KQpgYGAKCiMjIGxvY2FsIHZzIGdsb2JhbCB2YXJpYWJsZXMKCkxvY2FsIHZhcmlhYmxlcyBhcmUgdGhvc2UgaW5zaWRlIHRoZSBmdW5jdGlvbiBvciBsb2NhbCBlbnZpcm9ubWVudC4gVGhlc2UgY2Fubm90IGJlIGNhbGxlZCBvdXRzaWRlIG9mIHRoZSBmdW5jdGlvbi0KYGBge3J9CmNtIDwtIDEwCmluY2gudG8uY20gPC0gZnVuY3Rpb24oaW5jaD0xKXsKICBjbSA8LSBpbmNoKjIuNTQKICByZXR1cm4oY20pCn0KaW5jaC50by5jbSgpCmNtCmBgYApJbiB0aGUgZXhhbXBsZSBjbSB2YXJpYWJsZSBpcyBjYWxsZWQuIEJ1dCB0aGUgdmFsdWUgaXMgbm90IGZyb20gdGhlIGZ1bmN0aW9uLiBUaGUgdmFsdWUgYXNzaWduZWQgdG8gY20gYmVmb3JlIHRoZSBmdW5jdGlvbiB3YXMgY2FsbGVkIGhlcmUsIHdoaWNoIGlzIGdsb2JhbC4KCiMjIyBDaGFuZ2VzIGdsb2JhbCB2YXJpYWJsZXMgZnJvbSBpbnNpZGUgdGhlIGZ1bmN0aW9uICggPC0gdnMuIDw8LSApCgpJbiB0aGUgYWJvdmUgZXhhbXBsZSB3ZSd2ZSBzZWVuIHRoYXQgdGhlIHZhbHVlIG9mIGNtIHdhc24ndCBjaGFuZ2VkLiBXZSBjYW4gdXNlIDw8LSB0byBjaGFuZ2UgYW55IHZhcmlhYmxlcyB2YWx1ZSBvZiB0aGUgcHJlY2VkaW5nIHNjb3BlIGZyb20gaW5zaWRlIHRoZSBmdW5jdGlvbiAtIApgYGB7cn0KY20gPC0gMTAKaW5jaC50by5jbSA8LSBmdW5jdGlvbihpbmNoPTEpewogIGNtIDw8LSBpbmNoKjIuNTQKICByZXR1cm4oY20pCn0KaW5jaC50by5jbSgpCmNtCmBgYApTbyBub3cgdGhlIHZhcmlhYmxlJ3MgdmFsdWUgb2YgdGhlIGdsb2JhbCBlbnZpcm9ubWVudCdzIGhhcyBjaGFuZ2VkLgpEZXRhaWxzIG9uIHRoaXMgY2FuIGJlIGZvdW5kIGluIHRoaXMgc3RhY2tvdmVyIGZsb3cgYW5zd2VyIGh0dHBzOi8vc3RhY2tvdmVyZmxvdy5jb20vcXVlc3Rpb25zLzMyNjIzODU2L2RpZmZlcmVuY2UtYmV0d2Vlbi1hbmQ/bm9yZWRpcmVjdD0xJmxxPTEKCgpIZXJlIGlzIGEgY29kZSB0aGF0IHV0aWxpemVzIHdoaWxlIGxvb3AgdG8gZmluZCBwcmltZSBmYWN0b3JzIC0gCmBgYHtyfQpwcmltZV9mYWN0b3JzX0xvb3AgPC0gZnVuY3Rpb24oeCl7CiAgZmFjdG9ycyA9IGMoKQogIGkgPSAyCiAgd2hpbGUoeCA+PSBpKXsKICAgIGlmKCEgeCAlJSBpKSB7CiAgICAgIGZhY3RvcnMgPC0gYyhmYWN0b3JzLCBpKQogICAgICB4IDwtIHgvaQogICAgICBpIDwtIGkgLSAxCiAgICB9CiAgICBpIDwtIGkgKyAxCiAgfQogIHJldHVybihmYWN0b3JzKQp9CnByaW1lX2ZhY3RvcnNfTG9vcCgyMzY0KQpgYGAKCiMjIEludmlzaWJsZQoKSWYgeW91IGRvbid0IHdhbnQgdG8gbG9hZCBhIG91dHB1dCBhZnRlciBjYWxjdWxhdGlvbiwgYW5kIG9ubHkgdG8gYXNzaWduLCB0aGVuIHVzZSBpbnZpc2libGUoKSBpbnN0ZWFkIG9mIHJldHVybigpLgpgYGB7cn0KCnRyaWFsX2Z1bmNfcmV0IDwtIGZ1bmN0aW9uKHgpewogIHJlcyA8LSBtZWFuKHgpCiAgcmV0dXJuKHJlcykKfQoKdHJpYWxfZnVuY19pbnYgPC0gZnVuY3Rpb24oeCl7CiAgcmVzIDwtIG1lYW4oeCkKICBpbnZpc2libGUocmVzKQp9Cgp2YWxzIDwtIGMoNCw1LDIsNiw5KQp0cmlhbF9mdW5jX3JldCh4ID0gdmFscykKdHJpYWxfZnVuY19pbnYoeCA9IHZhbHMpCgpgYGAKClRoZSByZXR1cm5lZCByZXN1bHQgY2FuIG9ubHkgYmUgc2hvd24gYWZ0ZXIgYXNzaWduaW5nIHRvIGFuIG9iamVjdDoKYGBge3J9CmEgPC0gdHJpYWxfZnVuY19pbnYoeCA9IHZhbHMpCmEKYGBgCgoKCiMjIFR5cGVzIG9mIGZ1bmN0aW9ucyAKClRoZXJlIGFyZSBtYWlubHkgdGhyZWUgdHlwZXMgb2YgZnVuY3Rpb246CgotIFByaW1pdGl2ZSBGdW5jdGlvbnMKLSBJbmZpeCBGdW5jdGlvbnMKLSBSZXBsYWNlbWVudCBGdW5jdGlvbnMKCiMjIyBQcmltaXRpdmUgZnVuY3Rpb25zIAoKVG8gc2VlIHRoZSBhdmFpbGFibGUgcHJpbWl0aXZlIGZ1bmN0aW9uIGluIFIgLSAKYGBge3J9Cm5hbWVzKG1ldGhvZHM6OjouQmFzaWNGdW5zTGlzdCkKYGBgCgpGb3IgZXhhbXBsZSBzdW0gaXMgYSBwcmltaXRpdmUgZnVuY3Rpb24gLSAKYGBge3J9CnN1bQpgYGAKCldlIGNhbiBzZWUgaXQgYnkgdGhlIHdvcmQgYC5QcmltaXRpdmUoInN1bSIpYCBpbiB0aGUgb3V0cHV0LgoKQ2hlY2sgaWYgYSBmdW5jdGlvbiBpcyBwcmltaXRpdmUgLSAKYGBge3J9CmlzLnByaW1pdGl2ZShtZWFuKQppcy5wcmltaXRpdmUoc3VtKQppcy5wcmltaXRpdmUoaXMucHJpbWl0aXZlKQppcy5wcmltaXRpdmUoaXMuaW50ZWdlcikKYGBgCgpQcmltaXRpdmUgZnVuY3Rpb25zIGhhcyB0aGUgdHlwZSA9ICJidWlsdGluIiAtCmBgYHtyfQp0eXBlb2Yoc3VtKQpgYGAKCldoZXJlYXMgLSAKYGBge3J9CnR5cGVvZihtZWFuKQpgYGAKCiMjIyBJbmZpeCBmdW5jdGlvbnMgb3Igb3BlcmF0b3JzIAoKSW5maXggZnVuY3Rpb25zIGFyZSB0aG9zZSBmdW5jdGlvbnMgaW4gd2hpY2ggdGhlIGZ1bmN0aW9uIG5hbWUgY29tZXMgaW4gYmV0d2VlbiBpdHMgYXJndW1lbnRzLCBhbmQgaGVuY2UgaGF2ZSB0d28gYXJndW1lbnRzLiBSIGNvbWVzIHdpdGggYSBudW1iZXIgb2YgYnVpbHQtaW4gaW5maXggb3BlcmF0b3JzIHN1Y2ggYXMgOiwgOjosIDo6OiwgJCwgQCwgXiwgKiwgLywgKywgLSwgPiwgPj0sIDwsIDw9LCA9PSwgIT0sICEsICYsICYmLCB8LCB8fCwgfiwgPC0sIGFuZCA8PC0uIE9uZSBjYW4gY3JlYXRlIGhpcyBvd24gaW5maXggZnVuY3Rpb25zIHRoYXQgc3RhcnQgYW5kIGVuZCB3aXRoICUuIFRoZSBuYW1lIG9mIGFuIGluZml4IGZ1bmN0aW9uIGlzIG1vcmUgZmxleGlibGUgYXMgaXQgY2FuIGNvbnRhaW4gYW55IHNlcXVlbmNlIG9mIGNoYXJhY3RlcnMgZXhjZXB0ICUuIFRoZXJlIGFyZSBzb21lIHByZWRlZmluZWQgaW5maXggb3BlcmF0b3JzIGluIFIgcHJvZ3JhbW1pbmcuIApbU291cmNlXShodHRwczovL3d3dy5nZWVrc2ZvcmdlZWtzLm9yZy90eXBlcy1vZi1mdW5jdGlvbnMtaW4tci1wcm9ncmFtbWluZy8pCgpFeGFtcGxlczoKCiogJSUJLSBSZW1haW5kZXIgb3BlcmF0b3IgICAKKiAlLyUJLSBJbnRlZ2VyIERpdmlzaW9uICAgCiogJSolCS0gTWF0cml4IG11bHRpcGxpY2F0aW9uICAgCiogJW8lCS0gT3V0ZXIgUHJvZHVjdCAgIAoqICV4JQktIEtyb25lY2tlciBwcm9kdWN0ICAgCiogJWluJQktIE1hdGNoaW5nIE9wZXJhdG9yICAgCgpZb3UgY2FuIGNyZWF0ZSB5b3VyIG93biBpbmZpeCBmdW5jdGlvbiBbU291cmNlXShodHRwczovL3N0YWNrb3ZlcmZsb3cuY29tL3F1ZXN0aW9ucy8xOTQ0MTA5Mi9ob3ctY2FuLWktY3JlYXRlLWFuLWluZml4LWJldHdlZW4tb3BlcmF0b3IpIC0gCmBgYHtyfQojIG51bWJlciBpbiBiZXR3ZWVuIHR3byB2YWx1ZXMKIiU+PCUiICA8LSBmdW5jdGlvbih4LCBybmcpIHggPiBybmdbMV0gICYgeCA8IHJuZ1syXQoKIyBudW1iZXIgaW4gYmV0d2VlbiB0d28gdmFsdWVzIGluY2x1ZGluZyB0aG9zZQoiJT49PCUiIDwtIGZ1bmN0aW9uKHgsIHJuZykgeCA+PSBybmdbMV0gJiB4IDw9IHJuZ1syXQoKeCA9IDE6Nwp4CnhbeCAlPjwlIGMoMiw1KV0KeFt4ICU+PTwlIGMoMiw1KV0KYGBgCgojIyMgUmVwbGFjZW1lbnQgZnVuY3Rpb25zIAoKUmVwbGFjZW1lbnQgZnVuY3Rpb25zIG1vZGlmeSB0aGVpciBhcmd1bWVudHMgaW4gcGxhY2UobW9kaWZ5aW5nIGFuIFIgb2JqZWN0IHVzdWFsbHkgY3JlYXRlcyBhIGNvcHkpLiBUaGUgbmFtZSBvZiByZXBsYWNlbWVudCBmdW5jdGlvbnMgYXJlIGFsd2F5cyBzdWNjZWVkZWQgYnkgPC4gVGhleSBtdXN0IGhhdmUgYXJndW1lbnRzIG5hbWVkIHggYW5kIHZhbHVlLCBhbmQgcmV0dXJuIHRoZSBtb2RpZmllZCBvYmplY3QuCgoKCmBgYHtyfQoicmVwbGFjZV9sYXN0PC0iIDwtIGZ1bmN0aW9uKHgsIHZhbHVlKQp7CiAgeFtsZW5ndGgoeCldID0gdmFsdWUKICB4Cn0KYGBgClJ1biB0aGUgZnVuY3Rpb24gYXM6CmByZXBsYWNlX2xhc3QoeCkgPC0gdmFsdWVgCgpgYGB7cn0KeCA8LSAxOjYKeApyZXBsYWNlX2xhc3QoeCkgPC0gOTk5ICAgCiMgaXQgd2lsbCByZXBsYWNlIHRoZSBsYXN0IHZhbHVlIGFzIGRlZmluZWQgaW4gdGhlIGZ1bmN0aW9uCnByaW50KHgpCmBgYAoKRmluZCBtb3JlIGRpc2N1c3Npb24gb24gdGhpcyBpbiBbaGVyZV0oaHR0cHM6Ly9zdGFja292ZXJmbG93LmNvbS9xdWVzdGlvbnMvMTE1NjMxNTQvd2hhdC1hcmUtcmVwbGFjZW1lbnQtZnVuY3Rpb25zLWluLXIpLgoKCgojIyBPYnRhaW4gdGhlIHNvdXJjZSBjb2RlIG9mIGZ1bmN0aW9uIGluIFIKCiMjIyBOb24tcHJpbWl0aXZlIGZ1bmN0aW9ucyBjYXNlCgpbU291cmNlMV0oaHR0cHM6Ly9jcmFuLnItcHJvamVjdC5vcmcvZG9jL21hbnVhbHMvUi1pbnRyby5odG1sI09iamVjdC1vcmllbnRhdGlvbikgICAKW1NvdXJjZTJdKGh0dHBzOi8vc3RhY2tvdmVyZmxvdy5jb20vcXVlc3Rpb25zLzE5MjI2ODE2L2hvdy1jYW4taS12aWV3LXRoZS1zb3VyY2UtY29kZS1mb3ItYS1mdW5jdGlvbikgICAgCltTb3VyY2UzXShodHRwczovL3N0YWNrb3ZlcmZsb3cuY29tL3F1ZXN0aW9ucy8xNDAzNTUwNi9ob3ctdG8tc2VlLXRoZS1zb3VyY2UtY29kZS1vZi1yLWludGVybmFsLW9yLXByaW1pdGl2ZS1mdW5jdGlvbikgIApGb3IgbWFueSBnZW5lcmljIGZ1bmN0aW9ucyB0aGUgZnVuY3Rpb24gYm9keSBpcyBxdWl0ZSBzaG9ydCwgZm9yIGV4YW1wbGUgLQpgYGB7cn0KbWVhbgpgYGAKClRoZSBwcmVzZW5jZSBvZiBVc2VNZXRob2QgaW5kaWNhdGVzIHRoaXMgaXMgYSBnZW5lcmljIGZ1bmN0aW9uLiBUbyBzZWUgd2hhdCBtZXRob2RzIGFyZSBhdmFpbGFibGUgd2UgY2FuIHVzZSBtZXRob2RzKCkgLQpgYGB7cn0KbWV0aG9kcyhtZWFuKQpgYGAKTm9uLXZpc2libGUgZnVuY3Rpb25zIGFyZSBhc3Rlcmlza2VkLgoKVG8gcmVhZCB0aGUgbm9uLXZpc2libGUgZnVuY3Rpb25zIHdlIGNhbiB1dGlsaXplIHRoZSBgZ2V0QW55d2hlcmUoKWAgZnVuY3Rpb24gLSAKYGBge3J9CmdldEFueXdoZXJlKG1lYW4ucXVvc3VyZSkKYGBgCgpJdCBjYW4gYWxzbyBiZSB1c2VkIGZvciBvdGhlcnMgLSAKYGBge3J9CmdldEFueXdoZXJlKG1lYW4uZGVmYXVsdCkKZ2V0QW55d2hlcmUoRmlsdGVyKQpgYGAKCmdldFMzbWV0aG9kIGZ1bmN0aW9uIGNhbiBiZSB1c2VkIHRvbyAtIApgYGB7cn0KZ2V0UzNtZXRob2QoZiA9ICJtZWFuIiwgY2xhc3MgPSAiZGVmYXVsdCIpCmBgYAoKQW5vdGhlciBlYXN5IHdheSBpcyB0byB1c2UgdGhlIGJvZHkgZnVuY3Rpb24gaWYgeW91IGtub3cgdGhlIGNsYXNzIG9mIHRoZSBmdW5jdGlvbiAtIApgYGB7cn0KYm9keShtZWFuLmRlZmF1bHQpCmBgYAoKQXJndW1lbnRzIGNhbiBiZSBvYnRhaW5lZCB1c2luZyAtIApgYGB7cn0KYXJncyhtZWFuLmRlZmF1bHQpCmBgYAoKSWYgeW91IHVzZSBgZWRpdCgpYCwgYSBwcm9tcHQgd2lsbCBvcGVuIHVwIHdpdGggdGhlIGZ1bmN0aW9ucyBjb2RlIC0gCmBgYHtyLCBldmFsPUZBTFNFfQplZGl0KGxtLmZpdCkKYGBgCgoKCgoKCgpTTyBNVUNIIFRPIExFQVJOLCBTTyBMSVRUTEUgVElNRSA6LSkKCgo=