@@ -1,7 +1,8 @@

 Package: TDbasedUFEadv

 Type: Package

 Title: TDbasedUFEadv

-Version: 0.99.8

+Version: 0.99.9

+Language: en-US

 Authors@R: 

     person("Taguchi", "Y-h.", ,

     "[email protected]", role = c("aut", "cre"),

@@ -10,7 +11,7 @@ Description:

     This is a comprehensive package to perform

     Tensor decomposition based unsupervised feature extraction.

     It can perform unsupervised feature extraction.

-    It uses tensor decompission.

+    It uses tensor decomposition.

     It is  applicable to gene expression, DNA methylation, and 

     histone modification etc.

     It can perform multiomics analysis.

@@ -19,7 +20,8 @@ biocViews:

     GeneExpression, 

     FeatureExtraction, 

     MethylationArray,

-    SingleCell    

+    SingleCell,

+    Software

 License: GPL-3

 Encoding: UTF-8

 Imports: 

@@ -43,6 +45,10 @@ Imports:

     hash,

     shiny

 RoxygenNote: 7.2.3

+BugReports: 

+ https://github.com/tagtag/TDbasedUFEadv/issues

+URL:

+ https://github.com/tagtag/TDbasedUFEadv

 Suggests: 

     knitr,

     rmarkdown,

@@ -1,9 +1,9 @@

 # Generated by roxygen2: do not edit by hand

-export(PrepareSummarizedExperimentTensorRect)

 export(computeSVD)

 export(prepareCondDrugandDisease)

 export(prepareCondTCGA)

+export(prepareSummarizedExperimentTensorRect)

 export(prepareTensorfromList)

 export(prepareTensorfromMatrix)

 export(prepareexpDrugandDisease)

@@ -31,6 +31,7 @@ importFrom(graphics,boxplot)

 importFrom(graphics,hist)

 importFrom(graphics,par)

 importFrom(hash,keys)

+importFrom(methods,is)

 importFrom(methods,new)

 importFrom(rTensor,as.tensor)

 importFrom(rTensor,hosvd)

@@ -49,4 +50,5 @@ importFrom(stats,filter)

 importFrom(stats,optim)

 importFrom(stats,p.adjust)

 importFrom(stats,pchisq)

+importFrom(stats,var)

 importFrom(utils,read.csv)

@@ -1,3 +1,3 @@

-# TDbasedUFEadv 0.99.0

+# TDbasedUFEadv 0.99.8

-* Added a `NEWS.md` file to track changes to the package.

+* Addressing many comments from reviewers. 

similarity index 93%

rename from R/init.R

rename to R/AllClasses.R

@@ -1,4 +1,4 @@

-#' Title

+#' @title Class definitions

 #'

 #' @slot sample character. 

 #' @slot feature list. 

deleted file mode 100644

@@ -1,24 +0,0 @@

-#' Title Prepare tensor generated from two matricies that share samples

-#'

-#' @param sample Chracter vecor of sample names

-#' @param feature list of features from two matrices

-#' @param value array, contents of 

-#' @param featureRange Genomic Ranges to be associated with features

-#' @param sampleData List of conditional labeling associated with samples

-#'

-#' @return Tensor generated from two matricies that share samples

-#' @export

-#'

-#' @examples

-#' matrix1 <- matrix(runif(10000),200) #row features, column samples

-#' matrix2 <- matrix(runif(20000),400) #row features, column samples

-#' Z <- prepareTensorfromMatrix(t(matrix1),t(matrix2))

-#' Z <- PrepareSummarizedExperimentTensorRect(sample=as.character(seq_len(50)),

-#' feature=list(as.character(seq_len(200)),as.character(seq_len(400))),

-#' sampleData=list(rep(seq_len(2),each=25)),value=Z)

-PrepareSummarizedExperimentTensorRect <- function(sample,feature,value,

-    featureRange=GRanges(NULL),sampleData=list(NULL)){

-    new("SummarizedExperimentTensorRect",sample=sample,

-        feature=feature,value=value,

-        featureRange=featureRange,sampleData=sampleData)

-}

\ No newline at end of file

@@ -2,7 +2,8 @@

 "_PACKAGE"

 ## usethis namespace: start

-#' @importFrom methods new

+#' @importFrom stats var

+#' @importFrom methods new is

 #' @importFrom utils read.csv

 #' @import RTCGA.rnaseq

 #' @import RTCGA.clinical

@@ -7,20 +7,30 @@

 #' @param scale If matrix should be scaled or not

 #'

 #' @return Singular value vectors attributed to two sets of objects associated 

-#' with eingular value vectors attriuted to features, by multiplying  

+#' with singular value vectors attributed to features, by multiplying  

 #' @export

 #'

 #' @examples

 #' matrix1 <- matrix(runif(200),20)

 #' matrix2 <- matrix(runif(400),20)

 #' SVD <- computeSVD(matrix1,matrix2)

-computeSVD <- function(matrix1,matrix2,dim=10,scale=TRUE){

-    matrix1[is.na(matrix1)] <-0 

-    matrix2[is.na(matrix2)] <-0 

-    Z <- t(matrix1) %*% matrix2    

-    if (scale) Z <- Z/mean(Z)

-    SVD <- svd(Z,dim,dim)

-    u<- matrix1 %*% SVD$u

-    v<- matrix2 %*% SVD$v

-    return(list(SVD=SVD,u=u,v=v))

+computeSVD <- function(matrix1, matrix2, dim = as.integer(10), scale = TRUE) {

+  # Argument check

+  stopifnot("`matrix1` must be a matrix." = is.matrix(matrix1))

+  stopifnot("`matrix2` must be a matrix." = is.matrix(matrix2))

+  stopifnot("`dim` must be a integer." = is.integer(dim))

+  stopifnot("`scale` must be a logical." = is.logical(scale))

+  stopifnot(

+    "# of rows must be common between `matrix1` and `matrix2`" 

+        = nrow(matrix1) == nrow(matrix2)

+  )

+  #

+  matrix1[is.na(matrix1)] <- 0

+  matrix2[is.na(matrix2)] <- 0

+  Z <- t(matrix1) %*% matrix2

+  if (scale) Z <- Z / mean(Z)

+  SVD <- svd(Z, dim, dim)

+  u <- matrix1 %*% SVD$u

+  v <- matrix2 %*% SVD$v

+  return(list(SVD = SVD, u = u, v = v))

 }

\ No newline at end of file

@@ -1,4 +1,4 @@

-#' Title Prepare condition matrix for expDrug

+#' @title Prepare condition matrix for expDrug

 #'

 #' @param expDrug input gene expression profile

 #'

@@ -8,20 +8,22 @@

 #' @examples

 #' \donttest{

 #' require(RTCGA.rnaseq)

-#'LIST <- list(ACC.rnaseq,

-#'             BLCA.rnaseq,

-#'             BRCA.rnaseq)

-#' dummy <- prepareexpDrugandDisease(LIST)

-#' expDrug <- dummy[[1]]

-#' Cond <- prepareCondDrugandDisease(expDrug)

+#' Cancer_cell_lines <- list(ACC.rnaseq,BLCA.rnaseq,BRCA.rnaseq)

+#' Drug_and_Disease <- prepareexpDrugandDisease(Cancer_cell_lines)

+#' Cond <- prepareCondDrugandDisease(Drug_and_Disease$expDrug)

 #' }

-prepareCondDrugandDisease <- function(expDrug){

-    dir <- system.file("extdata", package="TDbasedUFEadv")

-    TCGA <- read.csv(file.path(dir,"drug_response.txt"), sep="\t")

-    Cond <- table(TCGA[,2],TCGA[,3])

-    ID <- lapply(strsplit(as.character(colnames(expDrug)),"-"),"[",seq_len(3))

-    ID <- t(data.frame(ID))

-    ID <- paste(ID[,1],ID[,2],ID[,3],sep="-")

-    Cond <- Cond[match(ID,rownames(Cond)),]

-    return(Cond)

+prepareCondDrugandDisease <- function(expDrug) {

+  # Arugument Check

+  stopifnot(

+    "`expDrug` must be an ExpressionSet." = is(expDrug, "ExpressionSet")

+  )

+  #

+  dir <- system.file("extdata", package = "TDbasedUFEadv")

+  TCGA <- read.csv(file.path(dir, "drug_response.txt"), sep = "\t")

+  Cond <- table(TCGA$patient.arr, TCGA$drug.name)

+  ID <- lapply(strsplit(as.character(colnames(expDrug)), "-"), "[", seq_len(3))

+  ID <- t(data.frame(ID))

+  ID <- paste(ID[, 1], ID[, 2], ID[, 3], sep = "-")

+  Cond <- Cond[match(ID, rownames(Cond)), ]

+  return(Cond)

 }

\ No newline at end of file

@@ -1,10 +1,10 @@

-#' Title Prepare Sample label for TCGA data

+#' @title Prepare Sample label for TCGA data

 #'

 #' @param Multi_sample list of sample ids

 #' @param Clinical List of clinical data matrix from RTCGA.clinical

-#' @param k Column numbers used for conditions

-#' @param j Column numbers that include corresponding sample ids 

-#' in clinical data

+#' @param ID_column_of_Multi_sample Column numbers used for conditions

+#' @param ID_column_of_Clinical Column numbers that include corresponding

+#'  sample ids in clinical data

 #'

 #' @return list of sample labels

 #' @export

@@ -12,22 +12,47 @@

 #' @examples

 #' require(RTCGA.clinical)

 #' require(RTCGA.rnaseq)

-#' Clinical <- list(BLCA.clinical,BRCA.clinical,CESC.clinical,COAD.clinical)

-#' Multi_sample <- list(BLCA.rnaseq[seq_len(100),1,drop=FALSE],

-#'                     BRCA.rnaseq[seq_len(100),1,drop=FALSE],

-#'                     CESC.rnaseq[seq_len(100),1,drop=FALSE],

-#'                     COAD.rnaseq[seq_len(100),1,drop=FALSE])

-#' k <- c(770,1482,773,791)

-#' j <- c(20,20,12,14)

-#' cond <- prepareCondTCGA(Multi_sample,Clinical,k,j)

-prepareCondTCGA <- function(Multi_sample,Clinical,k,j)

-{

-    Cond <- rep(list(NA),length(Multi_sample))

-    for (i in seq_len(length(Multi_sample)))

-    {

-        index <- match(tolower(substring(Multi_sample[[i]][,1],1,12)),

-                       Clinical[[i]][,j[i]])

-        Cond[[i]]<- Clinical[[i]][index,k[i]]

-    }

-    return(Cond)

-}

\ No newline at end of file

+#' Clinical <- list(BLCA.clinical, BRCA.clinical, CESC.clinical, COAD.clinical)

+#' Multi_sample <- list(

+#'   BLCA.rnaseq[seq_len(100), 1, drop = FALSE],

+#'   BRCA.rnaseq[seq_len(100), 1, drop = FALSE],

+#'   CESC.rnaseq[seq_len(100), 1, drop = FALSE],

+#'   COAD.rnaseq[seq_len(100), 1, drop = FALSE]

+#' )

+#' ID_column_of_Multi_sample <- c(770, 1482, 773, 791)

+#' ID_column_of_Clinical <- c(20, 20, 12, 14)

+#' cond <- prepareCondTCGA(

+#'   Multi_sample, Clinical,

+#'   ID_column_of_Multi_sample, ID_column_of_Clinical

+#' )

+prepareCondTCGA <- function(Multi_sample, Clinical,

+                            ID_column_of_Multi_sample,

+                            ID_column_of_Clinical) {

+  # Argument check

+  stopifnot("`Multi_sample` must be an list." = is.list(Multi_sample))

+  stopifnot("`Clinical` must be an list." = is.list(Multi_sample))

+  stopifnot(

+    "`ID_column_of_Clinical` must be a vector" = is.vector(ID_column_of_Clinical)

+  )

+  stopifnot(

+    "`ID_column_of_Multi_sample` must be a vector" = is.vector(ID_column_of_Multi_sample)

+  )

+  stopifnot(

+    "Length must be common among `Multi_sample` " = var(unlist(lapply(list(

+      Multi_sample, Clinical,

+      ID_column_of_Multi_sample,

+      ID_column_of_Clinical

+    ), length))) == 0

+  )

+  #

+  Cond <- rep(list(NA), length(Multi_sample))

+  for (i in seq_len(length(Multi_sample)))

+  {

+    index <- match(

+      tolower(substring(Multi_sample[[i]][, 1], 1, 12)),

+      Clinical[[i]][, ID_column_of_Clinical[i]]

+    )

+    Cond[[i]] <- Clinical[[i]][index, ID_column_of_Multi_sample[i]]

+  }

+  return(Cond)

+}

new file mode 100644

@@ -0,0 +1,34 @@

+#' @title Prepare tensor generated from two matrices that share samples

+#'

+#' @param sample Character vector of sample names

+#' @param feature list of features from two matrices

+#' @param value array, contents of 

+#' @param featureRange Genomic Ranges to be associated with features

+#' @param sampleData List of conditional labeling associated with samples

+#'

+#' @return Tensor generated from two matrices that share samples

+#' @export

+#'

+#' @examples

+#' matrix1 <- matrix(runif(10000),200) #row features, column samples

+#' matrix2 <- matrix(runif(20000),400) #row features, column samples

+#' Z <- prepareTensorfromMatrix(t(matrix1),t(matrix2))

+#' Z <- prepareSummarizedExperimentTensorRect(sample=as.character(seq_len(50)),

+#' feature=list(as.character(seq_len(200)),as.character(seq_len(400))),

+#' sampleData=list(rep(seq_len(2),each=25)),value=Z)

+prepareSummarizedExperimentTensorRect <- function(

+    sample, feature, value,

+    featureRange = GRanges(NULL), sampleData = list(NULL)) {

+  # Argument check

+  stopifnot("`sample` must be a character." = is.character(sample))

+  stopifnot("`feature` must be a list." = is.list(feature))

+  stopifnot("`value` must be a array." = is.array(value))

+  stopifnot("`featureRange` must be an GRanges." = is(featureRange, "GRanges"))

+  stopifnot("`sampleData` must be a list." = is.list(sampleData))

+  #

+  new("SummarizedExperimentTensorRect",

+    sample = sample,

+    feature = feature, value = value,

+    featureRange = featureRange, sampleData = sampleData

+  )

+}

\ No newline at end of file

@@ -1,7 +1,7 @@

-#' Title Prepare tensor from a list that includes multiple profiles

+#' @title Prepare tensor from a list that includes multiple profiles

 #'

 #' @param Multi  a list that includes multiple profiles

-#' @param L the number of projection dimensions

+#' @param proj_dim the number of projection dimensions

 #'

 #' @return a tensor as a bundle of singular value vectors obtained by 

 #' applying  SVD to individual omics

@@ -11,11 +11,23 @@

 #' require(MOFAdata)

 #' data("CLL_data")

 #' data("CLL_covariates")

-#' Z <- prepareTensorfromList(CLL_data,10)

-prepareTensorfromList <- function(Multi,L)

-{

-    LIST <- lapply(Multi,function(x){x[is.na(x)]<-0;return(x)})

-    SVD_lst <- lapply(LIST,function(x){SVD <- svd(x,L);return(t(SVD$v[,seq_len(L)]))})

-    Z <- array(unlist(SVD_lst),c(dim(SVD_lst[[1]]),length(Multi)))

-    return(Z)

+#' Z <- prepareTensorfromList(CLL_data,as.integer(10))

+prepareTensorfromList <- function(Multi, proj_dim) {

+  # Argument check

+  stopifnot("`Multi` must be a list." = is.list(Multi))

+  stopifnot("`Proj_dim` must be an integer." = is.integer(proj_dim))

+  #

+  Multi_list <- lapply(Multi, function(x) {

+    x[is.na(x)] <- 0

+    return(x)

+  })

+  SVD_lst <- lapply(

+    Multi_list,

+    function(x) {

+      SVD <- svd(x, proj_dim)

+      return(t(SVD$v[, seq_len(proj_dim)]))

+    }

+  )

+  Z <- array(unlist(SVD_lst), c(dim(SVD_lst[[1]]), length(Multi)))

+  return(Z)

 }

\ No newline at end of file

@@ -1,4 +1,4 @@

-#' Title Generate tensor from two matricies

+#' @title Generate tensor from two matrices

 #'

 #' @param matrix1 the first input matrix

 #' @param matrix2 the second input matrix

@@ -8,14 +8,25 @@

 #'

 #' @examples

 #' Z <- prepareTensorfromMatrix(matrix(runif(100),10),matrix(runif(100),10))

-prepareTensorfromMatrix <-function(matrix1,matrix2){

-    L1 <- dim(matrix1)[2]

-    L2 <- dim(matrix2)[2]

-    matrix1[is.na(matrix1)] <-0 

-    matrix2[is.na(matrix2)] <-0 

-    Z <- apply(cbind(matrix1,matrix2),1,

-               function(x){outer(x[seq_len(L1)],x[L1+seq_len(L2)])})

-    dim(Z) <- c(L1,L2,dim(Z)[2])

-    Z <- aperm(Z,c(3,1,2))

-    return(Z)

+prepareTensorfromMatrix <- function(matrix1, matrix2) {

+  # Argument Check

+  stopifnot("`matrix1` must be a matrix." = is.matrix(matrix1))

+  stopifnot("`matrix2` must be a matrix." = is.matrix(matrix2))

+  #

+  col_num1 <- dim(matrix1)[2]

+  col_num2 <- dim(matrix2)[2]

+  matrix1[is.na(matrix1)] <- 0

+  matrix2[is.na(matrix2)] <- 0

+  Z <- apply(

+    cbind(matrix1, matrix2), 1,

+    function(x) {

+      outer(

+        x[seq_len(col_num1)],

+        x[col_num1 + seq_len(col_num2)]

+      )

+    }

+  )

+  dim(Z) <- c(col_num1, col_num2, dim(Z)[2])

+  Z <- aperm(Z, c(3, 1, 2))

+  return(Z)

 }

\ No newline at end of file

@@ -1,7 +1,8 @@

-#' Title Generating gene expression of drug treated cell lines and a disease

+#' @title Generating gene expression of drug treated cell lines and a disease

 #' cell line

 #'

-#' @param LIST list that includes indivisual data set from RTCGA.rnaseq 

+#' @param Cancer_cell_lines <- list(ACC.rnaseq,BLCA.rnaseq,BRCA.rnaseq)

+#'  list that includes individual data set from RTCGA.rnaseq 

 #'

 #' @return list of expDrug and expDisease 

 #' @export

@@ -9,35 +10,44 @@

 #' @examples

 #'  \donttest{

 #' require(RTCGA.rnaseq)

-#' LIST <- list(ACC.rnaseq,

-#'             BLCA.rnaseq,

-#'             BRCA.rnaseq)

-#' dummy <- prepareexpDrugandDisease(LIST)

+#' Cancer_cell_lines <- list(ACC.rnaseq,BLCA.rnaseq,BRCA.rnaseq)

+#' Drug_and_Disease <- prepareexpDrugandDisease(Cancer_cell_lines)

 #' }

-prepareexpDrugandDisease <- function(LIST){

-    dir <- system.file("extdata", package="TDbasedUFEadv")

-    TCGA <- read.csv(file.path(dir,"drug_response.txt"), sep="\t")

-    TCGAdb <- unique(TCGA[,1])

-    if (length(TCGAdb)>16) TCGAdb <- TCGAdb[-16]

-    RTCGA_all <- matrix(NA, nrow=dim(TCGA)[1],ncol=dim(LIST[[1]])[2])

-    LISTp <- rep(list(NA),length(LIST))

-    toTCGA <- function(x){

-        ID <- lapply(strsplit(as.character(x[,1]),"-"),"[",seq_len(3))

-        ID <- t(data.frame(ID))

-        ID <- paste(ID[,1],ID[,2],ID[,3],sep="-")

-        return( x[ID %in% TCGA[,2],])

-    }

-    LISTp <- lapply(LIST,toTCGA)

-    expDrug <- NULL

-    for (i in seq_len(length(LISTp)))

-    {

-        expDrug <- rbind(expDrug,data.frame(LISTp[[i]]))

-    }

-    expDrug <- convertTCGA(expDrug)

-    ID <- lapply(strsplit(as.character(LIST[[3]][,1]),"-"),"[",seq_len(3))

+prepareexpDrugandDisease <- function(Cancer_cell_lines) {

+  # Argument check

+  stopifnot(

+    "`Cancer_cell_lines` must be an list." = is.list(Cancer_cell_lines)

+  )

+  #

+  dir <- system.file("extdata", package = "TDbasedUFEadv")

+  TCGA <- read.csv(file.path(dir, "drug_response.txt"), sep = "\t")

+  TCGAdb <- unique(TCGA$cancers)

+  if (length(TCGAdb) > 16) TCGAdb <- TCGAdb[-16]

+  RTCGA_all <- matrix(NA,

+    nrow = dim(TCGA)[1],

+    ncol = dim(Cancer_cell_lines[[1]])[2]

+  )

+  Cancer_cell_lines_p <- rep(list(NA), length(Cancer_cell_lines))

+  toTCGA <- function(x) {

+    ID <- lapply(strsplit(as.character(x[, 1]), "-"), "[", seq_len(3))

     ID <- t(data.frame(ID))

-    ID <- paste(ID[,1],ID[,2],ID[,3],sep="-")

-    expDisease <- LIST[[3]][!(ID %in% TCGA[,2]),]

-    expDisease <- convertTCGA(expDisease)

-    return(list(expDrug=expDrug,expDisease=expDisease))

+    ID <- paste(ID[, 1], ID[, 2], ID[, 3], sep = "-")

+    return(x[ID %in% TCGA$patient.arr, ])

+  }

+  Cancer_cell_lines_p <- lapply(Cancer_cell_lines, toTCGA)

+  expDrug <- NULL

+  for (i in seq_len(length(Cancer_cell_lines_p)))

+  {

+    expDrug <- rbind(expDrug, data.frame(Cancer_cell_lines_p[[i]]))

+  }

+  expDrug <- convertTCGA(expDrug)

+  ID <- lapply(

+    strsplit(as.character(Cancer_cell_lines[[3]][, 1]), "-"),

+    "[", seq_len(3)

+  )

+  ID <- t(data.frame(ID))

+  ID <- paste(ID[, 1], ID[, 2], ID[, 3], sep = "-")

+  expDisease <- Cancer_cell_lines[[3]][!(ID %in% TCGA$patient.arr), ]

+  expDisease <- convertTCGA(expDisease)

+  return(list(expDrug = expDrug, expDisease = expDisease))

 }

\ No newline at end of file

@@ -1,13 +1,13 @@

-#' Title Select feature when projection strategy is employed for the

+#' @title Select feature when projection strategy is employed for the

 #'  case where features are shared with multiple omics profiles

 #'

 #' @param HOSVD HOSVD 

 #' @param Multi list of omics profiles, row: sample, column: feature

 #' @param cond list of conditions for individual omics profiles

-#' @param de initial value for optimization of statdard deviation

+#' @param de initial value for optimization of standard deviation

 #' @param p0 Threshold P-value

 #' @param breaks The number of bins of histogram of P-values

-#' @param input_all The number of selected feature. if null, intearactive mode

+#' @param input_all The number of selected feature. if null, interactive mode

 #' is activated 

 #'

 #' @return list composed of logical vector that represent which features are selected and p-values

@@ -17,7 +17,7 @@

 #' require(TDbasedUFE)

 #' Multi <- list(matrix(runif(1000),10),matrix(runif(1000),10),

 #' matrix(runif(1000),10),matrix(runif(1000),10))

-#' Z <- prepareTensorfromList(Multi,10)

+#' Z <- prepareTensorfromList(Multi,as.integer(10))

 #' Z <- aperm(Z,c(2,1,3))

 #' Z <- PrepareSummarizedExperimentTensor(feature =as.character(1:10),

 #'                                       sample=array("",1),value=Z)

@@ -25,90 +25,135 @@

 #' cond <- rep(list(rep(1:2,each=5)),4)

 #' index <- selectFeatureProj(HOSVD,Multi,cond,de=0.1,input_all=2)

 selectFeatureProj <-

-    function(HOSVD,Multi,cond,de=1e-4,p0=0.01,breaks=100,input_all=NULL){

+  function(HOSVD, Multi, cond, de = 1e-4, p0 = 0.01, breaks = as.integer(100),

+           input_all = NULL) {

+    # Augument check

+    stopifnot("`HOSVD` must be a list." = is.list(HOSVD))

+    stopifnot("`Multi` must be a list." = is.list(Multi))

+    stopifnot("`de` must be a numeric." = is.numeric(de))

+    stopifnot("`p0` must be a numeric." = is.numeric(p0))

+    stopifnot("`breaks` must be a integer." = is.integer(breaks))

+    stopifnot("`input_all` must be a vector." = is.vector(input_all) |

+      is.null(input_all))

+    #

     interact <- FALSE

-    if (is.null(input_all))

-    {

-    interact <- TRUE

-    LIST1 <- lapply(Multi,function(x){data.matrix(x)%*%data.matrix(HOSVD$U[[1]])})

-    j<-1

-    ui <- fluidPage(

+    Multi_list <- lapply(

+      Multi,

+      function(x) {

+        data.matrix(x) %*% data.matrix(HOSVD$U[[1]])

+      }

+    )

+    if (is.null(input_all)) {

+      interact <- TRUE

+      j <- 1

+      ui <- fluidPage(

         sidebarLayout(

-            sidebarPanel(

-                actionButton(inputId="action", label="Next"),

-                actionButton(inputId="prev",  label="Prev"), 

-                actionButton(inputId="select", label="Select")),

-            mainPanel(

-                plotOutput("plot")

-            )

+          sidebarPanel(

+            actionButton(inputId = "action", label = "Next"),

+            actionButton(inputId = "prev", label = "Prev"),

+            actionButton(inputId = "select", label = "Select")

+          ),

+          mainPanel(

+            plotOutput("plot")

+          )

         )

-    )

-    server <- function(input, output){

+      )

+      server <- function(input, output) {

         observeEvent(input$action, {

-            if (j<dim(HOSVD$U[[1]])[2]) j<<-j+1

+          if (j < dim(HOSVD$U[[1]])[2]) j <<- j + 1

         })

         observeEvent(input$prev, {

-            if (j!=1){j<<-j-1}

-        })  

+          if (j != 1) {

+            j <<- j - 1

+          }

+        })

         observeEvent(input$select, {

-            input_all <<-j ; stopApp()

-        })  

+          input_all <<- j

+          stopApp()

+        })

         output$plot <- renderPlot({

-            input$action

-            input$prev

-            par(mfrow=c(length(cond),1))

-            par(mai=c(0.3,0.2,0.2,0.2))

-            for (i in seq_len(length(cond)))

-            {

-                boxplot(LIST1[[i]][,j]~cond[[i]],main=paste(j,i,sep="-"))

-                abline(0,0,col=2,lty=2)

-            }

-            par(mfrow=c(1,1))

+          input$action

+          input$prev

+          par(mfrow = c(length(cond), 1))

+          par(mai = c(0.3, 0.2, 0.2, 0.2))

+          for (i in seq_len(length(cond)))

+          {

+            boxplot(Multi_list[[i]][, j] ~ cond[[i]],

+              main = paste(j, i, sep = "-")

+            )

+            abline(0, 0, col = 2, lty = 2)

+          }

+          par(mfrow = c(1, 1))

         })

+      }

+      app <- shinyApp(ui, server)

+      runApp(app)

+      input_all <- j

+    } else {

+      par(mfrow = c(length(cond), 1))

+      par(mai = c(0.3, 0.2, 0.2, 0.2))

+      for (i in seq_len(length(cond)))

+      {

+        boxplot(Multi_list[[i]][, input_all] ~ cond[[i]],

+          main = paste(input_all, i, sep = "-")

+        )

+        abline(0, 0, col = 2, lty = 2)

+      }

+      par(mfrow = c(1, 1))

     }

-    app<- shinyApp(ui, server)

-    runApp(app)

-    input_all <- j

-    }

-    th <- function(sd,breaks,p0){

-        P2 <- pchisq((u/sd)^2,1,lower.tail=FALSE)

-        hc<- hist(1-P2,breaks=breaks,plot=FALSE)

-        return(sd(hc$count[seq_len(sum(hc$breaks

-                                       <1-min(P2[p.adjust(P2,"BH")>p0])))]))

+    th <- function(sd, breaks, p0) {

+      P2 <- pchisq((u / sd)^2, 1, lower.tail = FALSE)

+      hc <- hist(1 - P2, breaks = breaks, plot = FALSE)

+      return(sd(hc$count[seq_len(sum(hc$breaks

+      < 1 - min(P2[p.adjust(P2, "BH") > p0])))]))

     }

-        u<- HOSVD$U[[1]][,input_all]

-        sd <- optim(de,function(x){th(x,breaks,p0)},

-                    control=list(warn.1d.NelderMead=FALSE))$par

-        sd1 <- seq(0.1*sd,2*sd,by=0.1*sd)

-        th0 <- apply(matrix(sd1,ncol=1),1,function(x){th(x,breaks,p0)})

-        P2 <- pchisq((u/sd)^2,1,lower.tail=FALSE)

-        ui <- fluidPage(

-            sidebarLayout(

-                sidebarPanel(

-                    actionButton(inputId="action", label="Next")),

-                mainPanel(

-                    plotOutput("plot")

-                )

-            )

+    u <- HOSVD$U[[1]][, input_all]

+    sd <- optim(de, function(x) {

+      th(x, breaks, p0)

+    },

+    control = list(warn.1d.NelderMead = FALSE)

+    )$par

+    sd1 <- seq(0.1 * sd, 2 * sd, by = 0.1 * sd)

+    th0 <- apply(matrix(sd1, ncol = 1), 1, function(x) {

+      th(x, breaks, p0)

+    })

+    P2 <- pchisq((u / sd)^2, 1, lower.tail = FALSE)

+    ui <- fluidPage(

+      sidebarLayout(

+        sidebarPanel(

+          actionButton(inputId = "action", label = "Next")

+        ),

+        mainPanel(

+          plotOutput("plot")

         )

-        server <- function(input, output){

-            observeEvent(input$action, {

-                stopApp()

-            })

-            output$plot <- renderPlot({

-                input$action

-                par(mfrow=c(1,2))

-                plot(sd1,th0,type="o")

-                arrows(sd,max(th0),sd,min(th0),col=2)

-                hist(1-P2,breaks=breaks)

-                par(mfrow=c(1,1))

-            })

-        }

-        app<- shinyApp(ui, server)

-        if (interact) runApp(app)

-        index <- p.adjust(P2,"BH")<p0

-        index_all <- list(index=index,p.value=P2)

-        return(index_all)

-}

+      )

+    )

+    server <- function(input, output) {

+      observeEvent(input$action, {

+        stopApp()

+      })

+      output$plot <- renderPlot({

+        input$action

+        par(mfrow = c(1, 2))

+        plot(sd1, th0, type = "o")

+        arrows(sd, max(th0), sd, min(th0), col = 2)

+        hist(1 - P2, breaks = breaks)

+        par(mfrow = c(1, 1))

+      })

+    }

+    app <- shinyApp(ui, server)

+    if (interact) {

+      runApp(app)

+    } else {

+      par(mfrow = c(1, 2))

+      plot(sd1, th0, type = "o")

+      arrows(sd, max(th0), sd, min(th0), col = 2)

+      hist(1 - P2, breaks = breaks)

+      par(mfrow = c(1, 1))

+    }

+    index <- p.adjust(P2, "BH") < p0

+    index_all <- list(index = index, p.value = P2)

+    return(index_all)

+  }

@@ -1,14 +1,14 @@

-#' Title Select features through the selection  of singular value vectors

+#' @title Select features through the selection  of singular value vectors

 #'

-#' @param SVD SVD compued from matrix generated by partial summation of a tensor

+#' @param SVD SVD computed from matrix generated by partial summation of a tensor

 #' @param cond Condition to select singular value vectors

 #' @param de  Initial values to be used for optimization of standard deviation  

 #' @param p0  Threshold value for the significance

-#' @param breaks Number of bins of hitogram of P-values

+#' @param breaks Number of bins of histogram of P-values

 #' @param input_all The ID of selected singular value vectors. If it is null, 

 #' interactive mode is activated.

 #'

-#' @return List of lists that inlcudes P-vales as well as if individual

+#' @return List of lists that includes P-vales as well as if individual

 #'  features selected.

 #' @export

 #'

@@ -20,96 +20,124 @@

 #' index_all <- selectFeatureRect(SVD,

 #' list(NULL,rep(seq_len(2),each=5),rep(seq_len(2),each=10)),de=rep(0.5,2),

 #' input_all=1)

-selectFeatureRect <- function(SVD,cond,de=rep(1e-4,2),p0=0.01,

-                              breaks=100,input_all=NULL)

-    {

-    interact<-FALSE

-    if(is.null(input_all))

-        {

-            interact<-TRUE

-            j<-1

-            ui <- fluidPage(

-                sidebarLayout(

-                    sidebarPanel(

-                        actionButton(inputId="action", label="Next"),

-                        actionButton(inputId="prev",  label="Prev"), 

-                        actionButton(inputId="select", label="Select")),

-                    mainPanel(

-                        plotOutput("plot")

-                    )

-                )

-            )

-            

-            server <- function(input, output){

-                observeEvent(input$action, {

-                    if (j<dim(SVD$SVD$u)[2]) j<<-j+1

-                })

-                observeEvent(input$prev, {

-                    if (j!=1){j<<-j-1}

-                })  

-                observeEvent(input$select, {

-                    input_all <<-j ; stopApp()

-                })  

-                output$plot <- renderPlot({

-                    input$action

-                    input$prev

-                    par(mfrow=c(1,2))

-                    boxplot(SVD$SVD$u[,j]~cond[[2]],main=j)

-                    abline(0,0,col=2,lty=2)

-                    boxplot(SVD$SVD$v[,j]~cond[[3]],main=j)

-                    abline(0,0,col=2,lty=2)

-                    par(mfrow=c(1,1))

-                })

-            }

-            

-            app<- shinyApp(ui, server)

-            if(interact) runApp(app)

-    } 

-        th <- function(sd,breaks,p0){

-        P2 <- pchisq((u/sd)^2,1,lower.tail=FALSE)

-        hc<- hist(1-P2,breaks=breaks,plot=FALSE)

-        return(sd(hc$count[seq_len(sum(hc$breaks

-                                       <1-min(P2[p.adjust(P2,"BH")>p0])))]))

+selectFeatureRect <- function(SVD, cond, de = rep(1e-4, 2), p0 = 0.01,

+                              breaks = as.integer(100), input_all = NULL) {

+  # Augument check

+  stopifnot("`SVD` must be a list." = is.list(SVD))

+  stopifnot("`cond` must be a list." = is.list(cond))

+  stopifnot("`de` must be a numeric." = is.numeric(de))

+  stopifnot("`p0` must be a numeric." = is.numeric(p0))

+  stopifnot("`breaks` must be a integer." = is.integer(breaks))

+  stopifnot("`input_all` must be a vector." = is.vector(input_all) |

+    is.null(input_all))

+  #

+  interact <- FALSE

+  if (is.null(input_all)) {

+    interact <- TRUE

+    j <- 1

+    ui <- fluidPage(

+      sidebarLayout(

+        sidebarPanel(

+          actionButton(inputId = "action", label = "Next"),

+          actionButton(inputId = "prev", label = "Prev"),

+          actionButton(inputId = "select", label = "Select")

+        ),

+        mainPanel(

+          plotOutput("plot")

+        )

+      )

+    )

+

+    server <- function(input, output) {

+      observeEvent(input$action, {

+        if (j < dim(SVD$SVD$u)[2]) j <<- j + 1

+      })

+      observeEvent(input$prev, {

+        if (j != 1) {

+          j <<- j - 1

         }

-        index_all <- rep(list(NA))

-        for (i in seq_len(2))

-        {

-            u<- scale(SVD[[i+1]][,input_all])

-            sd <- optim(de[i],function(x){th(x,breaks,p0)},

-                        control=list(warn.1d.NelderMead=FALSE))$par

-            sd1 <- seq(0.1*sd,2*sd,by=0.1*sd)

-            th0 <- apply(matrix(sd1,ncol=1),1,function(x){th(x,breaks,p0)})

-            P2 <- pchisq((u/sd)^2,1,lower.tail=FALSE)