Changeset ff48350 in tol

Timestamp:

Nov 17, 2008, 9:11:51 AM (18 years ago)

Author:

Víctor de Buen <vdebuen@…>

Branches:

1941-docker-image-to-test, devel, master

Children:

d250b78

Parents:

53ceb48

Message:

Adding optional parameters of R KDE

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@176 be4846ae-f051-483a-831f-b64e7d08527f

Location:

tol/stdlib/math/stat/kde

Files:

• _rkde.tol (modified) (1 diff)
• tolRkde.R (modified) (1 diff)

tol/stdlib/math/stat/kde/_rkde.tol

@@ -64 +64 @@
     // Extract extra arguments
     Real n       = getOptArg(optArgs, "n",       512);
+    Real adjust  = getOptArg(optArgs, "adjust",  1);
+    Real from    = getOptArg(optArgs, "from",    -1/0);
+    Real to      = getOptArg(optArgs, "to",      +1/0);
+    Real cut     = getOptArg(optArgs, "cut",     3);
     Real verbose = getOptArg(optArgs, "verbose", FALSE);
-
+    Real leftBounded  = !IsUnknown(from) & (from>-1/0);
+    Real rightBounded = !IsUnknown(to)   & (to  <+1/0);
     Set args.info =
       [[
         [[n, "n", "int"]],
+        [[adjust, "adjust", "real"]],
+        [[leftBounded, "leftBounded", "bool"]],
+        [[from, "from", "real"]],
+        [[rightBounded, "rightBounded", "bool"]],
+        [[to, "to", "real"]],
+        [[cut, "cut", "real"]],
         [[verbose, "verbose", "bool"]],
         [[_sample.bbm, "sample.bbm"]],

tol/stdlib/math/stat/kde/tolRkde.R

@@ -27 +27 @@
 
   # Extract optional arguments
-  verbose    <- get.tol.arg(Rkde_args$verbose, FALSE)
-  n          <- get.tol.arg(Rkde_args$n,       512)
+  verbose      <- get.tol.arg(Rkde_args$verbose,      FALSE)
+  n_           <- get.tol.arg(Rkde_args$n,            512)
+  adjust_      <- get.tol.arg(Rkde_args$ajust,        1)
+  leftBounded  <- get.tol.arg(Rkde_args$leftBounded,  FALSE)
+  from_        <- get.tol.arg(Rkde_args$from,         -1/0)
+  rightBounded <- get.tol.arg(Rkde_args$rightBounded, FALSE)
+  to_          <- get.tol.arg(Rkde_args$to,           +1/0)
+  cut_         <- get.tol.arg(Rkde_args$cut,          3)
   if(verbose)  { print(Rkde_args) }
-  
-  dens <- density(sample)
+  if(leftBounded & rightBounded)
+  {
+    dens <- density(sample,bw = "nrd0", adjust = adjust_,
+        kernel = c("gaussian", "epanechnikov", "rectangular",
+                   "triangular", "biweight", "cosine", "optcosine"),
+        window = kernel, 
+        give.Rkern = FALSE,n=n_,from=from_,to=to_,cut=cut_)
+  } 
+  else if(!leftBounded & rightBounded)
+  {
+    dens <- density(sample,bw = "nrd0", adjust = adjust_,
+        kernel = c("gaussian", "epanechnikov", "rectangular",
+                   "triangular", "biweight", "cosine", "optcosine"),
+        window = kernel, 
+        give.Rkern = FALSE,n=n_,from=from_,to=to_,cut=cut_)
+  }
+  else if(leftBounded & !rightBounded)
+  {
+    dens <- density(sample,bw = "nrd0", adjust = adjust_,
+        kernel = c("gaussian", "epanechnikov", "rectangular",
+                   "triangular", "biweight", "cosine", "optcosine"),
+        window = kernel, 
+        give.Rkern = FALSE,n=n_,from=from_,cut=cut_)  
+  }
+  else if(!leftBounded & !rightBounded)
+  {
+    dens <- density(sample,bw = "nrd0", adjust = adjust_,
+        kernel = c("gaussian", "epanechnikov", "rectangular",
+                   "triangular", "biweight", "cosine", "optcosine"),
+        window = kernel, 
+        give.Rkern = FALSE,n=n_,cut=cut_)
+  }
   kdeX <- dens$x
   kdeY <- dens$y