From bad996638a3b5ab3f1f4224af43c879f3240fc64 Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Tue, 14 Feb 2017 09:47:42 +0100 Subject: [PATCH 01/23] ci.level in localtest (only for kernel) --- DESCRIPTION | 2 +- R/localtest.R | 28 ++++--- man/localtest.Rd | 3 +- src/lsq.mod | 207 +++++++++++++++++++++++++++++++++++++++++++++++ src/program2.f90 | 33 ++++++-- 5 files changed, 256 insertions(+), 17 deletions(-) create mode 100644 src/lsq.mod diff --git a/DESCRIPTION b/DESCRIPTION index 4b36d29..fe6bc74 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,4 +35,4 @@ Imports: shinyjs, wesanderson, ggplot2 -RoxygenNote: 5.0.1 +RoxygenNote: 5.0.0 diff --git a/R/localtest.R b/R/localtest.R index c8ab255..fa9257c 100644 --- a/R/localtest.R +++ b/R/localtest.R @@ -141,7 +141,7 @@ localtest <- function(formula, data = data, na.action = "na.omit", nboot = 500, h0 = -1.0, h = -1.0, nh = 30, kernel = "epanech", p = 3, kbin = 100, rankl = NULL, ranku = NULL, seed = NULL, cluster = TRUE, - ncores = NULL, ...) { + ncores = NULL, ci.level = 0.95, ...) { if(kernel == "gaussian") kernel <- 3 if(kernel == "epanech") kernel <- 1 @@ -187,7 +187,7 @@ localtest <- function(formula, data = data, na.action = "na.omit", ncmax <- 5 c2 <- NULL # if(is.null(seed)) seed <- -1 - + nalfas <- length(ci.level) @@ -323,22 +323,30 @@ localtest <- function(formula, data = data, na.action = "na.omit", pcmin = as.double(rankl), # rango de busqueda maximo r = as.integer(der), D = as.double(rep(-1.0,1)), - Ci = as.double(rep(-1.0,1)), - Cs = as.double(rep(-1.0,1)), + Ci = as.double(rep(-1.0,nalfas)), + Cs = as.double(rep(-1.0,nalfas)), # seed = as.integer(seed), umatrix = as.double(umatrix), + level = as.double(ci.level), + nalfas = as.integer(nalfas), PACKAGE = "npregfast" ) + decision <- character(nalfas) + for(i in 1:nalfas){ + if (localtest$Ci[i] <= 0 & 0 <= localtest$Cs[i]) { + decision[i] <- "Acepted" + } else { + decision[i] <- "Rejected" + } + } + + - if (localtest$Ci <= 0 & 0 <= localtest$Cs) { - decision <- "Acepted" - } else { - decision <- "Rejected" - } res <- cbind(d = round(localtest$D, digits = 4), Lwr = round(localtest$Ci, digits = 4), - Upr = round(localtest$Cs, digits = 4), Decision = decision) + Upr = round(localtest$Cs, digits = 4), Decision = decision, + Ci.Level = round(ci.level, digits = 2)) # class(res) <- 'localtest' }else{ diff --git a/man/localtest.Rd b/man/localtest.Rd index 6a5560a..6c800af 100644 --- a/man/localtest.Rd +++ b/man/localtest.Rd @@ -7,7 +7,8 @@ localtest(formula, data = data, na.action = "na.omit", der, smooth = "kernel", weights = NULL, nboot = 500, h0 = -1, h = -1, nh = 30, kernel = "epanech", p = 3, kbin = 100, rankl = NULL, - ranku = NULL, seed = NULL, cluster = TRUE, ncores = NULL, ...) + ranku = NULL, seed = NULL, cluster = TRUE, ncores = NULL, + ci.level = 0.95, ...) } \arguments{ \item{formula}{An object of class \code{formula}: a sympbolic diff --git a/src/lsq.mod b/src/lsq.mod new file mode 100644 index 0000000..d5d427e --- /dev/null +++ b/src/lsq.mod @@ -0,0 +1,207 @@ +GFORTRAN module version '10' created from program2.f90 +MD5:e2c0d7d5e3709bd95ab57a404d49dd51 -- If you edit this, you'll get what you deserve. + +(() () () () () () () () () () () () () () () () () () () () () () () () +() () ()) + +() + +() + +() + +() + +() + +(2 'bksub2' 'lsq' '' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL +UNKNOWN 0 0 SUBROUTINE IMPLICIT_PURE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 0 +UNKNOWN ()) 3 0 (4 5 6) () 0 () () () 0 0) +7 'cov' 'lsq' '' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL UNKNOWN 0 +0 SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 0 UNKNOWN ()) 8 0 (9 10 11 +12 13 14) () 0 () () () 0 0) +15 'd' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +EXPLICIT-SAVE 0 0 ALLOCATABLE DIMENSION) (REAL 8 0 0 0 REAL ()) 0 0 () ( +1 0 DEFERRED () ()) 0 () () () 0 0) +16 'dp' 'lsq' '' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +IMPLICIT-SAVE 0 0) (INTEGER 4 0 0 0 INTEGER ()) 0 0 () (CONSTANT ( +INTEGER 4 0 0 0 INTEGER ()) 0 '8') () 0 () () () 0 0) +17 'hdiag' 'lsq' '' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL +UNKNOWN 0 0 SUBROUTINE IMPLICIT_PURE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 0 +UNKNOWN ()) 18 0 (19 20 21 22) () 0 () () () 0 0) +23 'includ' 'lsq' '' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL +UNKNOWN 0 0 SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 0 UNKNOWN ()) 24 +0 (25 26 27) () 0 () () () 0 0) +28 'initialized' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC +UNKNOWN EXPLICIT-SAVE 0 0) (LOGICAL 4 0 0 0 LOGICAL ()) 0 0 () () 0 () () +() 0 0) +29 'inv' 'lsq' '' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL UNKNOWN +0 0 SUBROUTINE IMPLICIT_PURE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 0 UNKNOWN ()) +30 0 (31 32) () 0 () () () 0 0) +33 'lsq' 'lsq' '' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN UNKNOWN +0 0) (UNKNOWN 0 0 0 0 UNKNOWN ()) 0 0 () () 0 () () () 0 0) +34 'ncol' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +EXPLICIT-SAVE 0 0) (INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +35 'nobs' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +EXPLICIT-SAVE 0 0) (INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +36 'partial_corr' 'lsq' '' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL +UNKNOWN 0 0 SUBROUTINE IMPLICIT_PURE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 0 +UNKNOWN ()) 37 0 (38 39 40 41 42) () 0 () () () 0 0) +43 'r' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +EXPLICIT-SAVE 0 0 ALLOCATABLE DIMENSION) (REAL 8 0 0 0 REAL ()) 0 0 () ( +1 0 DEFERRED () ()) 0 () () () 0 0) +44 'r_dim' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +EXPLICIT-SAVE 0 0) (INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +45 'regcf' 'lsq' '' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL +UNKNOWN 0 0 SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 0 UNKNOWN ()) 46 +0 (47 48 49) () 0 () () () 0 0) +50 'reordr' 'lsq' '' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL +UNKNOWN 0 0 SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 0 UNKNOWN ()) 51 +0 (52 53 54 55) () 0 () () () 0 0) +56 'rhs' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +EXPLICIT-SAVE 0 0 ALLOCATABLE DIMENSION) (REAL 8 0 0 0 REAL ()) 0 0 () ( +1 0 DEFERRED () ()) 0 () () () 0 0) +57 'row_ptr' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +EXPLICIT-SAVE 0 0 ALLOCATABLE DIMENSION) (INTEGER 4 0 0 0 INTEGER ()) 0 +0 () (1 0 DEFERRED () ()) 0 () () () 0 0) +58 'rss' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +EXPLICIT-SAVE 0 0 ALLOCATABLE DIMENSION) (REAL 8 0 0 0 REAL ()) 0 0 () ( +1 0 DEFERRED () ()) 0 () () () 0 0) +59 'rss_set' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +EXPLICIT-SAVE 0 0) (LOGICAL 4 0 0 0 LOGICAL ()) 0 0 () () 0 () () () 0 0) +60 'selected_real_kind' '(intrinsic)' '' 1 ((PROCEDURE UNKNOWN-INTENT +UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 FUNCTION) (UNKNOWN 0 0 0 0 UNKNOWN ()) +0 0 () () 60 () () () 0 0) +61 'sing' 'lsq' '' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL UNKNOWN +0 0 SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 0 UNKNOWN ()) 62 0 (63 64) +() 0 () () () 0 0) +65 'ss' 'lsq' '' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL UNKNOWN 0 +0 SUBROUTINE) (UNKNOWN 0 0 0 0 UNKNOWN ()) 0 0 () () 0 () () () 0 0) +66 'sserr' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +EXPLICIT-SAVE 0 0) (REAL 8 0 0 0 REAL ()) 0 0 () () 0 () () () 0 0) +67 'startup' 'lsq' '' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL +UNKNOWN 0 0 SUBROUTINE) (UNKNOWN 0 0 0 0 UNKNOWN ()) 68 0 (69 70) () 0 () +() () 0 0) +71 'tol' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +EXPLICIT-SAVE 0 0 ALLOCATABLE DIMENSION) (REAL 8 0 0 0 REAL ()) 0 0 () ( +1 0 DEFERRED () ()) 0 () () () 0 0) +72 'tol_set' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +EXPLICIT-SAVE 0 0) (LOGICAL 4 0 0 0 LOGICAL ()) 0 0 () () 0 () () () 0 0) +73 'tolset' 'lsq' '' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL +UNKNOWN 0 0 SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 0 UNKNOWN ()) 74 +0 (75) () 0 () () () 0 0) +76 'toly' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +EXPLICIT-SAVE 0 0) (REAL 8 0 0 0 REAL ()) 0 0 () () 0 () () () 0 0) +77 'varprd' 'lsq' '' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL +UNKNOWN 0 0 FUNCTION ALWAYS_EXPLICIT) (REAL 8 0 0 0 REAL ()) 78 0 (79 80) +() 81 () () () 0 0) +82 'vmove' 'lsq' '' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL +UNKNOWN 0 0 SUBROUTINE) (UNKNOWN 0 0 0 0 UNKNOWN ()) 83 0 (84 85 86) () +0 () () () 0 0) +87 'vorder' 'lsq' '' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +EXPLICIT-SAVE 0 0 ALLOCATABLE DIMENSION) (INTEGER 4 0 0 0 INTEGER ()) 0 +0 () (1 0 DEFERRED () ()) 0 () () () 0 0) +4 'x' '' '' 3 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DIMENSION +DUMMY) (REAL 8 0 0 0 REAL ()) 0 0 () (1 0 ASSUMED_SHAPE (CONSTANT ( +INTEGER 4 0 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) +5 'b' '' '' 3 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DIMENSION +DUMMY) (REAL 8 0 0 0 REAL ()) 0 0 () (1 0 ASSUMED_SHAPE (CONSTANT ( +INTEGER 4 0 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) +6 'nreq' '' '' 3 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) ( +INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +9 'nreq' '' '' 8 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) ( +INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +10 'var' '' '' 8 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) +(REAL 8 0 0 0 REAL ()) 0 0 () () 0 () () () 0 0) +11 'covmat' '' '' 8 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DIMENSION DUMMY) (REAL 8 0 0 0 REAL ()) 0 0 () (1 0 ASSUMED_SHAPE ( +CONSTANT (INTEGER 4 0 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) +12 'dimcov' '' '' 8 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) +(INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +13 'sterr' '' '' 8 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DIMENSION DUMMY) (REAL 8 0 0 0 REAL ()) 0 0 () (1 0 ASSUMED_SHAPE ( +CONSTANT (INTEGER 4 0 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) +14 'ifault' '' '' 8 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DUMMY) (INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +19 'xrow' '' '' 18 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DIMENSION DUMMY) (REAL 8 0 0 0 REAL ()) 0 0 () (1 0 ASSUMED_SHAPE ( +CONSTANT (INTEGER 4 0 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) +20 'nreq' '' '' 18 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) +(INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +21 'hii' '' '' 18 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) +(REAL 8 0 0 0 REAL ()) 0 0 () () 0 () () () 0 0) +22 'ifault' '' '' 18 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DUMMY) (INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +25 'weight' '' '' 24 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DUMMY) (REAL 8 0 0 0 REAL ()) 0 0 () () 0 () () () 0 0) +26 'xrow' '' '' 24 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DIMENSION DUMMY) (REAL 8 0 0 0 REAL ()) 0 0 () (1 0 ASSUMED_SHAPE ( +CONSTANT (INTEGER 4 0 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) +27 'yelem' '' '' 24 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) +(REAL 8 0 0 0 REAL ()) 0 0 () () 0 () () () 0 0) +31 'nreq' '' '' 30 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) +(INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +32 'rinv' '' '' 30 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DIMENSION DUMMY) (REAL 8 0 0 0 REAL ()) 0 0 () (1 0 ASSUMED_SHAPE ( +CONSTANT (INTEGER 4 0 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) +38 'in' '' '' 37 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) ( +INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +39 'cormat' '' '' 37 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DIMENSION DUMMY) (REAL 8 0 0 0 REAL ()) 0 0 () (1 0 ASSUMED_SHAPE ( +CONSTANT (INTEGER 4 0 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) +40 'dimc' '' '' 37 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) +(INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +41 'ycorr' '' '' 37 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DIMENSION DUMMY) (REAL 8 0 0 0 REAL ()) 0 0 () (1 0 ASSUMED_SHAPE ( +CONSTANT (INTEGER 4 0 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) +42 'ifault' '' '' 37 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DUMMY) (INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +47 'beta' '' '' 46 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DIMENSION DUMMY) (REAL 8 0 0 0 REAL ()) 0 0 () (1 0 ASSUMED_SHAPE ( +CONSTANT (INTEGER 4 0 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) +48 'nreq' '' '' 46 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) +(INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +49 'ifault' '' '' 46 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DUMMY) (INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +52 'list' '' '' 51 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DIMENSION DUMMY) (INTEGER 4 0 0 0 INTEGER ()) 0 0 () (1 0 ASSUMED_SHAPE +(CONSTANT (INTEGER 4 0 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) +53 'n' '' '' 51 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) ( +INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +54 'pos1' '' '' 51 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) +(INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +55 'ifault' '' '' 51 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DUMMY) (INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +63 'lindep' '' '' 62 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DIMENSION DUMMY) (LOGICAL 4 0 0 0 LOGICAL ()) 0 0 () (1 0 ASSUMED_SHAPE +(CONSTANT (INTEGER 4 0 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) +64 'ifault' '' '' 62 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DUMMY) (INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +69 'nvar' '' '' 68 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) +(INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +70 'fit_const' '' '' 68 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DUMMY) (LOGICAL 4 0 0 0 LOGICAL ()) 0 0 () () 0 () () () 0 0) +75 'eps' '' '' 74 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +OPTIONAL DUMMY) (REAL 8 0 0 0 REAL ()) 0 0 () () 0 () () () 0 0) +79 'x' '' '' 78 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DIMENSION +DUMMY) (REAL 8 0 0 0 REAL ()) 0 0 () (1 0 ASSUMED_SHAPE (CONSTANT ( +INTEGER 4 0 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) +80 'nreq' '' '' 78 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) +(INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +81 'fn_val' '' '' 78 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN +UNKNOWN 0 0 RESULT ALWAYS_EXPLICIT) (REAL 8 0 0 0 REAL ()) 0 0 () () 0 () +() () 0 0) +84 'from' '' '' 83 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) +(INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +85 'to' '' '' 83 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) ( +INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +86 'ifault' '' '' 83 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 +DUMMY) (INTEGER 4 0 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) +) + +('bksub2' 0 2 'cov' 0 7 'd' 0 15 'dp' 0 16 'hdiag' 0 17 'includ' 0 23 +'initialized' 0 28 'inv' 0 29 'lsq' 0 33 'ncol' 0 34 'nobs' 0 35 +'partial_corr' 0 36 'r' 0 43 'r_dim' 0 44 'regcf' 0 45 'reordr' 0 50 'rhs' +0 56 'row_ptr' 0 57 'rss' 0 58 'rss_set' 0 59 'selected_real_kind' 0 60 +'sing' 0 61 'ss' 0 65 'sserr' 0 66 'startup' 0 67 'tol' 0 71 'tol_set' 0 +72 'tolset' 0 73 'toly' 0 76 'varprd' 0 77 'vmove' 0 82 'vorder' 0 87) diff --git a/src/program2.f90 b/src/program2.f90 index b51c8e5..cfa0f8e 100644 --- a/src/program2.f90 +++ b/src/program2.f90 @@ -271,7 +271,7 @@ subroutine rfast_h_alo(X,Y,W,n,h,p,Xb,Pb,kbin,kernel,nh) subroutine localtest_(F,X,Y,W,n,h0,h,nh,p,kbin,fact,nf,kernel,nboot,& -pcmax,pcmin,r,D,Ci,Cs,umatrix) +pcmax,pcmin,r,D,Ci,Cs,umatrix,level,nalfas) !!DEC$ ATTRIBUTES DLLEXPORT::localtest @@ -280,12 +280,12 @@ subroutine localtest_(F,X,Y,W,n,h0,h,nh,p,kbin,fact,nf,kernel,nboot,& implicit none integer,parameter::kfino=1000 integer i,n,j,kbin,p,nf,F(n),fact(nf),iboot,ir,l,k,& -nh,nboot,kernel,r,index,posmin,posmax +nh,nboot,kernel,r,index,posmin,posmax,nalfas double precision X(n),Y(n),W(n),Waux(n),xb(kbin),pb(kbin,3,nf),& u,h(nf),Pb_0(kbin,3),res(n),Pb_0boot(kbin,3,nboot),meanerr,P_0(n),Err(n),& -C(3,nf),xmin(nf),xmax(nf),pcmax(nf),pcmin(nf),Ci,Cs,& +C(3,nf),xmin(nf),xmax(nf),pcmax(nf),pcmin(nf),Ci(nalfas),Cs(nalfas),& Dboot(nboot),D,pmax,pasox,pasoxfino,icont(kbin,3,nf),xminc,xmaxc,h0,& -umatrix(n,nboot) +umatrix(n,nboot),level(nalfas) !REAL(4) rand double precision, allocatable:: Yboot(:),muhatg(:),errg(:),errgboot(:),& muhatgboot(:),Xfino(:),Pfino(:),p0(:,:),pred(:),pboot(:,:,:,:),cboot(:,:,:),& @@ -709,9 +709,29 @@ subroutine localtest_(F,X,Y,W,n,h0,h,nh,p,kbin,fact,nf,kernel,nboot,& Ci=-1 Cs=-1 +do i=1,nalfas + call ICbootstrap_beta_per(Dboot,nboot,1-level(i),Ci(i),Cs(i)) +end do + +end subroutine + + + + + +subroutine ICbootstrap_beta_per(X,nboot,beta,li,ls) +implicit none +integer nboot,nalfa +double precision X(nboot),li,ls,alfa(3),Q(3),beta -call ICbootstrap(D,Dboot,nboot,Ci,Cs) +alfa(1)=beta/2 +alfa(2)=0.5 +alfa(3)=1-beta/2 +nalfa=3 +call quantile (X,nboot,alfa,nalfa,Q) +li=Q(1)!-Q(2) +ls=Q(3)!-Q(2) end subroutine @@ -719,6 +739,9 @@ subroutine localtest_(F,X,Y,W,n,h0,h,nh,p,kbin,fact,nf,kernel,nboot,& + + + !************************************************* !************************************************* From 8cf984d0f922b85b248cb285b5667503548d9193 Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Tue, 14 Feb 2017 10:00:12 +0100 Subject: [PATCH 02/23] ci.level help --- R/localtest.R | 1 + man/localtest.Rd | 2 ++ 2 files changed, 3 insertions(+) diff --git a/R/localtest.R b/R/localtest.R index fa9257c..257e495 100644 --- a/R/localtest.R +++ b/R/localtest.R @@ -55,6 +55,7 @@ #'@param ncores An integer value specifying the number of cores to be used #' in the parallelized procedure. If \code{NULL} (default), the number of cores #' to be used is equal to the number of cores of the machine - 1. +#'@param ci.level Level of bootstrap confidence interval. Defaults to 0.95 (corresponding to 95\%). Note that the function accepts a vector of levels. #' @param \ldots Other options. #' #' diff --git a/man/localtest.Rd b/man/localtest.Rd index 6c800af..91317ea 100644 --- a/man/localtest.Rd +++ b/man/localtest.Rd @@ -83,6 +83,8 @@ not worth parallelize.} in the parallelized procedure. If \code{NULL} (default), the number of cores to be used is equal to the number of cores of the machine - 1.} +\item{ci.level}{Level of bootstrap confidence interval. Defaults to 0.95 (corresponding to 95\%). Note that the function accepts a vector of levels.} + \item{\ldots}{Other options.} } \value{ From 801a2f3cd4ffe83be62ffd6235646867952a29fd Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Thu, 28 Sep 2017 17:09:05 +0200 Subject: [PATCH 03/23] changes for the allotest, eventually i'm going to do it in R directly --- src/program2.f90 | 433 +++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 403 insertions(+), 30 deletions(-) diff --git a/src/program2.f90 b/src/program2.f90 index cfa0f8e..8a64535 100644 --- a/src/program2.f90 +++ b/src/program2.f90 @@ -17,10 +17,10 @@ subroutine allotest_(X,Y,W,n,kbin,nboot,T,pvalor,umatrix) !!DEC$ ATTRIBUTES DLLEXPORT::test_allo !!DEC$ ATTRIBUTES C, REFERENCE, ALIAS:'test_allo_' :: test_allo -integer n,kbin,p,iboot,nboot,i +integer n,kbin,p,iboot,nboot,i,j double precision X(n),X2(n),Y(n),Y2(n),W(n),& errg(n),muhatg(n),Yboot(n),h,T,Tboot,pvalor,& -umatrix(n,nboot), aux +umatrix(n,nboot), aux, beta(10) !real u, rand double precision u real,external::rnnof @@ -28,7 +28,7 @@ subroutine allotest_(X,Y,W,n,kbin,nboot,T,pvalor,umatrix) - +w=1 h=-1.0 @@ -44,16 +44,28 @@ subroutine allotest_(X,Y,W,n,kbin,nboot,T,pvalor,umatrix) ! Estimación Piloto +!p=1 +!call Reglineal_pred(X,Y,W,n,p,muhatg) + + p=1 -call Reglineal_pred(X,Y,W,n,p,muhatg) +call Reglineal (X,Y,W,n,p,Beta) do i=1,n - errg(i)=Y(i)-muhatg(i) +muhatg(i)=beta(1) +do j=1,p +muhatg(i)=muhatg(i)+beta(j+1)*X(i)**j +end do end do -call RfastC3(X,Y,W,n,p,kbin,h,T) + errg=Y-muhatg +!print *, errg(1:n) + +call RfastC3(X,Y,W,n,p,kbin,h,T) +print *, T + pvalor=0 do iboot=1,nboot do i=1,n @@ -79,35 +91,232 @@ subroutine allotest_(X,Y,W,n,kbin,nboot,T,pvalor,umatrix) +subroutine allotest_sestelo_(X,Y,W,n,kbin,nboot,T,pvalor,umatrix) +implicit none + +!!DEC$ ATTRIBUTES DLLEXPORT::test_allo +!!DEC$ ATTRIBUTES C, REFERENCE, ALIAS:'test_allo_' :: test_allo + +integer n,kbin,p,iboot,nboot,i,j +double precision X(n),X2(n),Y(n),Y2(n),W(n),& +errg(n),muhatg(n),Yboot(n),h,T,Tboot,pvalor,& +umatrix(n,nboot), aux, beta(10) +!real u, rand +double precision u +real,external::rnnof +integer,external::which_min,which_max2 + + +h=-1.0 +aux = 0.001 +do i=1,n + X2(i)=max(X(i),aux) + Y2(i)=max(Y(i),aux) +end do + +X2=log(X2) +Y2=log(Y2) + +! Estimación Piloto escala normal +p=1 +call Reglineal (X2,Y2,W,n,p,Beta) + +do i=1,n +muhatg(i)=exp(beta(1)) +do j=1,p +muhatg(i)=muhatg(i)*X(i)**beta(j+1) +end do +end do +errg=Y-muhatg ! residuos modelo alometrico + + +!print *, errg(1:n) + +call RfastC3_sestelo(X,Y,W,n,p,kbin,h,T) +print *, T + +pvalor=0 +do iboot=1,nboot + do i=1,n + !u=RAND() + !call test_random(u) + u = umatrix(i,iboot) + if (u.le.(5.0+sqrt(5.0))/10) then + Yboot(i)=muhatg(i)+errg(i)*(1-sqrt(5.0))/2 + else + Yboot(i)=muhatg(i)+errg(i)*(1+sqrt(5.0))/2 + end if + end do + h=-1.0 +call RfastC3_sestelo(X,Yboot,W,n,p,kbin,h,Tboot) +if(Tboot.gt.T) pvalor=pvalor+1 +end do + +pvalor=pvalor/nboot + +end subroutine + + +subroutine RfastC3_sestelo(X,Y,W,n,p,kbin,h,T) +implicit none + +integer,parameter::kernel=1,nh=20 +integer n,kbin,p,i,j +double precision X(n),Y(n),W(n),Xb(kbin),pred1(n),h,X2(n),Y2(n),& +Pb(kbin,3),residuo(n),predg(n),T,sumw,sum2,xmin,xmax,rango,beta(10),aux +integer,external::which_min + + + +aux = 0.001 +do i=1,n + X2(i)=max(X(i),aux) + Y2(i)=max(Y(i),aux) +end do +! Ajustamos el modelo lineal primero +X2=log(X2) +Y2=log(Y2) + +p=1 +call Reglineal (X2,Y2,W,n,p,Beta) +do i=1,n +predg(i)=exp(beta(1)) +do j=1,p +predg(i)=predg(i)*X(i)**beta(j+1) +end do +end do + +Residuo=Y-predg + +! ----------------------------------------- + +!print *, predg + +!do i=1,n + ! print (*,*) predg(i) +!end do + +p=3 +!call rfast_h_alo(X,Residuo,W,n,h,p,Xb,Pb,kbin,kernel,nh) +call Grid1d(X,W,n,Xb,kbin) + + + +call rfast_h(X,Residuo,W,n,h,p,Xb,Pb(1,1),kbin,kernel,nh) + + +!stop + +!call Interpola_alo(Xb,Pb,kbin,X,pred1,pred2,n) +call Interpola(Xb,Pb(1,1),kbin,X,pred1,n) + +!do i=1,n +!print *, residuo(1:n) +! print *, pred1(i) +!end do + + + !print *, pred1(1:n) + +!Centro las pred1 +sumw=0 +sum2=0 +do i=1,n +sumw=sumw+W(i) +sum2=sum2+pred1(i) +end do + + + +do i=1,n +Pred1(i)=pred1(i)-(sum2/sumw) +end do + + + + +xmin=9999 +xmax=-xmin +do i=1,n +if(x(i).le.xmin) xmin=x(i) +if(x(i).ge.xmax) xmax=x(i) +end do + +rango=xmax-xmin + +T=0 +do i=1,n +!if (abs(X(i)).le.xmax-(0.10*rango)) +T=T+abs(pred1(i)) +end do + + + +end subroutine + + subroutine RfastC3(X,Y,W,n,p,kbin,h,T) implicit none integer,parameter::kernel=1,nh=20 -integer n,kbin,p,i -double precision X(n),Y(n),W(n),Xb(kbin),pred1(n),pred2(n),h,& -Pb(kbin),residuo(n),predg(n),T,sumw,sum2,xmin,xmax,rango +integer n,kbin,p,i,j +double precision X(n),Y(n),W(n),Xb(kbin),pred1(n),h,& +Pb(kbin,3),residuo(n),predg(n),T,sumw,sum2,xmin,xmax,rango,beta(10) integer,external::which_min + + ! Ajustamos el modelo lineal primero p=1 -call Reglineal_pred(X,Y,W,n,p,predg) +!call Reglineal_pred(X,Y,W,n,p,predg) + +call Reglineal (X,Y,W,n,p,Beta) do i=1,n -Residuo(i)=Y(i)-predg(i) +predg(i)=beta(1) +do j=1,p +predg(i)=predg(i)+beta(j+1)*X(i)**j end do +end do + +Residuo=Y-predg + ! ----------------------------------------- -p=2 +!print *, predg + +!do i=1,n + ! print (*,*) predg(i) +!end do + +p=2 + + + +!call rfast_h_alo(X,Residuo,W,n,h,p,Xb,Pb,kbin,kernel,nh) +call Grid1d(X,W,n,Xb,kbin) -call rfast_h_alo(X,Residuo,W,n,h,p,Xb,Pb,kbin,kernel,nh) -call Interpola_alo(Xb,Pb,kbin,X,pred1,pred2,n) +call rfast_h(X,Residuo,W,n,h,p,Xb,Pb(1,1),kbin,kernel,nh) +!stop + +!call Interpola_alo(Xb,Pb,kbin,X,pred1,pred2,n) +call Interpola(Xb,Pb(1,1),kbin,X,pred1,n) + +do i=1,n +!print *, residuo(1:n) + print *, pred1(i) +end do + + + !print *, pred1(1:n) + !Centro las pred1 sumw=0 sum2=0 @@ -116,10 +325,15 @@ subroutine RfastC3(X,Y,W,n,p,kbin,h,T) sum2=sum2+pred1(i) end do + + do i=1,n -Pred1(i)=pred1(i)-sum2/sumw +Pred1(i)=pred1(i)-(sum2/sumw) end do + + + xmin=9999 xmax=-xmin do i=1,n @@ -170,6 +384,8 @@ subroutine Reglineal_pred(X,Y,W,n,p,Pred) + + !********************************************************* ! !Subroutine RFAST_H_alo MODIFICADA PARA EL CONTRASTE ALOMETRICO @@ -755,18 +971,22 @@ subroutine globaltest_(F,X,Y,W,n,h0,h,nh,p,kbin,fact,nf,kernel,nboot,r,T,& implicit none integer i,z,n,j,kbin,p,nf,F(n),fact(nf),iboot,k,& -nh,nboot,kernel,r,pp +nh,nboot,kernel,r,pp,icont,ii double precision X(n),Y(n),W(n),Waux(n),xb(kbin),pb(kbin,3,nf),& h(nf),h0,hp(nf),pred1(kbin,nf),pred0(kbin),pol(n,nf),& -u,Tboot,T,pvalor,umatrix(n,nboot) +u,Tboot(4),pvalor(4),umatrix(n,nboot),h0i,hi(nf),hgi(nf),meanerr,T(4),& +RSS0,RSS1,hg(nf) !REAL(4) rand double precision, allocatable:: Yboot(:),muhatg(:),errg(:),errgboot(:),& -muhatgboot(:),muhatg2(:) - +muhatgboot(:),muhatg2(:),fpar(:,:),fpar_est(:),Xaux(:) -allocate (errg(n),muhatg(n),Yboot(n),errgboot(n),muhatgboot(n),muhatg2(n)) +allocate (errg(n),muhatg(n),Yboot(n),errgboot(n),muhatgboot(n),muhatg2(n),& + fpar_est(n),fpar(n,nf),Xaux(n)) +h0i = h0 +hi = h +hgi = h0 Xb=-1 Pb=-1 @@ -777,6 +997,9 @@ subroutine globaltest_(F,X,Y,W,n,h0,h,nh,p,kbin,fact,nf,kernel,nboot,r,T,& call rfast_h(X,Y,W,n,h0,p,Xb,Pb,kbin,kernel,nh) call Interpola (Xb,Pb(1,1,1),kbin,X,muhatg,n) +print *, h0 + +!print *, muhatg @@ -784,9 +1007,9 @@ subroutine globaltest_(F,X,Y,W,n,h0,h,nh,p,kbin,fact,nf,kernel,nboot,r,T,& errg(i)=Y(i)-muhatg(i) end do -do i=1,kbin - pred0(i)=Pb(i,r+1,1) -end do +!do i=1,kbin +! pred0(i)=Pb(i,r+1,1) +!end do @@ -800,12 +1023,42 @@ subroutine globaltest_(F,X,Y,W,n,h0,h,nh,p,kbin,fact,nf,kernel,nboot,r,T,& do i=1,kbin pred1(i,j)=Pb(i,r+1,1) end do + call Interpola (Xb,Pb(1,1,1),kbin,X,fpar(1,j),n) end do +do i=1,n + do j=1,nf + if(F(i).eq.fact(j)) fpar_est(i)=fpar(i,j) + end do +end do + +! !interpolamos efectos parciales para RSS +! icont=0 +! do i=1,n +! if (F(i).eq.fact(j)) then +! icont=icont+1 +! Xaux(icont)=X(i) +! end if +! end do +! call Interpola (Xb,Pb(1,1,1),kbin,Xaux,fpar,icont) + +! ii=0 +! do i=1,n +! if (F(i).eq.fact(j)) then +! ii=ii+1 +! fpar_est(i)=fpar(ii) +! end if +! end do + +! end do + +!print *, h(1), h(2) + + ! estimo polinomios hp=0 !ventana para pol @@ -836,21 +1089,56 @@ subroutine globaltest_(F,X,Y,W,n,h0,h,nh,p,kbin,fact,nf,kernel,nboot,r,T,& errg(1:n)=Y(1:n)-muhatg2(1:n) !********************************** +!centro errores +meanerr=sum(errg(1:n))/n +do i=1,n + errg(i)=errg(i)-meanerr +end do !Estadistico -T=0 +T(1)=0 do j=1,nf do i=1,kbin +!do i=1,n ! T=T+abs(pred0(i)-pred1(i,j)) -T=T+abs(pred1(i,j)) +if(Xb(i).ge.-1.and.Xb(i).le.1) T(1)=T(1)+abs(pred1(i,j)) +!if(X(i).ge.-1.5.and.X(i).le.1.5) T(1)=T(1)+abs(fpar(i,j)) end do end do +! para la g +T(2)=0 +do j=1,nf + Waux=0 + do i=1,n + if (F(i).eq.fact(j)) Waux(i)=W(i) + end do + call rfast_h(X,errg,Waux,n,hg(j),p,Xb,Pb,kbin,kernel,nh) + do i=1,kbin + if(Xb(i).ge.-2.and.Xb(i).le.2) T(2)=T(2)+abs(Pb(i,1,1)) +end do +end do + + + +RSS0=0 +RSS1=0 +do i=1,n + RSS0=RSS0+(Y(i)-muhatg2(i))**2 + RSS1=RSS1+(Y(i)- muhatg(i) - fpar_est(i) )**2 +end do +T(3)=RSS0-RSS1 +T(4)=T(3)/RSS1 + + + + + @@ -870,6 +1158,9 @@ subroutine globaltest_(F,X,Y,W,n,h0,h,nh,p,kbin,fact,nf,kernel,nboot,r,T,& end if end do +!h0 = h0i +!h = hi +!hg = h0i call rfast_h(X,Yboot,W,n,h0,p,Xb,Pb,kbin,kernel,nh) call Interpola (Xb,Pb(1,1,1),kbin,X,muhatgboot,n) @@ -885,30 +1176,112 @@ subroutine globaltest_(F,X,Y,W,n,h0,h,nh,p,kbin,fact,nf,kernel,nboot,r,T,& end do - +!efectos parciales do j=1,nf Waux=0 do i=1,n if (F(i).eq.fact(j)) Waux(i)=W(i) end do call rfast_h(X,errgboot,Waux,n,h(j),p,Xb,Pb,kbin,kernel,nh) - do i=1,kbin pred1(i,j)=Pb(i,r+1,1) end do +call Interpola (Xb,Pb(1,1,1),kbin,X,fpar(1,j),n) !interpolamos efectos parciales para RSS +end do + +do i=1,n + do j=1,nf + if(F(i).eq.fact(j)) fpar_est(i)=fpar(i,j) + end do +end do + + + + + + +!polinomios + + +! estimo polinomios +hp=0 !ventana para pol + + +if(r.eq.1) pp=0 !grado pol, solo calcula medias +if(r.eq.2) pp=1 + + +do j=1,nf + Waux=0 + do i=1,n + if (F(i).eq.fact(j)) Waux(i)=W(i) + end do + call rfast_h(X,errgboot,Waux,n,hp(j),pp,Xb,Pb,kbin,kernel,nh) + call Interpola (Xb,Pb(1,1,1),kbin,X,pol(1,j),n) end do +if(r.eq.0) pol=0 -Tboot=0 +!********************************** +do i=1,n + do j=1,nf + if(F(i).eq.fact(j)) muhatg2(i)=muhatgboot(i)+pol(i,j) + end do +end do + +errgboot(1:n)=Yboot(1:n)-muhatg2(1:n) +!********************************** + + + + + + + +Tboot(1)=0 do k=1,nf do z=1,kbin +! do z=1,n ! Tboot=Tboot+abs(pred0(z)-pred1(z,k)) - Tboot=Tboot+abs(pred1(z,k)) + if(Xb(z).ge.-1.and.Xb(z).le.1) Tboot(1)=Tboot(1)+abs(pred1(z,k)) +! if(X(z).ge.-1.and.X(z).le.1) Tboot(1)=Tboot(1)+abs(fpar(z,k)) end do end do -if(Tboot.gt.T) pvalor=pvalor+1 + + + + +! para la g +Tboot(2)=0 +do j=1,nf + Waux=0 + do i=1,n + if (F(i).eq.fact(j)) Waux(i)=W(i) + end do + call rfast_h(X,errgboot,Waux,n,hg(j),p,Xb,Pb,kbin,kernel,nh) + do i=1,kbin + if(Xb(i).ge.-2.and.Xb(i).le.2) Tboot(2)=Tboot(2)+abs(Pb(i,1,1)) + ! if(Xb(i).ge.-2.and.Xb(i).le.2) T(2)=T(2)+abs(Pb(i,1,1)) +end do +end do + +RSS0=0 +RSS1=0 +do i=1,n + RSS0=RSS0+(Yboot(i)-muhatg2(i))**2 + RSS1=RSS1+(Yboot(i)- muhatgboot(i)-fpar_est(i) )**2 +end do +Tboot(3)=RSS0-RSS1 +Tboot(4)=Tboot(3)/RSS1 + + + +do j=1,4 +if(Tboot(j).gt.T(j)) pvalor(j)=pvalor(j)+1 +end do + end do From f841d0ec39e7348f96ffe6aa63edb072a4d71cdc Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Thu, 28 Sep 2017 17:09:19 +0200 Subject: [PATCH 04/23] changes in allotest --- src/lsq.mod | Bin 12134 -> 1642 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/src/lsq.mod b/src/lsq.mod index d5d427e5a4f6a2a9bb540714258b0084619c8eab..692e81fecffe85e0f63531ff595e0bc12d30bd4f 100644 GIT binary patch literal 1642 zcmV-w29^0AiwFP!000001JzntbJ|D{exF~_Z^94R(&!jTj|wPRYC*UJBcwTz&;srZ@vj%}G0?Y$% zw)YnB5NuYk4K|O#Y$g5mV2GsCxq(yskYsQ}a9HsxfpGtA_k1r2AS`#^@vi_BI-Of* z)U|q3$AYQ-k3ITof9Ts2%bvh+)SC{h58>y~v$_Kke-0wP#?z0^XgcZJ7W9X=gMPO^ zac{$$n1iq8-PpDMjou`tOea5`)hOK~)eI1sT4WPT%}E zD2b3vxeW1yBtSom%`Xr{_OEOh)+3xr~#4)5+#yUmPnF8@YnO@bCEx-MXF;1qn>O6o@Kv>T=%ab~}+nso#yO{hY=9yXg@RH+J_X5F6zF1~YzmSza2NjSGI*gNO9St5{&2CL zU12;j(?HQdG0GCCVkp5TSe%^GClf&pSG}yPU|e*k;N*;IKk$J zyWOA9@ZMlIN!a~o;1~x4yX(=j!Qr|)Z~qSd;`opy1;o(WcHYvPV|M9clDTxh`Rg#8 z>iFw@;IDW7{N|4qNUA_W)`C7w?d}AX*xcq0_*q^6iURoS#=-gTg09Bd9LeKmQV5*M zz$$V$hTghF-u8)T!>6;D$&#}mSqRcA#Tchx>|5qk27*p%x5uF8xs*w^el#@9)frE= zm;stt#;YMU_a_ct-_bW|5{G*^zDbigpfaAzi3BvBrfL-dfW|oZ*ZI=&Y=0JybM?t=^SI zP?*2`&r4S^gHj9qsPH}CP z=WlW4>+uB=#&fUU(pxoFVq*@;v=9!6=d~UgIUGcVtcvxoXA5OsBuu5y&KuXrMi^cM zneZZy;Cl3^h*5meR+CNnsGvQ(##OHCR%Gen&_t3}4+jO^+P$}*B>)t5rK;5PJ~A)I z88~Sax3Y;QTWzI^Y+Cxe6o5)k5-T2q1oxBtHUqA=og|V4Gl+F#L0Woh6~q4RW=Gqu z-;_(LTI5n5!5O&3!iEojz3{dP1SXxvF&uO7dvZFlQX z@b~U~vp%?p+8{{Hoh*VtW_#ORvblePY07?3E`;CC3#?I=3z^8dRo));Iy$~)Ue3YcJ-!@ zEuEE4t7;#Aw{&u0V|dyYE`k&{R*RtV=426gm-3d6SlUL56YbD}ieHmSzL^u>(&JW2 z92#*wMTD>|G3p4!v6A%T;aDYwZa938@h&nEcsp6tp@kDA?T^BVdT2Egfj1sK?F6J4 z@7_t;VQ{L&O(rS8be0Bam0vH$=8 literal 12134 zcmdT~*>c)Q6n)oM+&4khIHg@;-iT2$)Udc%lF1W=LAF)F;1Sq~=j-QmORZ=#)`A_o zh6!q9sZZZN_x9aBe;Q9_lkSLackBC&M-N`G_jg;8RYj&%;4Kf{ny!M~E!_pX>tK1S zeYol<(y(X#>1iuvZLdvFx0TN2x??UcO?zo5#@gtt*QQEmXVkx<$K5@7YyUup8-M=? z8_JsvU3&-makD(|+iP#{1rOc_Nouv)bc&B8Ued-pi~iS0zWlzwztm)sH~W9_uS_bn zS{IY?x!aphT$+#m9*w__&ibR7JDSmO+?x;FGj^YP?)gB9?vsN5rt^=J@qE@FxzrzC z4EpE&+2Vq|q&xW9{We{=|AaqcammN32U4a>5m|=F*J@k`UV2 zwEM;7V(tzG#j-*k14fgUSX>fRc)fp8Lt2Ox#{5Qg$;f zTh#*EyA0fm?xZ_(XYNFZK#-vjuh{t*FXm?C`Hbfcjz%FdPU1TskEXLODAtn1?czU| z9l2Q2AjZwwUtVY7|4uHeoGEIDG=(&kG_4T2rjzV%SDX7RQyS}GHCk&1l%l1Xq*h0< zAbGpmZ892DW*5Z_dHV!3#}!zh5Z_`Kb(qTS?sES|(7+VlEdxgM#cCG>8B~omvm&`- ztzkQ=+t}2W?vUOgLm@*YqnKp|Se8ZJY%zu4(xfR4dp?cZi(-3)PUJ{sU-;9ak- zGH@DieKn(OSj;FJHW>~X9jqp{f8ixuB2!^VcfmTl*RKrKR2fuLBU2|69-LW>7Mc~@ zoL0?Wl9nbMi(vO-ad*gyw;3^?#C+6zG6_ShWxP2PXLYcDM}o#N4!n!KcgUz*GeJXK z!jCBBSHyZ{L9h1S##~0Vjez6B8;nMsVt2hOO{TS(GGpH z3`!W(934xWD1k8(xj`U8NK8N(q49BuA}2GLp*% zhM~(dvaxt@Vs*%7E@TKSN*O?mh_u0~!->7aCym~5sg;UeZKN}R_wCpZ8}1hXd4DNz#P+3n{!l;69+2m6(GMj6I z-603mhc-A!gmJatnt|UO(CguL_uyqDRS(~<&3r~n9i9(!4023zcuFjC0V17c$e8Hh z{&}ahWl!qrsT>se`#<^li6c};+A%)n`y*lPpFTC?)R)wo4~O3%jpBV}Cj#3@<}r1r z)A`WtEvA2UFI;Ms&pD|)=aeTcPPEIy6(A4#PL=@m-v(Zo`>nMPk@TNQ+lk{>d<(6D z&zGFusZ4`r(<6n;td7{j)b!={kk2nYL%uw7R2;6zW8W^BuggD`=aym>pxP=R{nCM> zT8&c36Dol8w~UxQ%*p2$Qc9I086HOZa+9*0mpkbijo^-auT&8Wd(-gmY2zU_#9zr9G%*R5JoGd+QNM2ZxbcVbvV|Nzea&wh-xg6s6)-*!86N zY&le%hT>bCiYN`hzX%fk1*!&#jeI|XM1_Mp7)?c4*PNrgB0okYppcR8Rgk&Up$;V) zc^D{T$d}$>DfZH^-YF-c+{v&dy^fdnc@1cH`k+rED5u?xwi0C?dE@WnV;-$e3G-4y z1O?7wnG+)y$4iMg{`d=?jA2l(l4Da{c_Fc*P%{KZsZ74x?Ny-^bpg~ha3)-~G?~%} zUV%&~8h}jOwZ~H6{DWdbf==ZiMW;`dLpeaZxfjfB>NNcETNta z-8dVk_LYA?@5J_(ji?MF4o1rCWIi6U!EEo2RY3X2t{jPsFIZs?4N2t^ECmQyNFC2# zeGdesV?i8`iE?BzbciGiI=aoi-#p^R0=mTg&?Z`9c!0L)lnwybUv7s zE)0kSa=5w40vVF>GV2N!u#l>MUBQ6fhh5XzYlj#P!tM0AkrqHXqut2Lv8Lv@g&8fD zQE#w9@H0_ILVqqq#5!7W1+-CrC(#(=3MHFdy>DXwSk!QCkxRcq(ct!T{hz-;P4OiwAu%DDRl;Sj3H*> Date: Thu, 28 Sep 2017 17:10:43 +0200 Subject: [PATCH 05/23] changes in globaltest... testing a new test statistics for the revision of jrss c --- R/globaltest.R | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/R/globaltest.R b/R/globaltest.R index bec8df3..a2fa1b4 100644 --- a/R/globaltest.R +++ b/R/globaltest.R @@ -300,19 +300,25 @@ globaltest <- function(formula, data = data, na.action = "na.omit", kernel = as.integer(kernel), nboot = as.integer(nboot), r = as.integer(der), - T = as.double(rep(-1, 1)), - pvalor = as.double(rep(-1, 1)), + T = as.double(rep(-1, 4)), + pvalor = as.double(rep(-1, 4)), # umatrix = as.double(umatrix) #seed = as.integer(seed), umatrix = array(umatrix, c(n, nboot)), PACKAGE = "npregfast" ) - if (globaltest$pvalor < 0.05) { - decision <- "Rejected" + decision <- character(4) + for (j in 1:4){ + if (globaltest$pvalor[j] < 0.05) { + decision[j] <- "Rejected" } else { - decision <- "Acepted" + decision[j] <- "Accepted" + } } + + + res <- data.frame(cbind(Statistic = globaltest$T, pvalue = globaltest$pvalor), Decision = I(decision)) # res=cbind(Statistic=round(globaltest$T,digits=4),pvalue=round(globaltest$pvalor,digits=4),Decision=I(decision)) From e6f5bd0329eb0a714d557afb6a48faa72f326e26 Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Thu, 28 Sep 2017 18:21:29 +0200 Subject: [PATCH 06/23] new test programmed directly in R (two statistic tests, test = c("res", "lrt"), bootstrap paralellized --- R/allotest.R | 102 +++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 83 insertions(+), 19 deletions(-) diff --git a/R/allotest.R b/R/allotest.R index 88ef767..5fdf8a5 100644 --- a/R/allotest.R +++ b/R/allotest.R @@ -8,9 +8,13 @@ #' @param na.action A function which indicates what should happen when the #' data contain 'NA's. The default is 'na.omit'. #'@param nboot Number of bootstrap repeats. -#'@param kbin Number of binning nodes over which the function -#' is to be estimated. #'@param seed Seed to be used in the bootstrap procedure. +#' \item{cluster}{Is the procedure parallelized? (for splines smoothers).} +#' \item{ncores}{Number of cores used in the parallelized procedure? (for splines smoothers).} +#' \item{test}{Statistic test to be used, based on residuals on the null model +#' (\code{res}) or based on the likelihood ratio test +#' using rss0 and rss1 \code{lrt} .} +#' #'@details In order to facilitate the choice of a model appropriate #' to the data while at the same time endeavouring to minimise the #' loss of information, a bootstrap-based procedure, that test whether the @@ -65,7 +69,18 @@ allotest <- function(formula, data = data, na.action = "na.omit", - nboot = 500, kbin = 200, seed = NULL) { + nboot = 500, seed = NULL, cluster = TRUE, + ncores = NULL, test = "res", ...) { + + if (isTRUE(cluster)) { + if (is.null(ncores)) { + num_cores <- detectCores() - 1 + }else{ + num_cores <- ncores + } + registerDoParallel(cores = num_cores) + } + ffr <- interpret.frfastformula(formula, method = "frfast") varnames <- ffr$II[2, ] @@ -101,7 +116,7 @@ allotest <- function(formula, data = data, na.action = "na.omit", set.seed(seed) } - umatrix <- matrix(runif(n*nboot), ncol = nboot, nrow = n) + #umatrix <- matrix(runif(n*nboot), ncol = nboot, nrow = n) if (is.null(f)) f <- rep(1, n) @@ -116,21 +131,36 @@ allotest <- function(formula, data = data, na.action = "na.omit", xx <- data[, 2][f == i] n <- length(xx) w <- rep(1, n) - fit <- .Fortran("allotest_", - x = as.double(xx), - y = as.double(yy), - w = as.double(w), - n = as.integer(n), - kbin = as.integer(kbin), - nboot = as.integer(nboot), - # seed = as.integer(seed), - T = as.double(-1), - pvalue = as.double(-1), - umatrix = as.double(umatrix), - PACKAGE = "npregfast" - ) - res[[i]] <- list(statistic = fit$T, pvalue = fit$pvalue) + m <- lm(log(yy) ~ log(xx), weights = w) + muhatg <- exp(coef(m)[1]) * xx**coef(m)[2] + errg <- yy - muhatg + + if(test == "res") {t <- sta_res(x = xx, y = yy)} + if(test == "lrt") {t <- sta_rss(x = xx, y = yy)} + #print(c(t1, t2)) + + yboot <- replicate(nboot, muhatg + errg * + sample(c(-sqrt(5) + 1, sqrt(5) + 1)/2, size = n, + replace = TRUE, + prob = c(sqrt(5) + 1, sqrt(5) - 1)/(2 * sqrt(5)))) + + if(test == "res") { + tboot <- unlist(foreach(i = 1:nboot) %dopar% { + sta_res(x = xx, y = yboot[, i]) + }) + } + + if(test == "lrt") { + tboot <- unlist(foreach(i = 1:nboot) %dopar% { + sta_rss(x = xx, y = yboot[, i]) + }) + } + pvalue <- mean(tboot>t) + + + res[[i]] <- list(statistic = c(t), pvalue = c(pvalue)) + } @@ -156,4 +186,38 @@ allotest <- function(formula, data = data, na.action = "na.omit", return(result) -} \ No newline at end of file +} + + + + + + +sta_res <- function(x, y){ + model <- lm(log(y) ~ log(x)) + muhat <- exp(coef(model)[1]) * x**coef(model)[2] + residuo <- y - muhat + pred <- as.numeric(predict(gam(residuo ~ s(x)))) + #pred <- predict(frfast(residuo ~ x, data = data.frame(x, residuo), nboot = 0), newdata = data.frame(x=x))$Estimation[,1] + #pred <- pred - mean(pred) + #rango <- max(x) - min(x) + #ii <- abs(x) <= (max(x)-0.1*rango) + t <- sum(abs(pred)) +} + +sta_rss <- function(x, y){ + model <- lm(log(y) ~ log(x)) + m0 <- exp(coef(model)[1]) * x**coef(model)[2] + rss0 <- sum((y - m0)**2) + m1 <- as.numeric(predict(gam(y ~ s(x)))) + rss1 <- sum((y - m1)**2) + #rango <- max(x) - min(x) + #ii <- abs(x) <= (max(x)-0.1*rango) + t <- (rss0 - rss1)/rss1 +} + + + + + + From bfd0b0660ed2526870faab314a7973c3aceb28e0 Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Mon, 23 Oct 2017 13:37:22 +0200 Subject: [PATCH 07/23] change at accepted (misspeling) --- R/localtest.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/localtest.R b/R/localtest.R index 257e495..e8c89b3 100644 --- a/R/localtest.R +++ b/R/localtest.R @@ -336,7 +336,7 @@ localtest <- function(formula, data = data, na.action = "na.omit", decision <- character(nalfas) for(i in 1:nalfas){ if (localtest$Ci[i] <= 0 & 0 <= localtest$Cs[i]) { - decision[i] <- "Acepted" + decision[i] <- "Accepted" } else { decision[i] <- "Rejected" } From f9e08f77909f0a125f897ab55b8fabf9a98ebbdd Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Mon, 23 Oct 2017 13:59:09 +0200 Subject: [PATCH 08/23] implemented more than one ci.level in the localtest function with smooth = splines. With smooth = kernel it was done before! --- R/localtest.R | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/R/localtest.R b/R/localtest.R index e8c89b3..3e9aaad 100644 --- a/R/localtest.R +++ b/R/localtest.R @@ -443,15 +443,30 @@ localtest <- function(formula, data = data, na.action = "na.omit", } - ci <- quantile(unlist(d_allboot), probs = c(0.025, 0.975), na.rm = TRUE) + + + decision <- character(nalfas) + cilower <- numeric(nalfas) + ciupper <- numeric(nalfas) + + for(i in 1:nalfas){ + alpha <- 1-ci.level[i] + ci <- quantile(unlist(d_allboot), + probs = c(alpha/2, 1 - (alpha/2)), na.rm = TRUE) if (ci[1] <= 0 & 0 <= ci[2]) { - decision <- "Acepted" + decision[i] <- "Accepted" } else { - decision <- "Rejected" + decision[i] <- "Rejected" } - res <- cbind(d = round(d, digits = 4), Lwr = round(ci[1], digits = 4), - Upr = round(ci[2], digits = 4), Decision = decision) + cilower[i] <- ci[1] + ciupper[i] <- ci[2] + } + + + res <- cbind(d = round(d, digits = 4), Lwr = round(cilower, digits = 4), + Upr = round(ciupper, digits = 4), Decision = decision, + Ci.Level = round(ci.level, digits = 2)) rownames(res) <- NULL From 860d29ada9271b9e68c301cccd315de2cb4356f1 Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Mon, 23 Oct 2017 14:05:36 +0200 Subject: [PATCH 09/23] misspeling in help file allotest --- R/allotest.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/allotest.R b/R/allotest.R index 5fdf8a5..bd531ba 100644 --- a/R/allotest.R +++ b/R/allotest.R @@ -13,7 +13,7 @@ #' \item{ncores}{Number of cores used in the parallelized procedure? (for splines smoothers).} #' \item{test}{Statistic test to be used, based on residuals on the null model #' (\code{res}) or based on the likelihood ratio test -#' using rss0 and rss1 \code{lrt} .} +#' using rss0 and rss1 \code{lrt}.} #' #'@details In order to facilitate the choice of a model appropriate #' to the data while at the same time endeavouring to minimise the From 111e715f3245e911c2b113661693beb1ae5336c4 Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Mon, 23 Oct 2017 14:19:24 +0200 Subject: [PATCH 10/23] added a cat("\n") in the print.frfast() --- R/print.frfast.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/print.frfast.R b/R/print.frfast.R index 1d364d8..19738b8 100644 --- a/R/print.frfast.R +++ b/R/print.frfast.R @@ -56,6 +56,7 @@ print.frfast <- function(x = model, ...) { cat("Triangular") if (model$kernel == 3) cat("Gaussian") + cat("\n") } From b69798882a1cfe315caa3307ad90d56d6c1b2baf Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Fri, 27 Oct 2017 18:52:23 +0200 Subject: [PATCH 11/23] new version for JSS --- .DS_Store | Bin 15364 -> 8196 bytes NEWS | 14 +++ R/frfast.R | 167 ++++++++++++++++++++++++++++-------- R/interpret.frfastformula.R | 54 ------------ inst/.DS_Store | Bin 0 -> 6148 bytes 5 files changed, 145 insertions(+), 90 deletions(-) delete mode 100755 R/interpret.frfastformula.R create mode 100644 inst/.DS_Store diff --git a/.DS_Store b/.DS_Store index ca7b857b17c2de0bfdcc6328c9262bfc34a09500..daf4c118929bc08c0c6036d945890072207ff2f1 100644 GIT binary patch literal 8196 zcmeHM&2G~`5T12R>!>OX5`rErByJH(RHXKTutIu3;!q_B4*WEB93@7H9XSpWgdo2H zCw>kHi6b0%2~-}SRWIej3xMDSnEk2kb%;1Yk=T`XXFW6De&f%Hopk_!)W&WVU>yJq z?9`T4aQH=|aoXpaCOj9=62wElTWz+3!Ei29Ig|oQ0i}RaKq;UU_*WFbXEtrdg6BSu zs!=JR6!4 zAgI^fanuGl`0;6zEtKE}fx9p^>}B2wytF8A1^F53NS!Dd|8c;s|XR1Yz^=E zjW~%MUx)o8IU@0s9m+2-Id%dKiCHV)XA$*jNUYE30^FNnOuQ1C_Ce(4mfgjnP-w8A6cW-;X8%%1!*mp;4ogF*sA(j#Cmd;J5TbIjbWmYz))yl?J z+1#vb%w~ph{$lmY_156gI5|nmrNgUfB$e~v`>Q>M z6`1s6l#fWVE}Il2Fga=Q%JAaU^PefJ2BpA>DNx|d>vaFWz4-nAiPfiwl>$nEKd%7M z>&q|VTf~6#4KTBZZU#Q{SaU>s6i?4 HR~7gP-;5dB literal 15364 zcmeHMTWl0n82>JNgtY|=xPjga;kLbS3lM6zrCbVSFGD-9JG1W0wuDk` zA{r4eY7{StJb>{6FQ~y6jcI%^Jn=w@N-)GHUyP{nh4|!u&Y5<1TdKaODCZ<|{&W7z zxqRoFbN0*v05)gh)c^qi@YBPjK9jP0BxYyNq*UN(Do7&5L!!4j9J7+*graxFKoL&*fae$Tsc6EElIB)4l`tK*s_GjoDD+L6KEtml%1mX}Y-NAA&mIW75jW#B zN7DOPtu5mAMZI!|Z70Udk?1bd80gVUT5QXWn3j>|!Diebm+mgpirWLtcE*Z3-C?2Z zGUIL^Z`4yzw|=EZFC83gXlM)uYU_uBfx(7VRBWtWJv5}BQ~YI>wHvlY?c>j%eBspT zGw*%CW<>kGcRoO|sE_9tspL&Ke>tx$%v!SGj&8nF#bdpgEVL6XdB7qk4nlhlsNdda zpw1f{tf?m?Yid_9R2v(sf`Ph*Dnj+CiKxEMP@^;@s+X7%+Vc=CD7quGIcRQOu$Z;O zd~=Y@(dMC8Fyi_4htpQVwt9IaTR(?3jaUx0_aR}cYifgm>MBmyDuTALzMi1HJQ3Qz zNLW7MJb3ZK6@tTqBH{G6iFdc)@MM~)+RTc-t>%(lYjF{4MH?a+(6m8xxNqo2Q| z#j!{tmPtfhqbZSKPEJ?MPGpjnv)eU}x=gdzvD0n~SN7<7#xdFr@;Cd9R*G_Z^f|1h zohjF}EoYaJc1Tu)#M=Xk|6O(0mDs52K2Bm*U9GOs^y!?dth!z; zS9MSn-fpv2sp{xgvON0(mR*F8;S0{Nn{XSxhaccBA~CC&ShWZr#d2JNkKszJ#u}_6 zX068%Hen04;tt$N>}n@=b>ji-!3ai)T}iYsg-_x!JdQ*7G!ElQJcXz644%a|@J)OR zFHGRs<}ro|iSJ~2mV1C5fg4`ZrcG3+CNhM1E_@4pxz~A@5O5XqF{r^93|K~5B%p?L50f~S_Kq4R! fkO)WwBmxoviGV~vA|Mfv2uK7Z0uq7$B?7+#AiSks diff --git a/NEWS b/NEWS index 0801c74..1f08761 100644 --- a/NEWS +++ b/NEWS @@ -26,4 +26,18 @@ This file documents software changes since the previous edition. * the plotting functions have been changed. Users can choose between the plot.frfast function, used for base graphics, and the autoplot.frfast function, which is appropriate for ggplot2-type plot and returns objects of the ggplot class. * we have merged the plottdiff function of the previous version of the package with plot.frfast and with autoplot.frfast by means of the new argument diffwith. This new argument lets users visualize the differences between two factor’s levels. + + + + # npregfast 1.4.1 (2017-10-30) + + * the localtest function has a new argument: ci.level. + * new implementation in R of the allotest. Now it is possible + to choose between two statistic test: "res" (based on residuals on the + null model) or "lrt" (based on the likelihood ratio test using rss0 and rss1). + * fixed some bugs in the formula argument of frfast function. + + + + \ No newline at end of file diff --git a/R/frfast.R b/R/frfast.R index 3ec5b3c..1d484df 100644 --- a/R/frfast.R +++ b/R/frfast.R @@ -225,7 +225,7 @@ -frfast <- function(formula, data = data, na.action = "na.omit", +frfast <- function(formula, data, na.action = "na.omit", model = "np", smooth = "kernel", h0 = -1.0, h = -1.0, nh = 30, weights = NULL, kernel = "epanech", p = 3, @@ -239,9 +239,9 @@ frfast <- function(formula, data = data, na.action = "na.omit", if (missing(formula)) { stop("Argument \"formula\" is missing, with no default") } - if (missing(data)) { - stop("Argument \"data\" is missing, with no default") - } + #if (missing(data)) { + # stop("Argument \"data\" is missing, with no default") + #} if (!(kernel %in% 1:3)) { stop("Kernel not suported") } @@ -274,37 +274,89 @@ frfast <- function(formula, data = data, na.action = "na.omit", ncmax <- 5 c2 <- NULL + - + if (smooth != "splines") { - ffr <- interpret.frfastformula(formula, method = "frfast") - varnames <- ffr$II[2, ] - aux <- unlist(strsplit(varnames,split = ":")) + cl <- match.call() + mf <- match.call(expand.dots = FALSE) + m <- match(x = c("formula", "data", "subset", "weights", "na.action", "offset"), + table = names(mf), nomatch = 0L) + mf <- mf[c(1L, m)] + mf$drop.unused.levels <- TRUE + mf[[1L]] <- quote(stats::model.frame) + + + + + + mf <- eval(expr = mf, envir = parent.frame()) + + mt <- attr(mf, "terms") + y <- model.response(mf, "numeric") + w <- as.vector(model.weights(mf)) + if (!is.null(w) && !is.numeric(w)) + stop("'weights' must be a numeric vector") + + terms <- attr(mt, "term.labels") + + + + aux <- unlist(strsplit(terms,split = ":")) varnames <- aux[1] + namef <- aux[2] + response <- as.character(attr(mt, "variables")[2]) if (unlist(strsplit(varnames,split = ""))[1] == "s") { stop("Argument \"formula\" is wrong specified, see details of -model specification in 'Details' of the frfast help." ) + model specification in 'Details' of the frfast help." ) } - namef <- aux[2] - if (length(aux) == 1) {f <- NULL}else{f <- data[ ,namef]} - newdata <- data - data <- data[ ,c(ffr$response, varnames)] + + #newdata <- data + data <- mf - if (na.action == "na.omit"){ # ver la f + if (na.action == "na.omit"){ # ver la f, corregido data <- na.omit(data) }else{ stop("The actual version of the package only supports 'na.omit' (observations are removed if they contain any missing values)") } - #newdata <- na.omit(newdata[ ,varnames]) + + if (length(aux) == 1) {f <- NULL}else{f <- data[ ,namef]} n <- nrow(data) + }else{ + + ffr <- interpret.gam(formula) - varnames <- ffr$pred.names[1] + cl <- match.call() + mf <- match.call(expand.dots = FALSE) + mf$formula <- ffr$fake.formula + + m <- match(x = c("formula", "data", "subset", "weights", "na.action", "offset"), + table = names(mf), nomatch = 0L) + mf <- mf[c(1L, m)] + + mf$drop.unused.levels <- TRUE + mf[[1L]] <- quote(stats::model.frame) + + mf <- eval(expr = mf, envir = parent.frame()) + + mt <- attr(mf, "terms") + y <- model.response(mf, "numeric") + w <- as.vector(model.weights(mf)) + if (!is.null(w) && !is.numeric(w)) + stop("'weights' must be a numeric vector") + + terms <- attr(mt, "term.labels") + + response <- as.character(attr(mt, "variables")[2]) + + + varnames <- terms[1] if (":" %in% unlist(strsplit(ffr$fake.names,split = ""))) { stop("Argument \"formula\" is wrong specified, see details of model specification in 'Details' of the frfast help." ) @@ -314,30 +366,72 @@ model specification in 'Details' of the frfast help." ) model specification in 'Details' of the frfast help." ) } - namef <- ffr$pred.names[2] - if (length(ffr$pred.names) == 1) {f <- NULL}else{f <- data[ ,namef]} - newdata <- data - if (length(ffr$pred.names) == 1) { - data <- data[ ,c(ffr$response, varnames)] - }else{ - data <- data[ ,c(ffr$response, varnames, namef)] - } + + # newdata <- data + + # if (length(ffr$pred.names) == 1) { + # data <- data[ ,c(ffr$response, varnames)] + # }else{ + # data <- data[ ,c(ffr$response, varnames, namef)] + # } + # + datam <- mf + if (na.action == "na.omit"){ - data <- na.omit(data) + datam <- na.omit(datam) }else{ stop("The actual version of the package only supports 'na.omit' (observations are removed if they contain any missing values)") } - n <- nrow(data) + + if (length(terms) == 1) { + f <- NULL + namef <- 1 + }else{ + namef <- terms[2] + f <- mf[ ,namef] + } + n <- nrow(datam) } + if(missing(data)) { + + response <- strsplit(response, "\\$")[[1]][2] + terms2 <- strsplit(terms, "\\$") + + if(length(terms) == 1){ + formula <- as.formula(paste0(response, "~s(",terms2[[1]][2],")")) + #data <- data + names(datam) <- c(response, terms2[[1]][2]) + varnames <- terms2[[1]][2] + namef <- "F" + }else{ + formula <- as.formula(paste0(response, "~s(",terms2[[1]][2],", by = ", terms2[[2]][2],")")) + #data2 <- data + names(datam) <- c(response, terms2[[1]][2], terms2[[2]][2]) + varnames <- terms2[[1]][2] + namef <- terms2[[2]][2] + } + + + + data <- datam + + + + } + + +# strsplit(formula,split = "$") + + if (is.null(f)) f <- rep(1.0, n) etiquetas <- unique(f) nf <- length(etiquetas) @@ -356,7 +450,7 @@ model specification in 'Details' of the frfast help." ) if (length(h) == 1) h <- rep(h, nf) } - + weights <- w if (is.null(weights)) { weights <- rep(1.0, n) }else{ @@ -393,7 +487,7 @@ model specification in 'Details' of the frfast help." ) frfast <- .Fortran("frfast_", f = as.integer(f), x = as.double(data[ ,varnames]), - y = as.double(data[ ,ffr$response]), + y = as.double(data[ ,response]), w = as.double(weights), n = as.integer(n), h0 = as.double(h0), @@ -511,7 +605,7 @@ model specification in 'Details' of the frfast help." ) b = frfast$b, bl = frfast$binf, bu = frfast$bsup, - name = c(ffr$response,varnames), + name = c(response,varnames), formula = formula, nh = frfast$nh, r2 = r2, @@ -527,8 +621,8 @@ model specification in 'Details' of the frfast help." ) # grid xgrid <- seq(min(data[ ,varnames]), max(data[ ,varnames]), length.out = kbin) newd <- expand.grid(xgrid, unique(f)) - names(newd) <- ffr$pred.names - + names(newd) <- c(varnames, namef) + # estimations p <- array(NA, dim = c(kbin, 3, nf)) m <- gam(formula, weights = weights, data = data.frame(data, weights), ...) @@ -549,7 +643,8 @@ model specification in 'Details' of the frfast help." ) FUN.VALUE = numeric(kfino)) newdfino <- data.frame(as.vector(xgridfino), rep(unique(f), each = kfino)) - names(newdfino) <- ffr$pred.names + names(newdfino) <- c(varnames, namef) + # max muhatfino <- as.vector(predict(m, newdata = newdfino, type = "response")) @@ -619,7 +714,7 @@ model specification in 'Details' of the frfast help." ) # bootstrap m <- gam(formula, weights = weights, data = data.frame(data, weights), ...) muhat <- as.vector(predict(m, type = "response")) - err <- data[, ffr$response] - muhat + err <- data[, response] - muhat err <- err - mean(err) yboot <- replicate(nboot, muhat + err * sample(c(-sqrt(5) + 1, sqrt(5) + 1)/2, size = n, @@ -630,7 +725,7 @@ model specification in 'Details' of the frfast help." ) allboot <- foreach(i = 1:nboot) %dopar% { datab <- data - datab[, ffr$response] <- yboot[, i] + datab[, response] <- yboot[, i] aux <- mainfun(formula, data = data.frame(datab, weights), weights = weights, ...) return(aux) @@ -729,7 +824,7 @@ model specification in 'Details' of the frfast help." ) h0 = NA, fmod = f, xdata = data[, varnames], - ydata = data[, ffr$response], + ydata = data[, response], w = weights, #fact=fact, # Lo tuve que comentar pq me daba error kbin = kbin, @@ -753,7 +848,7 @@ model specification in 'Details' of the frfast help." ) b = NA, bl = NA, bu = NA, - name = c(ffr$response,varnames), + name = c(response,varnames), formula = formula, nh = nh, r2 = NA, diff --git a/R/interpret.frfastformula.R b/R/interpret.frfastformula.R deleted file mode 100755 index 1763433..0000000 --- a/R/interpret.frfastformula.R +++ /dev/null @@ -1,54 +0,0 @@ -#' @importFrom stats as.formula terms.formula - -interpret.frfastformula <- -function(formula, method = "frfast") { - - env <- environment(formula) - if(inherits(formula, "character")) - formula <- as.formula(formula) - tf <- terms.formula(formula) - terms <- attr(tf, "term.labels") - # if(length(grep(":",terms))!=0) stop("Symbol '*' is not allowed") - - nt <- length(terms) - if(attr(tf, "response") > 0) { - ns <- attr(tf, "specials")$frfast - 1 # -1 for the response - response <- as.character(attr(tf, "variables")[2]) - vtab<-attr(tf,"factors") - } else { - ns <- attr(tf, "specials")$frfast - response <- NULL - } - - II <- list() - k <- 0 - if(nt) { - for (i in 1:nt) { - if (i %in% ns) { - k = k+1 - st <- eval(parse(text = terms[i]), envir = env) - if(method == "frfast" & st$cov[1] != "ONE") { - stop("The function frfast does not allow for \"by\" variables") - } - II[[k]] <- st$cov - # h[[k]] <- st$h - # partial[k] <- terms[i] - } else { - k = k+1 - II[[k]]<- c("ONE", terms[i]) - # h[[k]] <- 0 - # partial[k] <- terms[i] - } - } - } - II <- if(length(II)) { - matrix(unlist(II), nrow = 2) - } else { - matrix(0, nrow = 2) - } - res <- list(response = response, II = II,vtab=vtab) - - class(res) <- "frfast.formula" - return(res) -} - diff --git a/inst/.DS_Store b/inst/.DS_Store new file mode 100644 index 0000000000000000000000000000000000000000..5b6ff9c609b6e831bac0fa555e2d045f0a6d2a4c GIT binary patch literal 6148 zcmeHKOG*P#5UkcL0)k}e@?F6j3?ZH%2Z(~ALL9{qF}qoLE{|sQ2Vs~9Zrn&Ubk}=5 zUGFiqn4Sh;%l+*oumCWpJL1E`)cm>o#7-(>L^{tnV1qln;|5QY>f;ILo@0jxJfa`* zU$Es_ySMdgzkTlS^N!<(C@Te|fE17dQa}p)S^@99wE0=0q7;w Date: Fri, 27 Oct 2017 19:35:48 +0200 Subject: [PATCH 12/23] problem with weights an help file --- R/allotest.R | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/R/allotest.R b/R/allotest.R index bd531ba..929cc04 100644 --- a/R/allotest.R +++ b/R/allotest.R @@ -9,11 +9,24 @@ #' data contain 'NA's. The default is 'na.omit'. #'@param nboot Number of bootstrap repeats. #'@param seed Seed to be used in the bootstrap procedure. -#' \item{cluster}{Is the procedure parallelized? (for splines smoothers).} -#' \item{ncores}{Number of cores used in the parallelized procedure? (for splines smoothers).} -#' \item{test}{Statistic test to be used, based on residuals on the null model +#' @param cluster A logical value. If \code{TRUE} (default), the +#' bootstrap procedure is parallelized (only for \code{smooth = "splines"}). +#' Note that there are cases +#' (e.g., a low number of bootstrap repetitions) that R will gain in +#' performance through serial computation. R takes time to distribute tasks +#' across the processors also it will need time for binding them all together +#' later on. Therefore, if the time for distributing and gathering pieces +#' together is greater than the time need for single-thread computing, it does +#' not worth parallelize. +#'@param ncores An integer value specifying the number of cores to be used +#' in the parallelized procedure. If \code{NULL} (default), the number of cores +#' to be used is equal to the number of cores of the machine - 1. +#'@param test Statistic test to be used, based on residuals on the null model #' (\code{res}) or based on the likelihood ratio test -#' using rss0 and rss1 \code{lrt}.} +#' using rss0 and rss1 \code{lrt}. +#' @param \ldots Other options. +#' +#' #' #'@details In order to facilitate the choice of a model appropriate #' to the data while at the same time endeavouring to minimise the @@ -132,7 +145,7 @@ allotest <- function(formula, data = data, na.action = "na.omit", n <- length(xx) w <- rep(1, n) - m <- lm(log(yy) ~ log(xx), weights = w) + m <- lm(log(yy) ~ log(xx)) muhatg <- exp(coef(m)[1]) * xx**coef(m)[2] errg <- yy - muhatg From 3568458f8dfdc4de4c634501b29d723eb3596d5d Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Fri, 27 Oct 2017 19:35:57 +0200 Subject: [PATCH 13/23] added again --- R/interpret.frfastformula.R | 54 +++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100755 R/interpret.frfastformula.R diff --git a/R/interpret.frfastformula.R b/R/interpret.frfastformula.R new file mode 100755 index 0000000..4f751ea --- /dev/null +++ b/R/interpret.frfastformula.R @@ -0,0 +1,54 @@ +#' @importFrom stats as.formula terms.formula + +interpret.frfastformula <- + function(formula, method = "frfast") { + + env <- environment(formula) + if(inherits(formula, "character")) + formula <- as.formula(formula) + tf <- terms.formula(formula) + terms <- attr(tf, "term.labels") + # if(length(grep(":",terms))!=0) stop("Symbol '*' is not allowed") + + nt <- length(terms) + if(attr(tf, "response") > 0) { + ns <- attr(tf, "specials")$frfast - 1 # -1 for the response + response <- as.character(attr(tf, "variables")[2]) + vtab<-attr(tf,"factors") + } else { + ns <- attr(tf, "specials")$frfast + response <- NULL + } + + II <- list() + k <- 0 + if(nt) { + for (i in 1:nt) { + if (i %in% ns) { + k = k+1 + st <- eval(parse(text = terms[i]), envir = env) + if(method == "frfast" & st$cov[1] != "ONE") { + stop("The function frfast does not allow for \"by\" variables") + } + II[[k]] <- st$cov + # h[[k]] <- st$h + # partial[k] <- terms[i] + } else { + k = k+1 + II[[k]]<- c("ONE", terms[i]) + # h[[k]] <- 0 + # partial[k] <- terms[i] + } + } + } + II <- if(length(II)) { + matrix(unlist(II), nrow = 2) + } else { + matrix(0, nrow = 2) + } + res <- list(response = response, II = II,vtab=vtab) + + class(res) <- "frfast.formula" + return(res) + } + From ff6aeba166bfe93c5d1f3dc488bc6c978bca3ef9 Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Fri, 27 Oct 2017 19:36:17 +0200 Subject: [PATCH 14/23] changes for namespace --- R/frfast.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/frfast.R b/R/frfast.R index 1d484df..3503d03 100644 --- a/R/frfast.R +++ b/R/frfast.R @@ -219,6 +219,7 @@ #' @importFrom doParallel registerDoParallel #' @importFrom parallel detectCores #' @importFrom foreach foreach %dopar% +#' @importFrom stats coef model.response model.weights #' #' @export From 5233557a57a4b9af1f0ab62e75583e92bdc38c13 Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Fri, 27 Oct 2017 19:36:29 +0200 Subject: [PATCH 15/23] roxygen --- DESCRIPTION | 2 +- NAMESPACE | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index fe6bc74..8e96d53 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,4 +35,4 @@ Imports: shinyjs, wesanderson, ggplot2 -RoxygenNote: 5.0.0 +RoxygenNote: 6.0.1 diff --git a/NAMESPACE b/NAMESPACE index 8496894..d877168 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -37,7 +37,10 @@ importFrom(sfsmisc,D1D2) importFrom(shinyjs,colourInput) importFrom(shinyjs,useShinyjs) importFrom(stats,as.formula) +importFrom(stats,coef) importFrom(stats,lm) +importFrom(stats,model.response) +importFrom(stats,model.weights) importFrom(stats,na.omit) importFrom(stats,predict) importFrom(stats,quantile) From 8e2523c4b30dd03a29499a4330efcbb3454ab89b Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Fri, 27 Oct 2017 19:36:40 +0200 Subject: [PATCH 16/23] delete one print --- src/program2.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/program2.f90 b/src/program2.f90 index 8a64535..f428279 100644 --- a/src/program2.f90 +++ b/src/program2.f90 @@ -64,7 +64,7 @@ subroutine allotest_(X,Y,W,n,kbin,nboot,T,pvalor,umatrix) !print *, errg(1:n) call RfastC3(X,Y,W,n,p,kbin,h,T) -print *, T +!print *, T pvalor=0 do iboot=1,nboot From d648d65cda2dbe94a1ad2c1c457cfe4bf35f5186 Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Fri, 27 Oct 2017 19:40:52 +0200 Subject: [PATCH 17/23] ploblem with log --- R/allotest.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/allotest.R b/R/allotest.R index 929cc04..b13babe 100644 --- a/R/allotest.R +++ b/R/allotest.R @@ -142,6 +142,8 @@ allotest <- function(formula, data = data, na.action = "na.omit", for (i in etiquetas) { yy <- data[, 1][f == i] xx <- data[, 2][f == i] + yy[yy == 0] <- 0.0001 + xx[xx == 0] <- 0.0001 n <- length(xx) w <- rep(1, n) From 29dcec90aee0ad139887f0ac54c6cd954246ec5c Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Fri, 27 Oct 2017 19:42:33 +0200 Subject: [PATCH 18/23] help file changed --- man/allotest.Rd | 32 ++++++++++++++++++++++++-------- man/autoplot.frfast.Rd | 1 - man/barnacle.Rd | 1 - man/children.Rd | 1 - man/critical.Rd | 7 +++---- man/criticaldiff.Rd | 7 +++---- man/frfast.Rd | 9 ++++----- man/globaltest.Rd | 7 +++---- man/localtest.Rd | 7 +++---- man/npregfast.Rd | 7 +++---- man/plot.frfast.Rd | 1 - man/predict.frfast.Rd | 1 - man/reexports.Rd | 4 ++-- man/runExample.Rd | 1 - man/summary.frfast.Rd | 9 ++++----- 15 files changed, 49 insertions(+), 46 deletions(-) diff --git a/man/allotest.Rd b/man/allotest.Rd index a970733..36ff4fc 100644 --- a/man/allotest.Rd +++ b/man/allotest.Rd @@ -5,7 +5,7 @@ \title{Bootstrap based test for testing an allometric model} \usage{ allotest(formula, data = data, na.action = "na.omit", nboot = 500, - kbin = 200, seed = NULL) + seed = NULL, cluster = TRUE, ncores = NULL, test = "res", ...) } \arguments{ \item{formula}{An object of class \code{formula}: a sympbolic description @@ -19,10 +19,27 @@ data contain 'NA's. The default is 'na.omit'.} \item{nboot}{Number of bootstrap repeats.} -\item{kbin}{Number of binning nodes over which the function -is to be estimated.} - \item{seed}{Seed to be used in the bootstrap procedure.} + +\item{cluster}{A logical value. If \code{TRUE} (default), the +bootstrap procedure is parallelized (only for \code{smooth = "splines"}). + Note that there are cases +(e.g., a low number of bootstrap repetitions) that R will gain in +performance through serial computation. R takes time to distribute tasks +across the processors also it will need time for binding them all together +later on. Therefore, if the time for distributing and gathering pieces +together is greater than the time need for single-thread computing, it does +not worth parallelize.} + +\item{ncores}{An integer value specifying the number of cores to be used +in the parallelized procedure. If \code{NULL} (default), the number of cores +to be used is equal to the number of cores of the machine - 1.} + +\item{test}{Statistic test to be used, based on residuals on the null model +(\code{res}) or based on the likelihood ratio test +using rss0 and rss1 \code{lrt}.} + +\item{\ldots}{Other options.} } \value{ An object is returned with the following elements: @@ -59,9 +76,6 @@ library(npregfast) data(barnacle) allotest(DW ~ RC, data = barnacle, nboot = 50, seed = 130853) -} -\author{ -Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. } \references{ Sestelo, M. and Roca-Pardinas, J. (2011). A new approach to estimation of @@ -74,4 +88,6 @@ estimation and inference methods in flexible regression models. Applications in Biology, Engineering and Environment. PhD Thesis, Department of Statistics and O.R. University of Vigo. } - +\author{ +Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. +} diff --git a/man/autoplot.frfast.Rd b/man/autoplot.frfast.Rd index f3ac9a0..225e049 100644 --- a/man/autoplot.frfast.Rd +++ b/man/autoplot.frfast.Rd @@ -132,4 +132,3 @@ gridExtra::grid.arrange(grobs = facs, ncol = 2, nrow = 1) \author{ Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. } - diff --git a/man/barnacle.Rd b/man/barnacle.Rd index 8c3fa8d..a800bd7 100644 --- a/man/barnacle.Rd +++ b/man/barnacle.Rd @@ -31,4 +31,3 @@ length-weight relationship of \eqn{Pollicipes} \eqn{pollicipes} aspects of its biology and management. Journal of Shellfish Research, 30(3), 939--948. } - diff --git a/man/children.Rd b/man/children.Rd index c17ae6e..3190bc9 100644 --- a/man/children.Rd +++ b/man/children.Rd @@ -28,4 +28,3 @@ data(children) head(children) } - diff --git a/man/critical.Rd b/man/critical.Rd index c0d9f3e..999075c 100644 --- a/man/critical.Rd +++ b/man/critical.Rd @@ -51,9 +51,6 @@ critical(fit, der = 2) # critical(fit2, der = 1) # critical(fit2, der = 2) -} -\author{ -Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. } \references{ Sestelo, M. (2013). Development and computational implementation of @@ -61,4 +58,6 @@ estimation and inference methods in flexible regression models. Applications in Biology, Engineering and Environment. PhD Thesis, Department of Statistics and O.R. University of Vigo. } - +\author{ +Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. +} diff --git a/man/criticaldiff.Rd b/man/criticaldiff.Rd index 928a4b6..f276245 100644 --- a/man/criticaldiff.Rd +++ b/man/criticaldiff.Rd @@ -48,9 +48,6 @@ criticaldiff(fit2) criticaldiff(fit2, der = 1) criticaldiff(fit2, der = 1, level1 = "lens", level2 = "barca") -} -\author{ -Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. } \references{ Sestelo, M. (2013). Development and computational implementation of @@ -58,4 +55,6 @@ estimation and inference methods in flexible regression models. Applications in Biology, Engineering and Environment. PhD Thesis, Department of Statistics and O.R. University of Vigo. } - +\author{ +Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. +} diff --git a/man/frfast.Rd b/man/frfast.Rd index 06ee8c8..285aeec 100644 --- a/man/frfast.Rd +++ b/man/frfast.Rd @@ -4,7 +4,7 @@ \alias{frfast} \title{Fitting nonparametric models} \usage{ -frfast(formula, data = data, na.action = "na.omit", model = "np", +frfast(formula, data, na.action = "na.omit", model = "np", smooth = "kernel", h0 = -1, h = -1, nh = 30, weights = NULL, kernel = "epanech", p = 3, kbin = 100, nboot = 500, rankl = NULL, ranku = NULL, seed = NULL, cluster = TRUE, ncores = NULL, ...) @@ -226,9 +226,6 @@ summary(fit3) # fit4 <- frfast(DW ~ RC : F, data = barnacle, model = "allo", nboot = 100) # summary(fit4) -} -\author{ -Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. } \references{ Huxley, J. S. (1924). Constant differential growth-ratios and their @@ -239,4 +236,6 @@ estimation and inference methods in flexible regression models. Applications in Biology, Engineering and Environment. PhD Thesis, Department of Statistics and O.R. University of Vigo. } - +\author{ +Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. +} diff --git a/man/globaltest.Rd b/man/globaltest.Rd index 0b78fab..ee294c4 100644 --- a/man/globaltest.Rd +++ b/man/globaltest.Rd @@ -127,9 +127,6 @@ globaltest(DW ~ RC : F, data = barnacle, der = 1, seed = 130853, nboot = 100) # seed = 130853, der = 0, smooth = "splines") -} -\author{ -Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. } \references{ Sestelo, M. (2013). Development and computational implementation of @@ -137,4 +134,6 @@ estimation and inference methods in flexible regression models. Applications in Biology, Engineering and Environment. PhD Thesis, Department of Statistics and O.R. University of Vigo. } - +\author{ +Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. +} diff --git a/man/localtest.Rd b/man/localtest.Rd index 91317ea..22c7df0 100644 --- a/man/localtest.Rd +++ b/man/localtest.Rd @@ -151,9 +151,6 @@ localtest(DW ~ RC : F, data = barnacle, der = 1, seed = 130853, nboot = 100) # localtest(height ~ s(age, by = sex), data = children, seed = 130853, # der = 1, smooth = "splines") -} -\author{ -Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. } \references{ Sestelo, M. (2013). Development and computational implementation of @@ -161,4 +158,6 @@ estimation and inference methods in flexible regression models. Applications in Biology, Engineering and Environment. PhD Thesis, Department of Statistics and O.R. University of Vigo. } - +\author{ +Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. +} diff --git a/man/npregfast.Rd b/man/npregfast.Rd index f284d3c..aa13f89 100644 --- a/man/npregfast.Rd +++ b/man/npregfast.Rd @@ -60,9 +60,6 @@ For a listing of all routines in the NPRegfast package type: View a \href{http://sestelo.shinyapps.io/npregfast}{demo Shiny app} or see the full \href{https://github.com/sestelo/npregfast}{README} on GitHub. } -\author{ -Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. -} \references{ Efron, B. (1979). Bootstrap methods: another look at the jackknife. Annals of Statistics, 7, 1--26. @@ -86,4 +83,6 @@ aspects of its biology and management. Journal of Shellfish Research, Wand, M. P. and Jones, M. C. (1995). Kernel Smoothing. Chapman & Hall, London. } - +\author{ +Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. +} diff --git a/man/plot.frfast.Rd b/man/plot.frfast.Rd index 07b4e72..30f1e9a 100644 --- a/man/plot.frfast.Rd +++ b/man/plot.frfast.Rd @@ -115,4 +115,3 @@ plot(fit2, fac = "barca", diffwith = "lens", der = 1) \author{ Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. } - diff --git a/man/predict.frfast.Rd b/man/predict.frfast.Rd index 993b1a5..b14e091 100644 --- a/man/predict.frfast.Rd +++ b/man/predict.frfast.Rd @@ -55,4 +55,3 @@ predict(fit, newdata = nd) \author{ Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. } - diff --git a/man/reexports.Rd b/man/reexports.Rd index 8fc910e..3a7999e 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -2,9 +2,10 @@ % Please edit documentation in R/autoplot.frfast.R \docType{import} \name{reexports} -\alias{autoplot} \alias{reexports} +\alias{autoplot} \title{Objects exported from other packages} +\keyword{internal} \description{ These objects are imported from other packages. Follow the links below to see their documentation. @@ -12,5 +13,4 @@ below to see their documentation. \describe{ \item{ggplot2}{\code{\link[ggplot2]{autoplot}}} }} -\keyword{internal} diff --git a/man/runExample.Rd b/man/runExample.Rd index 2e5c6b0..9b6a602 100644 --- a/man/runExample.Rd +++ b/man/runExample.Rd @@ -20,4 +20,3 @@ if (interactive()) { runExample() } } - diff --git a/man/summary.frfast.Rd b/man/summary.frfast.Rd index 0a9ab44..f309e64 100644 --- a/man/summary.frfast.Rd +++ b/man/summary.frfast.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/summary.frfast.R \name{summary.frfast} -\alias{print.frfast} \alias{summary.frfast} +\alias{print.frfast} \title{Summarizing fits of \code{frfast} class} \usage{ \method{summary}{frfast}(object = model, ...) @@ -51,9 +51,6 @@ fit3 <- frfast(DW ~ RC, data = barnacle, model = "allo", nboot = 100) fit3 summary(fit3) -} -\author{ -Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. } \references{ Sestelo, M. (2013). Development and computational implementation of @@ -61,4 +58,6 @@ estimation and inference methods in flexible regression models. Applications in Biology, Engineering and Environment. PhD Thesis, Department of Statistics and O.R. University of Vigo. } - +\author{ +Marta Sestelo, Nora M. Villanueva and Javier Roca-Pardinas. +} From b9da69772d7564c133decb5fd3feca726d029d07 Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Fri, 27 Oct 2017 19:43:41 +0200 Subject: [PATCH 19/23] problem with print in .f90 --- src/program2.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/program2.f90 b/src/program2.f90 index f428279..50b862c 100644 --- a/src/program2.f90 +++ b/src/program2.f90 @@ -311,7 +311,7 @@ subroutine RfastC3(X,Y,W,n,p,kbin,h,T) do i=1,n !print *, residuo(1:n) - print *, pred1(i) + !print *, pred1(i) end do @@ -997,7 +997,7 @@ subroutine globaltest_(F,X,Y,W,n,h0,h,nh,p,kbin,fact,nf,kernel,nboot,r,T,& call rfast_h(X,Y,W,n,h0,p,Xb,Pb,kbin,kernel,nh) call Interpola (Xb,Pb(1,1,1),kbin,X,muhatg,n) -print *, h0 +!print *, h0 !print *, muhatg From f6d489f51ee8e6d594b3b79cf232f00485418d3d Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Fri, 27 Oct 2017 19:50:24 +0200 Subject: [PATCH 20/23] print deleted --- src/lsq.mod | Bin 1642 -> 1703 bytes src/program2.f90 | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lsq.mod b/src/lsq.mod index 692e81fecffe85e0f63531ff595e0bc12d30bd4f..6d27a8fae4bd18a0928e106eecd0695097885f09 100644 GIT binary patch literal 1703 zcmV;Y23YwYiwFP!000001JznvccMrTe(zsVZ zFqve2{T9tdL?$C(T#dPOE1|!t{;H_zsxP01qshn^z}jCtyEeSoLFo7%a8%-89@w+3 zy?|xluc7@i3))NHUEme%A68rb9{#e{t|$J|wbj$>e6b3)OKYR?__gxdllJ)e(RJ2# z-|@C~Al{DcaBI7MdlUGpV735b8e2u4{M#Jf(H!z`h zci-=IdK2qDx{1;MW;~27^WXSQVvI({gN2uxBdcrPn}e=7=sd(&^EZrM=^TXs5$7!l zWKh_(d?FuSc0*L)=Kf1vIkIJVvL{CYIaEMS^2oIaxek;EN`VSMMW9jwJ|_f~fm;-0 z_-c%L#;5*)2I?_t ziGeq6k@qj>G_FL^NSCLDGh1B;@hRgE)j{AvphOT3B@#s79B=ME7x~jzq$)N*-jhOz zHmD`YASfWHB_e2%2+r1-xy~=UjvZvnAJ{<*uRr|K>mbilrlj*cv2GInr=au*RAa|N zs_^6;6_fWJBojiUAeJyh6jK@UlEi?IvDUmOf2QodI(Hx>;Jmr-p47=5?=^~O(BFFg zV|XEG(4lT-LBxM+?gznj_$E9ypWKk zfxVh9FV?e53X9BCkTj6=LkVO)lE4oZC+GCZM35s^v}6Hf5oC-p9|A)(7Nmo`}|bI`g?KIS*2aK-vc}#wi&4o;e)?K_?Y%G3a?d$Rry- z8fxb13QM*W9aR1huZq;%o;ZB{K;NVa4DRLlCRJpB4)I)0B%rc1RV@hsRE2?m`@fAw zMWcC{1)JbBx&F?PS5RRLm=pl3%yv{Av{){U=5cGt#+SAKVqc1>YwSc(lR%R}Qw|la zMT*9-)xNR_3iFp&h84fXJlx)(6yn}FUSrAX}bPc8!#>I>36i zt-UtM*aJ=2Lw5A3!ybyha^bAwnnsf?BsEVRs2D|Nafo=;ibQAVEN9Pd6GrUd*U==} z;wxt2>H4(lPF{v01%BV9R2HKlAq6z;C&wvY{zILLAQUN7ees4I67Yfe({@%*83aM9 z%%WqtQ(Rlw=WlW4>+uBw#&d7BYp-i7u{MW9S_lXD^IDIH91h|_R>}I;vxOon5@u4U z=Z$MbJqj;^TzIjM;Cl2Z@o{|7RFif2D4{*PB~`BLR^-9Mp^hYt9u5+^wMTn9O94pA zm8w$P_mTT@oPm>iaVzU+ve8z`$R^hbGXOF@NvwDb65LPn+YGqcc9K{Y%pknlf;9Bh zGKT#dKcr39ugfJ_E^=uf!5O%uL=7K~x3D)U1VuQFV>ssE_vCa^4idRK;xyA}bgGg& z*HF%!0;#B*rL(o>zPED`l|hh-J6QyQ%(gdSy1ZIB4;kJ^r_H!X-GoHdbLX3C^*y+R z(?P9}P1g{k5tTHIzm}f$GIPrj9CNUpM>8_V)BdDbLO5!3$v!YN^Qg5tJFTgCa9Ue2 za#ZALx_aHmmZlt>R#iU!Zs_Eq#_+5yoChIktmZ*w&B;8lF69jyDOnpWPSjloD*l^D z_M18JEiGxK#G#(lQ+SBl6620Q97}0G9*$*F=!V1h6xKz?18XOXJG5{jW&Ke&k$0^| zJg~;2r;tO6vF@F;9R{ar(qw`|E!V(-Q@y->f(L~sNnZkvXcwTz&;srZ@vj%}G0?Y$% zw)YnB5NuYk4K|O#Y$g5mV2GsCxq(yskYsQ}a9HsxfpGtA_k1r2AS`#^@vi_BI-Of* z)U|q3$AYQ-k3ITof9Ts2%bvh+)SC{h58>y~v$_Kke-0wP#?z0^XgcZJ7W9X=gMPO^ zac{$$n1iq8-PpDMjou`tOea5`)hOK~)eI1sT4WPT%}E zD2b3vxeW1yBtSom%`Xr{_OEOh)+3xr~#4)5+#yUmPnF8@YnO@bCEx-MXF;1qn>O6o@Kv>T=%ab~}+nso#yO{hY=9yXg@RH+J_X5F6zF1~YzmSza2NjSGI*gNO9St5{&2CL zU12;j(?HQdG0GCCVkp5TSe%^GClf&pSG}yPU|e*k;N*;IKk$J zyWOA9@ZMlIN!a~o;1~x4yX(=j!Qr|)Z~qSd;`opy1;o(WcHYvPV|M9clDTxh`Rg#8 z>iFw@;IDW7{N|4qNUA_W)`C7w?d}AX*xcq0_*q^6iURoS#=-gTg09Bd9LeKmQV5*M zz$$V$hTghF-u8)T!>6;D$&#}mSqRcA#Tchx>|5qk27*p%x5uF8xs*w^el#@9)frE= zm;stt#;YMU_a_ct-_bW|5{G*^zDbigpfaAzi3BvBrfL-dfW|oZ*ZI=&Y=0JybM?t=^SI zP?*2`&r4S^gHj9qsPH}CP z=WlW4>+uB=#&fUU(pxoFVq*@;v=9!6=d~UgIUGcVtcvxoXA5OsBuu5y&KuXrMi^cM zneZZy;Cl3^h*5meR+CNnsGvQ(##OHCR%Gen&_t3}4+jO^+P$}*B>)t5rK;5PJ~A)I z88~Sax3Y;QTWzI^Y+Cxe6o5)k5-T2q1oxBtHUqA=og|V4Gl+F#L0Woh6~q4RW=Gqu z-;_(LTI5n5!5O&3!iEojz3{dP1SXxvF&uO7dvZFlQX z@b~U~vp%?p+8{{Hoh*VtW_#ORvblePY07?3E`;CC3#?I=3z^8dRo));Iy$~)Ue3YcJ-!@ zEuEE4t7;#Aw{&u0V|dyYE`k&{R*RtV=426gm-3d6SlUL56YbD}ieHmSzL^u>(&JW2 z92#*wMTD>|G3p4!v6A%T;aDYwZa938@h&nEcsp6tp@kDA?T^BVdT2Egfj1sK?F6J4 z@7_t;VQ{L&O(rS8be0Bam0vH$=8 diff --git a/src/program2.f90 b/src/program2.f90 index 50b862c..bf6f8c3 100644 --- a/src/program2.f90 +++ b/src/program2.f90 @@ -133,7 +133,7 @@ subroutine allotest_sestelo_(X,Y,W,n,kbin,nboot,T,pvalor,umatrix) !print *, errg(1:n) call RfastC3_sestelo(X,Y,W,n,p,kbin,h,T) -print *, T +!print *, T pvalor=0 do iboot=1,nboot From 6431b26fb969d0b6ddd37806be495ad7c333f498 Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Fri, 27 Oct 2017 20:04:55 +0200 Subject: [PATCH 21/23] added travis --- .travis.yml | 11 +++++++++++ src/lsq.mod | Bin 1703 -> 1642 bytes 2 files changed, 11 insertions(+) create mode 100644 .travis.yml diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..d04ecda --- /dev/null +++ b/.travis.yml @@ -0,0 +1,11 @@ +language: r +cache: packages +sudo: true + +r: +# - oldrel + - release + - devel + + +warnings_are_errors: true \ No newline at end of file diff --git a/src/lsq.mod b/src/lsq.mod index 6d27a8fae4bd18a0928e106eecd0695097885f09..692e81fecffe85e0f63531ff595e0bc12d30bd4f 100644 GIT binary patch literal 1642 zcmV-w29^0AiwFP!000001JzntbJ|D{exF~_Z^94R(&!jTj|wPRYC*UJBcwTz&;srZ@vj%}G0?Y$% zw)YnB5NuYk4K|O#Y$g5mV2GsCxq(yskYsQ}a9HsxfpGtA_k1r2AS`#^@vi_BI-Of* z)U|q3$AYQ-k3ITof9Ts2%bvh+)SC{h58>y~v$_Kke-0wP#?z0^XgcZJ7W9X=gMPO^ zac{$$n1iq8-PpDMjou`tOea5`)hOK~)eI1sT4WPT%}E zD2b3vxeW1yBtSom%`Xr{_OEOh)+3xr~#4)5+#yUmPnF8@YnO@bCEx-MXF;1qn>O6o@Kv>T=%ab~}+nso#yO{hY=9yXg@RH+J_X5F6zF1~YzmSza2NjSGI*gNO9St5{&2CL zU12;j(?HQdG0GCCVkp5TSe%^GClf&pSG}yPU|e*k;N*;IKk$J zyWOA9@ZMlIN!a~o;1~x4yX(=j!Qr|)Z~qSd;`opy1;o(WcHYvPV|M9clDTxh`Rg#8 z>iFw@;IDW7{N|4qNUA_W)`C7w?d}AX*xcq0_*q^6iURoS#=-gTg09Bd9LeKmQV5*M zz$$V$hTghF-u8)T!>6;D$&#}mSqRcA#Tchx>|5qk27*p%x5uF8xs*w^el#@9)frE= zm;stt#;YMU_a_ct-_bW|5{G*^zDbigpfaAzi3BvBrfL-dfW|oZ*ZI=&Y=0JybM?t=^SI zP?*2`&r4S^gHj9qsPH}CP z=WlW4>+uB=#&fUU(pxoFVq*@;v=9!6=d~UgIUGcVtcvxoXA5OsBuu5y&KuXrMi^cM zneZZy;Cl3^h*5meR+CNnsGvQ(##OHCR%Gen&_t3}4+jO^+P$}*B>)t5rK;5PJ~A)I z88~Sax3Y;QTWzI^Y+Cxe6o5)k5-T2q1oxBtHUqA=og|V4Gl+F#L0Woh6~q4RW=Gqu z-;_(LTI5n5!5O&3!iEojz3{dP1SXxvF&uO7dvZFlQX z@b~U~vp%?p+8{{Hoh*VtW_#ORvblePY07?3E`;CC3#?I=3z^8dRo));Iy$~)Ue3YcJ-!@ zEuEE4t7;#Aw{&u0V|dyYE`k&{R*RtV=426gm-3d6SlUL56YbD}ieHmSzL^u>(&JW2 z92#*wMTD>|G3p4!v6A%T;aDYwZa938@h&nEcsp6tp@kDA?T^BVdT2Egfj1sK?F6J4 z@7_t;VQ{L&O(rS8be0Bam0vH$=8 literal 1703 zcmV;Y23YwYiwFP!000001JznvccMrTe(zsVZ zFqve2{T9tdL?$C(T#dPOE1|!t{;H_zsxP01qshn^z}jCtyEeSoLFo7%a8%-89@w+3 zy?|xluc7@i3))NHUEme%A68rb9{#e{t|$J|wbj$>e6b3)OKYR?__gxdllJ)e(RJ2# z-|@C~Al{DcaBI7MdlUGpV735b8e2u4{M#Jf(H!z`h zci-=IdK2qDx{1;MW;~27^WXSQVvI({gN2uxBdcrPn}e=7=sd(&^EZrM=^TXs5$7!l zWKh_(d?FuSc0*L)=Kf1vIkIJVvL{CYIaEMS^2oIaxek;EN`VSMMW9jwJ|_f~fm;-0 z_-c%L#;5*)2I?_t ziGeq6k@qj>G_FL^NSCLDGh1B;@hRgE)j{AvphOT3B@#s79B=ME7x~jzq$)N*-jhOz zHmD`YASfWHB_e2%2+r1-xy~=UjvZvnAJ{<*uRr|K>mbilrlj*cv2GInr=au*RAa|N zs_^6;6_fWJBojiUAeJyh6jK@UlEi?IvDUmOf2QodI(Hx>;Jmr-p47=5?=^~O(BFFg zV|XEG(4lT-LBxM+?gznj_$E9ypWKk zfxVh9FV?e53X9BCkTj6=LkVO)lE4oZC+GCZM35s^v}6Hf5oC-p9|A)(7Nmo`}|bI`g?KIS*2aK-vc}#wi&4o;e)?K_?Y%G3a?d$Rry- z8fxb13QM*W9aR1huZq;%o;ZB{K;NVa4DRLlCRJpB4)I)0B%rc1RV@hsRE2?m`@fAw zMWcC{1)JbBx&F?PS5RRLm=pl3%yv{Av{){U=5cGt#+SAKVqc1>YwSc(lR%R}Qw|la zMT*9-)xNR_3iFp&h84fXJlx)(6yn}FUSrAX}bPc8!#>I>36i zt-UtM*aJ=2Lw5A3!ybyha^bAwnnsf?BsEVRs2D|Nafo=;ibQAVEN9Pd6GrUd*U==} z;wxt2>H4(lPF{v01%BV9R2HKlAq6z;C&wvY{zILLAQUN7ees4I67Yfe({@%*83aM9 z%%WqtQ(Rlw=WlW4>+uBw#&d7BYp-i7u{MW9S_lXD^IDIH91h|_R>}I;vxOon5@u4U z=Z$MbJqj;^TzIjM;Cl2Z@o{|7RFif2D4{*PB~`BLR^-9Mp^hYt9u5+^wMTn9O94pA zm8w$P_mTT@oPm>iaVzU+ve8z`$R^hbGXOF@NvwDb65LPn+YGqcc9K{Y%pknlf;9Bh zGKT#dKcr39ugfJ_E^=uf!5O%uL=7K~x3D)U1VuQFV>ssE_vCa^4idRK;xyA}bgGg& z*HF%!0;#B*rL(o>zPED`l|hh-J6QyQ%(gdSy1ZIB4;kJ^r_H!X-GoHdbLX3C^*y+R z(?P9}P1g{k5tTHIzm}f$GIPrj9CNUpM>8_V)BdDbLO5!3$v!YN^Qg5tJFTgCa9Ue2 za#ZALx_aHmmZlt>R#iU!Zs_Eq#_+5yoChIktmZ*w&B;8lF69jyDOnpWPSjloD*l^D z_M18JEiGxK#G#(lQ+SBl6620Q97}0G9*$*F=!V1h6xKz?18XOXJG5{jW&Ke&k$0^| zJg~;2r;tO6vF@F;9R{ar(qw`|E!V(-Q@y->f(L~sNnZkvX Date: Fri, 27 Oct 2017 20:24:11 +0200 Subject: [PATCH 22/23] fix first steps with travis --- .travis.yml | 6 +++++- R/allotest.R | 2 ++ src/.gitignore | 1 + src/lsq.mod | Bin 1642 -> 0 bytes 4 files changed, 8 insertions(+), 1 deletion(-) delete mode 100644 src/lsq.mod diff --git a/.travis.yml b/.travis.yml index d04ecda..a7c002d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -8,4 +8,8 @@ r: - devel -warnings_are_errors: true \ No newline at end of file +warnings_are_errors: true + + +notifications: + slack: newstat:ZqBL05R4NoRMqPZXnuzbF4OZ \ No newline at end of file diff --git a/R/allotest.R b/R/allotest.R index b13babe..367a06b 100644 --- a/R/allotest.R +++ b/R/allotest.R @@ -209,6 +209,7 @@ allotest <- function(formula, data = data, na.action = "na.omit", sta_res <- function(x, y){ + y[y == 0] <- 0.0001 model <- lm(log(y) ~ log(x)) muhat <- exp(coef(model)[1]) * x**coef(model)[2] residuo <- y - muhat @@ -221,6 +222,7 @@ sta_res <- function(x, y){ } sta_rss <- function(x, y){ + y[y == 0] <- 0.0001 model <- lm(log(y) ~ log(x)) m0 <- exp(coef(model)[1]) * x**coef(model)[2] rss0 <- sum((y - m0)**2) diff --git a/src/.gitignore b/src/.gitignore index ff122c5..f52894f 100644 --- a/src/.gitignore +++ b/src/.gitignore @@ -1,2 +1,3 @@ NPRegfast.so program2.o +lsq.mod diff --git a/src/lsq.mod b/src/lsq.mod deleted file mode 100644 index 692e81fecffe85e0f63531ff595e0bc12d30bd4f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1642 zcmV-w29^0AiwFP!000001JzntbJ|D{exF~_Z^94R(&!jTj|wPRYC*UJBcwTz&;srZ@vj%}G0?Y$% zw)YnB5NuYk4K|O#Y$g5mV2GsCxq(yskYsQ}a9HsxfpGtA_k1r2AS`#^@vi_BI-Of* z)U|q3$AYQ-k3ITof9Ts2%bvh+)SC{h58>y~v$_Kke-0wP#?z0^XgcZJ7W9X=gMPO^ zac{$$n1iq8-PpDMjou`tOea5`)hOK~)eI1sT4WPT%}E zD2b3vxeW1yBtSom%`Xr{_OEOh)+3xr~#4)5+#yUmPnF8@YnO@bCEx-MXF;1qn>O6o@Kv>T=%ab~}+nso#yO{hY=9yXg@RH+J_X5F6zF1~YzmSza2NjSGI*gNO9St5{&2CL zU12;j(?HQdG0GCCVkp5TSe%^GClf&pSG}yPU|e*k;N*;IKk$J zyWOA9@ZMlIN!a~o;1~x4yX(=j!Qr|)Z~qSd;`opy1;o(WcHYvPV|M9clDTxh`Rg#8 z>iFw@;IDW7{N|4qNUA_W)`C7w?d}AX*xcq0_*q^6iURoS#=-gTg09Bd9LeKmQV5*M zz$$V$hTghF-u8)T!>6;D$&#}mSqRcA#Tchx>|5qk27*p%x5uF8xs*w^el#@9)frE= zm;stt#;YMU_a_ct-_bW|5{G*^zDbigpfaAzi3BvBrfL-dfW|oZ*ZI=&Y=0JybM?t=^SI zP?*2`&r4S^gHj9qsPH}CP z=WlW4>+uB=#&fUU(pxoFVq*@;v=9!6=d~UgIUGcVtcvxoXA5OsBuu5y&KuXrMi^cM zneZZy;Cl3^h*5meR+CNnsGvQ(##OHCR%Gen&_t3}4+jO^+P$}*B>)t5rK;5PJ~A)I z88~Sax3Y;QTWzI^Y+Cxe6o5)k5-T2q1oxBtHUqA=og|V4Gl+F#L0Woh6~q4RW=Gqu z-;_(LTI5n5!5O&3!iEojz3{dP1SXxvF&uO7dvZFlQX z@b~U~vp%?p+8{{Hoh*VtW_#ORvblePY07?3E`;CC3#?I=3z^8dRo));Iy$~)Ue3YcJ-!@ zEuEE4t7;#Aw{&u0V|dyYE`k&{R*RtV=426gm-3d6SlUL56YbD}ieHmSzL^u>(&JW2 z92#*wMTD>|G3p4!v6A%T;aDYwZa938@h&nEcsp6tp@kDA?T^BVdT2Egfj1sK?F6J4 z@7_t;VQ{L&O(rS8be0Bam0vH$=8 From ceb6f0a3f646eaac443bf0a353ffdfe808fe86cf Mon Sep 17 00:00:00 2001 From: Marta Sestelo Date: Fri, 27 Oct 2017 20:26:24 +0200 Subject: [PATCH 23/23] new date --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8e96d53..5801194 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -3,7 +3,7 @@ Type: Package Title: Nonparametric Estimation of Regression Models with Factor-by-Curve Interactions Version: 1.4.0.9000 -Date: 2016-11-18 +Date: 2017-10-27 Author: Marta Sestelo [aut, cre], Nora M. Villanueva [aut], Javier Roca-Pardinas [aut]