[Returnanalytics-commits] r2513 - pkg/PerformanceAnalytics/sandbox/pulkit/week3/code

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Jul 7 16:47:29 CEST 2013


Author: pulkit
Date: 2013-07-07 16:47:29 +0200 (Sun, 07 Jul 2013)
New Revision: 2513

Added:
   pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R
Log:
Golden Section Algorithm

Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R	                        (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R	2013-07-07 14:47:29 UTC (rev 2513)
@@ -0,0 +1,64 @@
+#' @title
+#' Golden Section Algorithm
+#'
+#' @description
+#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ‘Triple Penance’ Rule(January 1, 2013).
+
+
+golden_section<-function(a,b,minimum = TRUE,function_name,confidence,...){
+
+    # DESCRIPTION
+    # A function to perform the golden search algorithm on the provided function
+
+    # Inputs:
+    #
+    # a: The starting point
+    #
+    # b: The end point
+    #
+    # minimum: If we want to calculate the minimum set minimum= TRUE(default)
+    #
+    # function_name: The name of the function
+  
+    FUN = match.fun(function_name)
+    tol = 10^-9
+    sign = 1 
+    
+    if(!minimum){
+        sign = -1
+    }
+    N = round(ceiling(-2.078087*log(tol/abs(b-a))))
+    r = 0.618033989
+    c = 1.0 - r
+    x1 = r*a + c*b
+    x2 = c*a + r*b
+    f1 = sign * FUN(x1,...)
+    f2 = sign * FUN(x2,...)
+    for(i in 1:N){
+        if(f1>f2){
+            a = x1
+            x1 = x2
+            f1 = f2
+            x2 = c*a+r*b
+            f2 = sign*FUN(x2,...)
+        }
+        else{
+            b = x2
+            x2 = x1
+            f2 = f1
+            x1 = r*a + c*b
+            f1 = sign*FUN(x1,...)
+    }
+    }
+    if(f1<f2){
+        return(list(min_value=sign*f1,x=x1))
+    }
+    else{
+        return(list(min_value=sign*f2,x=x2))
+    }
+}   
+      
+
+
+
+



More information about the Returnanalytics-commits mailing list