I'm trying to create an app which allows the user to dynamically transform variables in a linear regression model to understand the impact that doing so has on regression diagnostics (residual plots etc.).
In the app below, you will see that the user has the option to log transform the target variable, and upon doing so, is presented with three types of log transformations to perform. This works fine with a single variable, but I'm trying to provide the ability to do so with the predictors as well. This gets particularly complicated because the number of predictors is not fixed and is based on a user's selection.
I recognize that one issue here is that I need to create a separate tabsetPanel for each predictor. For this reason, I created a function to create the tabsetPanel, which allows the user to specify the ID. This component of the app works fine, but when it comes time to try and render the dynamic parameter selections, to app doesn't function. Does anyone have any idea how to fix this? Apologies if the reproducible example below is a bit long - couldn't figure out a way to simplify without losing the scope of the general question.
## libraries
library(tidyverse)
library(shiny)
## stored data objects, including variable and transformation names
dat <- mtcars
var_names <- dat %>% select(1:3) %>% colnames %>% sort
tran_names <- c("None", "Logarithmic")
## create conditional UI for transformation parameters
param_select <- function(object_name) {
tabsetPanel(
id = object_name,
type = "hidden",
tabPanel("None",
fluidRow()),
tabPanel("Logarithmic",
fluidRow(column(width = 3,
selectInput(inputId = "log_param",
label = "Type:",
choices = c("Natural", "Base 2", "Base 10"))))))
}
## create base UI
ui <- fluidPage(
fluidRow(column(width = 2,
## input selector for target variable
selectInput(inputId = "target",
label = "Target Variable",
choices = var_names)),
column(width = 2,
## input selector for target variable transformation, excluding polynomials
selectInput(inputId = "target_trans",
label = "Select Transformation",
choices = tran_names %>% .[.!="Polynomial"])),
column(width = 8, param_select("params"))),
## input selector for number of predictors
numericInput(inputId = "preds_n",
label = "Select Number of Predictors",
value = 1,
min = 1,
max = length(var_names) - 1,
width = "190px"),
## stored layout for dynamic UI
fluidRow(column(width = 2, uiOutput("preds_ui")),
column(width = 2, uiOutput("pred_trans_ui")),
column(width = 8, uiOutput("pred_param_ui")))
)
server <- function(input, output, session) {
## parameter selections for target variable
observeEvent(input$target_trans, {
updateTabsetPanel(session = session, inputId = "params", selected = input$target_trans)
})
## create objects to store individual predictors
preds <- reactive(paste0("Predictor ", seq_len(input$preds_n)))
output$preds_ui <- renderUI({
preds() %>% map(~ selectInput(inputId = .x,
label = .x,
choices = var_names,
selected = isolate(input[[.x]])) %||% "")
})
## create objects to store individual predictors transformations
pred_trans <- reactive(paste0("Transformation ", seq_len(input$preds_n)))
output$pred_trans_ui <- renderUI({
pred_trans() %>% map(~ selectInput(inputId = .x,
label = .x,
choices = tran_names,
selected = isolate(input[[.x]])) %||% "")
})
## create objects to store individual predictors transformations parameters
## this is where i'm stuck :(
pred_params <- reactive(paste0("Parameter ", seq_len(input$preds_n)))
pred_param_select <- reactive(pred_params() %>%
map(~param_select(object_name = .x) %>%
setNames(nm = .x)))
output$pred_param_ui <- renderUI({
pred_params() %>%
map(~observeEvent(input[[.x]], {
updateTabsetPanel(session = session, inputId = "params", selected = input[[.x]])
}))
})
}
shinyApp(ui, server)
Note that this question is an extension of my previous question here.
Related
I am trying to generate a shiny app that will first allow the user to (using the notion of dplyr verbs) select the variables they are interested in and then filter those variables based on subsequent selections. I am trying to do this using conditionalPanel() but I am getting stuck finding a way to access the input$ from each conditional panel.
Here is an example:
library('shiny')
library('tidyverse')
library('shinyWidgets')
#Create the data
data <- select(mtcars, c(gear, carb))
#Create page with sidebarlayout
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
#Create picker input where relevant variables are selected
pickerInput(
inputId = 'vars',
label = 'Variables',
choices = colnames(data),
selected = colnames(data),
multiple = T,
pickerOptions(actionsBox = TRUE)
),
#Create conditional panels which show when the variable above is selected
#These panels will be used to filter the data that is selected based on the above variables
conditionalPanel(condition = "input.vars.includes('gear')",
pickerInput(inputId = 'gear',
label = 'Gear',
choices = unique(data$gear),
selected = unique(data$gear),
multiple = T,
pickerOptions(actionsBox = TRUE)
)
),
conditionalPanel(condition = "input.vars.includes('carb')",
pickerInput(inputId = 'carb',
label = 'Carb',
choices = unique(data$carb),
selected = unique(data$carb),
multiple = T,
pickerOptions(actionsBox = TRUE)
)
)
),
mainPanel(
#Show the selected data
verbatimTextOutput('term_selected'),
#Show the selected and filtered data - this won't show
verbatimTextOutput('term_selected_filtered'),
#Try debug with just getting the
verbatimTextOutput('debug_print')
)
)
)
server <- function(input, output) {
#Create the reactive selected data
selected_data <- reactive ({
data %>%
select(input$vars)
})
#Render the selected data
output$term_selected <- renderPrint(selected_data())
#This is where i am stuck
#I need to find a way to access the inputs related to the conditional functions
# selected_filtered_data <- reactive ({
# for (i in length(input$vars)) {
# selected_data() %>%
# filter(input$[first condiitonal panel select] %in% as.symbol(input$vars[i])
# }
# })
#
output$term_selected_filtered <- renderPrint(selected_filtered_data())
#Try to render input input$[first item of input.vars]
output$debug_print <- renderPrint(input$as.symbol(input$vars[1]))
}
shinyApp(ui = ui, server = server)
The problem lies in the server. I have tried input$as.symbol(input$vars[1]) to access the input$gear (assuming that was selected), but it just throws the error: attempt to apply non-function. I tried adding !! as syntactic sugar in front of as.symbol(), but that makes no difference.
I also tried this, in the hope that i could conditionally filter, and had no luck.
selected_filtered_data <- reactive({
selected_data() %>%
if('gear' %in% input$vars) {
filter(gear %in% input$gear) %>%
}
if('carb' %in% input$vars) {
filter(carb %in% input$carb)
}
})
How should I go about doing this?
We may use across (if we want to filter the rows when both column conditions are TRUE) or replace across with if_any (if either one of them is TRUE when they are both selected)
selected_data() %>%
filter(across(all_of(intersect(input$vars,
c('gear', "carb"))), ~ .x %in% input[[cur_column()]]))
-full code
library('shiny')
library('dplyr')
library(tidyr)
library('shinyWidgets')
#Create the data
data <- select(mtcars, c(gear, carb))
#Create page with sidebarlayout
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
#Create picker input where relevant variables are selected
pickerInput(
inputId = 'vars',
label = 'Variables',
choices = colnames(data),
selected = colnames(data),
multiple = TRUE,
pickerOptions(actionsBox = TRUE)
),
#Create conditional panels which show when the variable above is selected
#These panels will be used to filter the data that is selected based on the above variables
conditionalPanel(condition = "input.vars.includes('gear')",
pickerInput(inputId = 'gear',
label = 'Gear',
choices = unique(data$gear),
selected = unique(data$gear),
multiple = T,
pickerOptions(actionsBox = TRUE)
)
),
conditionalPanel(condition = "input.vars.includes('carb')",
pickerInput(inputId = 'carb',
label = 'Carb',
choices = unique(data$carb),
selected = unique(data$carb),
multiple = TRUE,
pickerOptions(actionsBox = TRUE)
)
)
),
mainPanel(
#Show the selected data
verbatimTextOutput('term_selected'),
#Show the selected and filtered data - this won't show
verbatimTextOutput('term_selected_filtered'),
#Try debug with just getting the
verbatimTextOutput('debug_print')
)
)
)
server <- function(input, output) {
#Create the reactive selected data
selected_data <- reactive ({
req(input$vars)
data %>%
select(input$vars)
})
#Render the selected data
output$term_selected <- renderPrint(selected_data())
#This is where i am stuck
#I need to find a way to access the inputs related to the conditional functions
selected_filtered_data <- reactive ({
selected_data() %>%
filter(across(all_of(intersect(input$vars, c('gear', "carb"))), ~ .x %in% input[[cur_column()]]))
})
#
output$term_selected_filtered <- renderPrint(
selected_filtered_data()
)
output$debug_print <- renderPrint(input[[input$vars[1]]])
}
shinyApp(ui = ui, server = server)
-output
I have a dashboard where slider is getting updated based on a dropdown widget. My issue is that dropdown selects the name of the column, and slider filters the selected column. The issue is when i create reactive filtered dataset: specifically this line: filter(input$selectx > input$my_slider[1]. i understand that it does not work cause the input$selectx is a character name of the column (eg "mean_radius", and I need a name without quotations (eg mean_radius). I tried quote(), {{}} and other functions but could not sort it out
#loading packages
library(shiny)
library(tidyverse)
library(datateachr) #cancer_sample dataset was used from this data package
library(rstatix)
library(shinythemes)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Cancer", titleWidth = 300),
dashboardSidebar(
width = 300,
selectInput("selectx", label = h3("Select X Variable"),
choices = list("radius_mean", "texture_mean", "perimeter_mean", "area_mean"),
selected = "area_mean"),
tags$br(),
sliderInput("my_slider",
label = h3("Range of X Variable"),
min = min(cancer_sample$area_mean, na.rm = TRUE),
max = max(cancer_sample$area_mean, na.rm = TRUE),
value = c(143.5,2501))
),
dashboardBody(
#makes the place holder for the plot
box(title = "Scatter Plot", solidHeader = TRUE, collapsible = TRUE, width = 12, plotOutput("my_plot", click = "plot_click")),
box(title = "Data Table", solidHeader = TRUE, collapsible = TRUE, width = 12, tableOutput("my_data"))
)
)
server <- function(input, output, session) {
#makes a reactive function to minimize repeated code
filtered <- reactive({
#the dataset that is being used
cancer_sample %>%
#filters the data set based on the area mean range from the slider, and the check boxes that are selected
filter(input$selectx > input$my_slider[1],
input$selectx < input$my_slider[2])
})
observe({
col <- cancer_sample %>% select(input$selectx)
#makes a slider that you can manipulate to show only data points that has an area mean that falls in the certain range
updateSliderInput(session, "my_slider",
value = col,
min = min(col, na.rm = TRUE),
max = max(col, na.rm = TRUE))
})
output$my_plot <- renderPlot({
filtered() %>%
#produces a graph with area_mean on the x-axis and perimeter_mean on the y-axis.
ggplot(aes_string(x = input$selectx, y = perimeter_mean)) +
geom_point(aes(colour = diagnosis))
})
output$my_data <- renderTable(
filtered() %>%
select(ID:area_mean)
)
}
# Run the application
shinyApp(ui = ui, server = server)
Your problem is not shiny connected, so the question could be easily simplified.
Unfortunately you do not provide the dataset here. So I could not provide a working example.
quote will always return what is inside quote(input$selectx) -> input$selectx so this for sure not a solution.
Please use the e.g. .data solution here.
airquality %>% filter(.data[[input$selectx]] > input$my_slider[1],
.data[[input$selectx]] < input$my_slider[2])
I am building a Shiny App where users can filter out certain projects. I want the project names to appear in the dropdown only if they appear within a certain date range.
I've been able to populate the selectize menu and have been able to make it so users can select all or remove all projects (from the answer to a question I asked previously). However, now that I'm trying to make these names reactive to the date, the observeEvent code from my previous question crashes. I tried to wrap it in a reactive expression, but then nothing happens.
How do I make my projects filterable by date while still keeping the select all and remove all functionality?
library(shiny)
library(plotly)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
library(htmltools)
library(lubridate)
ui = fluidPage(
tabsetPanel(
tabPanel("View 1", fluid = TRUE,
sidebarLayout(
sidebarPanel(
h4("Select Your Desired Filters"),
div(id = "inputs",
dateRangeInput(
inputId = "date_filter",
label = "Filter by Month and Year",
start = today(),
end = (today() + 90),
min = "2021-04",
max = NULL,
format = "yyyy-mm",
startview = "month",
weekstart = 0,
language = "en",
separator = " to ",
width = NULL,
autoclose = TRUE
),
br()),
h5("Include/Exclude Specific Projects"),
selectizeInput(inputId = "filter_by_project",
label = "Filter by Project",
choices = sort(unique(test$project)),
multiple = TRUE,
selected = sort(unique(test$project))),
actionButton(inputId = "remove_all",
label = "Unselect All Projects", style = "color: #FFFFFF; background-color: #CA001B; border_color: #CA001B"),
actionButton(inputId = "add_all",
label = "Select All Projects", style = "color: #FFFFFF; background-color: #CA001B; border_color: #CA001B")
),
mainPanel(
)
)
)
)
)
server = function(input, output, session) {
#Here's the dataset
test <- tibble(project = c("Justin", "Corey","Sibley"),
date = ymd(c("2021-04-20", "2021-04-01", "2021-05-05")),
april_2021 = c(10, 100, 101),
may_2021 = c(1, 4, 7))
#I want users to be able to filter the list of projects by date, which should update the selectize options
test <- reactive({
test %>%
dplyr::filter(date >= input$date_filter[1],
date <= input$date_filter[2])
})
observeEvent(input$remove_all, {reactive({
updateSelectizeInput(session,"filter_by_project",choices=sort(unique(test()$project)),
selected=NULL, options = list(placeholder="Please Select at Least One Project")
)
})
})
observeEvent(input$add_all, {reactive({
updateSelectizeInput(session,"filter_by_project",choices=sort(unique(test()$project)), selected=sort(unique(test()$project)) )
})
})
}
shinyApp(ui = ui, server = server)
You have to major problems. First is using the same name for your input data.frame and for your reactive element. You've called them both test which causes confusion as to whether you are trying to use the data.frame or the reactive object. You should use different names. The second problem is you do not need to use reactive() for your observeEvents() calls. You just need to put the code you want to run in a block.
Fixing these problems, your server functon should look more like this
server = function(input, output, session) {
#Here's the dataset
testdata <- tibble(project = c("Justin", "Corey","Sibley"),
date = ymd(c("2021-04-20", "2021-04-01", "2021-05-05")),
april_2021 = c(10, 100, 101),
may_2021 = c(1, 4, 7))
#I want users to be able to filter the list of projects by date, which should update the selectize options
test <- reactive({
testdata %>%
dplyr::filter(date >= input$date_filter[1],
date <= input$date_filter[2])
})
observeEvent(input$remove_all, {
updateSelectizeInput(session,"filter_by_project", choices=sort(unique(test()$project)),
selected=NULL, options = list(placeholder="Please Select at Least One Project")
)
})
observeEvent(input$add_all, {
updateSelectizeInput(session,"filter_by_project", choices=sort(unique(test()$project)), selected=sort(unique(test()$project)) )
})
}
This one has me really going around in circles.
I am working on an R script that loads a dataframe and uses fields from the dataframe to populate a hierarchical set of selectizeInput. E.g. each of the inputs represent a subset of what is in the previous. Each SubRegion contains multiple LCC’s, Each LCC contains multiple ENB’s, and so on.
When the user select a value in any of the inputs, that value will used to filter the dataframe and all of the other selectizeInputs need to be updated from the filtered data.
It seems to work fine for the first input (SubRegionInput) but every time I try to get it to respond to and/or filter by any of the others (e.g. add input$LCCInput to the observe block) they get populated for a few seconds and then go blank.
I suspect the answer is quite simple and/or I am doing something really dumb, but I am a total hack with no formal R training so am probably missing something quite basic (if so sorry).
Below is a partial chunk of code (sorry I can’t include it all but this is for work and I can’t share the details of what I am doing).
NOTES
The current outputs are just so I can see what is going on while I develop this portion of the code.
I know right now it is only set up to filter on the one value…everything I have tried to do it on more has failed so I included the most functional code I have so far.
ui <- fluidPage(
# Application title
titlePanel("KPI DrillDown"),
# Sidebar with a slider input for number of bins
fluidRow(
selectizeInput("SubRegionInput", "SubRegion", SubRegionList ,selected = NULL, multiple = TRUE),
selectizeInput("LCCInput", "LCC", LCCList,selected = NULL, multiple = TRUE),
selectizeInput("ENBIDInput", "ENBID", ENBIDList,selected = NULL, multiple = TRUE),
selectizeInput("SiteNumInput", "SiteNumber", SiteNumberList,selected = NULL, multiple = TRUE),
selectizeInput("SiteNameInput", "SiteName", SiteNameList,selected = NULL, multiple = TRUE),
selectizeInput("LNCELInput", "LNCell", LNCellList,selected = NULL, multiple = TRUE),
selectizeInput("SectorInput", "Sector", SectorList,selected = NULL, multiple = TRUE),
mainPanel(
#plotOutput("distPlot")
verbatimTextOutput("SubRegionText"),
verbatimTextOutput("LCCText"),
verbatimTextOutput("view")
)
)
)
server <- function(input, output) {
observe({
input$SubRegionInput
temp <- SiteInfo[SiteInfo$SITE_SUB_REGION %in% input$SubRegionInput, ]
thisLCCList = sort(temp$BACKHAUL_LCC[!is.na(temp$BACKHAUL_LCC)])
updateSelectizeInput(session = getDefaultReactiveDomain()
, inputId = "LCCInput"
, choices = thisLCCList
, selected= NULL)
thisENBIDList = sort(temp$ENODEB_ID[!is.na(temp$ENODEB_ID)])
updateSelectizeInput(session = getDefaultReactiveDomain()
, inputId = "ENBIDInput"
, choices = thisENBIDList
, selected= NULL)
thisSiteNumberList = sort(temp$SITE_NUMBER[!is.na(temp$SITE_NUMBER)])
updateSelectizeInput(session = getDefaultReactiveDomain()
, inputId = "SiteNumInput"
, choices = thisSiteNumberList
, selected= NULL)
thisSiteNameList = sort(temp$SITE_NAME[!is.na(temp$SITE_NAME)])
updateSelectizeInput(session = getDefaultReactiveDomain()
, inputId = "SiteNameInput"
, choices = thisSiteNameList
, selected= NULL)
thisLNCellList = sort(temp$SECTOR_NUMBER[!is.na(temp$SECTOR_NUMBER)])
updateSelectizeInput(session = getDefaultReactiveDomain()
, inputId = "LNCELInput"
, choices = thisLNCellList
, selected= NULL)
thisSectorList = sort(temp$Sector[!is.na(temp$Sector)])
updateSelectizeInput(session = getDefaultReactiveDomain()
, inputId = "SectorInput"
, choices = thisSectorList
, selected= NULL)
output$view<- renderPrint(temp)
})
Since I do not have access to your data, I used mtcars as an example.
To begin with, since you have so many filtering, I would suggest creating a search or update button, which is what I did in my codes. I only did one filtering using dplyr after extracting all the selectizeInputs. I have to manually change all the empty searching parameter to select all in order to avoid filtering to NA.
Overall, I think the problem with your code was you are observing too many updateSelectizeInputs at once. I did try to recreate using your way, and what I ended with was that I could only update single selectizeInput, and the other selectizeInputs were not selectable.
Hopefully, this method fits your data.
Codes:
library(shiny)
library(dplyr)
library(DT)
data <- mtcars
SubRegionList <- unique(data$cyl)
LCCList <- unique(data$gear)
ENBIDList <- unique(data$am)
SiteNumberList <- unique(data$vs)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("KPI DrillDown"),
# Sidebar with a slider input for number of bins
fluidRow(
selectizeInput("SubRegionInput", "SubRegion/cyl", SubRegionList ,selected = NULL, multiple = TRUE),
uiOutput("LCCInput"),
uiOutput("ENBIDInput"),
uiOutput("SiteNumInput"),
uiOutput("Search"),
mainPanel(
verbatimTextOutput("view")
)
)
)
# Define server logic required
server <- function(input, output, session) {
SiteInfo <- data
# temp <- ""
observe({
if (!is.null(input$SubRegionInput)){
subRegionSelected <- input$SubRegionInput
## Create a temp dataset with the selected sub regions.
temp <- SiteInfo[SiteInfo$cyl %in% subRegionSelected, ]
## Push the newly created selectizeInput to UI
output$LCCInput <- renderUI({
selectizeInput("LCCInput", "LCC/gear", unique(temp$gear), selected = NULL, multiple = TRUE)
})
output$ENBIDInput <- renderUI({
selectizeInput("ENBIDInput", "ENBID/am", unique(temp$am),selected = NULL, multiple = TRUE)
})
output$SiteNumInput <- renderUI({
selectizeInput("SiteNumInput", "SiteNumber/vs", unique(temp$vs), selected = NULL, multiple = TRUE)
})
output$Search <- renderUI({
actionButton("Search", "Search")
})
## Function that linked to the actionButton
display <- eventReactive(input$Search,{
temp <- SiteInfo[SiteInfo$cyl %in% input$SubRegionInput, ]
# ## manually change all the empty searching parameter to select all in order to avoid filtering to NA
LCC <- input$LCCInput
if (is.null(input$LCCInput)){LCC <- unique(temp$gear)}
ENBID <- input$ENBIDInput
if (is.null(input$ENBIDInput)){EBVID <- unique(temp$am)}
SiteNum <- input$SiteNumInput
if (is.null(input$SiteNumInput)){LCC <- unique(temp$vs)}
## Dplyr::filter data
temp <- temp %>%
filter(gear %in% LCC & am %in% ENBID & vs %in% SiteNum)
temp
})
## Run the actionButton
output$view <- renderPrint({
display()
})
} else {
## Display waht the data looks like when no Sub Region is selected
output$view<- renderPrint(data)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have a question that I'm having trouble getting to work. I have a Shiny app that I want to accept two user input, send it back from ui.R to server.R, and insert that as a variable into a URL query string to download the file from a database. At first, we hardcoded the values to test the algorithm but we eventually want to make it user defined. I thought that saving as a variable and replacing it in the query string would work, but it didn't... I tried to concatenate pieces of the URL and I'm getting an error "Warning: Error in cat: argument 1 (type 'closure') cannot be handled by 'cat'". I tried to search online but couldn't find a good solution to my problem. Here is my code so far... As you see in the code, what I want to get is at least form the url and showing it as text on the ui just to see that it is being dynamic. Then when I know I can insert the user input, then I can continue on with storing the downloaded file.
#ui.R
library(shiny)
library(leaflet)
library(foreach)
library(ape)
library(data.table)
library(DT)
# Choices for the genetic distance model
geneticDistanceModel <- c(
"raw" = "raw",
"JC69" = "JC69",
"K80" = "K80",
"F81" = "F81",
"K81" = "K81",
"F84" = "F84",
"BH87" = "BH87",
"T92" = "T92",
"TN93" = "TN93",
"GG95" = "GG95",
"logdet" = "logdet",
"paralin" = "paralin"
)
shinyUI(navbarPage("TeMPuЯa", id="nav", position = c("fixed-top"),
# needed to keep fixed-top navbar from obscuring content
header = tags$style(type = "text/css", "body {padding-top: 70px;}"),
collapsible = "true",
tabPanel("Tool",
h1("Instructions"),
p("Placeholder"),
sidebarLayout(
sidebarPanel(
textInput("taxonomy", label = h4("Enter taxonomy group:"), value = "Porifera"),
textInput("geography", label = h4("Enter geographical location:"), value = "all"),
sliderInput("latitude", label = h4("Latitude difference"), min = 10, max = 30, value = 20),
sliderInput("genetic", label = h4("Genetic similarity threshold"), min = 10, max = 20, value = 15),
sliderInput("outgroups", label = h4("Select a distance from the outgroup"), min = 1, max = 2, value = 1.3, step = 0.1),
selectInput("distanceModels", label = h4("Select a genetic distance model"), geneticDistanceModel, selected = "K80"),
submitButton("Submit"),
br(),
downloadButton("download", label = "Download CSV")
),
mainPanel(
leafletOutput("worldmap"),
br(),
div(style='height:300px; width:850px; overflow:scroll',
DT::dataTableOutput("url", width = 850)),
textOutput("text")
)
)
),
tabPanel("Genetic Distance Models Info",
h1("Genetic distance models:"),
a("Link to more explanation for the distance models used in R", href = "http://svitsrv25.epfl.ch/R-doc/library/ape/html/dist.dna.html"),
br(),
p(strong("raw:") ,"This is simply the proportion or the number of sites that differ between each pair of sequences. This may be useful to draw 'saturation plots'."),
p(strong("JC69:") ,"This model was developed by Jukes and Cantor (1969)."),
p(strong("K80:") ,"The distance derived by Kimura (1980), sometimes referred to as 'Kimura's 2-parameters distance'."),
p(strong("F81:") ,"Felsenstein (1981) generalized the Jukes-Cantor model."),
p(strong("K81:") ,"This model is called the Kimura's 'three substitution types model' (3ST), and is sometimes referred to as 'Kimura's 3-parameters distance'."),
p(strong("F84:") ,"This model generalized K80, and was first introduced by Felsenstein in 1984."),
p(strong("BH87:") ,"Barry and Hartigan (1987)."),
p(strong("T92:") ,"Tamura (1992) generalized the Kimura model."),
p(strong("TN93:") ,"Tamura and Nei (1993) model."),
p(strong("GG95:") ,"Galtier and Gouy (1995) model."),
p(strong("logdet:") ,"The Log-Det distance, developed by Lockhart et al. (1994), is related to BH87. However, this distance is symmetric."),
p(strong("paralin:") ,"Lake (1994) developed the paralinear distance which can be viewed as another variant of the Barry-Hartigan distance.")
)
))
# server.R
library(shiny)
library(leaflet)
library(foreach)
library(ape)
library(data.table)
library(DT)
source("tsvtoDataFrame.R")
shinyServer(function(input, output, session) {
# Create the map
output$worldmap <- renderLeaflet({
leaflet() %>%
addTiles() %>% # Add default OpenStreetMap map tiles
setView(lng = -93.85, lat = 37.45, zoom = 4)
})
textInput <- reactive({
var1 <- "http://www.boldsystems.org/index.php/API_Public/combined?taxon="
var2 <- "&geo="
var3 <- "&format=tsv"
paste(c(var1), c(input$taxonomy), c(var2), c(input$geography), c(var3))
})
output$text <- renderText({
textInput
})
output$url <- DT::renderDataTable(
dfMatchOverallBest,
options = list(scrollX = TRUE)
)
})
textInput is a reactive, so you should use
output$text <- renderText({
textInput()
})
Also you should probably use paste0 instead of paste to get your URL, and the c() command is not necessary.