Probability of HIV infection in Men or transgender women who have sex with other men
Something to describe here
Men/transgender women who have sex with other men 1
Men/transgender women who have sex with other men 2
Men/transgender women who have sex with other men 3
Men/transgender women who have sex with other men 4
Kaplan Meier plot
Probability of acquiring HIV over time
Probability of HIV infection in Young Women at Risk
Something to describe here
Young women at high risk 1
Young women at high risk 2
Young women at high risk 3
Young women at high risk 4
Kaplan Meier plot
Probability of acquiring HIV over time
Probability of HIV infection in people who inject drugs
Something to describe here
People who inject drugs 1
People who inject drugs 2
People who inject drugs 3
People who inject drugs 4
Kaplan Meier plot
Probability of acquiring HIV over time
Probability of HIV infection in HIV negative partner in HIV-serodiscordant heterosexual couples
Something to describe here
HIV negative partner in HIV-serodiscordant heterosexual couples 1
HIV negative partner in HIV-serodiscordant heterosexual couples 2
HIV negative partner in HIV-serodiscordant heterosexual couples 3
HIV negative partner in HIV-serodiscordant heterosexual couples 4
Kaplan Meier plot
Probability of acquiring HIV over time
Probability of HIV infection
Something to describe here
Men/transgender women who have sex with other men
People who inject drugs
Young women at high risk
HIV negative partner in HIV-serodiscordant heterosexual couples
Kaplan Meier plot
Probability of acquiring HIV over time
model.txt
[LONGITUDINAL]
input = {alpha, pardfrq, parsex,sex, frq,parage, age, parcrai,nocondom, parsyp,syphilis,parmar,parhsv,parage2,parmppso,parfin,parchild,mar,hsv,mppso,fin,child,parageL,parageH,parsex2,parchild2,age2,age3,child2,sex2,alpha2,alpha3,alpha4}
EQUATION:
CRAI=1+nocondom*parcrai
SYP=1+syphilis*parsyp
AGE=1+parage*(age-24)
ALP=alpha*CRAI*SYP*AGE
h = ALP
ddt_H=h
S=exp(-H)
SEX=1+sex*parsex
DFRQ=1+frq*pardfrq
ALP2=alpha2*DFRQ*SEX
h2 = ALP2
ddt_H2=h2
S2=exp(-H2)
MAR=1+mar*parmar
HSV=1+hsv*parhsv
AGE_2=1+parage2*(age2-24)
MPPSO=1+mppso*parmppso
FIN=1+fin*parfin
CHILD_2=1+parchild*(child-1)
ALP3=alpha3*MAR*HSV*AGE_2*MPPSO*FIN*CHILD_2
h3 = ALP3
ddt_H3=h3
S3=exp(-H3)
if age3<34
AGE_3=1+parageL*(age3-34)
else
AGE_3=1+parageH*(age3-34)
end
CHILD_3=1+parchild2*(child2-3)
SEX_2=1+sex2*parsex2
ALP4=alpha4*AGE_3*SEX_2*CHILD_3
h4 = ALP4
ddt_H4=h4
S4=exp(-H4)
ui.R
library(shinydashboard)
sidebar <- dashboardSidebar(
tags$style("@import url(https://use.fontawesome.com/releases/v5.14.0/css/all.css);"),
hr(),
sidebarMenu(id="tabs",
menuItem("About", tabName = "about", icon = icon("list-alt")),
menuItem("Between populations", tabName = "between_populations_page", icon = icon("people-arrows", lib = "font-awesome"), selected = T),
menuItem("Within populations", tabName = "plot", icon = icon("sync-alt"),
menuSubItem("Men/transgender women who have sex with other men", tabName = "msm_page", icon = icon("angle-right")),
menuSubItem("People who inject drugs", tabName = "inj_page", icon = icon("angle-right")),
menuSubItem("Young women at high risk", tabName = "ywomen_page", icon = icon("angle-right")),
menuSubItem("HIV negative partner in HIV-serodiscordant heterosexual couples", tabName = "partners_page", icon = icon("angle-right"))),
menuItem("Acknowledgement", tabName = "ack", icon = icon("fas fa-user-friends")),
menuItem("Citation", tabName = "cite", icon = icon("fas fa-share-alt")),
menuItem("Codes", icon = icon("file-text-o"),
menuSubItem("Mlxtran", tabName = "mlxtran", icon = icon("angle-right")),
menuSubItem("ui.R", tabName = "ui", icon = icon("angle-right")),
menuSubItem("server.R", tabName = "server", icon = icon("angle-right")),
menuSubItem("shinymlxTools.R", tabName = "tools", icon = icon("angle-right"))
)
),
hr(),
menuItem("Advanced Risk Options", icon = icon("vial"),
numericInput("p_lower_risk", label = "Define lower risk limit",value=0.01,min=0,max=1,step=0.05),
numericInput("p_higher_risk", label = "Define higher risk limit",value=0.05,min=0,max=1,step=0.05),
numericInput("time_risk", label = "Define time of risk (days)",value=364,min=0,max=150*7,step=28)
),
hr()
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "msm_page",
fluidRow(
box(width = 12, title = "Probability of HIV infection in Men or transgender women who have sex with other men", collapsed = T, collapsible = T,
"Something to describe here"),
valueBoxOutput("vbox_group_msm1", width = 3
),
valueBoxOutput("vbox_group_msm2", width = 3
),
valueBoxOutput("vbox_group_msm3", width = 3
),
valueBoxOutput("vbox_group_msm4", width = 3
),
box(width = 3, height = 520, solidHeader = T, status = "primary", title="Men/transgender women who have sex with other men 1", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S"),
numericInput("age_msm1", label="Age",value=24,min=18,max=47,step=1),
selectInput("nocondom_msm1", label="Condomless receptive anal intercourse in the past 3 months", choices=c(No=1,Yes=0)),
selectInput("syphilis_msm1", label="Siphilis Seroreactivity", choices=c(Negative=0,Positive=1))
),box(width = 3, height = 520, solidHeader = T, status = "warning", title="Men/transgender women who have sex with other men 2", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S"),
numericInput("age_msm2", label="Age",value=24,min=18,max=47,step=1),
selectInput("nocondom_msm2", label="Condomless receptive anal intercourse in the past 3 months", choices=c(No=1,Yes=0), selected = 1),
selectInput("syphilis_msm2", label="Siphilis Seroreactivity", choices=c(Negative=0,Positive=1))
),box(width = 3, height = 520, solidHeader = T, status = "success", title="Men/transgender women who have sex with other men 3", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S"),
numericInput("age_msm3", label="Age",value=24,min=18,max=47,step=1),
selectInput("nocondom_msm3", label="Condomless receptive anal intercourse in the past 3 months", choices=c(No=1,Yes=0)),
selectInput("syphilis_msm3", label="Siphilis Seroreactivity", choices=c(Negative=0,Positive=1), selected = 1)
),box(width = 3, height = 520, solidHeader = T, status = "danger", title="Men/transgender women who have sex with other men 4", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S"),
numericInput("age_msm4", label="Age",value=24,min=18,max=47,step=1),
selectInput("nocondom_msm4", label="Condomless receptive anal intercourse in the past 3 months", choices=c(No=1,Yes=0), selected = 1),
selectInput("syphilis_msm4", label="Siphilis Seroreactivity", choices=c(Negative=0,Positive=1), selected = 1)
),
box(width = 6, height=750, title="Kaplan Meier plot",solidHeader = TRUE,
#tags$style(HTML(".selectize-input [data-value=c(\'S\',\'S2\',\'S3\',\'S4\'] {background:c(red,blue) }")),
splitLayout(cellWidths = c("15%", "85%"), checkboxGroupInput("legendOutput_msm1", label = "Plot:",
choiceNames = list(HTML('<span class="foo blue"></span>MoWSM 1'),
HTML('<span class="foo purple"></span>MoWSM 2'),
HTML('<span class="foo orange"></span>MoWSM 3'),
HTML('<span class="foo navy"></span>MoWSM 4')),
choiceValues = c('S_msm1', 'S_msm2', 'S_msm3', 'S_msm4'),
selected=c('S_msm1', 'S_msm2', 'S_msm3', 'S_msm4'),inline = F),
plotOutput("plot1_msm", height = 900)
)),
box(width = 6, height=750, title="Probability of acquiring HIV over time",solidHeader = TRUE,
#tags$style(HTML(".selectize-input [data-value=c(\'S\',\'S2\',\'S3\',\'S4\'] {background:c(red,blue) }")),
splitLayout(cellWidths = c("15%", "85%"), checkboxGroupInput("legendOutput_msm2", label = "Plot:",
choiceNames = list(HTML('<span class="foo blue"></span>MoWSM 1'),
HTML('<span class="foo purple"></span>MoWSM 2'),
HTML('<span class="foo orange"></span>MoWSM 3'),
HTML('<span class="foo navy"></span>MoWSM 4')),
choiceValues = c('S_msm1', 'S_msm2', 'S_msm3', 'S_msm4'),
selected=c('S_msm1', 'S_msm2', 'S_msm3', 'S_msm4'),inline = F),
plotOutput("plot2_msm", height = 900)
))
)
),
tabItem(tabName = "ywomen_page",
fluidRow(
box(width = 12, title = "Probability of HIV infection in Young Women at Risk", collapsed = T, collapsible = T,
"Something to describe here"),
valueBoxOutput("vbox_group_yw1", width = 3
),
valueBoxOutput("vbox_group_yw2", width = 3
),
valueBoxOutput("vbox_group_yw3", width = 3
),
valueBoxOutput("vbox_group_yw4", width = 3
),
box(width = 3, height = 520, solidHeader = T, status = "primary", title="Young women at high risk 1", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S3"),
numericInput("age_yw1", label="Age",value=24,min=18,max=47,step=1),
selectInput("mar_yw1", label="Marital status", choices=c(Single=0,Married=1), selected = 1)
,
selectInput("hsv_yw1", label="HSV2", choices=c(Negative=0,Positive=1)),
selectInput("mppso_yw1", label="Partner has other sex partners", choices=c(Yes=0,No=1))
,
selectInput("fin_yw1", label="Financial support", choices=c(Yes=0,No=1)),
numericInput("child_yw1", label="Number of children",value=1,min=0,max=9,step=1)
),
box(width = 3, height = 520, solidHeader = T, status = "warning", title="Young women at high risk 2", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S3"),
numericInput("age_yw2", label="Age",value=24,min=18,max=47,step=1),
selectInput("mar_yw2", label="Marital status", choices=c(Single=0,Married=1))
,
selectInput("hsv_yw2", label="HSV2", choices=c(Negative=0,Positive=1)),
selectInput("mppso_yw2", label="Partner has other sex partners", choices=c(Yes=0,No=1), selected = 1)
,
selectInput("fin_yw2", label="Financial support", choices=c(Yes=0,No=1)),
numericInput("child_yw2", label="Number of children",value=1,min=0,max=9,step=1)
),
box(width = 3, height = 520, solidHeader = T, status = "success", title="Young women at high risk 3", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S3"),
numericInput("age_yw3", label="Age",value=24,min=18,max=47,step=1),
selectInput("mar_yw3", label="Marital status", choices=c(Single=0,Married=1), selected = 1)
,
selectInput("hsv_yw3", label="HSV2", choices=c(Negative=0,Positive=1)),
selectInput("mppso_yw3", label="Partner has other sex partners", choices=c(Yes=0,No=1), selected = 1)
,
selectInput("fin_yw3", label="Financial support", choices=c(Yes=0,No=1)),
numericInput("child_yw3", label="Number of children",value=1,min=0,max=9,step=1)
),
box(width = 3, height = 520, solidHeader = T, status = "danger", title="Young women at high risk 4", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S3"),
numericInput("age_yw4", label="Age",value=24,min=18,max=47,step=1),
selectInput("mar_yw4", label="Marital status", choices=c(Single=0,Married=1))
,
selectInput("hsv_yw4", label="HSV2", choices=c(Negative=0,Positive=1)),
selectInput("mppso_yw4", label="Partner has other sex partners", choices=c(Yes=0,No=1))
,
selectInput("fin_yw4", label="Financial support", choices=c(Yes=0,No=1)),
numericInput("child_yw4", label="Number of children",value=1,min=0,max=9,step=1)
),
box(width = 6, height=750, title="Kaplan Meier plot",solidHeader = TRUE,
#tags$style(HTML(".selectize-input [data-value=c(\'S\',\'S2\',\'S3\',\'S4\'] {background:c(red,blue) }")),
splitLayout(cellWidths = c("15%", "85%"), checkboxGroupInput("legendOutput_yw1", label = "Plot:",
choiceNames = list(HTML('<span class="foo blue"></span>YW1'),
HTML('<span class="foo purple"></span>YW2'),
HTML('<span class="foo orange"></span>YW3'),
HTML('<span class="foo navy"></span>YW4')),
choiceValues = c('S_yw1', 'S_yw2', 'S_yw3', 'S_yw4'),
selected=c('S_yw1', 'S_yw2', 'S_yw3', 'S_yw4'),inline = F),
plotOutput("plot1_yw", height = 900)
)),
box(width = 6, height=750, title="Probability of acquiring HIV over time",solidHeader = TRUE,
#tags$style(HTML(".selectize-input [data-value=c(\'S\',\'S2\',\'S3\',\'S4\'] {background:c(red,blue) }")),
splitLayout(cellWidths = c("15%", "85%"), checkboxGroupInput("legendOutput_yw2", label = "Plot:",
choiceNames = list(HTML('<span class="foo blue"></span>YW1'),
HTML('<span class="foo purple"></span>YW2'),
HTML('<span class="foo orange"></span>YW3'),
HTML('<span class="foo navy"></span>YW4')),
choiceValues = c('S_yw1', 'S_yw2', 'S_yw3', 'S_yw4'),
selected=c('S_yw1', 'S_yw2', 'S_yw3', 'S_yw4'),inline = F),
plotOutput("plot2_yw", height = 900)
))
)
),
tabItem(tabName = "inj_page",
fluidRow(
box(width = 12, title = "Probability of HIV infection in people who inject drugs", collapsed = T, collapsible = T,
"Something to describe here"),
valueBoxOutput("vbox_group_inj1", width = 3
),
valueBoxOutput("vbox_group_inj2", width = 3
),
valueBoxOutput("vbox_group_inj3", width = 3
),
valueBoxOutput("vbox_group_inj4", width = 3
),
box(width = 3, height = 520,solidHeader = T, status = "primary", title="People who inject drugs 1", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S2"),
selectInput("sex_injd1", label="Sex at birth", choices=c(Male=0,Female=1), selected = 1),
selectInput("frq_injd1", label="Injection frequency in the past 3 months", choices=c(Weekly=0,Daily=1))
),
box(width = 3, height = 520,solidHeader = T, status = "warning", title="People who inject drugs 2", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S2"),
selectInput("sex_injd2", label="Sex at birth", choices=c(Male=0,Female=1)),
selectInput("frq_injd2", label="Injection frequency in the past 3 months", choices=c(Weekly=0,Daily=1))
),
box(width = 3, height = 520,solidHeader = T, status = "success", title="People who inject drugs 3", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S2"),
selectInput("sex_injd3", label="Sex at birth", choices=c(Male=0,Female=1), selected = 1),
selectInput("frq_injd3", label="Injection frequency in the past 3 months", choices=c(Weekly=0,Daily=1), selected = 1)
),
box(width = 3, height = 520,solidHeader = T, status = "danger", title="People who inject drugs 4", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S2"),
selectInput("sex_injd4", label="Sex at birth", choices=c(Male=0,Female=1)),
selectInput("frq_injd4", label="Injection frequency in the past 3 months", choices=c(Weekly=0,Daily=1), selected = 1)
),
box(width = 6, height=750, title="Kaplan Meier plot",solidHeader = TRUE,
#tags$style(HTML(".selectize-input [data-value=c(\'S\',\'S2\',\'S3\',\'S4\'] {background:c(red,blue) }")),
splitLayout(cellWidths = c("15%", "85%"), checkboxGroupInput("legendOutput_injd1", label = "Plot:",
choiceNames = list(HTML('<span class="foo blue"></span>InjDrug 1'),
HTML('<span class="foo purple"></span>InjDrug 2'),
HTML('<span class="foo orange"></span>InjDrug 3'),
HTML('<span class="foo navy"></span>InjDrug 4')),
choiceValues = c('S_injd1', 'S_injd2', 'S_injd3', 'S_injd4'),
selected=c('S_injd1', 'S_injd2', 'S_injd3', 'S_injd4'),inline = F),
plotOutput("plot1_inj", height = 900)
)),
box(width = 6, height=750, title="Probability of acquiring HIV over time",solidHeader = TRUE,
#tags$style(HTML(".selectize-input [data-value=c(\'S\',\'S2\',\'S3\',\'S4\'] {background:c(red,blue) }")),
splitLayout(cellWidths = c("15%", "85%"), checkboxGroupInput("legendOutput_injd2", label = "Plot:",
choiceNames = list(HTML('<span class="foo blue"></span>InjDrug 1'),
HTML('<span class="foo purple"></span>InjDrug 2'),
HTML('<span class="foo orange"></span>InjDrug 3'),
HTML('<span class="foo navy"></span>InjDrug 4')),
choiceValues = c('S_injd1', 'S_injd2', 'S_injd3', 'S_injd4'),
selected=c('S_injd1', 'S_injd2', 'S_injd3', 'S_injd4'),inline = F),
plotOutput("plot2_inj", height = 900)
))
)
),
tabItem(tabName = "partners_page",
fluidRow(
box(width = 12, title = "Probability of HIV infection in HIV negative partner in HIV-serodiscordant heterosexual couples", collapsed = T, collapsible = T,
"Something to describe here"),
valueBoxOutput("vbox_group_p1", width = 3
),
valueBoxOutput("vbox_group_p2", width = 3
),
valueBoxOutput("vbox_group_p3", width = 3
),
valueBoxOutput("vbox_group_p4", width = 3
),
box(width = 3,height = 520, solidHeader = T, status = "primary", title="HIV negative partner in HIV-serodiscordant heterosexual couples 1", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S4"),
numericInput("age_p1", label="Age",value=34,min=18,max=43,step=1),
selectInput("sex_p1", label="Sex at birth", choices=c(Male=0,Female=1), selected = 1),
numericInput("child_p1", label="Number of children",value=3,min=0,max=20,step=1)
),
box(width = 3,height = 520, solidHeader = T, status = "warning", title="HIV negative partner in HIV-serodiscordant heterosexual couples 2", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S4"),
numericInput("age_p2", label="Age",value=34,min=18,max=43,step=1),
selectInput("sex_p2", label="Sex at birth", choices=c(Male=0,Female=1)),
numericInput("child_p2", label="Number of children",value=3,min=0,max=20,step=1)
),
box(width = 3,height = 520, solidHeader = T, status = "success", title="HIV negative partner in HIV-serodiscordant heterosexual couples 3", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S4"),
numericInput("age_p3", label="Age",value=34,min=18,max=43,step=1),
selectInput("sex_p3", label="Sex at birth", choices=c(Male=0,Female=1), selected = 1),
numericInput("child_p3", label="Number of children",value=0,min=0,max=20,step=1)
),
box(width = 3,height = 520, solidHeader = T, status = "danger", title="HIV negative partner in HIV-serodiscordant heterosexual couples 4", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S4"),
numericInput("age_p4", label="Age",value=34,min=18,max=43,step=1),
selectInput("sex_p4", label="Sex at birth", choices=c(Male=0,Female=1)),
numericInput("child_p4", label="Number of children",value=0,min=0,max=20,step=1)
),
box(width = 6, height=750, title="Kaplan Meier plot",solidHeader = TRUE,
#tags$style(HTML(".selectize-input [data-value=c(\'S\',\'S2\',\'S3\',\'S4\'] {background:c(red,blue) }")),
splitLayout(cellWidths = c("15%", "85%"), checkboxGroupInput("legendOutput_p1", label = "Plot:",
choiceNames = list(HTML('<span class="foo blue"></span>Partners 1'),
HTML('<span class="foo purple"></span>Partners 2'),
HTML('<span class="foo orange"></span>Partners 3'),
HTML('<span class="foo navy"></span>Partners 4')),
choiceValues = c('S_p1', 'S_p2', 'S_p3', 'S_p4'),
selected=c('S_p1', 'S_p2', 'S_p3', 'S_p4'),inline = F),
plotOutput("plot1_p", height = 900)
)),
box(width = 6, height=750, title="Probability of acquiring HIV over time",solidHeader = TRUE,
#tags$style(HTML(".selectize-input [data-value=c(\'S\',\'S2\',\'S3\',\'S4\'] {background:c(red,blue) }")),
splitLayout(cellWidths = c("15%", "85%"), checkboxGroupInput("legendOutput_p2", label = "Plot:",
choiceNames = list(HTML('<span class="foo blue"></span>Partners 1'),
HTML('<span class="foo purple"></span>Partners 2'),
HTML('<span class="foo orange"></span>Partners 3'),
HTML('<span class="foo navy"></span>Partners 4')),
choiceValues = c('S_p1', 'S_p2', 'S_p3', 'S_p4'),
selected=c('S_p1', 'S_p2', 'S_p3', 'S_p4'),inline = F),
plotOutput("plot2_p", height = 900)
))
)
),
tabItem(tabName = "between_populations_page",
#fluidPage(
fluidRow(
#column(
# width = 4,
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "styles.css")
),
box(width = 12, title = "Probability of HIV infection", collapsed = T, collapsible = T,
"Something to describe here"),
#selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S"),
valueBoxOutput("vbox_group1", width = 3
),
valueBoxOutput("vbox_group2", width = 3
),
valueBoxOutput("vbox_group3", width = 3
),
valueBoxOutput("vbox_group4", width = 3
),
box(width = 3, height = 520, solidHeader = T, status = "primary", title="Men/transgender women who have sex with other men", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S"),
numericInput("age", label="Age",value=24,min=18,max=47,step=1),
selectInput("nocondom", label="Condomless receptive anal intercourse in the past 3 months", choices=c(No=1,Yes=0)),
selectInput("syphilis", label="Siphilis Seroreactivity", choices=c(Negative=0,Positive=1))
),
#box(width = 6, height=100, background = "blue", title=""),
box(width = 3, height = 520,solidHeader = T, status = "warning", title="People who inject drugs", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S2"),
selectInput("sex", label="Sex at birth", choices=c(Male=0,Female=1)),
selectInput("frq", label="Injection frequency in the past 3 months", choices=c(Weekly=0,Daily=1))
),
#box(width = 6, height=100, background = "yellow", title=""),
box(width = 3, height = 520, solidHeader = T, status = "success", title="Young women at high risk", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S3"),
numericInput("age2", label="Age",value=24,min=18,max=47,step=1),
selectInput("mar", label="Marital status", choices=c(Single=0,Married=1))
,
selectInput("hsv", label="HSV2", choices=c(Negative=0,Positive=1)),
selectInput("mppso", label="Partner has other sex partners", choices=c(Yes=0,No=1))
,
selectInput("fin", label="Financial support", choices=c(Yes=0,No=1)),
numericInput("child", label="Number of children",value=1,min=0,max=9,step=1)
),
#box(width = 6, height=100, background = "green", title=""),
box(width = 3,height = 520, solidHeader = T, status = "danger", title="HIV negative partner in HIV-serodiscordant heterosexual couples", collapsible = T,
# selectInput("out1", h4("Select population to plot"), choices=c('Men/transgender women who have sex with other men'='S','Injection drug users'='S2', 'Young women at high risk'='S3','HIV negative partner in HIV-serodiscordant heterosexual couples'='S4'),selected="S4"),
numericInput("age3", label="Age",value=34,min=18,max=43,step=1),
selectInput("sex2", label="Sex at birth", choices=c(Male=0,Female=1)),
numericInput("child2", label="Number of children",value=3,min=0,max=20,step=1)
)
,
#,
# box(width = 6, height=100, background = "red", title="")
#),
box(width = 6, height=750, title="Kaplan Meier plot",solidHeader = TRUE,
#tags$style(HTML(".selectize-input [data-value=c(\'S\',\'S2\',\'S3\',\'S4\'] {background:c(red,blue) }")),
splitLayout(cellWidths = c("20%", "80%"), checkboxGroupInput("legendOutput_1", label = "Plot:",
choiceNames = list(HTML('<span class="foo blue"></span>MoWSM'),
HTML('<span class="foo purple"></span>InjDrug'),
HTML('<span class="foo orange"></span>YWomen'),
HTML('<span class="foo navy"></span>Partners')),
choiceValues = c('S', 'S2', 'S3', 'S4'),
selected=c('S', 'S2', 'S3', 'S4'),inline = F),
plotOutput("plot1", height = 900)
)),
box(width = 6, height=750, title="Probability of acquiring HIV over time",solidHeader = TRUE,
#tags$style(HTML(".selectize-input [data-value=c(\'S\',\'S2\',\'S3\',\'S4\'] {background:c(red,blue) }")),
splitLayout(cellWidths = c("20%", "80%"), checkboxGroupInput("legendOutput_2", label = "Plot:",
choiceNames = list(HTML('<span class="foo blue"></span>MoWSM'),
HTML('<span class="foo purple"></span>InjDrug'),
HTML('<span class="foo orange"></span>YWomen'),
HTML('<span class="foo navy"></span>Partners')),
choiceValues = c('S', 'S2', 'S3', 'S4'),
selected=c('S', 'S2', 'S3', 'S4'),inline = F),
plotOutput("plot2", height = 900)
))
#),
)
),
tabItem(tabName = "mlxtran",
box( width = NULL, status = "primary", solidHeader = TRUE, title="model.txt",
pre(includeText("model.txt"))
)
),
tabItem(tabName = "ui",
box( width = NULL, status = "primary", solidHeader = TRUE, title="ui.R",
pre(includeText("ui.R"))
)
),
tabItem(tabName = "server",
box( width = NULL, status = "primary", solidHeader = TRUE, title="server.R",
pre(includeText("server.R"))
)
),
tabItem(tabName = "tools",
box( width = NULL, status = "primary", solidHeader = TRUE, title="server.R",
pre(includeText("shinymlxTools.R"))
)
),
tabItem(tabName = "cite",
box( width = 12,collapsible = FALSE, solidHeader = TRUE, title="Citation",
"Full methodology and results of this project was published in X. The paper is freely available for anyone to read, download, and distribute. To cite any of the results or code used from this website, please cite the original paper;")
),
tabItem(tabName = "ack",
box( width = 12,collapsible = FALSE, solidHeader = TRUE, title="Acknowledgements",
"We thank the contribution of the participants in the studies and the staff that worked on the trials.",
br(),
"This project was founded by PhRMA Foundation Postdoctoral Fellowship in Translational Medicine and
Therapeutics, and by the Bill and Melinda Gates Foundation, grant OPP1099837.")
),
tabItem(tabName = "about",
box(width = 12,collapsible = FALSE,
"Welcome to the UCSF HIV-risk tool developed by Savic Labs.",
br()),
box(width = 12,collapsible = FALSE, solidHeader = TRUE, title="PURPOSE",status = "success",
"This tool allows the user to explore the risk of HIV infection based on individual characteristics identified as significant predictors of HIV risk for key populations.",
br(),
br(),
"Using multivariate parametric time-to-event models, the time course of the probability of remaining HIV uninfected may be simulated in 4 different target populations at high risk of acquiring HIV:",
br(),
"- Men or transgender wome who have sex with other men",
br(),
"- People who inject drugs",
br(),
"- Young women at high sexual risk",
br(),
"- HIV negative partner in HIV-serodiscordant heterosexual couples",
br(),
br(),
"The tool serves as a companion interactive app for the manuscript: Modeling the probability of HIV infection over time in high risk seronegative participants receiving placebo in five randomized double-blind placebo-controlled HIV pre-exposure prophylaxis trials: a patient-level pooled analysis. [citation]",
br(),
"It could serve to stimulate conversation about HIV prevention and as an informational tool for assisting on efficient future trial planning.",
br()),
box(width = 12,collapsible = FALSE, solidHeader = TRUE, title="ABOUT",status = "primary",
"It was developed by integrating data from patients enrolled in the placebo arms of 5 phase III clinical studies that evaluated the efficacy of daily tenofovir treatment, administered with or without emtricitabine, as pre-exposure prophilaxis (PrEP) in target populations at high risk of HIV infection. These double-blind randomized clinical trials were iPrEx [NCT00458393], VOICE [NCT00705679], Partners PrEP [NCT00557245], BTS [NCT00119106] TDF2 [NCT00448669].",
br()),
box(width = 12,collapsible = FALSE, solidHeader = TRUE, title="HOW TO USE THIS APP",status="danger",
"The tool simulates different HIV risk profiles over time based on the selected individual characteristics. These profiles are shown as the probability of remaining HIV uninfected over time in a Kaplan Meier plot, or as the cumulative probability of acquiring HIV infection over time.",
br(),
br(),
"HIV risk over time can be compared between the key populations included or within the same key population by comparing four different individuals.",
br(),
br(),
"Between populations",
br(),
"1. For each population, select the characteristics of interest to the individual.",
br(),
"2. The simulated HIV risk profiles over time will be shown for each population.",
br(),
"3. These profiles will be identified as low, medium and high risk based on the risk stratification defined in “Advanced risk options” tab.",
br(),
br(),
"Within populations",
br(),
"1. Select the key population of interest.",
br(),
"2. Select the characteristics of interest for each individual profile.",
br(),
"3. HIV risk over time is simulated for these different profiles of the same target population.",
br(),
"4. These profiles will be identified as low, medium and high risk based on the risk stratification defined in “Advanced risk options” tab.",
br(),
br(),
"Advanced risk options",
br(),
"The definition of low, medium and high risk phenotypes can be set by the user in the “Advanced Risk Options” tab, by selecting the risk limits (probability of HIV infection) for low and high risk at a given time of follow up.",
br(),
"The default risk definition is based on the risk stratification explored in the accompanying manuscript, in which low risk is defined as <1% probability of acquiring HIV infection at 1 year of follow up, moderate as 1% to 5% probability and high risk as >5% probability.",
br()),
box(width = 12,collapsible = FALSE, solidHeader = TRUE, title="REFERENCES",status="warning",
"More information on the methods used are available at X (placebo paper citation)",
br(),
"iPrEx [NCT00458393] citation",
br(),
"VOICE [NCT00705679] citation",
br(),
"Partners PrEP [NCT00557245] citation",
br(),
"BTS [NCT00119106] citation",
br(),
"TDF2 [NCT00448669] citation",
br())
)
)
)
##Citation Section------
dashboardPage(
#skin = "black",
dashboardHeader(title = "HIV risk"),
sidebar,
body
)
server.R
library("mlxR")
library("gridExtra")
library("tidyr")
library("dplyr")
library("ggplot2")
source("shinymlxTools.R")
f <- list(name=c('S','S2', 'S3', 'S4'), time=seq(0,150,by=0.1))
f <- list(f)
nf <- length(f)
info <- info_res(f)
f_msm <- list(name=c('S_msm1','S_msm2', 'S_msm3', 'S_msm4'), time=seq(0,150,by=0.1))
f_msm <- list(f_msm)
f_yw <- list(name=c('S_yw1','S_yw2', 'S_yw3', 'S_yw4'), time=seq(0,150,by=0.1))
f_yw <- list(f_yw)
f_injd <- list(name=c('S_injd1','S_injd2', 'S_injd3', 'S_injd4'),
time=seq(0,150,by=0.1))
f_injd <- list(f_injd)
f_p <- list(name=c('S_p1','S_p2', 'S_p3', 'S_p4'),
time=seq(0,150,by=0.1))
f_p <- list(f_p)
color_values = c(
"S" = "#0073b7",
"S2" = "#800080",
"S3" = "#f47925",
"S4" = "#28314f",
"S_msm1" = "#0073b7",
"S_msm2" = "#800080",
"S_msm3" = "#f47925",
"S_msm4" = "#28314f",
"S_yw1" = "#0073b7",
"S_yw2" = "#800080",
"S_yw3" = "#f47925",
"S_yw4" = "#28314f",
"S_injd1" = "#0073b7",
"S_injd2" = "#800080",
"S_injd3" = "#f47925",
"S_injd4" = "#28314f",
"S_p1" = "#0073b7",
"S_p2" = "#800080",
"S_p3" = "#f47925",
"S_p4" = "#28314f"
)
server <- function(input, output) {
ref <- reactive({
input$butref
p <- list(name = c('alpha', 'parage', 'parcrai', 'parsyp', 'age', 'nocondom', 'syphilis', 'alpha2', 'pardfrq', 'parsex', 'sex', 'frq','alpha3','parmar','parhsv','parage2', 'parmppso','parfin','parchild','mar','hsv','age2','mppso','fin','child', 'alpha4', 'parageL', 'parageH','parsex2','parchild2','age3','sex2', 'child2'),
value = isolate(c(0.00103, -0.0305, -0.73, 0.64, input$age, as.numeric(input$nocondom), as.numeric(input$syphilis), 5e-04, 2.22, 2.33, as.numeric(input$sex), as.numeric(input$frq),0.001,-0.813,0.997,-0.068, -0.443,0.512,-0.162,as.numeric(input$mar),as.numeric(input$hsv),input$age2,as.numeric(input$mppso),as.numeric(input$fin),input$child,0.000166,-0.253,0.0579,0.742,-0.0828,input$age3,as.numeric(input$sex2),input$child2)))
r <- simulx( model = 'model.txt',
parameter = p,
output = f)
ref <- merge_res(r,f)
return(ref)
})
output_simulx_msm <- reactive({
p_msm <- list(name = c('alpha', 'parage', 'parcrai', 'parsyp',
'age_msm1', 'nocondom_msm1', 'syphilis_msm1',
'age_msm2', 'nocondom_msm2', 'syphilis_msm2',
'age_msm3', 'nocondom_msm3', 'syphilis_msm3',
'age_msm4', 'nocondom_msm4', 'syphilis_msm4'
),
value = c(0.00103, -0.0305, -0.73, 0.64,
input$age_msm1, as.numeric(input$nocondom_msm1), as.numeric(input$syphilis_msm1),
input$age_msm2, as.numeric(input$nocondom_msm2), as.numeric(input$syphilis_msm2),
input$age_msm3, as.numeric(input$nocondom_msm3), as.numeric(input$syphilis_msm3),
input$age_msm4, as.numeric(input$nocondom_msm4), as.numeric(input$syphilis_msm4)
))
output_simulx_msm <- simulx( model = 'model_msm.txt',
parameter = p_msm,
output = f_msm)
return(output_simulx_msm)
})
output_simulx_yw <- reactive({
p_yw <- list(name = c('alpha3', 'parmar', 'parhsv', 'parage2', 'parmppso', 'parfin', 'parchild',
'mar_yw1', 'hsv_yw1', 'age_yw1', 'mppso_yw1', 'fin_yw1', 'child_yw1',
'mar_yw2', 'hsv_yw2', 'age_yw2', 'mppso_yw2', 'fin_yw2', 'child_yw2',
'mar_yw3', 'hsv_yw3', 'age_yw3', 'mppso_yw3', 'fin_yw3', 'child_yw3',
'mar_yw4', 'hsv_yw4', 'age_yw4', 'mppso_yw4', 'fin_yw4', 'child_yw4'),
value = c(0.001,-0.813,0.997,-0.068,-0.443, 0.512, -0.162,
as.numeric(input$mar_yw1), as.numeric(input$hsv_yw1), as.numeric(input$age_yw1), as.numeric(input$mppso_yw1) , as.numeric(input$fin_yw1), as.numeric(input$child_yw1),
as.numeric(input$mar_yw2), as.numeric(input$hsv_yw2), as.numeric(input$age_yw2), as.numeric(input$mppso_yw2) , as.numeric(input$fin_yw2), as.numeric(input$child_yw2),
as.numeric(input$mar_yw3), as.numeric(input$hsv_yw3), as.numeric(input$age_yw3), as.numeric(input$mppso_yw3), as.numeric(input$fin_yw3), as.numeric(input$child_yw3),
as.numeric(input$mar_yw4), as.numeric(input$hsv_yw4), as.numeric(input$age_yw4), as.numeric(input$mppso_yw4) , as.numeric(input$fin_yw4), as.numeric(input$child_yw4)))
output_simulx_yw <- simulx( model = 'model_ywomen.txt',
parameter = p_yw,
output = f_yw)
return(output_simulx_yw)
})
output_simulx_injd <- reactive({
p_injd <- list(name = c('alpha2', 'pardfrq', 'parsex',
'sex_injd1', 'frq_injd1',
'sex_injd2', 'frq_injd2',
'sex_injd3', 'frq_injd3',
'sex_injd4', 'frq_injd4'
),
value = c(5e-04, 2.22, 2.33,
as.numeric(input$sex_injd1), as.numeric(input$frq_injd1),
as.numeric(input$sex_injd2), as.numeric(input$frq_injd2),
as.numeric(input$sex_injd3), as.numeric(input$frq_injd3),
as.numeric(input$sex_injd4), as.numeric(input$frq_injd4)))
output_simulx_injd <- simulx( model = 'model_inj_drug.txt',
parameter = p_injd,
output = f_injd)
return(output_simulx_injd)
})
output_simulx_p<- reactive({
p_p <- list(name = c('alpha4', 'parageL', 'parageH','parsex2','parchild2',
'age_p1', 'sex_p1', 'child_p1',
'age_p2','sex_p2', 'child_p2',
'age_p3','sex_p3', 'child_p3',
'age_p4','sex_p4', 'child_p4'
),
value = c(0.000166,-0.253,0.0579,0.742,-0.0828,
input$age_p1, as.numeric(input$sex_p1), input$child_p1,
input$age_p2, as.numeric(input$sex_p2), input$child_p2,
input$age_p3, as.numeric(input$sex_p3), input$child_p3,
input$age_p4, as.numeric(input$sex_p4), input$child_p4
))
output_simulx_p <- simulx(model = 'model_partners.txt',
parameter = p_p,
output = f_p)
return(output_simulx_p)
})
output_simulx <- reactive({
p <- list(name = c('alpha', 'parage', 'parcrai', 'parsyp', 'age', 'nocondom', 'syphilis', 'alpha2', 'pardfrq', 'parsex', 'sex', 'frq','alpha3','parmar','parhsv','parage2', 'parmppso','parfin','parchild','mar','hsv','age2','mppso','fin','child', 'alpha4', 'parageL', 'parageH','parsex2','parchild2','age3','sex2', 'child2'),
value = c(0.00103, -0.0305, -0.73, 0.64, input$age, as.numeric(input$nocondom), as.numeric(input$syphilis), 5e-04, 2.22, 2.33, as.numeric(input$sex), as.numeric(input$frq),0.001,-0.813,0.997,-0.068, -0.443,0.512,-0.162,as.numeric(input$mar),as.numeric(input$hsv),input$age2,as.numeric(input$mppso),as.numeric(input$fin),input$child,0.000166,-0.253,0.0579,0.742,-0.0828,input$age3,as.numeric(input$sex2),input$child2))
output_simulx <- simulx( model = 'model.txt',
parameter = p,
output = f)
return(output_simulx)
})
output$plot1 <- renderPlot(height = 500,
{
input_vector <- input$legendOutput_1 #c("S", "S2", "S3", "S4")
output_simulx=output_simulx()
output_sim <- bind_cols(output_simulx$S, output_simulx$S2, output_simulx$S3, output_simulx$S4) %>%
select(-time1, -time2, -time3) %>%
gather(2:5, key = surv, value = value) %>%
filter(surv %in% input_vector)
p_lower = as.numeric(input$p_lower_risk)
p_higher = as.numeric(input$p_higher_risk)
y_max_int <- output_sim %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2==150) %>%
summarise(max_surv = min(value))
min_y = y_max_int[1,1] - 0.05
min_x <- input$time_risk
risk_plot <- ggplot(output_sim, aes(time*7, value, color = surv)) +
#annotate(geom = "rect", ymin = -1, ymax = p_lower, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#53c1b0") + #green/blue
#annotate(geom = "rect",ymin = p_lower, ymax = p_higher, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#f8db5a") + #yellow
#annotate(geom = "rect",ymin = p_higher, ymax = 1, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#ed6a51") + #red
geom_line(size = 1) +
scale_x_continuous(breaks = seq(0, 150*7, 96))+
scale_color_manual(values = color_values)+
coord_cartesian(ylim = c(min_y, 1), xlim = c(0, 150*7))+
labs(x = "Time (days)", y = "HIV uninfected (%)")+
theme_bw()+
theme(
legend.position = "none"
)
print(risk_plot)
})
output$plot2 <- renderPlot(height = 500,
{
input_vector <- input$legendOutput_2 #c("S", "S2", "S3", "S4")
output_simulx=output_simulx()
output_sim <- bind_cols(output_simulx$S, output_simulx$S2, output_simulx$S3, output_simulx$S4) %>%
select(-time1, -time2, -time3) %>%
gather(2:5, key = surv, value = value) %>%
filter(surv %in% input_vector)
p_lower = as.numeric(input$p_lower_risk)
p_higher = as.numeric(input$p_higher_risk)
y_max_int <- output_sim %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2==150) %>%
summarise(max_surv = min(value))
max_y = 1-y_max_int[1,1]+0.05
min_x <- input$time_risk
risk_plot <- ggplot(output_sim, aes(time*7, 1 - value, color = surv)) +
annotate(geom = "rect", ymin = -1, ymax = p_lower, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#53c1b0") + #green/blue
annotate(geom = "rect",ymin = p_lower, ymax = p_higher, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#f8db5a") + #yellow
annotate(geom = "rect",ymin = p_higher, ymax = 1, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#ed6a51") + #red
geom_line(size = 1) +
scale_x_continuous(breaks = seq(0, 150*7, 96))+
scale_color_manual(values = color_values)+
coord_cartesian(ylim = c(0, max_y), xlim = c(0, 150*7))+
labs(x = "Time (days)", y = "Probability of HIV infection")+
theme_bw()+
theme(
legend.position = "none"
)
print(risk_plot)
}
)
output$vbox_group1 <- renderValueBox({
output_simulx=output_simulx()
output_s_risk <- output_simulx$S %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S
phrase_S1 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S1, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S1, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S1, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group2 <- renderValueBox({
output_simulx=output_simulx()
output_s_risk <- output_simulx$S2 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S2
phrase_S2 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S2, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S2,
"High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S2,
"Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group3 <- renderValueBox({
output_simulx=output_simulx()
output_s_risk <- output_simulx$S3 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S3
phrase_S3 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S3, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S3, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S3, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group4 <- renderValueBox({
output_simulx=output_simulx()
output_s_risk <- output_simulx$S4 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S4
phrase_S4 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S4, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S4, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S4, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$plot1_msm <- renderPlot(height = 500,
{
input_vector <- input$legendOutput_msm1 #c("S", "S2", "S3", "S4")
output_simulx_msm=output_simulx_msm()
output_sim_msm <- bind_cols(output_simulx_msm$S_msm1, output_simulx_msm$S_msm2, output_simulx_msm$S_msm3, output_simulx_msm$S_msm4) %>%
select(-time1, -time2, -time3) %>%
gather(2:5, key = surv, value = value) %>%
filter(surv %in% input_vector)
p_lower = as.numeric(input$p_lower_risk)
p_higher = as.numeric(input$p_higher_risk)
y_max_int <- output_sim_msm %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2==150) %>%
summarise(max_surv = min(value))
min_y = y_max_int[1,1] - 0.05
min_x <- input$time_risk
risk_plot_msm <- ggplot(output_sim_msm, aes(time*7, value, color = surv)) +
#annotate(geom = "rect", ymin = -1, ymax = p_lower, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#53c1b0") + #green/blue
#annotate(geom = "rect",ymin = p_lower, ymax = p_higher, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#f8db5a") + #yellow
#annotate(geom = "rect",ymin = p_higher, ymax = 1, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#ed6a51") + #red
geom_line(size = 1) +
scale_x_continuous(breaks = seq(0, 150*7, 96))+
scale_color_manual(values = color_values)+
coord_cartesian(ylim = c(min_y, 1), xlim = c(0, 150*7))+
labs(x = "Time (days)", y = "HIV uninfected (%)")+
theme_bw()+
theme(
legend.position = "none"
)
print(risk_plot_msm)
})
output$plot2_msm <- renderPlot(height = 500,
{
input_vector <- input$legendOutput_msm2 #c("S", "S2", "S3", "S4")
output_simulx=output_simulx_msm()
output_sim <- bind_cols(output_simulx$S_msm1, output_simulx$S_msm2, output_simulx$S_msm3, output_simulx$S_msm4) %>%
select(-time1, -time2, -time3) %>%
gather(2:5, key = surv, value = value) %>%
filter(surv %in% input_vector)
p_lower = as.numeric(input$p_lower_risk)
p_higher = as.numeric(input$p_higher_risk)
y_max_int <- output_sim %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2==150) %>%
summarise(max_surv = min(value))
max_y = 1-y_max_int[1,1]+0.05
min_x <- input$time_risk
risk_plot <- ggplot(output_sim, aes(time*7, 1 - value, color = surv)) +
annotate(geom = "rect", ymin = -1, ymax = p_lower, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#53c1b0") + #green/blue
annotate(geom = "rect",ymin = p_lower, ymax = p_higher, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#f8db5a") + #yellow
annotate(geom = "rect",ymin = p_higher, ymax = 1, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#ed6a51") + #red
geom_line(size = 1) +
scale_x_continuous(breaks = seq(0, 150*7, 96))+
scale_color_manual(values = color_values)+
coord_cartesian(ylim = c(0, max_y), xlim = c(0, 150*7))+
labs(x = "Time (days)", y = "Probability of HIV infection")+
theme_bw()+
theme(
legend.position = "none"
)
print(risk_plot)
}
)
output$vbox_group_msm1 <- renderValueBox({
output_simulx_msm=output_simulx_msm()
output_s_risk <- output_simulx_msm$S_msm1 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_msm1
phrase_S1 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S1, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S1, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S1, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group_msm2 <- renderValueBox({
output_simulx_msm=output_simulx_msm()
output_s_risk <- output_simulx_msm$S_msm2 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_msm2
phrase_S2 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S2, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S2, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S2, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group_msm3 <- renderValueBox({
output_simulx_msm=output_simulx_msm()
output_s_risk <- output_simulx_msm$S_msm3 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_msm3
phrase_S3 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S3, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S3, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S3, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group_msm4 <- renderValueBox({
output_simulx_msm=output_simulx_msm()
output_s_risk <- output_simulx_msm$S_msm4 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_msm4
phrase_S4 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S4, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S4, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S4, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$plot1_yw <- renderPlot(height = 500,
{
input_vector <- input$legendOutput_yw1 #c("S", "S2", "S3", "S4")
output_simulx_yw=output_simulx_yw()
output_sim_yw <- bind_cols(output_simulx_yw$S_yw1, output_simulx_yw$S_yw2, output_simulx_yw$S_yw3, output_simulx_yw$S_yw4) %>%
select(-time1, -time2, -time3) %>%
gather(2:5, key = surv, value = value) %>%
filter(surv %in% input_vector)
p_lower = as.numeric(input$p_lower_risk)
p_higher = as.numeric(input$p_higher_risk)
y_max_int <- output_sim_yw %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2==150) %>%
summarise(max_surv = min(value))
min_y = y_max_int[1,1] - 0.05
min_x <- input$time_risk
risk_plot_yw <- ggplot(output_sim_yw, aes(time*7, value, color = surv)) +
#annotate(geom = "rect", ymin = -1, ymax = p_lower, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#53c1b0") + #green/blue
#annotate(geom = "rect",ymin = p_lower, ymax = p_higher, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#f8db5a") + #yellow
#annotate(geom = "rect",ymin = p_higher, ymax = 1, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#ed6a51") + #red
geom_line(size = 1) +
scale_x_continuous(breaks = seq(0, 150*7, 96))+
scale_color_manual(values = color_values)+
coord_cartesian(ylim = c(min_y, 1), xlim = c(0, 150*7))+
labs(x = "Time (days)", y = "HIV uninfected (%)")+
theme_bw()+
theme(
legend.position = "none"
)
print(risk_plot_yw)
})
output$plot2_yw <- renderPlot(height = 500,
{
input_vector <- input$legendOutput_yw2 #c("S", "S2", "S3", "S4")
output_simulx=output_simulx_yw()
output_sim <- bind_cols(output_simulx$S_yw1, output_simulx$S_yw2, output_simulx$S_yw3, output_simulx$S_yw4) %>%
select(-time1, -time2, -time3) %>%
gather(2:5, key = surv, value = value) %>%
filter(surv %in% input_vector)
p_lower = as.numeric(input$p_lower_risk)
p_higher = as.numeric(input$p_higher_risk)
y_max_int <- output_sim %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2==150) %>%
summarise(max_surv = min(value))
max_y = 1-y_max_int[1,1]+0.05
min_x <- input$time_risk
risk_plot_yw <- ggplot(output_sim, aes(time*7, 1 - value, color = surv)) +
annotate(geom = "rect", ymin = -1, ymax = p_lower, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#53c1b0") + #green/blue
annotate(geom = "rect",ymin = p_lower, ymax = p_higher, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#f8db5a") + #yellow
annotate(geom = "rect",ymin = p_higher, ymax = 1, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#ed6a51") + #red
geom_line(size = 1) +
scale_x_continuous(breaks = seq(0, 150*7, 96))+
scale_color_manual(values = color_values)+
coord_cartesian(ylim = c(0, max_y), xlim = c(0, 150*7))+
labs(x = "Time (days)", y = "Probability of HIV infection")+
theme_bw()+
theme(
legend.position = "none"
)
print(risk_plot_yw)
}
)
output$vbox_group_yw1 <- renderValueBox({
output_simulx_yw=output_simulx_yw()
output_s_risk <- output_simulx_yw$S_yw1 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_yw1
phrase_S1 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S1, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S1, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S1, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group_yw2 <- renderValueBox({
output_simulx_yw=output_simulx_yw()
output_s_risk <- output_simulx_yw$S_yw2 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_yw2
phrase_S2 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S2, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S2, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S2, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group_yw3 <- renderValueBox({
output_simulx_yw=output_simulx_yw()
output_s_risk <- output_simulx_yw$S_yw3 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_yw3
phrase_S3 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S3, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S3, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S3, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group_yw4<- renderValueBox({
output_simulx_yw=output_simulx_yw()
output_s_risk <- output_simulx_yw$S_yw4 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_yw4
phrase_S4 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S4, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S4, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S4, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$plot1_inj <- renderPlot(height = 500,
{
input_vector <- input$legendOutput_injd1 #c("S", "S2", "S3", "S4")
output_simulx_injd=output_simulx_injd()
output_sim_inj <- bind_cols(output_simulx_injd$S_injd1, output_simulx_injd$S_injd2, output_simulx_injd$S_injd3, output_simulx_injd$S_injd4) %>%
select(-time1, -time2, -time3) %>%
gather(2:5, key = surv, value = value) %>%
filter(surv %in% input_vector)
p_lower = as.numeric(input$p_lower_risk)
p_higher = as.numeric(input$p_higher_risk)
y_max_int <- output_sim_inj %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2==150) %>%
summarise(max_surv = min(value))
min_y = y_max_int[1,1] - 0.05
min_x <- input$time_risk
risk_plot_inj <- ggplot(output_sim_inj, aes(time*7, value, color = surv)) +
#annotate(geom = "rect", ymin = -1, ymax = p_lower, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#53c1b0") + #green/blue
#annotate(geom = "rect",ymin = p_lower, ymax = p_higher, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#f8db5a") + #yellow
#annotate(geom = "rect",ymin = p_higher, ymax = 1, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#ed6a51") + #red
geom_line(size = 1) +
scale_x_continuous(breaks = seq(0, 150*7, 96))+
scale_color_manual(values = color_values)+
coord_cartesian(ylim = c(min_y, 1), xlim = c(0, 150*7))+
labs(x = "Time (days)", y = "HIV uninfected (%)")+
theme_bw()+
theme(
legend.position = "none"
)
print(risk_plot_inj)
})
output$plot2_inj <- renderPlot(height = 500,
{
input_vector <- input$legendOutput_injd2 #c("S", "S2", "S3", "S4")
output_simulx=output_simulx_injd()
output_sim <- bind_cols(output_simulx$S_injd1, output_simulx$S_injd2, output_simulx$S_injd3, output_simulx$S_injd4) %>%
select(-time1, -time2, -time3) %>%
gather(2:5, key = surv, value = value) %>%
filter(surv %in% input_vector)
p_lower = as.numeric(input$p_lower_risk)
p_higher = as.numeric(input$p_higher_risk)
y_max_int <- output_sim %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2==150) %>%
summarise(max_surv = min(value))
max_y = 1-y_max_int[1,1]+0.05
min_x <- input$time_risk
risk_plot_inj2 <- ggplot(output_sim, aes(time*7, 1 - value, color = surv)) +
annotate(geom = "rect", ymin = -1, ymax = p_lower, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#53c1b0") + #green/blue
annotate(geom = "rect",ymin = p_lower, ymax = p_higher, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#f8db5a") + #yellow
annotate(geom = "rect",ymin = p_higher, ymax = 1, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#ed6a51") + #red
geom_line(size = 1) +
scale_x_continuous(breaks = seq(0, 150*7, 96))+
scale_color_manual(values = color_values)+
coord_cartesian(ylim = c(0, max_y), xlim = c(0, 150*7))+
labs(x = "Time (days)", y = "Probability of HIV infection")+
theme_bw()+
theme(
legend.position = "none"
)
print(risk_plot_inj2)
}
)
output$vbox_group_inj1 <- renderValueBox({
output_simulx_injd=output_simulx_injd()
output_s_risk <- output_simulx_injd$S_injd1 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_injd1
phrase_S1 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S1, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S1, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S1, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group_inj2 <- renderValueBox({
output_simulx_injd=output_simulx_injd()
output_s_risk <- output_simulx_injd$S_injd2 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_injd2
phrase_S2 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S2, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S2, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S2, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group_inj3 <- renderValueBox({
output_simulx_injd=output_simulx_injd()
output_s_risk <- output_simulx_injd$S_injd3 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_injd3
phrase_S3 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S3, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S3, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S3, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group_inj4<- renderValueBox({
output_simulx_injd=output_simulx_injd()
output_s_risk <- output_simulx_injd$S_injd4 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_injd4
phrase_S4 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S4, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S4, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S4, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$plot1_p <- renderPlot(height = 500,
{
input_vector <- input$legendOutput_p1 #c("S", "S2", "S3", "S4")
output_simulx_p=output_simulx_p()
output_sim_p <- bind_cols(output_simulx_p$S_p1, output_simulx_p$S_p2, output_simulx_p$S_p3, output_simulx_p$S_p4) %>%
select(-time1, -time2, -time3) %>%
gather(2:5, key = surv, value = value) %>%
filter(surv %in% input_vector)
p_lower = as.numeric(input$p_lower_risk)
p_higher = as.numeric(input$p_higher_risk)
y_max_int <- output_sim_p %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2==150) %>%
summarise(max_surv = min(value))
min_y = y_max_int[1,1] - 0.05
min_x <- input$time_risk
risk_plot_p <- ggplot(output_sim_p, aes(time*7, value, color = surv)) +
#annotate(geom = "rect", ymin = -1, ymax = p_lower, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#53c1b0") + #green/blue
#annotate(geom = "rect",ymin = p_lower, ymax = p_higher, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#f8db5a") + #yellow
#annotate(geom = "rect",ymin = p_higher, ymax = 1, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#ed6a51") + #red
geom_line(size = 1) +
scale_x_continuous(breaks = seq(0, 150*7, 96))+
scale_color_manual(values = color_values)+
coord_cartesian(ylim = c(min_y, 1), xlim = c(0, 150*7))+
labs(x = "Time (days)", y = "HIV uninfected (%)")+
theme_bw()+
theme(
legend.position = "none"
)
print(risk_plot_p)
})
output$plot2_p <- renderPlot(height = 500,
{
input_vector <- input$legendOutput_p2 #c("S", "S2", "S3", "S4")
output_simulx=output_simulx_p()
output_sim <- bind_cols(output_simulx$S_p1, output_simulx$S_p2, output_simulx$S_p3, output_simulx$S_p4) %>%
select(-time1, -time2, -time3) %>%
gather(2:5, key = surv, value = value) %>%
filter(surv %in% input_vector)
p_lower = as.numeric(input$p_lower_risk)
p_higher = as.numeric(input$p_higher_risk)
y_max_int <- output_sim %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2==150) %>%
summarise(max_surv = min(value))
max_y = 1-y_max_int[1,1]+0.05
min_x <- input$time_risk
risk_plot_p <- ggplot(output_sim, aes(time*7, 1 - value, color = surv)) +
annotate(geom = "rect", ymin = -1, ymax = p_lower, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#53c1b0") + #green/blue
annotate(geom = "rect",ymin = p_lower, ymax = p_higher, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#f8db5a") + #yellow
annotate(geom = "rect",ymin = p_higher, ymax = 1, xmin = min_x, xmax = 150*8, alpha=0.5, fill="#ed6a51") + #red
geom_line(size = 1) +
scale_x_continuous(breaks = seq(0, 150*7, 96))+
scale_color_manual(values = color_values)+
coord_cartesian(ylim = c(0, max_y), xlim = c(0, 150*7))+
labs(x = "Time (days)", y = "Probability of HIV infection")+
theme_bw()+
theme(
legend.position = "none"
)
print(risk_plot_p)
}
)
output$vbox_group_p1 <- renderValueBox({
output_simulx_p=output_simulx_p()
output_s_risk <- output_simulx_p$S_p1 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_p1
phrase_S1 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S1, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S1, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S1, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group_p2 <- renderValueBox({
output_simulx_p=output_simulx_p()
output_s_risk <- output_simulx_p$S_p2 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_p2
phrase_S2 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S2, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S2, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S2, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group_p3 <- renderValueBox({
output_simulx_p=output_simulx_p()
output_s_risk <- output_simulx_p$S_p3 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_p3
phrase_S3 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S3, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S3, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S3, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
output$vbox_group_p4 <- renderValueBox({
output_simulx_p=output_simulx_p()
output_s_risk <- output_simulx_p$S_p4 %>%
mutate(increment = 0.1) %>%
mutate(time_2 = round(time/increment)*increment) %>%
filter(time_2 == ceiling((input$time_risk)/7))
low_risk = input$p_lower_risk
high_risk = input$p_higher_risk
s_risk <- 1-output_s_risk$S_p4
phrase_S4 <- paste("Prob = ", prettyNum(s_risk*100, digits = 2), "%", sep = "")
if (s_risk<=low_risk)
{
valueBox(phrase_S4, "Low risk",
#icon = icon("thumbs-up"),
color = 'green')
}
else
if (s_risk>high_risk)
{
valueBox(phrase_S4, "High risk",
#icon = icon("thumbs-down"),
color = 'red')
}
else {
valueBox(phrase_S4, "Medium risk",
#icon = icon("exclamation-triangle"),
color = 'yellow')
}
})
}
server.R
gg_color_hue <- function(n) {
hues = seq(15, 375, length=n+1)
hcl(h=hues, l=65, c=100)[1:n]}
info_res <- function(f){
if (!is.null(names(f)))
f <- list(f)
nf <- length(f)
info <- list()
for (k in (1:nf)){
fk <- f[[k]]
nk <- length(fk$name)
lk <- as.character(1:nk)
valk <- gg_color_hue(nk)
names(valk) <- lk
labk <- fk$name
names(labk) <- lk
info[[k]] <- list(values=valk, labels=labk, colour=lk)
}
return(info)
}
merge_res <- function(r1,f){
r2 <- list()
nf <- length(f)
for (j in (1:nf)){
fj <- f[[j]]
nj <- length(fj$name)
r <- r1[[fj$name[1]]]
if (nj>1){
for (k in (2:nj)){
rk <- r1[[fj$name[k]]]
r <- merge(r,rk)
}
}
r2[[j]] <- r
}
return(r2)
}
Citation
Full methodology and results of this project was published in X. The paper is freely available for anyone to read, download, and distribute. To cite any of the results or code used from this website, please cite the original paper;
Acknowledgements
We thank the contribution of the participants in the studies and the staff that worked on the trials.
This project was founded by PhRMA Foundation Postdoctoral Fellowship in Translational Medicine and Therapeutics, and by the Bill and Melinda Gates Foundation, grant OPP1099837.
This project was founded by PhRMA Foundation Postdoctoral Fellowship in Translational Medicine and Therapeutics, and by the Bill and Melinda Gates Foundation, grant OPP1099837.
Welcome to the UCSF HIV-risk tool developed by Savic Labs.
PURPOSE
This tool allows the user to explore the risk of HIV infection based on individual characteristics identified as significant predictors of HIV risk for key populations.
Using multivariate parametric time-to-event models, the time course of the probability of remaining HIV uninfected may be simulated in 4 different target populations at high risk of acquiring HIV:
- Men or transgender wome who have sex with other men
- People who inject drugs
- Young women at high sexual risk
- HIV negative partner in HIV-serodiscordant heterosexual couples
The tool serves as a companion interactive app for the manuscript: Modeling the probability of HIV infection over time in high risk seronegative participants receiving placebo in five randomized double-blind placebo-controlled HIV pre-exposure prophylaxis trials: a patient-level pooled analysis. [citation]
It could serve to stimulate conversation about HIV prevention and as an informational tool for assisting on efficient future trial planning.
Using multivariate parametric time-to-event models, the time course of the probability of remaining HIV uninfected may be simulated in 4 different target populations at high risk of acquiring HIV:
- Men or transgender wome who have sex with other men
- People who inject drugs
- Young women at high sexual risk
- HIV negative partner in HIV-serodiscordant heterosexual couples
The tool serves as a companion interactive app for the manuscript: Modeling the probability of HIV infection over time in high risk seronegative participants receiving placebo in five randomized double-blind placebo-controlled HIV pre-exposure prophylaxis trials: a patient-level pooled analysis. [citation]
It could serve to stimulate conversation about HIV prevention and as an informational tool for assisting on efficient future trial planning.
ABOUT
It was developed by integrating data from patients enrolled in the placebo arms of 5 phase III clinical studies that evaluated the efficacy of daily tenofovir treatment, administered with or without emtricitabine, as pre-exposure prophilaxis (PrEP) in target populations at high risk of HIV infection. These double-blind randomized clinical trials were iPrEx [NCT00458393], VOICE [NCT00705679], Partners PrEP [NCT00557245], BTS [NCT00119106] TDF2 [NCT00448669].
HOW TO USE THIS APP
The tool simulates different HIV risk profiles over time based on the selected individual characteristics. These profiles are shown as the probability of remaining HIV uninfected over time in a Kaplan Meier plot, or as the cumulative probability of acquiring HIV infection over time.
HIV risk over time can be compared between the key populations included or within the same key population by comparing four different individuals.
Between populations
1. For each population, select the characteristics of interest to the individual.
2. The simulated HIV risk profiles over time will be shown for each population.
3. These profiles will be identified as low, medium and high risk based on the risk stratification defined in “Advanced risk options” tab.
Within populations
1. Select the key population of interest.
2. Select the characteristics of interest for each individual profile.
3. HIV risk over time is simulated for these different profiles of the same target population.
4. These profiles will be identified as low, medium and high risk based on the risk stratification defined in “Advanced risk options” tab.
Advanced risk options
The definition of low, medium and high risk phenotypes can be set by the user in the “Advanced Risk Options” tab, by selecting the risk limits (probability of HIV infection) for low and high risk at a given time of follow up.
The default risk definition is based on the risk stratification explored in the accompanying manuscript, in which low risk is defined as <1% probability of acquiring HIV infection at 1 year of follow up, moderate as 1% to 5% probability and high risk as >5% probability.
HIV risk over time can be compared between the key populations included or within the same key population by comparing four different individuals.
Between populations
1. For each population, select the characteristics of interest to the individual.
2. The simulated HIV risk profiles over time will be shown for each population.
3. These profiles will be identified as low, medium and high risk based on the risk stratification defined in “Advanced risk options” tab.
Within populations
1. Select the key population of interest.
2. Select the characteristics of interest for each individual profile.
3. HIV risk over time is simulated for these different profiles of the same target population.
4. These profiles will be identified as low, medium and high risk based on the risk stratification defined in “Advanced risk options” tab.
Advanced risk options
The definition of low, medium and high risk phenotypes can be set by the user in the “Advanced Risk Options” tab, by selecting the risk limits (probability of HIV infection) for low and high risk at a given time of follow up.
The default risk definition is based on the risk stratification explored in the accompanying manuscript, in which low risk is defined as <1% probability of acquiring HIV infection at 1 year of follow up, moderate as 1% to 5% probability and high risk as >5% probability.
REFERENCES
More information on the methods used are available at X (placebo paper citation)
iPrEx [NCT00458393] citation
VOICE [NCT00705679] citation
Partners PrEP [NCT00557245] citation
BTS [NCT00119106] citation
TDF2 [NCT00448669] citation
iPrEx [NCT00458393] citation
VOICE [NCT00705679] citation
Partners PrEP [NCT00557245] citation
BTS [NCT00119106] citation
TDF2 [NCT00448669] citation