RadioButton в R Shiny, как использовать его при оценке различных типов данных с различными функциями - PullRequest
0 голосов
/ 13 февраля 2020

Я довольно новичок в R Shiny, поэтому я прошу прощения за ненужные функции и опечатки, которые я использовал для создания своего приложения и их относительных функций. Моя цель - преобразовать набор данных, который я загружу, с помощью двух разных функций, которые различаются в зависимости от самого набора данных. В частности, мой набор данных может включать в себя категориальные или непрерывные данные, поэтому мне нужно переключаться между двумя функциями, чтобы упорядочить данные в окончательной форме 0 и 1 (бинаризация). Я хотел бы переключаться между функциями (data_handling_typeA_training и data_handling_typeB_training), описанными ниже, в соответствии с данными типа A и данными типа B, которые я собираюсь загрузить в приложение Shiny.


Набор данных и functions

# Input type A ####

input <- data.frame(
            Sample = as.factor(c("c_01", "c_02", "c_03")),
            Pop = as.factor(c("A", "B", "C")),
            xx = c(11L, 9L, 10L),
            xx.1 = c(12L, 11L, 12L),
            zz = c(14L, 12L, 14L),
            zz.1 = c(14L, 13L, 15L),
            yy = c(17L, 16L, 16L),
            yy.1 = c(21L, 16L, 20L),
            ff = c(11L, 11L, 12L),
            ff.1 = c(12L, 13L, 12L),
            nn = c(11L, 11L, 11L),
            nn.1 = c(11L, 12L, 12L)
)

# # Input type B ####
# input <- data.frame(
#             Sample = as.factor(c("A_01", "A_02", "A_03")),
#             Pop = as.factor(c("X", "Y", "Z")),
#             aaa = as.factor(c("CAG", "CGG", "TGG")),
#             aaa.1 = as.factor(c("TGG", "TAG", "CAG")),
#             bbb = as.factor(c("GG", "GG", "GG")),
#             bbb.1 = as.factor(c("GA", "AG", "AG")),
#             ccc = as.factor(c("CAGG", "CAGG", "CAGG")),
#             ccc.1 = as.factor(c("CAGG", "CAAG", "CAAG")),
#             ddd = as.factor(c("CACC", "AAGC", "CACC")),
#             ddd.1 = as.factor(c("AACC", "AAGC", "AACT")),
#             eee = as.factor(c("ACG", "ATA", "ATG")),
#             eee.1 = as.factor(c("ATG", "ATG", "ATG"))
# )

data_handling_typeA_training <- function(input) {
    Populations<-as.factor(input[,2])
    input<-input[,-2]
    names = c(colnames(input))
    evenvals <- seq(2, ncol(input), by=2) 
    names_ok<-colnames(input[,evenvals])
    data_unl<-as.numeric(unlist(input[,-c(1)]))
    data_names<-as.data.frame(input[,1])
    library(plyr); library(dplyr)
    data_unl=dplyr::recode(data_unl,'1'=1,  '1.1'=2,    '1.2'=3,    '1.3'=4,    '2'=5,  '2.1'=6,    '2.2'=7,    '2.3'=8,    '3'=9,  '3.1'=10,   '3.2'=11,   '3.3'=12,   '4'=13, '4.1'=14,   '4.2'=15,   '4.3'=16,   '5'=17, '5.1'=18,   '5.2'=19,   '5.3'=20,   '6'=21, '6.1'=22,   '6.2'=23,   '6.3'=24,   '7'=25, '7.1'=26,   '7.2'=27,   '7.3'=28,   '8'=29, '8.1'=30,   '8.2'=31,   '8.3'=32,   '9'=33, '9.1'=34,   '9.2'=35,   '9.3'=36,   '10'=37,    '10.1'=38,  '10.2'=39,  '10.3'=40,  '11'=41,    '11.1'=42,  '11.2'=43,  '11.3'=44,  '12'=45,    '12.1'=46,  '12.2'=47,  '12.3'=48,  '13'=49,    '13.1'=50,  '13.2'=51,  '13.3'=52,  '14'=53,    '14.1'=54,  '14.2'=55,  '14.3'=56,  '15'=57,    '15.1'=58,  '15.2'=59,  '15.3'=60,  '16'=61,    '16.1'=62,  '16.2'=63,  '16.3'=64,  '17'=65,    '17.1'=66,  '17.2'=67,  '17.3'=68,  '18'=69,    '18.1'=70,  '18.2'=71,  '18.3'=72,  '19'=73,    '19.1'=74,  '19.2'=75,  '19.3'=76,  '20'=77,    '20.1'=78,  '20.2'=79,  '20.3'=80,  '21'=81,    '21.1'=82,  '21.2'=83,  '21.3'=84,  '22'=85,    '22.1'=86,  '22.2'=87,  '22.3'=88,  '23'=89,    '23.1'=90,  '23.2'=91,  '23.3'=92,  '24'=93,    '24.1'=94,  '24.2'=95,  '24.3'=96,  '25'=97,    '25.1'=98,  '25.2'=99,  '25.3'=100, '26'=101,   '26.1'=102, '26.2'=103, '26.3'=104, '27'=105,   '27.1'=106, '27.2'=107, '27.3'=108, '28'=109,   '28.1'=110, '28.2'=111, '28.3'=112, '29'=113,   '29.1'=114, '29.2'=115, '29.3'=116, '30'=117,   '30.1'=118, '30.2'=119, '30.3'=120, '31'=121,   '31.1'=122, '31.2'=123, '31.3'=124, '32'=125,   '32.1'=126, '32.2'=127, '32.3'=128, '33'=129,   '33.1'=130, '33.2'=131, '33.3'=132, '34'=133,   '34.1'=134, '34.2'=135, '34.3'=136, '35'=137,   '35.1'=138, '35.2'=139, '35.3'=140, '36'=141,   '36.1'=142, '36.2'=143, '36.3'=144, '37'=145,   '37.1'=146, '37.2'=147, '37.3'=148, '38'=149,   '38.1'=150, '38.2'=151, '38.3'=152, '39'=153,   '39.1'=154, '39.2'=155, '39.3'=156, '40'=157,   '40.1'=158, '40.2'=159, '40.3'=160, '41'=161,   '41.1'=162, '41.2'=163, '41.3'=164, '42'=165,   '42.1'=166, '42.2'=167, '42.3'=168, '43'=169,   '43.1'=170, '43.2'=171, '43.3'=172, '44'=173,   '44.1'=174, '44.2'=175, '44.3'=176, '45'=177,   '45.1'=178, '45.2'=179, '45.3'=180, '46'=181,   '46.1'=182, '46.2'=183, '46.3'=184, '47'=185,   '47.1'=186, '47.2'=187, '47.3'=188, '48'=189,   '48.1'=190, '48.2'=191, '48.3'=192, '49'=193,   '49.1'=194, '49.2'=195, '49.3'=196, '50'=197,
    )
    nX<-ncol(input[,-c(1)])
    data_unl<-as.data.frame(matrix(data_unl,ncol = nX))
    data_def<-cbind(data_names,data_unl)
    colnames(data_def)<- names
    input<-data_def
    names = c(colnames(input))
    nX <- ncol(input)-1
    listofdf <- lapply(1:nX, function(x) NULL)
    for (i in 1:nX) {
        listofdf[[i]] <- data.frame(input[,1], input[i],input[i+1])
    }
    listofdf <- listofdf [-c(seq(1, 10000, by=2))]
    listofdf_subs <- lapply(1:length(listofdf), function(x) NULL)
    for (i in 1:length(listofdf)) {
        listofdf_subs[[i]] <- cbind(rep(x = 1:nrow(listofdf[[1]]),
                                        times = 2),c(listofdf[[i]][,2],listofdf[[i]][,3]))
    }
    required_vals <- rep(x = 1,
                         times = nrow(x = listofdf_subs[[1]]))
    required_sz <- c(nrow(x = input), 197)
    listofdf_accum<-lapply(1:length(listofdf), function(x) NULL)
    for (i in 1:length(listofdf)){ 
        listofdf_accum[[i]]<-pracma::accumarray(subs = listofdf_subs[[i]],
                                                val = required_vals,
                                                sz = required_sz)}
    data_def <- list()
    for(i in 1:length(listofdf)){
        data_def[[i]] <- listofdf_accum[[i]]
    }
    mydf <- data.frame(data_def)
    values <- rep_len(x = ((0:3) / 10),
                      length.out = 197) + rep(x = 1:50,
                                              each = 4,
                                              length.out = 197)
    variables_ID <- paste(rep(x = names_ok,
                              each = 197),
                          values,
                          sep = "_")
    colnames(mydf)<-variables_ID
    mydf<-mydf[,-(which(colSums(mydf) == 0))] 
    mydf<-cbind(data_names,mydf)
    mydf[mydf=="2"]<-1
    row.names(mydf) <- mydf[,1]
    mydf<-mydf[,-1]
    df1_sel2 <- cbind(Populations,mydf)
    df1_sel2[, colSums(df1_sel2 != 0) > 0]
    df1_sel2<-df1_sel2[sapply(df1_sel2, function(x) length(unique(na.omit(x)))) > 1]
    df1_sel2 <<- df1_sel2
}
data_handling_typeB_training <- function(input) {
    Populations<-as.factor(input[,2])
    input<-input[,-2]
    names = c(colnames(input))
    evenvals <- seq(2, ncol(input), by=2) 
    names_ok<-colnames(input[,evenvals])
    data_unl<-unlist(input[,-c(1)])
    data_names<-as.data.frame(input[,1])
    library(plyr); library(dplyr)
    data_unl=dplyr::recode(data_unl,AA=1,   AC=2,   AG=3,   AT=4,   CA=5,   CC=6,   CG=7,   CT=8,   GA=9,   GC=10,  GG=11,  GT=12,  TA=13,  TC=14,  TG=15,  TT=16,  AAA=17, AAC=18, AAG=19, AAT=20, ACA=21, ACC=22, ACG=23, ACT=24, AGA=25, AGC=26, AGG=27, AGT=28, ATA=29, ATC=30, ATG=31, ATT=32, CAA=33, CAC=34, CAG=35, CAT=36, CCA=37, CCC=38, CCG=39, CCT=40, CGA=41, CGC=42, CGG=43, CGT=44, CTA=45, CTC=46, CTG=47, CTT=48, GAA=49, GAC=50, GAG=51, GAT=52, GCA=53, GCC=54, GCG=55, GCT=56, GGA=57, GGC=58, GGG=59, GGT=60, GTA=61, GTC=62, GTG=63, GTT=64, TAA=65, TAC=66, TAG=67, TAT=68, TCA=69, TCC=70, TCG=71, TCT=72, TGA=73, TGC=74, TGG=75, TGT=76, TTA=77, TTC=78, TTG=79, TTT=80, AAAA=81,    AAAC=82,    AAAG=83,    AAAT=84,    AACA=85,    AACC=86,    AACG=87,    AACT=88,    AAGA=89,    AAGC=90,    AAGG=91,    AAGT=92,    AATA=93,    AATC=94,    AATG=95,    AATT=96,    ACAA=97,    ACAC=98,    ACAG=99,    ACAT=100,   ACCA=101,   ACCC=102,   ACCG=103,   ACCT=104,   ACGA=105,   ACGC=106,   ACGG=107,   ACGT=108,   ACTA=109,   ACTC=110,   ACTG=111,   ACTT=112,   AGAA=113,   AGAC=114,   AGAG=115,   AGAT=116,   AGCA=117,   AGCC=118,   AGCG=119,   AGCT=120,   AGGA=121,   AGGC=122,   AGGG=123,   AGGT=124,   AGTA=125,   AGTC=126,   AGTG=127,   AGTT=128,   ATAA=129,   ATAC=130,   ATAG=131,   ATAT=132,   ATCA=133,   ATCC=134,   ATCG=135,   ATCT=136,   ATGA=137,   ATGC=138,   ATGG=139,   ATGT=140,   ATTA=141,   ATTC=142,   ATTG=143,   ATTT=144,   CAAA=145,   CAAC=146,   CAAG=147,   CAAT=148,   CACA=149,   CACC=150,   CACG=151,   CACT=152,   CAGA=153,   CAGC=154,   CAGG=155,   CAGT=156,   CATA=157,   CATC=158,   CATG=159,   CATT=160,   CCAA=161,   CCAC=162,   CCAG=163,   CCAT=164,   CCCA=165,   CCCC=166,   CCCG=167,   CCCT=168,   CCGA=169,   CCGC=170,   CCGG=171,   CCGT=172,   CCTA=173,   CCTC=174,   CCTG=175,   CCTT=176,   CGAA=177,   CGAC=178,   CGAG=179,   CGAT=180,   CGCA=181,   CGCC=182,   CGCG=183,   CGCT=184,   CGGA=185,   CGGC=186,   CGGG=187,   CGGT=188,   CGTA=189,   CGTC=190,   CGTG=191,   CGTT=192,   CTAA=193,   CTAC=194,   CTAG=195,   CTAT=196,   CTCA=197,   CTCC=198,   CTCG=199,
                           CTCT=200,    CTGA=201,   CTGC=202,   CTGG=203,   CTGT=204,   CTTA=205,   CTTC=206,   CTTG=207,   CTTT=208,   GAAA=209,   GAAC=210,   GAAG=211,   GAAT=212,   GACA=213,   GACC=214,   GACG=215,   GACT=216,   GAGA=217,   GAGC=218,   GAGG=219,   GAGT=220,   GATA=221,   GATC=222,   GATG=223,   GATT=224,   GCAA=225,   GCAC=226,   GCAG=227,   GCAT=228,   GCCA=229,   GCCC=230,   GCCG=231,   GCCT=232,   GCGA=233,   GCGC=234,   GCGG=235,   GCGT=236,   GCTA=237,   GCTC=238,   GCTG=239,   GCTT=240,   GGAA=241,   GGAC=242,   GGAG=243,   GGAT=244,   GGCA=245,   GGCC=246,   GGCG=247,   GGCT=248,   GGGA=249,   GGGC=250,   GGGG=251,   GGGT=252,   GGTA=253,   GGTC=254,   GGTG=255,   GGTT=256,   GTAA=257,   GTAC=258,   GTAG=259,   GTAT=260,   GTCA=261,   GTCC=262,   GTCG=263,   GTCT=264,   GTGA=265,   GTGC=266,   GTGG=267,   GTGT=268,   GTTA=269,   GTTC=270,   GTTG=271,   GTTT=272,   TAAA=273,   TAAC=274,   TAAG=275,   TAAT=276,   TACA=277,   TACC=278,   TACG=279,   TACT=280,   TAGA=281,   TAGC=282,   TAGG=283,   TAGT=284,   TATA=285,   TATC=286,   TATG=287,   TATT=288,   TCAA=289,   TCAC=290,   TCAG=291,   TCAT=292,   TCCA=293,   TCCC=294,   TCCG=295,   TCCT=296,   TCGA=297,   TCGC=298,   TCGG=299,   TCGT=300,   TCTA=301,   TCTC=302,   TCTG=303,   TCTT=304,   TGAA=305,   TGAC=306,   TGAG=307,   TGAT=308,   TGCA=309,   TGCC=310,   TGCG=311,   TGCT=312,   TGGA=313,   TGGC=314,   TGGG=315,   TGGT=316,   TGTA=317,   TGTC=318,   TGTG=319,   TGTT=320,   TTAA=321,   TTAC=322,   TTAG=323,   TTAT=324,   TTCA=325,   TTCC=326,   TTCG=327,   TTCT=328,   TTGA=329,   TTGC=330,   TTGG=331,   TTGT=332,   TTTA=333,   TTTC=334,   TTTG=335,   TTTT=336
                           )
    nX<-ncol(input[,-c(1)])
    data_unl<-as.data.frame(matrix(data_unl,ncol = nX))
    data_def<-cbind(data_names,data_unl)
    colnames(data_def)<- names
    input<-data_def
    names = c(colnames(input))
    nX <- ncol(input)-1
    listofdf <- lapply(1:nX, function(x) NULL)
    for (i in 1:nX) {
        listofdf[[i]] <- data.frame(input[,1], input[i],input[i+1])
    }
    listofdf <- listofdf [-c(seq(1, 10000, by=2))]

    listofdf_subs <- lapply(1:length(listofdf), function(x) NULL)
    for (i in 1:length(listofdf)) {
        listofdf_subs[[i]] <- cbind(rep(x = 1:nrow(listofdf[[1]]),
                                        times = 2),c(listofdf[[i]][,2],listofdf[[i]][,3]))
    }
    required_vals <- rep(x = 1,
                         times = nrow(x = listofdf_subs[[1]]))
    required_sz <- c(nrow(x = input), 1360)
    listofdf_accum<-lapply(1:length(listofdf), function(x) NULL)
    for (i in 1:length(listofdf)){ 
        listofdf_accum[[i]]<-pracma::accumarray(subs = listofdf_subs[[i]],
                                                val = required_vals,
                                                sz = required_sz)}
    data_def <- list()
    for(i in 1:length(listofdf)){
        data_def[[i]] <- listofdf_accum[[i]]
    }
    mydf <- data.frame(data_def)
    values_2_3 <- c('AA',   'AC',   'AG',   'AT',   'CA',   'CC',   'CG',   'CT',   'GA',   'GC',   'GG',   'GT',   'TA',   'TC',   'TG',   'TT',   'AAA',  'AAC',  'AAG',  'AAT',  'ACA',  'ACC',  'ACG',  'ACT',  'AGA',  'AGC',  'AGG',  'AGT',  'ATA',  'ATC',  'ATG',  'ATT',  'CAA',  'CAC',  'CAG',  'CAT',  'CCA',  'CCC',  'CCG',  'CCT',  'CGA',  'CGC',  'CGG',  'CGT',  'CTA',  'CTC',  'CTG',  'CTT',  'GAA',  'GAC',  'GAG',  'GAT',  'GCA',  'GCC',  'GCG',  'GCT',  'GGA',  'GGC',  'GGG',  'GGT',  'GTA',  'GTC',  'GTG',  'GTT',  'TAA',  'TAC',  'TAG',  'TAT',  'TCA',  'TCC',  'TCG',  'TCT',  'TGA',  'TGC',  'TGG',  'TGT',  'TTA',  'TTC',  'TTG',  'TTT')  
    values_4<-c('AAAA', 'AAAC', 'AAAG', 'AAAT', 'AACA', 'AACC', 'AACG', 'AACT', 'AAGA', 'AAGC', 'AAGG', 'AAGT', 'AATA', 'AATC', 'AATG', 'AATT', 'ACAA', 'ACAC', 'ACAG', 'ACAT', 'ACCA', 'ACCC', 'ACCG', 'ACCT', 'ACGA', 'ACGC', 'ACGG', 'ACGT', 'ACTA', 'ACTC', 'ACTG', 'ACTT', 'AGAA', 'AGAC', 'AGAG', 'AGAT', 'AGCA', 'AGCC', 'AGCG', 'AGCT', 'AGGA', 'AGGC', 'AGGG', 'AGGT', 'AGTA', 'AGTC', 'AGTG', 'AGTT', 'ATAA', 'ATAC', 'ATAG', 'ATAT', 'ATCA', 'ATCC', 'ATCG', 'ATCT', 'ATGA', 'ATGC', 'ATGG', 'ATGT', 'ATTA', 'ATTC', 'ATTG', 'ATTT', 'CAAA', 'CAAC', 'CAAG', 'CAAT', 'CACA', 'CACC', 'CACG', 'CACT', 'CAGA', 'CAGC', 'CAGG', 'CAGT', 'CATA', 'CATC', 'CATG', 'CATT', 'CCAA', 'CCAC', 'CCAG', 'CCAT', 'CCCA', 'CCCC', 'CCCG', 'CCCT', 'CCGA', 'CCGC', 'CCGG', 'CCGT', 'CCTA', 'CCTC', 'CCTG', 'CCTT', 'CGAA', 'CGAC', 'CGAG', 'CGAT', 'CGCA', 'CGCC', 'CGCG', 'CGCT', 'CGGA', 'CGGC', 'CGGG', 'CGGT', 'CGTA', 'CGTC', 'CGTG', 'CGTT', 'CTAA', 'CTAC', 'CTAG', 'CTAT', 'CTCA', 'CTCC', 'CTCG', 'CTCT', 'CTGA', 'CTGC', 'CTGG', 'CTGT', 'CTTA', 'CTTC', 'CTTG', 'CTTT', 'GAAA', 'GAAC', 'GAAG', 'GAAT', 'GACA', 'GACC', 'GACG', 'GACT', 'GAGA', 'GAGC', 'GAGG', 'GAGT', 'GATA', 'GATC', 'GATG', 'GATT', 'GCAA', 'GCAC', 'GCAG', 'GCAT', 'GCCA', 'GCCC', 'GCCG', 'GCCT', 'GCGA', 'GCGC', 'GCGG', 'GCGT', 'GCTA', 'GCTC', 'GCTG', 'GCTT', 'GGAA', 'GGAC', 'GGAG', 'GGAT', 'GGCA', 'GGCC', 'GGCG', 'GGCT', 'GGGA', 'GGGC', 'GGGG', 'GGGT', 'GGTA', 'GGTC', 'GGTG', 'GGTT', 'GTAA', 'GTAC', 'GTAG', 'GTAT', 'GTCA', 'GTCC', 'GTCG', 'GTCT', 'GTGA', 'GTGC', 'GTGG', 'GTGT', 'GTTA', 'GTTC', 'GTTG', 'GTTT', 'TAAA', 'TAAC', 'TAAG', 'TAAT', 'TACA', 'TACC', 'TACG', 'TACT', 'TAGA', 'TAGC', 'TAGG', 'TAGT', 'TATA', 'TATC', 'TATG', 'TATT', 'TCAA', 'TCAC', 'TCAG', 'TCAT', 'TCCA', 'TCCC', 'TCCG', 'TCCT', 'TCGA', 'TCGC', 'TCGG', 'TCGT', 'TCTA', 'TCTC', 'TCTG', 'TCTT', 'TGAA', 'TGAC', 'TGAG', 'TGAT', 'TGCA', 'TGCC', 'TGCG', 'TGCT', 'TGGA', 'TGGC', 'TGGG', 'TGGT', 'TGTA', 'TGTC', 'TGTG', 'TGTT', 'TTAA', 'TTAC', 'TTAG', 'TTAT', 'TTCA', 'TTCC', 'TTCG', 'TTCT', 'TTGA', 'TTGC', 'TTGG', 'TTGT', 'TTTA', 'TTTC', 'TTTG', 'TTTT')
    values<-c(values_2_3,values_4)

    variables_ID <- paste(rep(x = names_ok,
                              each = 336),
                          values,
                          sep = "_")
    colnames(mydf)<-variables_ID
    mydf<-mydf[,-(which(colSums(mydf) == 0))] 
    mydf<-cbind(data_names,mydf)
    mydf[mydf=="2"]<-1
    row.names(mydf) <- mydf[,1]
    mydf<-mydf[,-1]
    df1_sel2 <- cbind(Populations,mydf)
    df1_sel2 <<- df1_sel2
}

Следовательно, когда я запускаю приложение, я хотел бы переключаться между преобразованием данных типа A и типа B с помощью radioButton. Приложение, которое я разработал, выглядит следующим образом:


Блестящий пользовательский интерфейс и сервер

library(shiny)

    ui <- fluidPage(
            titlePanel("Converting different datasets"),
               sidebarLayout(
                sidebarPanel(
                    radioButtons("funct", "Distribution type:",
                                 c("Type A data" = "typeA",
                                   "Type B data" = "typeB")),
                    actionButton("conversion_button", HTML('<b>Convert Database</b>')) 
                ),
                mainPanel(
                    dataTableOutput("rendered_file2")
                )
            )
        )
        server <- function(input, output) {
            df1_sel2 <- reactive({ 
               funct <- switch(input$funct,
               typeA = data_handling_typeA_training, 
               typeB = data_handling_typeB_training, data_handling_typeA_training) 
               funct(input) })

            conversionButton <- eventReactive(input$conversion_button,{
                df1_sel2()
            })

            output$rendered_file2 <- DT::renderDataTable({
                conversionButton()
            })
        }

        shinyApp(ui = ui, server = server)

Однако я получаю следующую ошибку:

Предупреждение: ошибка в [.reactivevalues: неиспользованный аргумент (2)

Буду очень признателен, если кто-нибудь сможет мне помочь с этим вопросом!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...