Nothing
library(shiny)
library(tidyverse)
server <- function(input, output) {
output$downloadData <- downloadHandler("rabi-IDs.csv",
# This function should write data to a file given to it by
# the argument 'file'.
content = function(file) {
# Write to a file specified by the 'file' argument
write.table(ID_df, file, sep = ",", row.names = FALSE)
}
)
#############Misc Server Stuff#################
#makes a vector full of color names for randomizing
rand.colors <- colors() %>% stringr::str_extract("[a-z]+") %>% unique() %>% unlist()
rand.positions <- c("left leg", "right leg", "head", "thorax",
"abdomen", "tail", "right tibiotarsus", "forewing",
"4th toe on hindlimb", "1st digit", "3rd digit", "caudal fin")
#calculate the number of IDs generated
output$howmany <- renderText({
num.positions <- as.integer(input$num.positions)
num.robust <- as.integer(input$num.robust)
num.colors <- as.integer(input$num.colors)
paste0("With these parameters, you can get ", num.colors^(num.positions - num.robust), " unique IDs.")
})
########################Dynamic Input Boxes##################
#make the input boxes for the different color names
output$input_ui_colors <- renderUI({
num.colors <- as.integer(input$num.colors)
#if names is selected, give option for names
if (input$colornamesYN == "names") {
lapply(1:num.colors, function(i) {
textInput(paste0("n_input_colors_", i), label = paste0("Marking name #", i, " (e.g. '", sample(rand.colors,1),"'):"), value = (i-1))
})
#if numbers (default) is chosen, don't display anything
} else if (input$colornamesYN == "numbers") {
return()
#if neither, what HAPPENED?
} else {
textInput("lawdy", label = "lawdylawdylawdy", value = "lawdy me")
}
})
output$input_ui_positions <- renderUI({
num.positions <- as.integer(input$num.positions)
lapply(1:num.positions, function(i) {
textInput(paste0("n_input_position_", i), label = paste0("Position name #", i, " (e.g. '", sample(rand.positions,1),"'):"), value = (i)) })
})
########################Data Table##################
#makes the table of all your values
output$table <- renderTable({
num.positions <- as.integer(input$num.positions)
num.robust <- as.integer(input$num.robust)
num.colors <- as.integer(input$num.colors)
#if color names are chosen, take the user input
if (input$colornamesYN == "names") {
color.names <- lapply(1:num.colors, function(i) {input[[paste0("n_input_colors_", i)]]}) %>% unlist()
#else, it means numbers, so go from 0 to X-1
} else {
color.names <- as.character(0:(num.colors-1))
}
ID_lists <- rabi::rs_IDs(num.positions, num.robust, num.colors, color.names)
ID_lists %>% as.data.frame() %>% t() %>% as.data.frame() -> ID_df
rownames(ID_df) <- NULL
colnames(ID_df) <- lapply(1:dim(ID_df)[2], function(i) {input[[paste0("n_input_position_", i)]]}) %>% unlist()
##Making it a global variable so other functions can grab it
ID_df <<- ID_df
ID_df
})
##############Dynamically Adjust Selector Range##############
output$position.selector <- renderUI({
selectInput("num.positions", "Number of markable positions on animal:", choices = seq(2,input$num.colors,1))
})
output$robust.selector <- renderUI({
selectInput("num.robust", "Number of marked positions that can be erased before the ID loses guaranteed recoverability:", choices = seq(1,input$num.positions,1))
})
##############################################
}
ui <- fluidPage(
tags$title("'rabi' GUI"),
sidebarLayout(
sidebarPanel(
h1("Graphical User Interface for rabi's ID scheme generator"),
helpText(
"Note: This example uses Reed-Solomon polynomial oversampling (",
code("rs_IDs()"),
") to generate the ID sequences. ",
"Consequently, there are several stipulations that must be met: ",
tags$ol(
tags$li("The number of unique markings used (e.g. the different colors you have at your disposal) must be a prime number. (Weird, but whatever.)"),
tags$li("The number of positions to be marked on the animal can't be greater than the number of unique markings (see above). This number does NOT need to be prime though")
)
),
radioButtons("colornamesYN", "You can choose to use numbers to refer to different markings or specify your own names.", list("Use numbers (default)" = "numbers","Replace with user-defined names (e.g. blue, indigo, striped, clipped toe, etc)" = "names"), selected = NULL),
uiOutput("position.selector"),
uiOutput("robust.selector"),
selectInput("num.colors", "Number of unique markings available (round down to the closest prime):", choices = c(2, 3, 5, 7, 11, 13 ,17, 19), selected = 3),
p(" "),
p(" "),
hr(),hr(),
uiOutput("input_ui_colors"),
downloadButton('downloadData', 'Download as a CSV')
),
mainPanel(
h4("Name the locations that will be marked on the animal."),
uiOutput("input_ui_positions"),
hr(),hr(),
h4(textOutput("howmany")),
tableOutput("table")
)
)
)
shinyApp(ui = ui, server = server)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.