A Portmanteau Local Feature Discrimination for High-Dimensional Matrix-Variate Data

An example for PLFD

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