I'm still a newbie and struggling to figure this out.
Click on Blues LG (Loupe Style), AMD (Manufacturer), Clarion (Model). Hit Search and you will see a picture of glasses.
Should show a compatible product for all selected items. Now, choose Indie LG (Loupe Style). The image disappears. This doesn't happen on my local computer. The app runs fine and shows every picture.
The images are stored in www folder. See the codes. This was writen by the previous programmer and he had the app running fine with the same pictures. So I don't know what has changed since then? The only thing I have changed is one picture (Zolar) and that picture did show up. Any help would be greatly appreciated!!!
please excuse the code mess because I thought the solution was combining the server.r and ui.r into app.r and apparently, it didn't.
library(tidyverse)
library(shiny)
library(bslib)
library(dbplyr)
# Load Andau loupe data
andau_data <- readxl::read_excel("andau_loupe_data.xlsx")
#dput(andau_data)
# Load dental data
dental_data <- readxl::read_excel("Dental_data.xlsx")
#dput(dental_data)
dental_data <- readxl::read_excel("Dental_data.xlsx") %>%
filter(`Laser Mfg` != "") %>%
mutate(VLT = scales::percent(as.numeric(VLT)))
# theming options
andau_theme <- bs_theme(version = 5,
base_font = font_google("Open Sans"),
bg = "white",
fg = "#1f0900",
primary = "#6532c3")
# Define UI
ui <- fluidPage(
# Application title
titlePanel(
windowTitle = "Andau Medical",
title = tags$head(tags$link(rel="shortcut icon",
href="https://static.wixstatic.com/media/fd64a1_04ac9359d46640ed8126959220cd62db~mv2.png/v1/crop/x_347,y_713,w_1310,h_580/fill/w_356,h_165,al_c,q_85,usm_0.66_1.00_0.01,enc_auto/Andau%20Medical%20Logo.png",
type="png"))),
theme = andau_theme,
card(class="shadow p-3 mb-5 bg-body rounded",
card_header(inverse = T,fluidRow(
column(6,
align = 'left',
h5(a(img(width = "150px",
src = "https://static.wixstatic.com/media/fd64a1_04ac9359d46640ed8126959220cd62db~mv2.png/v1/crop/x_347,y_713,w_1310,h_580/fill/w_356,h_165,al_c,q_85,usm_0.66_1.00_0.01,enc_auto/Andau%20Medical%20Logo.png"),
href = "https://www.andaumedical.com"))),
column(6, align= 'right',
h5("customerservice@andaumedical.com"),
h5("1-844-263-2888"))))
,fluidRow(column(12,align='center',
h2(strong("Search eye protection by selecting a loupe style, and a laser device"))))
),
fluidRow(
column(
4,
align = 'center',
selectInput(
inputId = "loupestyle",
label = h4(strong("Loupe Style")),
choices = sort(andau_data$`Andau Frame`),
selected = NULL
)
),
column(
4,
align = 'center',
selectInput(
inputId = "mfg",
label = h4(strong("Manufacturer")),
choices = sort(dental_data$`Laser Mfg`),
selected = NULL
)
),
column(
4,
align = 'center',
selectInput(
inputId = "mod",
label = h4(strong("Model")),
choices = dental_data$`Laser Model`,
selected = NULL
)
)),
fluidRow(
column(
12,
align = "center",
br(),
actionButton("run",
icon = icon("magnifying-glass"),
style='padding-left:50px;padding-right:50px;padding-top:1px;padding-bottom:1px; font-size:80%',
h5(strong("Search")),
class = "btn-primary"))
),
br(),
fluidRow(
column(12,
p("Your information not available in the dropdowns? Contact Innovative Optics at (763) 425-7789"))
),
conditionalPanel(
condition = "input.run",
card(class="shadow p-3 mb-5 bg-body rounded",
fluidRow(column(12, align = "center",
h3(em("Device Information")),
tableOutput("userInfo"))),
fluidRow(column(12,
align = "center",
h3(em("Compatible Innovative Optics Product")),
tableOutput("tableInfo"))),
fluidRow(column(12, align = 'center',
imageOutput("productImage")))),
card(class="shadow p-3 mb-5 bg-body rounded",
fluidRow(column(12,
align = 'center',
h4(strong("Frequently Purchased Together")))),
fluidRow(
column(4, align = 'center',
imageOutput("rec1"),
tableOutput("tableRec1")),
column(4, align = 'center',
imageOutput("rec2"),
tableOutput("tableRec2")),
column(4, align = 'center',
imageOutput("rec3"),
tableOutput("tableRec3")))
)),
card(class="shadow p-3 mb-5 bg-body rounded",
card_footer(h5(
style = {
"color: #0FE410;
text-shadow: 1px 1px 1px black;"
},
"Powered by Innovative Optics"))
)
)
################################################################################
# Define server logic required to display information and pictures of lenses
# based on loupe, mfg, model and frequently purchased together (rec1, rec2,
# rec3 from dental_data)
################################################################################
server <- function(input, output, session) {
observeEvent(input$mfg,{
# filter dental data to select mfg
mfg_filtered_dental_data <- dental_data %>%
filter(`Laser Mfg` == input$mfg)
# update select input - laser model
updateSelectInput(inputId = "mod",
choices = sort(mfg_filtered_dental_data$`Laser Model`))
})
loupe_insert <- eventReactive(input$loupestyle,{
andau_data %>%
filter(`Andau Frame` == input$loupestyle)
})
selected_data <- eventReactive(input$mod,{
req(input$mfg)
dental_data %>%
filter(`Laser Mfg` == input$mfg,
`Laser Model` == input$mod)
})
user_info <- eventReactive(input$run,{
tibble(
"Andau Loupe Style" = loupe_insert()$`Andau Frame`,
"Laser Information" = glue::glue_safe(selected_data()$`Laser Mfg`, " ", selected_data()$`Laser Model`),
"Laser Specifications" = selected_data()$Wavelengths)
})
output$userInfo <- renderTable(bordered = T,
align = "l",
striped=T,
{
user_info()
})
table_info <- eventReactive(input$run,{
tibble("INVO Part Number" = if_else(selected_data()$`Eyewear Lens Compatible` == "GP30",
glue::glue_safe(loupe_insert()$`Innovative Optics Insert`,"." , selected_data()$`Eyewear Lens Compatible`),
glue::glue_safe(loupe_insert()$`Innovative Optics Insert`,"." , selected_data()$`Eyewear Lens Compatible`, ".2B")),
"Optical Density Specifications" = selected_data()$`Optical Density`,
"Visible Light Transmission" = selected_data()$VLT)
})
output$tableInfo <- renderTable(bordered = T,
align = "l",
striped=T,
height="100%",
{
table_info()
})
rec1_table <- eventReactive(input$run,{
tibble("INVO Part Number" = selected_data()$`Rec1`)
})
output$tableRec1 <- renderTable(bordered = T,
align = "l",
striped=T,
{
rec1_table()
})
rec2_table <- eventReactive(input$run,{
tibble("INVO Part Number" = selected_data()$`Rec2`)
})
output$tableRec2 <- renderTable(bordered = T,
align = "l",
striped=T,
{
rec2_table()
})
rec3_table <- eventReactive(input$run,{
tibble("INVO Part Number" = selected_data()$`Rec3`)
})
output$tableRec3 <- renderTable(bordered = T,
align = "l",
striped=T,
{
rec3_table()
})
image_location <- eventReactive(input$run,{
c(if_else(input$loupestyle == "Bolle" | input$loupestyle == "Jazz",
glue::glue_safe("www/", input$loupestyle, "/", selected_data()$`Eyewear Lens Compatible`, ".jpg"),
if_else(input$loupestyle == "MOS" & selected_data()$`Eyewear Lens Compatible` == "Pi1",
glue::glue_safe("www/", input$loupestyle, "/", selected_data()$`Eyewear Lens Compatible`, ".jpg"),
glue::glue_safe("www/", input$loupestyle, "/", selected_data()$`Eyewear Lens Compatible`, ".JPG"))),
if_else(selected_data()$`Eyewear Lens Compatible` == "Pi19",
glue::glue_safe("www/recs/", selected_data()$`Rec1`, ".jpeg"),
glue::glue_safe("www/recs/", selected_data()$`Rec1`, ".jpg")
),
if_else(selected_data()$`Eyewear Lens Compatible` == "Pi19",
glue::glue_safe("www/recs/", selected_data()$`Rec1`, ".jpeg"),
glue::glue_safe("www/recs/", selected_data()$`Rec2`, ".jpg")
),
glue::glue_safe("www/recs/", selected_data()$`Rec3`, ".jpg"))
})
output$productImage <- renderImage({
req(input$loupestyle)
req(input$mfg)
req(input$mod)
list(src = image_location()[[1]],
width = "500px",
contentType = "image/jpeg")
}
,deleteFile = FALSE)
output$rec1 <- renderImage({
req(input$loupestyle)
req(input$mfg)
req(input$mod)
list(src = image_location()[[2]],
height = "300px",
contentType = "image/jpeg")
}
,deleteFile = FALSE)
output$rec2 <- renderImage({
req(input$loupestyle)
req(input$mfg)
req(input$mod)
list(src = image_location()[[3]],
height = "300px",
contentType = "image/jpeg")
}
,deleteFile = FALSE)
output$rec3 <- renderImage({
req(input$loupestyle)
req(input$mfg)
req(input$mod)
list(src = image_location()[[4]],
height = "300px",
contentType = "image/jpeg")
}
,deleteFile = FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)