Skip to content

Commit

Permalink
Clean code/interface
Browse files Browse the repository at this point in the history
  • Loading branch information
@anikaliu
anikaliu committed Jul 19, 2022
1 parent 114df3a commit c800d18
Show file tree
Hide file tree
Showing 5 changed files with 41 additions and 45 deletions.
14 changes: 7 additions & 7 deletions sub/1_server_OneEventsTab.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,13 +26,12 @@ stats=reactive({
output$stats = DT::renderDataTable({
stats()%>%
mutate(pval=signif(pval, 3),
ratio_active=signif(ratio_active,3),
ratio_bg=signif(ratio_bg,3),
jaccard=signif(jaccard,3),
FPR=signif(FPR,3),
Jaccard=signif(Jaccard,3),
TPR=signif(TPR,3),
PPV=signif(PPV,3),
lift=signif(lift,3),
odds_ratio=signif(odds_ratio,3))%>%
Lift=signif(Lift,3),
`Odds Ratio`=signif(`Odds Ratio`,3))%>%
filter(pval<=input$pval)%>%
DT::datatable(escape=F, filter = "top",
extensions = "Buttons", rownames = F,
Expand All @@ -49,8 +48,9 @@ stats_filtered <- reactive({
})

output$plot_pairs=renderPlot({
variance=stats_filtered()%>%ungroup()%>%summarise(across(active:colnames(.)[length(colnames(.))],var))%>%t()
variable=setdiff(rownames(variance)[(variance>0)],NA)
variance=stats_filtered()%>%ungroup()%>%summarise(across(TP:colnames(.)[length(colnames(.))],var))%>%t()
n_levels=stats_filtered()%>%ungroup()%>%summarise(across(TP:colnames(.)[length(colnames(.))],function(x){length(unique(x))}))%>%t()
variable=intersect(setdiff(rownames(variance)[(variance>0)],c(NA, NaN)),rownames(n_levels)[(n_levels>2)])
ggpairs(stats_filtered()%>%select_at(c('direction', intersect(input$picker_metrics, variable))),
mapping=aes(color=direction, alpha=0.9),showStrips = T,
upper = list(continuous = "density", combo = "box_no_facet"))+
Expand Down
10 changes: 5 additions & 5 deletions sub/1_ui_OneEventsTab.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -104,13 +104,13 @@ tabPanel(
inputId = "picker_metrics",
label=h5("Time concordance metrics to show"),
multiple=T,
selected = c('ratio_active','ratio_bg','TPR','PPV','pval','logFC'),
selected = c('Odds ratio','FPR','TPR','PPV','pval','logFC','Jaccard'),
options = list(
`actions-box` = TRUE,
size = 12,
liveSearch=T
),
choices = c('ratio_active','ratio_bg','jaccard','TPR','PPV','pval','active','bg','lift','odds_ratio','n_active_total','n_bg_total','logFC')
choices = c('Odds ratio','TP','FP','FPR','TPR','PPV','pval','logFC','Jaccard','Lift')
),
plotOutput("plot_pairs",
hover = "plot_hover",
Expand All @@ -125,9 +125,9 @@ tabPanel(
inputId = "picker_metrics_x",
label="x-axis",
multiple=F,
selected = c('TPR'),
selected = c('logFC'),
options = list(`actions-box` = TRUE, size = 12,liveSearch=T),
choices = c('ratio_active','ratio_bg','jaccard','TPR','PPV','pval','active','bg','lift','odds_ratio','n_active_total','n_bg_total','logFC')
choices = c('Odds ratio','TP','FP','FPR','TPR','PPV','pval','logFC','Jaccard','Lift')
),
prettyCheckbox(
inputId = "logarithmic_x",
Expand All @@ -143,7 +143,7 @@ tabPanel(
multiple=F,
selected = c('pval'),
options = list(`actions-box` = TRUE, size = 12,liveSearch=T),
choices = c('ratio_active','ratio_bg','jaccard','TPR','PPV','pval','active','bg','lift','odds_ratio','n_active_total','n_bg_total','logFC')
choices = c('Odds ratio','TP','FP','FPR','TPR','PPV','pval','logFC','Jaccard','Lift')
),
prettyCheckbox(
inputId = "logarithmic_y",
Expand Down
5 changes: 3 additions & 2 deletions sub/2_server_TwoEventsTab.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -91,7 +91,7 @@ output$time_definition=renderTable(
output$main_heatmap=renderPlotly({
req(input$select_source,input$select_target)
#first_stats()%>%heatmap_firstact()%>%draw()
first_stats()%>%heatmap_firstact()%>%layout(width=800, height=200)
first_stats()%>%heatmap_firstact()%>%layout(width=800, height=350)

})

Expand All @@ -108,11 +108,12 @@ output$logFC=renderggiraph({
req(topstats())
if(input$wtf!='Histopathology'){
g=ggplot(topstats()%>%order_rdose_levels()%>%mutate(condition=paste0(COMPOUND_NAME,' (', rDOSE_LEVEL,')')),
aes(class,logFC))+
aes(class,abs(logFC)))+
geom_boxplot(outlier.shape = NA)+
facet_wrap(~stringr::str_wrap(event, width = 20), ncol = 4)+
geom_jitter_interactive(aes(tooltip = condition, data_id = condition, color=class),
width=0.3, alpha=0.8)+
ylab('absolute logFC')+
theme_bw()+
scale_color_viridis_d(begin=0.2)+
theme(axis.text.x = element_blank(), axis.title.x = element_blank(), axis.ticks.x =element_blank())
Expand Down
2 changes: 1 addition & 1 deletion sub/2_ui_TwoEventsTab.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,7 @@ tabPanel(
tabPanel(
title='Individual time series',
h5('Heatmap'),
plotlyOutput("main_heatmap", height = "5%")%>%
plotlyOutput("main_heatmap", height = "10%")%>%
withSpinner(color="#F25D18"),
h5('Color legend'),
tableOutput("time_definition"),
Expand Down
55 changes: 25 additions & 30 deletions sub/global.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,6 @@ library(shinyjs)
library(shiny)
library(shinyWidgets)
library(shinyBS)
library(ComplexHeatmap)
library(cowplot)
library(plotly)
library(DT)
Expand All @@ -26,7 +25,6 @@ get_topstats=function(topact, conds){
}

n_ts_per_event=readRDS('files/n_ts_per_event.rds')
n_ts_per_event_freq=readRDS('files/n_ts_per_event_freq.rds')

adverse_cond=c("Biliary Hyperplasia (low)",
"Biliary Hyperplasia (null)",
Expand All @@ -38,7 +36,7 @@ adverse_cond=c("Biliary Hyperplasia (low)",
"Hepatocellular Single Cell Necrosis (low)",
"Hepatocellular Single Cell Necrosis (null)",
"Increased Hepatocellular Mitosis (high)",
"Inflammation (high","Inflammation (low)")
"Inflammation (high)","Inflammation (low)")
####Two events####
summarise_to_stats=function(source_events, target_events, select_source,select_target){
df_new=source_events%>%
Expand Down Expand Up @@ -81,7 +79,7 @@ summarise_to_stats=function(source_events, target_events, select_source,select_t
return(df_new)
}
heatmap_firstact=function(df){
library(ComplexHeatmap)
# library(ComplexHeatmap)
library(RColorBrewer)
rownames(df)=NULL
m_source=df%>%mutate(condition=paste0(COMPOUND_NAME, ' (',rDOSE_LEVEL,')'))%>%
Expand Down Expand Up @@ -122,15 +120,11 @@ plot_hist=function(eventclass,select_event,type){

g=ggplot(df, aes(n))+
geom_histogram(binwidth = 1, fill=grey(0.6))+
# geom_text_repel(data=df%>%filter(event %in% select_event),aes(x=n, label=event), y=-0.005*n_ts_per_event_freq[[eventclass]], min.segment.length = 0.001)+
# geom_segment(data=df%>%filter(event %in% select_event),aes(x=n, xend=n,label=event), y=-0.005*n_ts_per_event_freq[[eventclass]], yend=0)+
geom_point_interactive(data=df%>%filter(event %in% select_event),aes(x=n,tooltip = event, data_id = event ), y=0)+
# geom_vline(xintercept = df%>%.$n, color='red')+
xlab(paste0('Number of time-series with \n ',eventclass,' event'))+
# ylim(-0.013*n_ts_per_event_freq[[eventclass]],NA)+
theme_minimal()+
ggtitle(paste0('Frequency of\ ',type,'\ events'))
girafe(ggobj = g,width_svg = 3,height_svg = 3,
girafe(ggobj = g,width_svg = 5,height_svg = 3,
options = list(opts_hover_inv(css = "opacity:0.5"),
opts_hover(css = "fill:wheat;stroke:orange;r:6pt;"),
opts_selection(type = "single")
Expand Down Expand Up @@ -187,7 +181,7 @@ get_stats=function(source,top_events, select_target,bg_target, include_same_time
df_act_freq=df_act%>%
filter_by_temporal_relation(df = ., include_same_time)%>%
group_by(event,direction)%>%
summarise(active=n())
summarise(TP=n())
n_act_freq=df_act%>%select(COMPOUND_NAME, rDOSE_LEVEL)%>%unique()%>%nrow()
###Background###
df_not_in_bg_cond=firstact$Histopathology%>%
Expand All @@ -205,31 +199,32 @@ get_stats=function(source,top_events, select_target,bg_target, include_same_time
select(COMPOUND_NAME, rDOSE_LEVEL, event, direction)%>%
unique()%>%
group_by(event,direction)%>%
summarise(bg=n())
summarise(FP=n())

n_bg_freq=df_bg%>%select(COMPOUND_NAME, rDOSE_LEVEL)%>%unique()%>%nrow()
df_result=left_join(df_act_freq,df_bg_freq)%>%
ungroup()%>%
rowwise()%>%
mutate(n_cond_bg=n_bg_freq, n_cond_active=n_act_freq, bg=ifelse(is.na(bg),0,bg))%>%
mutate('ratio_active'=active/n_cond_active,
'ratio_bg'=bg/n_cond_bg,
'jaccard'=active/(n_cond_active+bg),
'TPR'=active/n_cond_active,
'PPV'=active/(active+bg),
'n_active_total'=n_act_freq,
'n_bg_total'=n_bg_freq)%>%
mutate('lift'=(active/(n_cond_active+n_cond_bg))/(n_cond_active/(n_cond_bg+n_cond_active)*((active+bg)/(n_cond_bg+n_cond_active))))%>%
mutate('odds_ratio'=get_enrichment_directional(Yes = active,
notactive_yes = bg,
No = n_cond_active-active,
notactive_no = n_cond_bg-bg
)$estimate,
'pval'=get_enrichment_directional(Yes = active,
notactive_yes = bg,
No = n_cond_active-active,
notactive_no = n_cond_bg-bg
)$p.value)%>%select(-n_cond_bg, -n_cond_active)%>%
mutate(n_LE_absent=n_bg_freq, n_LE_present=n_act_freq, FP=ifelse(is.na(FP),0,FP))%>%
mutate('Odds Ratio'=get_enrichment_directional(Yes = TP,
notactive_yes = FP,
No = n_LE_present-TP,
notactive_no = n_LE_absent-FP
)$estimate,
'pval'=get_enrichment_directional(Yes = TP,
notactive_yes = FP,
No = n_LE_present-TP,
notactive_no = n_LE_absent-FP
)$p.value)%>%
mutate(
'FPR'=FP/n_LE_absent,
'TPR'=TP/n_LE_present,
'Jaccard'=TP/(n_LE_present+FP),
'PPV'=TP/(TP+FP),
'n_LE_present'=n_LE_present,
'n_LE_absent'=n_LE_absent)%>%
mutate('Lift'=(TP)/(n_LE_present*(TP+FP))*(n_LE_absent+n_LE_present))%>%
select(-n_LE_absent, -n_LE_present)%>%
arrange(pval)
if(source!='Histopathology'){
df_result=df_result%>%
Expand Down

0 comments on commit c800d18

Please sign in to comment.