[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