I am creating a shiny app for my data but my current code does not display the plot. Also based on column 8 onwards I also want to categorize my data under 2 checkboxes "Stage1" and "Stage2". And based on a dropdown, date range and checkbox show subset/filter the data and show the plot.
Stage1<-(mytest$status_2019|mytest$status_2020|mytest$status_2021|mytest$status_2022==1)
Stage2<-(mytest$status_stage2_2019|mytest$status_stage2_2020|mytest$status_stage2_2021|mytest$status_stage2_2022==1)
Here is mydata:
mydata<-structure(list(Id = c("DB-1", "DB-2", "DB-3", "DB-4", "DB-5",
"DB-6", "DB-7", "DB-9", "DB-11", "DB-12", "DB-13", "DB-14", "DB-15",
"DB-16", "DB-17", "DB-18", "DB-19", "DB-20", "DB-23", "DB-25",
"DB-26", "DB-27", "DB-28", "DB-29", "DB-30", "DB-31", "DB-32",
"DB-34", "DB-35", "DB-36", "DB-37"), examiner = c("Alex", "Alex",
"Alex", "Alex", "Alex", "Alex", "Kim", "Kim", "Kim", "Kim", "Kim",
"Alex", "Alex", "Jhon", "Jhon", "Jhon", "Jhon", "Jhon", "Jhon",
"Maymoon", "Maymoon", "Maymoon", "Maymoon", "Maymoon", "Mike",
"Mike", "Mike", "Mike", "Mike", "Mike", "Mike"), Relationship = c("sibling",
"mother", "self", "father", "self", "self", "self", "self", "self",
"mother", "self", "self", "self", "self", "mother", "father",
"self", "self", "mother", "self", "self", "self", "self", "sibling",
"father", "mother", "mother", "mother", "mother", "self", "father"
), signed_date = c("12/4/18", "11/27/18", "11/30/18", "11/13/18",
"11/27/18", "11/13/18", "11/28/18", "2/26/19", "4/3/19", "1/15/19",
"4/3/19", "11/13/18", "2/25/19", "12/6/18", "1/15/19", "11/30/18",
"12/4/18", "11/20/18", "4/3/19", "2/25/19", "2/14/19", "12/6/18",
"3/14/19", "12/7/18", "1/10/19", "3/12/19", "3/22/19", "12/20/18",
"3/21/19", "4/5/19", "11/15/18"), gender = c("male", "female",
"male", "male", "male", "male", "female", "female", "female",
"female", "male", "female", "female", "female", "female", "male",
"male", "female", "female", "female", "male", "male", "female",
"male", "male", "female", "female", "female", "female", "female",
"male"), stage1_date = c("2/21/19 21:15", "1/10/19 21:45", "1/9/19 19:50",
"1/10/19 21:40", "1/10/19 21:45", "1/9/20 14:50", "1/10/19 21:45",
"3/15/19 16:50", "4/26/19 19:20", "3/21/19 18:21", "4/26/19 19:20",
"1/10/19 21:40", "3/15/19 16:50", "1/10/19 21:45", "3/21/19 18:21",
"1/31/19 20:25", NA, "1/10/19 21:45", "1/9/20 14:50", "7/30/19 15:10",
"3/4/19 16:30", NA, "4/8/19 12:40", "2/6/19 20:36", "1/31/19 20:25",
"5/1/19 18:05", "4/8/19 12:41", "1/17/19 19:26", "5/1/19 18:05",
NA, "1/10/19 21:45"), stage2_date = c(NA, NA, NA, NA, "5/11/21 17:50",
NA, "5/21/21 17:46", NA, "5/11/21 17:37", NA, "5/21/21 17:47",
"5/15/21 16:07", "5/16/21 16:07", NA, NA, NA, "5/11/21 17:52",
NA, NA, "5/14/21 16:07", "5/11/21 17:37", "5/11/21 17:52", NA,
NA, NA, NA, NA, NA, NA, "5/11/21 17:42", NA), status_2019 = c(1,
1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 0,
1, 1, 1, 1, 1, 1, 1, 0, 1), status_2020 = c(0, 0, 0, 0, 0, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0), status_2021 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
status_2022 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), status_stage2_2020 = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), status_stage2_2021 = c(0,
0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 0, 0, 0, 1, 0, 0, 1,
1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0), status_stage2_2022 = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), row.names = c(NA, -31L
), spec = structure(list(cols = list(Id = structure(list(), class = c("collector_character",
"collector")), Onboarded = structure(list(), class = c("collector_character",
"collector")), Relationship = structure(list(), class = c("collector_character",
"collector")), signed_date = structure(list(), class = c("collector_character",
"collector")), gender = structure(list(), class = c("collector_character",
"collector")), stage1_date = structure(list(), class = c("collector_character",
"collector")), stage2_date = structure(list(), class = c("collector_character",
"collector")), status_2019 = structure(list(), class = c("collector_double",
"collector")), status_2020 = structure(list(), class = c("collector_double",
"collector")), status_2021 = structure(list(), class = c("collector_double",
"collector")), status_2022 = structure(list(), class = c("collector_double",
"collector")), status_stage2_2020 = structure(list(), class = c("collector_double",
"collector")), status_stage2_2021 = structure(list(), class = c("collector_double",
"collector")), status_stage2_2022 = structure(list(), class = c("collector_double",
"collector"))), default = structure(list(), class = c("collector_guess",
"collector")), delim = ","), class = "col_spec"), problems = <pointer: 0x7f7f0a7dc7c0>, class = c("spec_tbl_df",
"tbl_df", "tbl", "data.frame"))
Here is my code:
library(shiny)
library(tidyverse)
library(dplyr)
library(ggplot2)
library(lubridate)
mydata <- read_csv("test.csv")
mydata$signed_date <- as.Date(mydata$signed_date, format = "%Y-%m-%d", optional=FALSE)
server <- function(input, output, session) {
#Summarize Data and then Plot
data <- reactive({
req(input$examiner)
mydata %>%
dplyr::filter(examiner %in% input$examiner ,
signed_date >= input$daterange[1] &
signed_date <= input$daterange[2]) %>%
group_by(relation) %>% summarize(Total = n())
})
output$selected_var <- renderText({
paste("You have chosen ", input$examiner, "between", input$Dates[1], "and", input$Dates[2])
})
#Plot
output$plot <- renderPlot({
g <- ggplot(data(), aes( y = Total, x = relation))
g + geom_bar(stat = "sum")
})
}
ui <- basicPage(
titlePanel("My Dashboard"),
helpText("Shows my data"),
selectInput(inputId = "examiner",
label = h3("Choose examiner"),
choices = c("None", as.character(mydata$examiner), selected = "None")),
dateRangeInput("Dates", h3("Select the Dates"), format="yyyy-mm-dd", start = "2018-04-01"),
mainPanel(
textOutput("selected_var"),
plotOutput("plot")
)
)
shinyApp(ui = ui, server = server)
I am now running into the following error
Problem with filter() input ..1.
[34mℹ[39m Input ..1 is examiner %in% input$examiner.
[31mx[39m object 'examiner' not found
You have multiple problems:
Typos
Your date data is not in a standard date format
Your posted data had an error in it.
I've begun to clean up some of these typos, but I'll leave you to figure out the date issue. The below has a browser() statement in one of the reactives. Run the app and then work interactively at the R console to see the date problem (by running something like class(mydata$stage1_date). Once you clean up the date problem post better data.
Here's something that is a little closer.
mydata <-
structure(
list(
Id = c(
"DB-1",
"DB-2",
"DB-3",
"DB-4",
"DB-5",
"DB-6",
"DB-7",
"DB-9",
"DB-11",
"DB-12",
"DB-13",
"DB-14",
"DB-15",
"DB-16",
"DB-17",
"DB-18",
"DB-19",
"DB-20",
"DB-23",
"DB-25",
"DB-26",
"DB-27",
"DB-28",
"DB-29",
"DB-30",
"DB-31",
"DB-32",
"DB-34",
"DB-35",
"DB-36",
"DB-37"
),
examiner = c(
"Alex",
"Alex",
"Alex",
"Alex",
"Alex",
"Alex",
"Kim",
"Kim",
"Kim",
"Kim",
"Kim",
"Alex",
"Alex",
"Jhon",
"Jhon",
"Jhon",
"Jhon",
"Jhon",
"Jhon",
"Maymoon",
"Maymoon",
"Maymoon",
"Maymoon",
"Maymoon",
"Mike",
"Mike",
"Mike",
"Mike",
"Mike",
"Mike",
"Mike"
),
Relationship = c(
"sibling",
"mother",
"self",
"father",
"self",
"self",
"self",
"self",
"self",
"mother",
"self",
"self",
"self",
"self",
"mother",
"father",
"self",
"self",
"mother",
"self",
"self",
"self",
"self",
"sibling",
"father",
"mother",
"mother",
"mother",
"mother",
"self",
"father"
),
application_date = c(
"12/4/18",
"11/27/18",
"11/30/18",
"11/13/18",
"11/27/18",
"11/13/18",
"11/28/18",
"2/26/19",
"4/3/19",
"1/15/19",
"4/3/19",
"11/13/18",
"2/25/19",
"12/6/18",
"1/15/19",
"11/30/18",
"12/4/18",
"11/20/18",
"4/3/19",
"2/25/19",
"2/14/19",
"12/6/18",
"3/14/19",
"12/7/18",
"1/10/19",
"3/12/19",
"3/22/19",
"12/20/18",
"3/21/19",
"4/5/19",
"11/15/18"
),
gender = c(
"male",
"female",
"male",
"male",
"male",
"male",
"female",
"female",
"female",
"female",
"male",
"female",
"female",
"female",
"female",
"male",
"male",
"female",
"female",
"female",
"male",
"male",
"female",
"male",
"male",
"female",
"female",
"female",
"female",
"female",
"male"
),
stage1_date = c(
"2/21/19 21:15",
"1/10/19 21:45",
"1/9/19 19:50",
"1/10/19 21:40",
"1/10/19 21:45",
"1/9/20 14:50",
"1/10/19 21:45",
"3/15/19 16:50",
"4/26/19 19:20",
"3/21/19 18:21",
"4/26/19 19:20",
"1/10/19 21:40",
"3/15/19 16:50",
"1/10/19 21:45",
"3/21/19 18:21",
"1/31/19 20:25",
NA,
"1/10/19 21:45",
"1/9/20 14:50",
"7/30/19 15:10",
"3/4/19 16:30",
NA,
"4/8/19 12:40",
"2/6/19 20:36",
"1/31/19 20:25",
"5/1/19 18:05",
"4/8/19 12:41",
"1/17/19 19:26",
"5/1/19 18:05",
NA,
"1/10/19 21:45"
),
stage2_date = c(
NA,
NA,
NA,
NA,
"5/11/21 17:50",
NA,
"5/21/21 17:46",
NA,
"5/11/21 17:37",
NA,
"5/21/21 17:47",
"5/15/21 16:07",
"5/16/21 16:07",
NA,
NA,
NA,
"5/11/21 17:52",
NA,
NA,
"5/14/21 16:07",
"5/11/21 17:37",
"5/11/21 17:52",
NA,
NA,
NA,
NA,
NA,
NA,
NA,
"5/11/21 17:42",
NA
),
status_2019 = c(
1,
1,
1,
1,
1,
0,
1,
1,
1,
1,
1,
1,
1,
1,
1,
1,
0,
1,
0,
1,
1,
0,
1,
1,
1,
1,
1,
1,
1,
0,
1
),
status_2020 = c(
0,
0,
0,
0,
0,
1,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
1,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0
),
status_2021 = c(
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0
),
status_2022 = c(
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0
),
status_stage2_2020 = c(
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0
),
status_stage2_2021 = c(
0,
0,
0,
0,
1,
0,
1,
0,
1,
0,
1,
1,
1,
0,
0,
0,
1,
0,
0,
1,
1,
1,
0,
0,
0,
0,
0,
0,
0,
1,
0
),
status_stage2_2022 = c(
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0
)
),
row.names = c(NA, -31L),
spec = structure(list(
cols = list(
Id = structure(list(), class = c("collector_character",
"collector")),
Onboarded = structure(list(), class = c("collector_character",
"collector")),
Relationship = structure(list(), class = c("collector_character",
"collector")),
application_date = structure(list(), class = c("collector_character",
"collector")),
gender = structure(list(), class = c("collector_character",
"collector")),
stage1_date = structure(list(), class = c("collector_character",
"collector")),
stage2_date = structure(list(), class = c("collector_character",
"collector")),
status_2019 = structure(list(), class = c("collector_double",
"collector")),
status_2020 = structure(list(), class = c("collector_double",
"collector")),
status_2021 = structure(list(), class = c("collector_double",
"collector")),
status_2022 = structure(list(), class = c("collector_double",
"collector")),
status_stage2_2020 = structure(list(), class = c("collector_double",
"collector")),
status_stage2_2021 = structure(list(), class = c("collector_double",
"collector")),
status_stage2_2022 = structure(list(), class = c("collector_double",
"collector"))
),
default = structure(list(), class = c("collector_guess",
"collector")),
delim = ","
), class = "col_spec"),
# problems = < pointer:0x7f7f0a7dc7c0 > ,
class = c("spec_tbl_df",
"tbl_df", "tbl", "data.frame")
)
library(shiny)
library(tidyverse)
library(dplyr)
library(ggplot2)
library(lubridate)
# mydata <- read_csv("test.csv")
mydata$signed_date <-
as.Date(mydata$signed_date, format = "%Y-%m-%d", optional = FALSE)
server <- function(input, output, session) {
#Summarize Data and then Plot
data <- reactive({
req(input$examiner)
browser()
mydata %>%
dplyr::filter(
examiner %in% input$examiner ,
stage1_date >= input$daterange[1] &
stage1_date <= input$daterange[2]
) %>%
group_by(Relationship) %>% summarize(Total = n())
})
output$selected_var <- renderText({
paste("You have chosen ",
input$examiner,
"between",
input$Dates[1],
"and",
input$Dates[2])
})
#Plot
output$plot <- renderPlot({
g <- ggplot(data(), aes(y = Total, x = relation))
g + geom_bar(stat = "sum")
})
}
ui <- basicPage(
titlePanel("My Dashboard"),
helpText("Shows my data"),
selectInput(
inputId = "examiner",
label = h3("Choose examiner"),
choices = c("None", as.character(mydata$examiner), selected = "None")
),
dateRangeInput(
"daterange",
h3("Select the Dates"),
format = "yyyy-mm-dd",
start = "2018-04-01"
),
mainPanel(textOutput("selected_var"),
plotOutput("plot"))
)
shinyApp(ui = ui, server = server)
You have too many typos in your code as noted by #dca. Try this
mydata$signed_date <- as.Date(mydata$application_date, format = "%m/%d/%y", optional=FALSE)
server <- function(input, output, session) {
#Summarize Data and then Plot
data <- reactive({
#req(input$examiner)
if (is.null(input$examiner) | input$examiner=="None") return(NULL)
mydata %>% dplyr::filter(examiner %in% input$examiner) %>%
dplyr::filter(signed_date >= input$Dates[1] & signed_date <= input$Dates[2]) %>%
group_by(Relationship) %>% dplyr::summarize(Total = n())
})
output$selected_var <- renderText({
paste("You have chosen ", input$examiner, "between", input$Dates[1], "and", input$Dates[2])
})
#Plot
output$plot <- renderPlot({
req(data())
g <- ggplot(data(), aes( y = Total, x = Relationship))
g + geom_bar(stat = "sum")
})
}
ui <- basicPage(
titlePanel("My Dashboard"),
helpText("Shows my data"),
selectInput(inputId = "examiner",
label = h3("Choose examiner"),
choices = c("None", unique(mydata$examiner)), selected = "None"),
dateRangeInput("Dates", h3("Select the Dates"), format="yyyy-mm-dd", start = "2018-04-01"),
mainPanel(
textOutput("selected_var"),
plotOutput("plot")
)
)
shinyApp(ui = ui, server = server)
Related
I want to use ComplexHeatmap to plot the "types" (type 1, type 2) and "subtypes" as top annotations using block annotation.
The row annotations would be the column names of met.resolv.
Code Part 1:
library(ComplexHeatmap)
library(GetoptLong)
clust.col <- c("#003f5c", "#374c80","#7a5195","#bc5090","#ef5675","#ff764a", "#ffa600", "#84E4F7", "#FFB480","#FDFD86", "#00a692")
meth.col <- c("#ff816f", "#ffbaae", "#f1f1f1", "#7e959e", "#004252")
met.immune.col <- c("#01444f", "#01575e", "#0d6a6a", "#217d74", "#38917c", "#52a482", "#6eb786", "#8eca89", "#b0dc8c", "#d5ed90", "#fdfd96")
pdf("Plots/heatmap_methylresolver.pdf")
ha = HeatmapAnnotation(
name = "Sub-Cluster", empty = anno_empty(border = TRUE, height = unit(8, "mm")),
foo = anno_block(gp = gpar(fill = clust.col), labels = unique(meta$clust))
)
la = rowAnnotation(foo = anno_block(gp = gpar(col=met.immune.col),
labels = colnames(met.resolv),
labels_gp = gpar(col = "white", fontsize = 10)))
Heatmap(met.resolv, name = "SubClust", top_annotation = ha,
left_annotation = la, column_title = NULL)
Traceback:
Error: Length of `labels` should be as same as number of slices.
Code part 2:
group_block_anno = function(group, empty_anno, gp = gpar(),
label = NULL, label_gp = gpar()) {
seekViewport(qq("annotation_#{empty_anno}_#{min(group)}"))
loc1 = deviceLoc(x = unit(0, "npc"), y = unit(0, "npc"))
seekViewport(qq("annotation_#{empty_anno}_#{max(group)}"))
loc2 = deviceLoc(x = unit(1, "npc"), y = unit(1, "npc"))
seekViewport("global")
grid.rect(loc1$x, loc1$y, width = loc2$x - loc1$x, height = loc2$y - loc1$y,
just = c("left", "bottom"), gp = gp)
if(!is.null(label)) {
grid.text(label, x = (loc1$x + loc2$x)*0.5, y = (loc1$y + loc2$y)*0.5, gp = label_gp)
}
}
group_block_anno(meta[meta$type==1,], "empty", gp = gpar(fill = "#003f5c"), label = "type 1")
group_block_anno(meta[meta$type==2,], "empty", gp = gpar(fill = "#ffa600"), label = "type 2")
dev.off()
Data:
met.resolv
> dput(met.resolv[1:20,])
structure(list(Monocytes = c(0, 0, 0, 0, 0.0691477875220381,
0.0461824156116519, 0.00777223000960038, 0, 0, 0, 0.00165316191239164,
0.0245461060386295, 0.026342142484403, 0, 0, 0, 0.0362473177899938,
0, 0, 0.0615459951223746), `Dendritic Cells` = c(0, 0, 0.00772620422001257,
0, 0, 0, 0.0480402297895918, 0, 0, 0.00898992233305366, 0.057888955860833,
0.0362367878235371, 0, 0.0472205793224695, 0.0286203273050095,
0, 0, 0, 0, 0), Macrophages = c(0, 0.0664642500649833, 0, 0,
0.0371204658284402, 0, 0, 0.0225187084795453, 0.0603416047052193,
0, 0, 0, 0, 0, 0, 0.0313730144635087, 0.0704265029977412, 0,
0.00934366999330129, 0.0411264824824766), Neutrophils = c(0.173202855063056,
0, 0, 0.0643464479529596, 0, 0.0187142163615865, 0.0117918312263748,
0, 0, 0.115244141262919, 0.0520653071278115, 0.00997874098002133,
0, 0.00754706466322519, 0.0885236230551497, 0.0144246971006176,
0.000602296924347016, 0, 0.0195266392400734, 0.00343527794086701
), Eosinophils = c(0, 0.00809451621782635, 0, 0, 0, 0, 0, 0.0026662337469062,
0.0126433025837339, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.00796674767545607,
0), `Regulatory T cells` = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), `Naive T cells` = c(0, 0.00984426904423764,
0, 0.111694279700795, 0.0123267828167452, 0.0121761009946946,
0.015487451006506, 0, 0.0231848393777138, 0, 0.00278269237244245,
0.0200645732264692, 0, 0.0147361795082149, 0.0526711496398388,
0, 0.00992032127196248, 0, 0, 0.030586635289606), `Memory T cells` = c(0,
0.0312258875142767, 0.124409625779986, 0, 0.0135351004994425,
0.0537156172200875, 0.0540049513012593, 0.0297542571267331, 0,
0.0363411597373587, 0.0464268327265193, 0.0397546685980086, 0.0425232243321057,
0.0491394530734343, 0, 0.0512205034016493, 0.023265025230139,
0.130162735781893, 0, 0.00172924583134173), `CD8 T cells` = c(0.00282626493694126,
0.0225524838253428, 0, 0.0030508623462426, 0, 0.0128041131453121,
0, 0.102208367313482, 0, 0, 0, 0, 0.0668565430396047, 0.0343785834326558,
0, 0.0418137510155405, 0.0039045724524825, 0.0142647475514386,
0.0757110710314276, 0), `NK cells` = c(0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), `B cells` = c(0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0.0158949534772194, 0, 0, 0.0174286273520171,
0, 0, 0.0240398020597407, 0)), row.names = c("TCGA.2K.A9WE.01A",
"TCGA.2Z.A9J1.01A", "TCGA.2Z.A9J3.01A", "TCGA.2Z.A9J5.01A", "TCGA.2Z.A9J6.01A",
"TCGA.2Z.A9J7.01A", "TCGA.2Z.A9J8.01A", "TCGA.2Z.A9JD.01A", "TCGA.2Z.A9JI.01A",
"TCGA.2Z.A9JJ.01A", "TCGA.2Z.A9JO.01A", "TCGA.2Z.A9JQ.01A", "TCGA.4A.A93W.01A",
"TCGA.4A.A93X.01A", "TCGA.4A.A93Y.01A", "TCGA.5P.A9JU.01A", "TCGA.5P.A9JY.01A",
"TCGA.5P.A9KE.01A", "TCGA.A4.7288.01A", "TCGA.A4.7583.01A"), class = "data.frame")
meta
> dput(meta[1:20,])
structure(list(clust = c("1a", "2a", "2b", "1b", "2a", "2c",
"1c", "1c", "1b", "1d", "1e", "2c", "2b", "1c", "1e", "1c", "2c",
"1f", "1c", "2a"), type = c("1", "2", "2", "1", "2", "2", "1",
"1", "1", "1", "1", "2", "2", "1", "1", "1", "2", "1", "1", "2"
)), row.names = c("TCGA.2K.A9WE.01A", "TCGA.2Z.A9J1.01A", "TCGA.2Z.A9J3.01A",
"TCGA.2Z.A9J5.01A", "TCGA.2Z.A9J6.01A", "TCGA.2Z.A9J7.01A", "TCGA.2Z.A9J8.01A",
"TCGA.2Z.A9JD.01A", "TCGA.2Z.A9JI.01A", "TCGA.2Z.A9JJ.01A", "TCGA.2Z.A9JO.01A",
"TCGA.2Z.A9JQ.01A", "TCGA.4A.A93W.01A", "TCGA.4A.A93X.01A", "TCGA.4A.A93Y.01A",
"TCGA.5P.A9JU.01A", "TCGA.5P.A9JY.01A", "TCGA.5P.A9KE.01A", "TCGA.A4.7288.01A",
"TCGA.A4.7583.01A"), class = "data.frame")
Expected output (Example):
I wish to normalize my entire data.frame. Is it possible to do so? Of course, I want to keep the dates as they are.
dat <- structure(list(date = c("2021-01-01", "2021-01-02", "2021-01-03",
"2021-01-04", "2021-01-05", "2021-01-06"), launches = c(4, 0,
0, 0, 8, 4), pledged = c(50278.64, 0, 0, 0, 366279.590415302,
172073.0471292), backers = c(2880, 0, 0, 0, 6588, 3528), total_goal = c(24000,
0, 0, 0, 148000, 60000), mean_goal = c(6000, 0, 0, 0, 18500,
15000), US = c(4, 0, 0, 0, 4, 0), `number of success` = c(4,
0, 0, 0, 8, 4), duration_days = c(30, 0, 0, 0, 31, 30), Twitter = c(1324L,
1548L, 1297L, 1585L, 1636L, 1583L), replies = c(882L, 1252L,
910L, 1018L, 810L, 1000L), likes = c(22859L, 24375L, 17854L,
20341L, 19521L, 19401L), retweets = c(8621L, 8239L, 6141L, 6728L,
6938L, 6842L), group_date = c("01", "01", "01", "01", "01", "01"
)), row.names = c(NA, 6L), class = "data.frame")
We can do
j <- sapply(dat, is.numeric)
dat[j] <- scale(dat[j])
My apologies for the second question
I wish to label my lines in my plot
I would like for the first line (y=launches) to be named "worldwide" and the second line (y=US) to be named US visibly in my plot
What is the best way to do this ?
plot1 <- ggplot()+
geom_line(data=dataplot,mapping = aes(x = date, y = launches, group=1) ) +
geom_line(data=dataplot,mapping = aes(x = date, y = US, group=1), colour="blue" )+
ggtitle("Kickstarter")+
labs(y= "Newly launched projects", x = "date") +
scale_x_date(date_breaks = "1 month")
plot1`
structure(list(date = c("2021-01-01", "2021-01-02", "2021-01-03",
"2021-01-04", "2021-01-05", "2021-01-06"), launches = c(4, 0,
0, 0, 8, 4), pledged = c(50278.64, 0, 0, 0, 366279.590415302,
172073.0471292), backers = c(2880, 0, 0, 0, 6588, 3528), total_goal = c(24000,
0, 0, 0, 148000, 60000), mean_goal = c(6000, 0, 0, 0, 18500,
15000), US = c(4, 0, 0, 0, 4, 0), `number of success` = c(4,
0, 0, 0, 8, 4), duration_days = c(30, 0, 0, 0, 31, 30), Twitter = c(1324L,
1548L, 1297L, 1585L, 1636L, 1583L), replies = c(882L, 1252L,
910L, 1018L, 810L, 1000L), likes = c(22859L, 24375L, 17854L,
20341L, 19521L, 19401L), retweets = c(8621L, 8239L, 6141L, 6728L,
6938L, 6842L)), row.names = c(NA, 6L), class = "data.frame")
I would like to find which column contains the highest number of 1. Number 1 should appear only once per row. As soon as column with highest number 1 will be located the script should check also neighboring columns (+1+ / -1) and if any of them contain number 1 it should be also selected. All of these rows should be kept within subset function.
Let's put part of original data:
structure(list( `10` = c(0, 0, 0, 0), `34` = c(0, 0, 0, 0),
`59` = c(0, 0, 0, 0), `84` = c(0, 0, 0, 0),
`110` = c(0, 0, 0, 0), `134` = c(0, 0, 0, 0),
`165` = c(0, 0, 0, 0), `199` = c(0, 0, 0, 0),
`234` = c(0, 0, 0, 0),
`257` = c(0.0160178986200301, 0, 0.0409772658686249, 0.0289710439505515),
`362` = c(0.0679054515644214, 0.126933274414494, 0.0855598028367368, 0.0596214721268868),
`433` = c(0.490914059297718, 0.604765061128296, 0.813348757670254, 1),
`506` = c(1, 1, 1, 0.971410482822965),
`581` = c(0.198244295668807, 0.234158197083517, 0.269655970224324, 0.195318383259472),
`652` = c(0.271177756524115, 0.223018854028576, 0.301352982597324, 0.142584385725234),
`733` = c(0.212426561005602, 0.212778023272942, 0.228513228045468, 0),
`818` = c(0.213816778248395, 0.168570481661511, 0.264465345538678, 0),
`896` = c(0.137102063123377, 0, 0.320234382858867, 0),
`972` = c(0.108932231179123, 0, 0.179106729705261, 0),
`1039` = c(0.101762535865555, 0, 0, 0),
EOD = c("Peter", "Peter", "Peter", "Peter"),
Complex = c(""FT team", "FT team", "FT team", "FT team")),
.Names = c("10", "34", "59", "84", "110", "134", "165", "199",
"234", "257", "362", "433", "506", "581", "652", "733",
"818", "896", "972", "1039", "EOD", "Complex"),
row.names = c("Peter_1_Rep_1_E", "Peter_1_Rep_2_E",
"Peter_1_Rep_3_E", "Peter_1_Rep_4_E"),
class = "data.frame")
As you can clearly see in the original data the column 506 should be selected as the one containing the highest number of 1 and data should be subseted base on it. However, output would be exactly the same because in this data neighboring fraction (-1, 433) contains also 1. That's easy example.
Situation might be more complicated, like in that case:
structure(list( `10` = c(0, 0, 0, 0, 0, 0, 0, 0),
`34` = c(0, 0, 0, 0, 0, 0, 0, 0),
`59` = c(0, 0, 0, 0, 0, 0, 0, 0),
`84` = c(0, 0, 0, 0, 0, 0, 0, 0),
`110` = c(0, 0, 0, 0, 0, 0, 0, 0),
`134` = c(0.168783347110543, 0, 0.382618775924215, 0, 0.530638724516877, 0, 0.169526042048202, 0),
`165` = c(1, 0.36380544964196, 1, 0.13979454361738, 1, 0.239652477288689, 1, 0.240341578327444),
`199` = c(0.355158938904336, 1, 0.646724265971128, 1, 0.582637073151552, 1, 0.20319390520841, 1),
`234` = c(0.0963628165627114, 0.575436312346942, 0.229853828180188, 0.433555069046817, 0.247567185011894, 0.508529485059242, 0.138356164383562, 0.389880251276011),
`257` = c(0, 0.17393595585728, 0, 0.127787133715056, 0, 0.117147323350173, 0, 0),
`362` = c(0, 0, 0, 0.0919333108790839, 0, 0, 0, 0),
`433` = c(0, 0, 0, 0.0745570899292691, 0, 0, 0, 0),
`506` = c(0, 0, 0, 0, 0, 0, 0, 0),
`581` = c(0, 0, 0, 0, 0, 0, 0, 0),
`652` = c(0, 0, 0, 0, 0, 0, 0, 0),
`733` = c(0, 0, 0, 0, 0, 0, 0, 0),
`818` = c(0, 0, 0, 0, 0, 0, 0, 0),
`896` = c(0, 0, 0, 0, 0, 0, 0, 0),
`972` = c(0, 0, 0, 0, 0, 0, 0, 0),
`1039` = c(0, 0, 0, 0, 0, 0, 0, 0),
EOD = c("Paul", "Paul", "Paul", "Paul", "Paul", "Paul", "Paul", "Paul"),
Complex = c("GG Team", "GG Team", "GG Team", "GG Team", "GG Team", "GG Team", "GG Team", "GG Team")),
.Names = c("10", "34", "59", "84", "110", "134", "165", "199", "234", "257", "362", "433", "506", "581", "652", "733", "818", "896", "972", "1039", "EOD", "Complex"),
row.names = c("PaulG_1_Rep_1_E", "Paul_1_Rep_1_E", "PaulN_1_Rep_2_E", "PaulG_1_Rep_2_E", "Paul_1_Rep_3_E", "PaulC_1_Rep_3_E", "PaulC_1_Rep_4_E", "Paul_1_Rep_4_E"),
class = "data.frame")
In that situation there are two columns which contain the same number of 1s. In this case column with bigger colsum should be selected.
let df1 be your input:
df_num <- df1[,sapply(df1,is.numeric)] # keep only numeric columns to build filter
n1 <- colSums(df_num == 1) # number of 1s per column
i <- which(n1 == max(n1)) # index of cols with max 1s
if(length(i) > 1){
max_cs <- which.max(colSums(df_num[,i])) # index of col with max colsum among results
i <- i[max_cs] # our column index
}
filter <- rowSums(df_num[,seq(max(i-1,0),min(i+1,ncol(df_num)))]==1) >0 # filter is true if chosen column is 1 or if any neighbour is 1
df1[filter,] # your result
In both of your examples, all rows are kept
I'd use the tidyverse to convert it to long format then pull in the column sums to determine where the first one (with the largest sum) is:
library(tidyverse)
# add rownames to the data frame
df2$id <- rownames(df2)
# make a data frame of each column's sum
thecolsums <- colSums(df2[,map_lgl(df2, is.numeric)]) %>%
enframe(name = "colname", value = "colsum")
# change the data frame to long format
dflong <- df2 %>%
mutate(rowid = row_number()) %>%
gather(colname, val, -rowid)
# which column has the first 1 value
whichcol <- dflong %>%
group_by(colname) %>%
filter(val ==1) %>%
summarize(
firstone = min(rowid, na.rm = T)
) %>%
left_join(thecolsums, by = 'colname') %>%
filter(colsum == max(colsum)) %>%
pluck('colname')
# what's the numerical index of the column
whichcolindex <- which(names(df2) == whichcol)
# get previous and next columns if they exist
prevcolindex <- ifelse(whichcolindex < 1, F, whichcolindex -1)
nextcolindex <- ifelse(whichcolindex == ncol(df2) , F, whichcolindex +1)
# do the previous and next columns have 1s in them?
prevcolhasone <- any(df2[,prevcolindex] == 1)
nextcolhasone <- any(df2[,nextcolindex] == 1)
# create a vector with 1, 2 or 3 column indexes
finalindex <- c(
prevcolindex[prevcolhasone]
, whichcolindex
, nextcolindex[nextcolhasone]
)
# subset the original data frame, only preserving the columns in question
results <- df2[, finalindex]
genres=c("Action","Adventure","Animation","Biography","Comedy","Crime",
"Documentary","Drama","Family","Game.Show","Horror","Music","Musical",
"Mystery","Romance","Sci.Fi","Short","Thriller","War","Western")
This is my vector of genres.
Another data set has the same column names.
This is the data set column names
"Title" "Genre" "imdbRating" "Release_Year"
"Action" "Adventure" "Animation" "Biography" "Comedy"
"Crime" "Documentary" "Drama" "Family"
"Fantasy" "Game.Show" "Horror" "Music"
"Musical" "Mystery" "N.A" "Romance"
"Sci.Fi" "Short" "Sport" "Thriller"
"War" "Western"
I want to run this command for all genres replacing each genre with the value.
data_predict$genres[grepl("*genres*", data_predict$Genre)]=1
Orignal Data set
data_predict<-structure(list(Genre = structure(c(3L, 1L, 2L), .Label = c("Action, Adventure, Sci-Fi",
"Action, Drama, War", "Sci-Fi"), class = "factor"), Action = c(0,
0, 0), Adventure = c(0, 0, 0), Animation = c(0, 0, 0), Biography = c(0,
0, 0), Comedy = c(0, 0, 0), Crime = c(0, 0, 0), Documentary = c(0,
0, 0), Drama = c(0, 0, 0), Family = c(0, 0, 0), Game.Show = c(0,
0, 0), Horror = c(0, 0, 0), Music = c(0, 0, 0), Musical = c(0,
0, 0), Mystery = c(0, 0, 0), Romance = c(0, 0, 0), Sci.Fi = c(0,
0, 0), Short = c(0, 0, 0), Thriller = c(0, 0, 0), War = c(0,
0, 0), Western = c(0, 0, 0)), .Names = c("Genre", "Action", "Adventure",
"Animation", "Biography", "Comedy", "Crime", "Documentary", "Drama",
"Family", "Game.Show", "Horror", "Music", "Musical", "Mystery",
"Romance", "Sci.Fi", "Short", "Thriller", "War", "Western"), row.names = c(NA,
3L), class = "data.frame")
Expected result
data_predicted<-structure(list(Genre = structure(c(3L, 1L, 2L), .Label = c("Action, Adventure, Sci-Fi",
"Action, Drama, War", "Sci-Fi"), class = "factor"), Action = c(0,
1, 1), Adventure = c(0, 1, 0), Animation = c(0, 0, 0), Biography = c(0,
0, 0), Comedy = c(0, 0, 0), Crime = c(0, 0, 0), Documentary = c(0,
0, 0), Drama = c(0, 0, 1), Family = c(0, 0, 0), Game.Show = c(0,
0, 0), Horror = c(0, 0, 0), Music = c(0, 0, 0), Musical = c(0,
0, 0), Mystery = c(0, 0, 0), Romance = c(0, 0, 0), Sci.Fi = c(0,
0, 0), Short = c(0, 0, 0), Thriller = c(0, 0, 0), War = c(0,
0, 1), Western = c(0, 0, 0)), .Names = c("Genre", "Action", "Adventure",
"Animation", "Biography", "Comedy", "Crime", "Documentary", "Drama",
"Family", "Game.Show", "Horror", "Music", "Musical", "Mystery",
"Romance", "Sci.Fi", "Short", "Thriller", "War", "Western"), row.names = c(NA,
3L), class = "data.frame")
Try
library(qdapTools)
mtabulate(strsplit(as.character(data_predict$Genre), ', '))
Or
data_predict[-1] <- lapply(names(data_predict)[-1],
function(x) as.numeric(grepl(x, data_predict$Genre)))