Related
You can use the following piece of code as an example:
options(stringsAsFactors = FALSE)
options(encoding = "UTF-8")
library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(dplyr)
library(shinycssloaders)
library(data.table)
library(tidyverse)
library(DT)
dt <- structure(list(GENE = c("SI", "ARSA", "ABCA3", "KIT", "IVD", "COL18A1"), RefSeq_ID = c("NM_001041.4", "NM_000487.6", "NM_001089.3", "NM_000222.3", "NM_002225.5", "NM_001379500.1"), Tag = c("DM", "DM", "DM", "DM", "DM?", "DM"), clinvar_clnsig = c("Pathogenic", "Uncertain_significance", "NULL", "NULL", "NULL", "Likely_pathogenic"), MutationType = c("missense", "missense", "initiation", "missense", "missense", "nonsense"), ExpectedInheritance = c("AR", "AR", "AR", "AD", "AR", "AR"), Disease = c("Sucrase isomaltase deficiency", "Metachromatic leukodystrophy", "Fatal surfactant deficiency", "Piebaldism", "Isovaleric acidaemia", "Knobloch syndrome"), hgvs = c("1022T>C", "991G>A", "3G>C", "1861G>T", "1124G>A", "1876C>T"), hgvsAll = c("1022TtoC | L341P", "991GtoA | E331K", "3GtoC | M1I", "1861GtoT | A621S", "1124GtoA | G375D", "1876CtoT | R626*"), comments = c("Descr. as T/C 1021 L340P, mut. conf. by PC <1592>.", "Found in cis with Pd allele. Descr. as G985A E329R, mut. conf. by PC <1251>.", "Descr. as M1I, base change conf. by PC <1663>.", "Descr. as 1861G>C A621S, mut. conf. by PC <1495>.", "Descr. as c.1124G>A; G375A, mut. conf. by PC <1331>.", "Descr. as c.2416C>T, posn. conf. by PC <1439>."), gnomad_AC = c("NULL", "NULL", "NULL", "NULL", "NULL", "NULL"), pmid = c("10903344", "12809637", "16641205", "17124503", "19089597", "18484314"), pmidAll = c("NULL", "30052522", "24871971", "NULL", "32778825|32977617", "16532212"), CHROM = c("3", "22", "16", "4", "15", "21"), POS = c("165060026", "50626052", "2326464", "54727909", "40416348", "45487489"), REF = c("A", "C", "C", "G", "G", "C"), ALT = c("G", "T", "G", "T", "A", "T"), Support = c("NULL", "1", "0", "NULL", "2", "1"), Rankscore = c("0.48", "0.17", "0.38", "0.68", "0.5871645293736492", "0.99"), gdbid = c("120377", "119007", "3770735", "120117", "119354", "138752"), omimid = c("609845", "607574", "601615", "164920", "607036", "120328"), amino = c("Leu-Pro", "Glu-Lys", "Met-Ile", "Ala-Ser", "Gly-Asp", "Arg-Term"), deletion = c("NULL", "NULL", "NULL", "NULL", "NULL", "NULL"), insertion = c("NULL", "NULL", "NULL", "NULL", "NULL", "NULL"), codon = c("341", "331", "1", "621", "375", "626"), codonAff = c("341", "331", "1", "621", "375", "626"), descr = c("Leu341Pro", "Glu331Lys", "Met1Ile", "Ala621Ser", "Gly375Asp", "Arg626Term"), refseq = c("NM_001041.4", "NM_000487.6", "NM_001089.3", "NM_000222.3", "NM_002225.5", "NM_001379500.1"), dbsnp = c("rs267607049", "NULL", "NULL", "NULL", "rs769261274", "NULL"), gnomad_AF = c("NULL", "NULL", "NULL", "NULL", "NULL", "NULL"), gnomad_AN = c("NULL", "NULL", "NULL", "NULL", "NULL", "NULL"), new_date = c("2013-06-11", "2011-09-23", "2013-09-19", "2012-11-06", "2012-01-25", "2012-07-27"), base = c("M", "M", "M", "M", "M", "M"), clinvarID = c("1413", "556001", "NULL", "NULL", "NULL", "915432"), entrezID = c("6476", "410", "21", "3815", "3712", "80781"), hgncID = c("10856", "713", "33", "6342", "6186", "2195"), svar = c("NULL", "NULL", "NULL", "NULL", "NULL", "NULL"), mut = c("Y", "Y", "Y", "Y", "Y", "Y"), poly = c("Y", "Y", "Y", "Y", "N", "Y"), ftv = c("N", "N", "N", "N", "N", "Y"), TotalMutations = c(74L, 320L, 338L, 144L, 157L, 76L), NewMutations = c(1L, 5L, 14L, 2L, 1L, 5L), gene_date = c("1996-04-01", "1996-04-01", "2004-04-15", "1996-04-01", "1996-04-01", "2000-09-15"), author = c("Jacob", "Rafi", "Garmany", "Bondanza", "Bonilla Guerrero", "Williams"), title = c("Congenital sucrase-isomaltase deficiency arising from cleavage and secretion of a mutant form of the enzyme.", "Disease-causing mutations in cis with the common arylsulfatase A pseudodeficiency allele compound the difficulties in accurately identifying patients and carriers of metachromatic leukodystrophy.", "Surfactant composition and function in patients with ABCA3 mutations.", "Piebald trait: implication of kit mutation on in vitro melanocyte survival and on the clinical application of cultured epidermal autografts.", "Essential fatty acid profiling for routine nutritional assessment unmasks adrenoleukodystrophy in an infant with isovaleric acidaemia.", "A phenotypic variant of Knobloch syndrome."), fullname = c("J Clin Invest", "Mol Genet Metab", "Pediatr Res", "J Invest Dermatol", "J Inherit Metab Dis", "Ophthalmic Genet"), allname = c("The Journal of clinical investigation", "Molecular genetics and metabolism", "Pediatric research", "The Journal of investigative dermatology", "Journal of inherited metabolic disease", "Ophthalmic genetics"), vol = c("106", "79", "59", "127", "31S2", "29"), page = c("281", "83", "801", "676", "S453", "85"), year = c(2000L, 2003L, 2006L, 2007L, 2008L, 2008L), reftag = c("PRI", "PRI", "PRI", "PRI", "PRI", "PRI"), Some_ID = c("BM0042985", "BM0393251", "BM0673028", "BM0795183", "BM0867669", "BM0887391"), OtherNames = c("NULL", "ASA|MLD", "ABC-C|ABC3|EST111653|LBM180|SMDP3", "C-Kit|CD117|MASTC|PBT|SCFR", "ACAD2|IVDH", "GLCC|KNO|KNO1|KS"), Location = c("3q25.2-q26.2", "22q13.31-qter", "16p13.3", "4q11-q12", "15q14-q15", "21q22.3"), STRAND = c("-", "-", "-", "+", "+", "+"), FullGeneName = c("Sucrase-isomaltase", "Arylsulfatase A", "ATP binding cassette subfamily A member 3", "KIT proto-oncogene, receptor tyrosine kinase", "Isovaleryl-CoA dehydrogenase", "Collagen type XVIII alpha 1 chain")), row.names = c(NA, -6L), class = c("data.table", "data.frame"))
dt$gnomad_AC <- as.numeric(dt$gnomad_AC)
dt$Support <- as.numeric(dt$Support)
dt$Rankscore <- as.numeric(dt$Rankscore)
dt$gnomad_AF <- as.numeric(dt$gnomad_AF)
dt$gnomad_AN <- as.numeric(dt$gnomad_AN)
# ui
ui <- fluidPage(
theme = "slate",
navbarPage(
title = "Some Table",
header = tagList(useShinydashboard()),
tabPanel(
"Test",
fluidRow(
box(
dataTableOutput("mytable") %>% withSpinner(color="#0dc5c1"),
width = 12,
collapsible = FALSE,
title = "",
solidHeader = T
)
)
)
)
)
# server
server <- function(input, output) {
res <- reactive ({
outputdf <- withProgress(
message = "Loading ...",
expr = {sample_n(dt, size = 5) }
)
outputdf
})
output$mytable <-
renderDataTable(
res(),
filter = list(position = "top", clear = FALSE, plain = TRUE),
options = list(scrollX = TRUE,autoWidth = TRUE, search = list(regex = TRUE)),
rownames = FALSE
)
}
# app
shinyApp(ui, server)
And the output will give a table with filtering boxes on top of the table:
But the problem is that whenever I click on one of the filter boxes, it sends me back to the left side of the table. I have to scroll back again to where I clicked before I can use the filtering slider. Is there any way I can fix this?
I really appreciate any help you can provide.
This isn't a new issue. It looks like it's been reported a few times to the maintainers of the package.
In your UI, you can set the box to scroll. In the server, set your table to not scroll and not set an auto width.
The changes in the user interface.
ui <- fluidPage(
theme = "slate",
navbarPage(
title = "Some Table",
header = tagList(useShinydashboard()),
tabPanel(
"Test",
fluidRow(
box(style = "overflow-x: scroll;", # <--- I'm new!
dataTableOutput("mytable") %>% withSpinner(color = "#0dc5c1"),
width = 12,
collapsible = FALSE,
title = "",
solidHeader = T
)
)
)
)
)
The change in server.
# server
server <- function(input, output) {
res <- reactive ({
outputdf <- withProgress(
message = "Loading ...",
expr = {sample_n(dt, size = 5) }
)
outputdf
})
output$mytable <-
renderDataTable(
res(),
filter = list(position = "top", clear = FALSE, plain = TRUE),
options = list(scrollX = F, autoWidth = F, # <---- both of these have flipped
search = list(regex = TRUE)),
rownames = FALSE
)
}
I have a somewhat large list of paragraphs called psw_list short for paragraphs separated by word:
c("For", "more", "than", "five", "years,", "William", "Sencion", "did", "the", "same", "task", "over", "and", "over.", "He", "signed", "onto", "the", "New", "York", "City’s", "housing", "lottery", "site", "and", "applied", "for", "one", "of", "the", "city’s", "highly", "coveted,", "below-market", "apartments.", "Each", "time,", "he", "got", "the", "same", "response:", "silence.")
I'm only including the first paragraph because they're all this length, but I have each paragraph labeled as p1, p2, p3, etc. in the list, so you can reference it by using psw_list$p1 to get this one specifically. I need to save the name of a paragraph, for example psw_list$p1, inside of a loop that will randomly select a paragraph from the entire psw_list, any idea how to do that?
I have a quick question, regarding package DT implemented in shiny. I want to use the top filters in a renderdatable in a shiny app to filter out the rows that contain a specific word. I have set up in options regexp=TRUE, but I am still not able to make it work
I am using this regexp
^((?!intronic).)*$
I have tried escaping this part ((?!intronic).) but it doesn't work either
EDIT
This is my complete code for rendering the table
DT::datatable(df,
rownames = FALSE,
selection = "none",
style = 'bootstrap',
class = 'compact display',
#class = 'compact cell-border stripe hover',
filter = list(position = 'top', clear = FALSE),
escape = FALSE,
extensions = c('Buttons'),
options = list(
stateSave = FALSE,
ordering = FALSE,
autoWidth = TRUE,
searchCols = default_search_columns,
search = list(regex = TRUE, caseInsensitive = TRUE),
columnDefs = list(
list(
className = 'dt-center',
targets = cols_to_all,
render = JS("function(data, type, row, meta) {",
"return type === 'display' && typeof data === 'string' && data.length > 14 ?",
"'<span title=\"' + data + '\">' + data.substr(0, 14) + '...</span>' : data;",
"}")
),
list(
visible = FALSE,
targets = cols_to_hide
)),
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'font-size': '12px'});",
"}"),
#dom = 'Bfrtip',
sDom = '<"top">Blrt<"bottom">ip', # remove search general box and keep the top filters
#dom = 'BT<"clear">frti',
#dom = 'Bftir',
scroller = TRUE,
scrollX = TRUE,
#scrollY = "800px",
deferRender=TRUE,
buttons = list('colvis'),
#FixedHeader = TRUE,
pageLength = 25,
lengthMenu = list(c(25, 50, 100, -1), list('25', '50', '100', 'All'))#,
)
I have included the search option in the list
EDIT2
This is an example of my daframe, the real one has more than 50,000 rows and 160 columns. However, I am interested in applying the filter to the column named Func.refGene
>dput(df)
structure(list(Chr = c("chr1", "chr1", "chr1", "chr1", "chr1",
"chr1", "chr1", "chr1", "chr1", "chr1", "chr1", "chr1", "chr1",
"chr1", "chr1"), Start = c(69511L, 876499L, 877831L, 878314L,
879676L, 879676L, 879687L, 879687L, 881627L, 887560L, 887801L,
888639L, 888659L, 889158L, 889159L), End = c(69511L, 876499L,
877831L, 878314L, 879676L, 879676L, 879687L, 879687L, 881627L,
887560L, 887801L, 888639L, 888659L, 889158L, 889159L), GATK.RefCount = c("0",
"0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0",
"0"), GATK.AltCount = c("55", "60", "138", "184", "111", "111",
"110", "110", "103", "66", "138", "73", "50", "96", "96"), GATK.Filter = c("MQ_LT_40",
"PASS", "PASS", "PASS", "PASS", "PASS", "PASS", "PASS", "PASS",
"PASS", "PASS", "PASS", "PASS", "PASS", "PASS"), Func.refGene = c("exonic",
"intronic", "exonic", "exonic", "UTR3", "UTR3", "UTR3", "UTR3",
"exonic", "intronic", "exonic", "exonic", "exonic", "splicing;intronic",
"splicing;intronic"), Gene.refGene = c("OR4F5", "SAMD11", "SAMD11",
"SAMD11", "NOC2L", "SAMD11", "NOC2L", "SAMD11", "NOC2L", "NOC2L",
"NOC2L", "NOC2L", "NOC2L", "NOC2L", "NOC2L"), GeneDetail.refGene = c(".",
".", ".", ".", "NM_015658:c.*398C>T;NM_152486:c.*143G>A", "NM_015658:c.*398C>T;NM_152486:c.*143G>A",
"NM_015658:c.*387A>G;NM_152486:c.*154T>C", "NM_015658:c.*387A>G;NM_152486:c.*154T>C",
".", ".", ".", ".", ".", "NM_015658:exon8:c.888+4C>G", "NM_015658:exon8:c.888+3T>G"
)), row.names = c(NA, 15L), class = "data.frame")
You have to set the regex option like this:
library(DT)
datatable(iris,
options = list(search = list(regex = TRUE)))
Then you can check that ^((?!(setosa)).)*$ works well.
I've done something similar in mouse genes to remove "Rik" predicted genes. Here was my solution.
rik = grep("Rik$", rownames(DF))
datatable(DF[-rik,]) %>%
... %>%
formatSignif(columns = c('log2.FC', 'adj.P.val'), digits = 3)
I hope that helps.
I'm trying to classify a data frame of customer reviews into the respective categories. For example,
x <- data.frame(Reviews = c("The phone performance and display is good","Worth the money","Camera is good"))
The desired output is as below image
I tried creating a dictionary as below using R's Quanteda package
dic <- dictionary(list(camera = c("camera","lens","pixel", "pictures",
"pixels", "snap"), display = c("resolution", "display", "depth", "mode",
"color", "colour", "discolour"), performance = c("performance", "speed",
"usage", "fast", "run", "running", "lag", "processor", "shut", "shut down",
"restart", "hanging","hang"), Value = c("money", "worth", "budget", "value",
"price", "specs", "specifications", "invest",
"under","expectations","expected","expecting","expect")))
I would like to classify the texts based on keywords as stated above. Please help
P.S : dfm is one option. But particularly, I would like to know how to classify a data frame of texts as per the desired output.
Using already most of your code:
# Creating a DFM and saving the Reviews in a Vector
require("quanteda")
x <- dfm( Reviews <- c(
"The phone performance and display is good",
"Worth the money",
"Camera is good"),
tolower = TRUE)
I converted the capital letters to lowercase, otherwise, the fixed comparison would not work. Further, I recommend stopword removal and some kind of steaming.
# Creating the dictionary
dic <- dictionary(list(camera = c("camera","lens","pixel", "pictures", "pixels", "snap"),
display = c("resolution", "display", "depth", "mode", "color", "colour", "discolour"),
performance = c("performance", "speed", "usage", "fast", "run", "running", "lag", "processor", "shut", "shut down", "restart", "hanging","hang"),
Value = c("money", "worth", "budget", "value", "price", "specs", "specifications", "invest", "under","expectations","expected","expecting","expect")))
Using the dfm_lookup function:
# fixed parameter fof exact matching
res <- dfm_lookup(x, dic, valuetype = "fixed")
row.names(res)<- Reviews
res
Hope this is what you are looking for :)
I have a vector of lists in it. Every list contain field category
I need delete all lists with fields category == resource.
I tried
for(i in 1:length(myList)){
if(myList[[as.numeric(i)]]$data$category == "resource"){
myList[[as.numeric(i)]]<-NULL
}
}
Is it correct?
> dput(myList[1:2])
list(structure(list(data = structure(list(device = "iPad2,4",
os_version = "ios 7.1.2", connection_type = "wifi", category = "user",
platform = "ios", session_num = 2, ios_idfv = "E12AA218-4061-4BA1-AFA3-47FEE1511C2E",
client_ts = 1454926346, sdk_version = "unity 2.4.3", limited_ad_tracking = TRUE,
user_id = "436E8588-B2FA-411A-896C-5757E7A2A377", manufacturer = "apple",
jailbroken = TRUE, ios_idfa = "436E8588-B2FA-411A-896C-5757E7A2A377",
build = "1.0", session_id = "558910f2-7c2c-4280-84fc-2fef1a50d291",
v = 2, engine_version = "unity 4.6.9"), .Names = c("device",
"os_version", "connection_type", "category", "platform", "session_num",
"ios_idfv", "client_ts", "sdk_version", "limited_ad_tracking",
"user_id", "manufacturer", "jailbroken", "ios_idfa", "build",
"session_id", "v", "engine_version")), first_in_batch = TRUE,
country_code = "RO", arrival_ts = 1454926344, game_id = 24540,
ip = "93.168.249.0"), .Names = c("data", "first_in_batch",
"country_code", "arrival_ts", "game_id", "ip")), structure(list(
data = structure(list(os_version = "ios 9.2.1", engine_version = "unity 4.6.9",
category = "user", v = 2, ios_idfa = "F06962FE-FCE5-475F-8CC2-83FF1F89E573",
sdk_version = "unity 2.4.3", user_id = "F06962FE-FCE5-475F-8CC2-83FF1F89E573",
session_num = 2, platform = "ios", connection_type = "wifi",
manufacturer = "apple", client_ts = 1454925528, limited_ad_tracking = TRUE,
session_id = "3ab1fbbb-5103-4ad8-bf56-94f70fea94a7",
device = "iPad4,1", ios_idfv = "2C940E82-B074-4A15-B9A7-A5983759042F",
build = "1.0"), .Names = c("os_version", "engine_version",
"category", "v", "ios_idfa", "sdk_version", "user_id", "session_num",
"platform", "connection_type", "manufacturer", "client_ts",
"limited_ad_tracking", "session_id", "device", "ios_idfv",
"build")), first_in_batch = TRUE, country_code = "AU", arrival_ts = 1454925528,
game_id = 24540, ip = "110.175.52.0"), .Names = c("data",
"first_in_batch", "country_code", "arrival_ts", "game_id", "ip"
)))
You could use rlist package :
library(rlist)
filtered_list <- list.exclude(myList, data$category == "ressource")
We could use Filter from base R
Filter(function(x) x$data$category!="resource", myList)