rm(list=ls())
library(PLFD)
set.seed(2021)
n1 <- n2 <- 75
rDim <- cDim <- 60
n1Test <- n2Test <- 1000
M1 <- matrix(0.0, rDim, cDim)
M1[1:10, 1:10] <- matrix(
runif(10*10, 0.2, 0.8)*sample(-1:1, 10*10, TRUE, rep(1/3, 3)),
nrow=10
)
x1 <- sweep(array(rnorm(rDim*cDim*n1), c(rDim, cDim, n1)), 1:2, M1, '+')
x2 <- array(rnorm(rDim*cDim*n2), c(rDim, cDim, n2))
x1Test <- sweep(array(rnorm(rDim*cDim*n1Test), c(rDim, cDim, n1Test)), 1:2, M1, '+')
x2Test <- array(rnorm(rDim*cDim*n2Test), c(rDim, cDim, n2Test))
xTest <- c(x1Test, x2Test)
dim(xTest) <- c(rDim, cDim, n1Test+n2Test)
yTest <- c(rep(1, n1Test), rep(2, n2Test))
r0 <- c0 <- 5
plfd.model <- plfd(x1, x2, r0, c0)
print(plfd.model)
#> $n1
#> [1] 75
#>
#> $n2
#> [1] 75
#>
#> $rDim
#> [1] 60
#>
#> $cDim
#> [1] 60
#>
#> $blockMode
#> NULL
#>
#> $permNum
#> [1] 100
#>
#> $alpha
#> [1] 0
#>
#> $BlockNumber
#> [1] 144
#>
#> $paras
#> $paras[[1]]
#> $paras[[1]]$rIdx
#> [1] 1 2 3 4 5
#>
#> $paras[[1]]$cIdx
#> [1] 1 2 3 4 5
#>
#> $paras[[1]]$B
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] 0.09455177 0.2841402 0.03683576 -0.05432506 0.14518859
#> [2,] 0.02734638 0.2460957 0.15295615 -0.04761974 -0.66202660
#> [3,] -0.17549968 0.3664198 0.40057246 -0.75459010 0.39517202
#> [4,] -0.33267325 0.5662426 -0.44807927 0.82443855 0.03314218
#> [5,] 0.81278010 0.4315501 0.53688272 -0.45726553 0.04570656
#>
#> $paras[[1]]$M
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] 0.12568185 0.25989995 0.16069067 -0.07222946 0.05389460
#> [2,] -0.10598852 0.03356776 -0.03387595 0.08616139 -0.50724989
#> [3,] -0.09450095 0.17653757 0.07022355 -0.25518349 0.17650854
#> [4,] -0.25804196 0.36902381 -0.18482704 0.29270110 -0.06014336
#> [5,] 0.35316141 0.21139331 0.26053168 -0.38411359 -0.07751426
#>
#>
#> $paras[[2]]
#> $paras[[2]]$rIdx
#> [1] 1 2 3 4 5
#>
#> $paras[[2]]$cIdx
#> [1] 6 7 8 9 10
#>
#> $paras[[2]]$B
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] 0.5377759570 0.1858095 -0.007484638 -0.35200454 0.2920983
#> [2,] -0.0004088211 -0.4539923 -0.567485543 0.09976151 -0.2018753
#> [3,] 0.1176001104 0.1248567 -0.331533286 0.86764843 0.3258561
#> [4,] 0.6387824095 0.3080420 0.232368326 0.46270757 0.3952726
#> [5,] 0.0353163346 0.2256951 -0.103948054 0.63320262 0.2472014
#>
#> $paras[[2]]$M
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] 0.283769888 0.13255933 0.08938182 -0.29540545 0.29233260
#> [2,] -0.140298989 -0.02405215 -0.25451979 0.07148686 0.12822376
#> [3,] 0.043422018 0.03147612 -0.19532910 0.35299724 -0.26552784
#> [4,] 0.262393966 0.14418577 0.06727653 0.25396105 0.24917717
#> [5,] 0.002000147 0.03672050 0.02828220 0.32582161 0.03376714
#>
#>
#> $paras[[3]]
#> $paras[[3]]$rIdx
#> [1] 6 7 8 9 10
#>
#> $paras[[3]]$cIdx
#> [1] 1 2 3 4 5
#>
#> $paras[[3]]$B
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] 0.274764978 0.55995045 -0.07135825 -0.04246367 0.8795222
#> [2,] 0.629535202 -0.04448313 -0.17863215 0.91787578 -0.7686021
#> [3,] 0.432459081 -0.08908298 -0.52708754 -0.32437373 -0.1841520
#> [4,] 0.006961321 -0.10682616 0.76969841 -0.14818253 0.1345976
#> [5,] 0.836149493 0.14084122 -0.09644308 0.67707136 0.8148905
#>
#> $paras[[3]]$M
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] -0.03849077 0.10728089 0.0453202393 0.07048428 0.36851091
#> [2,] 0.20137930 0.11605537 -0.0003377157 0.37000626 -0.43058443
#> [3,] 0.13266730 -0.09357871 -0.4713386392 -0.25722118 -0.13300763
#> [4,] 0.05393132 0.04968041 0.3805316465 0.10940600 -0.02962719
#> [5,] 0.36589649 0.05795348 0.0692100492 0.32945898 0.53535711
#>
#>
#> $paras[[4]]
#> $paras[[4]]$rIdx
#> [1] 6 7 8 9 10
#>
#> $paras[[4]]$cIdx
#> [1] 6 7 8 9 10
#>
#> $paras[[4]]$B
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] -0.36914819 -0.3972291 -0.103909021 0.2761774 -0.70520826
#> [2,] -0.04375245 -0.2456492 -0.176521135 -0.8081000 -0.21937933
#> [3,] 0.02726080 -0.1505949 0.007090615 -0.6981436 0.53975442
#> [4,] 0.54609061 0.3135614 -0.627687373 0.4688254 0.09966865
#> [5,] -0.58683716 0.4980014 0.848566774 0.5687189 0.45786724
#>
#> $paras[[4]]$M
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] -0.09464628 -0.07256030 -0.05310478 0.2329607 -0.48554959
#> [2,] -0.20213060 -0.09933155 0.11543938 -0.4968433 -0.11771773
#> [3,] 0.07556163 0.18495577 -0.04184512 -0.3703578 0.31824759
#> [4,] 0.49007389 0.17174423 -0.26636683 0.2567638 0.04428639
#> [5,] -0.29400590 0.21166835 0.53133581 0.3128980 0.27302883
#>
#>
#>
#> attr(,"class")
#> [1] "plfd"
result <- predict(plfd.model, x=xTest, y=yTest)
print(result$mcr)
#> [1] 0.0175