I am building a data entry form for property management and using shiny.
Problem:
I have a dorpdown field (outputId = robapp) which is dependent on the selection of another dropdownfield (inputId = rob).
I managed that the displayed values in robapp are dependent on the selection in rob, see here.
However, the selected value from robapp is not saved when I click on the Übermitteln-Button (which binds my new entered data with my dataframe tdata.
I tried so many different solutions but I can't write the selected value in robapp in my save_data variable.
Any help is appreciated. Many thanks.
Preparing data
# tdata holds information of the tenants, new information entered via the form are added
tdata <- data.frame(matrix(rep(LETTERS,17), nrow = 1, ncol = 17))
colnames(tdata) <- c("Anrede", "Titel", "Vorname",
"Nachname", "Geburtsdatum", "Geburtsort",
"Familienstand", "Telefonnummer", "E-Mail",
"Beruf", "Arbeitgeber", "Abschluss Arbeitsvertrag",
"Datum Mietbeginn", "Mietobjekt", "Appartment",
"Miete (mtl.)", "Nebenkosten (mtl.)" )
# create list that holds the data of the rentable objects
rent_obj <- list( c("Astreet", "1", 1234, "MickeymouseHill"),
c("Bstreet", "74", 5678, "GothamCity"),
c("CStreet", "8", 9101, "Wonderland"),
c("DStreet", "10", 1213, "Valhalla"),
c("EStreet", "10", 1415, "Heaven")
)
# create empty list to hold labels consisting of "Streetname Housenumber, Zip Place"
obj_label <- vector(mode = "list", length = length(rent_obj))
# create names to show in dropdown list
local(
for (i in 1:length(rent_obj))
{
obj <- rent_obj[[i]] # unlist adress data of object i
strt_obj <- paste(obj[1], obj[2], sep = " ") # paste rent. object's street and housenumber
zip_obj <- paste( paste(strt_obj, obj[3], sep = ", "), obj[4], sep = " " ) # paste street, housenumber and zip code and place together
obj_label[i] <<- zip_obj # overwrite vector rent_obj with created labels
}
)
############################
# Adding Appartment Numbers
############################
# creating empty list for appartments per rentable object
app_no <- vector(mode = "list", length = length(rent_obj)) # length is total number of rent. objects
# name list entries with addresses of rent. objects
names(app_no) <- obj_label
# assigning appartment labels to rent. objects
app_no[[1]] <- c("EG rechts", "EG links", "1. OG rechts", "1. OG links", "Dach rechts", "Dach links")
app_no[[2]] <- as.character(1:14)
app_no[[3]] <- c("EG rechts", "EG links", "1. OG rechts", "1. OG links", "Dach rechts")
app_no[[4]] <- c("App 1", "App 2")
app_no[[5]] <- as.character(1:6)
UI
##################################
# Creating UserInterface For Form
##################################
# create user interface of form
ui <- dashboardPage(
dashboardHeader(title = "Stammdaten-Eingabe"), # set title for form
dashboardSidebar(),
dashboardBody(
###########
# Fields & Labels
###########
fluidRow(
#--- Anrede ---#
column(width = 2, selectInput( inputId = "sal", label = "Anrede", choices = list("Herr", "Frau"), selected = "NULL" )),
#--- Titel ---#
column(width = 2, selectInput( inputId = "deg", label = "Titel", choices = list("\n", "Dr.", "Prof."), selected = "\n" )), # "\n" creates blank entry
#--- Vorname ---#
column(width = 2, textInput( inputId = "fn", label = "Vorname", value = "" )),
#--- Nachname ---#
column(width = 2, textInput( inputId = "ln", label = "Nachname", value = "" )),
#--- Geburtsdatum ---#
column(width = 2, dateInput( inputId = "dob", label = "Geburtsdatum" )),
#--- Geburtsort ---#
column(width = 2, textInput( inputId = "pob", label = "Geburtsort", value = "" )),
), # close fluidRow
fluidRow(
#--- Familienstand ---#
column(width = 2, selectInput( inputId = "ms", label = "Familenstand", choices = list("Ledig", "Verheiratet"), selected = "\n" )),
#--- Telefonnummer ---#
column(width = 2, textInput( inputId = "pn", label = "Telefonnummer", value = "" )),
#--- E-Mail ---#
column(width = 2, textInput( inputId = "em", label = "E-Mail", value = "" )),
#--- Beruf ---#
column(width = 2, textInput( inputId = "job", label = "Beruf", value = "" )),
#--- Arbeitgeber ---#
column(width = 2, textInput( inputId = "emp", label = "Arbeitgeber", value = "" )),
#--- Abschluss Arbeitsvertrag ---#
column(width = 2, dateInput( inputId = "dec", label = "Datum Arbeitsvertrag" )),
), # close fluidRow
fluidRow(
#--- Datum Mietbeginn ---#
column(width = 2, dateInput( inputId = "drs", label = "Mietbeginn" )),
#--- Mietobjekt ---#
column(width = 2, selectInput( inputId = "rob", label = "Mietobjekt", choices = obj_label, selected = "\n" )),
#--- Mietobjekt - Appartment-Nummer ---#
column(width = 2, uiOutput( outputId = "robapp", label = "Appartment", value = "" )),
#--- Miete ---#
# CurrencyPlacement = "s" currency appears right to entered value
# decimalCharacter separates decimal places
# digitGroupSeparator indicates thousands seperator
column(width = 2, autonumericInput(inputId = "rinst", label = "Miete (mtl.)", value = "", min = 0, currencySymbol = "€", currencySymbolPlacement = "s", decimalPlaces = 2, decimalCharacter = ",", digitGroupSeparator = "." )),
#--- Nebenkosten ---#
# CurrencyPlacement = "s" currency appears right to entered value
# decimalCharacter separates decimal places
# digitGroupSeparator indicates thousands seperator
column(width = 2, autonumericInput(inputId = "addc", label = "Nebenkosten (mtl.)", value = "", min = 0, currencySymbol = "€", currencySymbolPlacement = "s", decimalPlaces = 2, decimalCharacter = ",", digitGroupSeparator = "." )),
), # close fluidRow
#############
# BUTTONS
#############
actionButton("addbutton", "Übernehmen")
)# close dashboardBody
)# close dashboardPage
Server
# create server function
server <- function(input, output, session)
{
############
# Dependent Dropdown (Rent. Obj. -> Appartment No.)
###########
# https://stackoverflow.com/questions/34929206/r-shiny-selectinput-that-is-dependent-on-another-selectinput
output$robapp <- renderUI({ selectInput(
inputId = "rob",
label = "Appartment",
choices = list( app_no[which(names(app_no)==input$rob)])[[1]] #input$rob is field name of rentable object's address, [[1]] unlists list which contains appartment numbers of filtered address
) # close selectInput
}) # close renderUI
# your action button condition
observe({ if(input$addbutton > 0)
{# start if
# create the new line to be added from your inputs
newLine <- isolate(c(input$sal, input$deg, input$fn,
input$ln, input$dob, input$pob,
input$ms, input$pn, input$em,
input$job, input$emp, input$dec,
input$drs, input$rob, input$robapp,
input$rinst, input$addc))
# update your data
# note the unlist of newLine, this prevents a bothersome warning message that the rbind will return regarding rownames because of using isolate.
isolate(updated_values <- rbind(as.matrix(tdata), unlist(newLine)))
save_data <<- updated_values
} # close if
})# close observe
} # close server function
Launch App
shinyApp(ui, server)
