How to use radioButton in Shiny when it is necessary to switch between different functions, according to the kind of uploaded dataset

shiny
,
1

...Hi all. I'm quite new with R Shiny so I apologise for the large number of redundant function I used to build my app and their relative functions. However, I'd like to use a Shiny app to convert the dataset I'll upload by using two different functions, which vary according to the dataset itself. In particular, my dataset might include categorical or continue data, so I have to switch between two functions in order to rearrange the data in the form of 0 and 1 (binarization).
I'd like to switch between the functions (data_handling_typeA_training and data_handling_typeB_training) reported below, according to the type A data and the type B data I'm going to upload in the Shiny app.


library(shiny)

# 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
}

Consequently, when I run the app, I'd like to switch between type A and type B transformation of the data by using a radioButton.
The app I developed is, as follows:

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)

However, when I run the app I keep on obtaining the following error:

Error: argument "input" is missing, with no default

I'd be very grateful if anybody could attend to this matter!

2

suggest you review the brackets on funct, not funct()() but just funct()

df1_sel2 <- reactive({ 
funct <- switch(input$funct,
 typeA = data_handling_typeA_training, 
typeB = data_handling_typeB_training, data_handling_typeA_training) 
funct(input) })

I think you have another issue, in that your B handler, introduces NA values that the pracma::accumarray doesnt like.

I also i would advise against naming your datasets or really naming any object as simply 'input' when you are working in a shiny context, because input has special importance for shiny, given how it handles reactivity, so it can be very confusing to others when reading your code.

Hope I helped you get back on track. Let me know if you need more help.

3

Dear @nirgrahamuk, I modify the script as you suggested me, but now I obtain the following error:

Warning: Error in [.reactivevalues: unused argument (2)

I'd be grateful if you could keep on helping me with this, since I couldn't fix the problem. Thank you also for your advices. Actually I observed sometimes the error that you mentioned about the introduction of NA values that the pracma::accumarray doesn't like, so I'd appreciate if you could attend to this matter, too.

4

Hi Eugenio, in the below I've made the mininum edits to your code, to change it to my prefence, I have not read every line of code and analysed everything..
but set up this way, pressing submit on option A does show me a Datatable of information, whereas B gives me the error message relating to the passing of the null values , here you go:


library(shiny)
library(plyr);
library(dplyr)
library(DT)

# Input type A ####

df <- 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(df){
  Populations<-as.factor(df[,2])
  df<-df[,-2]
  names = c(colnames(df))
  evenvals <- seq(2, ncol(df), by=2) 
  names_ok<-colnames(df[,evenvals])
  data_unl<-as.numeric(unlist(df[,-c(1)]))
  data_names<-as.data.frame(df[,1])
  
  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(df[,-c(1)])
  data_unl<-as.data.frame(matrix(data_unl,ncol = nX))
  data_def<-cbind(data_names,data_unl)
  colnames(data_def)<- names
  df<-data_def
  names = c(colnames(df))
  nX <- ncol(df)-1
  listofdf <- lapply(1:nX, function(x) NULL)
  for (i in 1:nX) {
    listofdf[[i]] <- data.frame(df[,1], df[i],df[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 = df), 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(df) {
  Populations<-as.factor(df[,2])
  df<-df[,-2]
  names = c(colnames(df))
  evenvals <- seq(2, ncol(df), by=2) 
  names_ok<-colnames(df[,evenvals])
  data_unl<-unlist(df[,-c(1)])
  data_names<-as.data.frame(df[,1])
  
  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(df[,-c(1)])
  data_unl<-as.data.frame(matrix(data_unl,ncol = nX))
  data_def<-cbind(data_names,data_unl)
  colnames(data_def)<- names
  df<-data_def
  names = c(colnames(df))
  nX <- ncol(df)-1
  listofdf <- lapply(1:nX, function(x) NULL)
  for (i in 1:nX) {
    listofdf[[i]] <- data.frame(df[,1], df[i],df[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 = df), 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
}

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(
      DT::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(df)
  })
  
  conversionButton <- eventReactive(input$conversion_button,{
    df1_sel2()
  })
  
  output$rendered_file2 <- DT::renderDataTable({
    DT::datatable(conversionButton())
  })
}

shinyApp(ui = ui, server = server)
5

Dear @nirgrahamuk, thank you once again, the code is actually improved since it works perfectly for the Type A dataset. However, when it comes to the dataset Type B (i.e. when I upload only the following dataset):

# 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"))
)

I keep on obtaining the following error:

Error: object of type 'closure' is not subsettable

Could you help me once again with this? Thank you in advance for you availability.

6

I can't reproduce your issue on my machine.
I took the full code that I posted above (where the single loaded dataframe has the name df) , and replaced the df assignment with your new table like

df <- 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"))
)

and this ran fine for me with no other changes.
It showed a table when either choice was submitted, and no errors printed

7

Hi @nirgrahamuk,
yes it works properly! Thanks a lot!
I still have only a minor issue, since when I use the data type B and run it with the RadioButton on type A function, it provides me the same converted database (while, when tested the type A data with type B function I obtained the following error):

Error: missing value where TRUE/FALSE needed

I'd like to obtain, if possible, the same error when testing the data type B with the function type A.
Thank you once again for the help

8

The error relates to missing values.
I don't know what your transformations are intended to do, you have so many manipulations. I'd be happy to help you but I'd need you to present me with bitesize challenges.

9

Thanks a lot!
As you have seen, the variables I have to deal with provides one or two values (for instance xx = (11,12), zz = (14,14).
I'd like to convert my db into a matrix of zeros and ones, so that for the new variables xx_11 and xx_12 I can observe 1 and 1 for the subject c_01 and 0 and 1 for the subject c_02.
In other words, I'd like to convert the db in a new one with all the observed combinations of variables as columns.
For the variable xx, for instance, I would like to observe the new columns such as:
xx_9, xx_10, xx_11 and xx_12, while the subjects would have, for those variables, the following values:
c_01 (0,0,1,1) --> since it was xx(11,12)
c_02 (1,0,1,0) --> since it was xx(9,11)
c_03 (0,1,0,1) --> since it was xx (10,12).

I'd like to do this for all the tested samples and i'd like to switch the function in case I obtain a db including the mentioned categorical results (i.e. AA, AT, AG, AC, etc.) so that, for instance:
variable aaa would be aaa_CAG, aaa_CGG, aaa_TAG, aaa_TGG.
The object A_01 would be, in this case, A_01 (1,0,0,1) --> since it was aaa(CAD,TGG).

Thank you again for your interest!

10

In simple terms. Your data source might have one of two different structures/contents. You have a transformation suited to each one.
At this time , one transformation will throw an error when applied on the 'wrong source' (from its perspective), on the other hand, the other transformation is more tolerant of the source data , and won't throw an error even if called on its incorrect counterpart data source.
Have I understood the general idea? Or way off?

11

It is correct, absolutely. I'd like to achieve the goal you reported

12

So I think the high-level strategy is to look at the data being passed and check for conditions that say it's the right kind of data before processing it and if it isn't then throw an error with stop() function. So the question is, what's the first thing you would check for if I gave you a random dataset and asked you if it was suitable for transformation A?

13

Yes, that's correct. The first thing to check is wheter the data (and their relative variables) are numerical (i.e. c_01 --> xx(12,13)) or categorical (i.e. c_01 --> aaa(AGG,TCG).

14

So you can test with is.factor() is.character() etc.
Then decide to proceed or throw error with stop()

Try write the code for that. I will help if you get stuck.

1 Like
15

Thanks a lot! You've been very helpful!

16

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.