R Under development (unstable) (2025-09-01 r88761 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(TFunHDDC) Loading required package: fda.usc Loading required package: fda Loading required package: splines Loading required package: fds Loading required package: rainbow Loading required package: MASS Loading required package: pcaPP Loading required package: RCurl Loading required package: deSolve Attaching package: 'fda' The following object is masked from 'package:graphics': matplot The following object is masked from 'package:datasets': gait Loading required package: mgcv Loading required package: nlme This is mgcv 1.9-3. For overview type 'help("mgcv-package")'. Loading required package: knitr fda.usc is running sequentially usign foreach package Please, execute ops.fda.usc() once to run in local parallel mode Deprecated functions: min.basis, min.np, anova.hetero, anova.onefactor, anova.RPm New functions: optim.basis, optim.np, fanova.hetero, fanova.onefactor, fanova.RPm ---------------------------------------------------------------------------------- > set.seed(1027) > #simulataed univariate data > data = genModelFD(ncurves=300, nsplines=35, alpha=c(0.9,0.9,0.9), + eta=c(10, 7, 17)) > plot(data$fd, col = data$groupd) [1] "done" > clm = data$groupd > model1=c("AkjBkQkDk", "AkjBQkDk", "AkBkQkDk", "ABkQkDk", "AkBQkDk", "ABQkDk") > t1<-tfunHDDC(data$fd,K=3,threshold=0.2,init="kmeans",nb.rep=2, + dfconstr="no", dfupdate="numeric", model=model1[1], itermax = 10) Time taken: ???? | Approx. remaining: ???? | 0% completeTime taken: 11.5 secs | Approx. remaining: 11.5 secs | 50% completeTime taken: 22.3 secs | Approx. remaining: 0 secs | 100% completetfunHDDC: model K threshold complexity BIC 1 AKJBKQKDK 3 0.2 1,070 -64,339.45 2 AKJBKQKDK 3 0.2 1,382 -64,558.05 SELECTED: model AKJBKQKDK with 3 clusters. Selection Criterion: BIC. > if (!is.null(t1$class)) table(clm, t1$class) clm 1 2 3 1 0 46 54 2 100 0 0 3 100 0 0 > ###############example when some classifications are known > if (FALSE) { # ommited due to long run times + known1=rep(NA,1,300) + known1[1]=clm[1] + known1[103]=clm[103] + known1[250]=clm[250] + t2<-tfunHDDC(data$fd,K=3,threshold=0.2,init="kmeans",nb.rep=10,dfconstr="no", + dfupdate="numeric", model=model1[1],known=known1) + table(clm, t2$class) + ################### example when some classifications are known and given in training + known1=rep(NA,1,300) + known1[1:100]=rep(3,1,50) + t3<-tfunHDDC(data$fd,K=3,threshold=0.2,init="kmeans",nb.rep=10,dfconstr="no", + dfupdate="numeric", model=model1[1],known=known1) + table(clm, t3$class) + } > ####################classification example with predictions > training=c(1:50,101:150, 201:250) > test=c(51:100,151:200, 251:300) > known1=clm[training] > t4<-tfunHDDC(data$fd[training],K=3,threshold=0.2,init="kmeans",nb.rep=1, + dfconstr="no", dfupdate="numeric", model=model1[1],known=known1, + itermax = 10) Time taken: ???? | Approx. remaining: ???? | 0% completeTime taken: 7.5 secs | Approx. remaining: 0 secs | 100% complete model K threshold complexity BIC 1 AKJBKQKDK 3 0.2 677 -31,523.19 SELECTED: model AKJBKQKDK with 3 clusters. Selection Criterion: BIC. Warning message: In .T_funhddc_main1(model = model, K = K, dfstart = dfstart, dfupdate = dfupdate, : No NAs in 'known' vector supplied, all values have known classification (parameter estimation only) > if (!is.null(t4$class)) { + table(clm[training], t4$class) + p1<-predict.tfunHDDC(t4,data$fd[test] ) + if (!is.null(p1$class)) table(clm[test], p1$class) + } 1 2 3 1 50 0 0 2 4 46 0 3 0 0 50 > ###########################NOX data > data1=fitNOxBenchmark(15) > plotNOx(data1) [1] "done" > > if (FALSE) { # ommited due to long run times + t1<-tfunHDDC(data1$fd,K=2,threshold=0.6,init="kmeans",nb.rep=20,dfconstr="no", + model=model1) + #t2<-tfunHDDC(data1$fd,K=2,threshold=0.4,init="kmeans",nb.rep=20, model=c("AkjBkQkDk", "AkjBQkDk", "AkBkQkDk", "ABkQkDk", "AkBQkDk", "ABQkDk")) + #t3<-tfunHDDC(data1$fd,K=2,threshold=0.2,init="kmeans",nb.rep=20, model=c("AkjBkQkDk", "AkjBQkDk", "AkBkQkDk", "ABkQkDk", "AkBQkDk", "ABQkDk")) + #t3<-tfunHDDC(data1$fd,K=2,threshold=0.05,init="kmeans",nb.rep=20, model=c("AkjBkQkDk", "AkjBQkDk", "AkBkQkDk", "ABkQkDk", "AkBQkDk", "ABQkDk")) + + table(data1$groupd, t1$class) + #table(data1$groupd, t2$class) + #table(data1$groupd, t2$class) + #table(data1$groupd, t3$class) + #table(data1$groupd, t4$class) + ###example for prediction + training=c(1:50) + test=c(51:115) + known1=data1$groupd[training] + t1<-tfunHDDC(data1$fd[training],K=2,threshold=0.6,init="kmeans",nb.rep=10, + dfconstr="no", model=model1,known=known1) + table(data1$groupd[training], t1$class) + p1<-predict.tfunHDDC(t1,data1$fd[test] ) + table(data1$groupd[test], p1$class) + } > ############################multivariate simulated data > set.seed(2341) > conTrig <- genTriangles() > # plotTriangles(conTrig) > cls = conTrig$groupd # groups 5 and 6 (contaminated) go into 1 and 3 respectively > res_s = tfunHDDC(conTrig$fd, K=4, dfconstr="no", dfupdate="numeric", + model="ABKQKDK", init="kmeans", threshold=0.2, nb.rep=1, + itermax=10) Time taken: ???? | Approx. remaining: ???? | 0% completeTime taken: 6.5 secs | Approx. remaining: 0 secs | 100% complete model K threshold complexity BIC 1 ABKQKDK 4 0.2 2,523 -96,141.86 SELECTED: model ABKQKDK with 4 clusters. Selection Criterion: BIC. > if (!is.null(res_s$class)) table(cls, res_s$class) cls 1 2 3 4 1 0 0 80 0 2 0 0 0 100 3 0 80 0 0 4 100 0 0 0 5 5 0 15 0 6 1 14 0 5 > > > > proc.time() user system elapsed 35.75 2.81 38.54