Align image side-by-side in Shiny - html

I am trying to align the image I calling from the web to be in the center on my shiny app. I am using the html tag here because the image file is not saved in my computer, but I am calling it from the web. fifa_data[fifa_data$Name==input$player_name,]$Photo in my server.R file looks something like this: "https://cdn.sofifa.org/players/4/19/200104.png"
Here is an snapshot of what it looks like now, and the red square is where I want the image to be displayed:
Here is a snippet of my ui.R
ui2<- dashboardPage(
dashboardHeader(title="BIG Player Hunter"),
dashboardSidebar(
fluidRow(
uiOutput(outputId = "image")),
fluidRow(
uiOutput(outputId = "image2")),
fluidRow(
uiOutput(outputId = "image3")),
# uiOutput(outputId = "image2"),
# uiOutput(outputId = "image3")),
selectizeInput('player_name',"Player Name:",
choices=fifa_data$Name,
selected=NULL,
multiple=TRUE),
sliderInput("player_count",
"Number of players:",
min=1,
max=50,
value=5),
sliderInput("proximity",
"How close:",
min=0.01,
max=0.99,
value=0.05),
sliderInput("valuerange", "Price Range", min = 0, max = max(fifa_data$ValueNumeric_pounds),
value = c(25, 75)),
actionButton("search", "Search"),
sidebarMenu(
menuItem("Shoot 소개", tabName = "shoot_info", icon= icon("heart", lib= "glyphicon")),
menuItem("점수순위 및 분석", tabName = "leaderboard", icon= icon("bar-chart-o")),
menuItem("참가신청서", tabName = "signup", icon=icon("pencil", lib= "glyphicon"),
badgeLabel = "관리자", badgeColor = "red")
),
uiOutput("checkbox")
),
dashboardBody(
tabItem(tabName = "shoot_info",
fluidRow(
dataTableOutput("table1"),
chartJSRadarOutput("radarchart1")
)
)
)
)
Here is a sinner of my server.R
output$image<- renderUI({
tags$img(src= fifa_data[fifa_data$Name==input$player_name,]$Photo)
})
output$image2<- renderUI({
tags$img(src= fifa_data[fifa_data$Name==input$player_name,]$Flag)
})
output$image3<- renderUI({
tags$img(src= fifa_data[fifa_data$Name==input$player_name,]$`Club Logo`)
})

Try the below code for your requirement
library(shiny)
library(shinydashboard)
header <- dashboardHeader()
body <- dashboardBody()
sidebar <- dashboardSidebar(uiOutput("images"),
sliderInput("player_count",
"Number of players:",
min = 1,
max = 50,
value = 5),
sliderInput("proximity",
"How close:",
min = 0.01,
max = 0.99,
value = 0.05),
actionButton("search", "Search")
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$images <- renderUI({
tags$div(img(src = "image1.png", width = 70, height = 90), img(src = "image2.png", width = 70, height = 90), img(src = "image3.png", width = 70, height = 90))
})
}
shinyApp(ui, server)
The screenshot of output

Related

How to put an icon to the title of an input widget in Shiny and Shiny dashboard

Is it possible to add an icon to the title of an input widget in Shiny and Shiny and Shiny dashboard? Below is an example. I want to add an icon to each input widget to indicate if it is a numeric input (using a bar-chart icon) or a text input (using a font icon). For now, I am using two columns. One with width = 1 for the icon, and the other is for the input widget. It would be great if I can add the icon to the title directly. Please let me know if there are ways to achieve this.
library(shiny)
library(shinydashboard)
header <- dashboardHeader(
title = "Icon Example"
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem(
text = "Input",
tabName = "Input"
)
)
)
body <- dashboardBody(
tabItem(
tabName = "Input",
fluidRow(
column(
width = 6,
box(
status = "primary", solidHeader = TRUE,
width = 12,
title = "Box 1",
fluidRow(
column(width = 1,
tags$div(HTML('<i class="fa fa-bar-chart" style = "color:#0072B2;"></i>'))
),
column(width = 11,
numericInput(inputId = "Num", label = "This is a numeric input", value = 1000))
),
fluidRow(
column(width = 1,
tags$div(HTML('<i class="fa fa-font" style = "color:#D55E00;"></i>'))
),
column(width = 11,
textInput(inputId = "Text", label = "This is a text input")
)
)
)
)
)
)
)
# User Interface
ui <- dashboardPage(
header = header,
sidebar = sidebar,
body = body
)
# Server logic
server <- function(input, output, session){}
# Complete app with UI and server components
shinyApp(ui, server)
Here is a screenshot of my code example. I would like to have the beginning of the input field aligned with the icon (as indicated by the red arrows). In other words, I hope the icon can be part of the title of the input widget.
Edit:
To increase the readability of the code we can use icon instead of HTML:
numericInput(inputId = "Num", label = div(icon("bar-chart", style = "color:blue;"), " This is a numeric input"), value = 1000)
Initial answer:
Just use your div as the label:
library(shiny)
library(shinydashboard)
header <- dashboardHeader(title = "Icon Example")
sidebar <- dashboardSidebar(sidebarMenu(menuItem(text = "Input", tabName = "Input")))
body <- dashboardBody(tabItem(tabName = "Input",
fluidRow(column(
width = 6,
box(
status = "primary",
solidHeader = TRUE,
width = 12,
title = "Box 1",
fluidRow(column(
width = 11,
numericInput(
inputId = "Num",
label = tags$div(HTML('<i class="fa fa-bar-chart" style = "color:#0072B2;"></i> This is a numeric input')),
value = 1000
)
)),
fluidRow(column(
width = 11,
textInput(
inputId = "Text",
label = tags$div(HTML('<i class="fa fa-font" style = "color:#D55E00;"></i> This is a text input'))
)
))
)
))))
# User Interface
ui <- dashboardPage(header = header,
sidebar = sidebar,
body = body)
# Server logic
server <- function(input, output, session) {}
# Complete app with UI and server components
shinyApp(ui, server)
Result:
You can achieve this by wrapping icon() to span() and tagList(). Check the updated code below:
library(shiny)
library(shinydashboard)
header <- dashboardHeader(
title = "Icon Example"
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem(
text = "Input",
tabName = "Input"
)
)
)
body <- dashboardBody(
tabItem(
tabName = "Input",
fluidRow(
column(
width = 6,
box(
status = "primary", solidHeader = TRUE,
width = 12,
title = span(tagList(icon("bar-chart"), "Box 1")),
fluidRow(
column(width = 1,
tags$div(HTML('<i class="fa fa-bar-chart" style = "color:#0072B2;"></i>'))
),
column(width = 11,
numericInput(inputId = "Num", label = "This is a numeric input", value = 1000))
)
),
box(
status = "primary", solidHeader = TRUE,
width = 12,
title = span(tagList(icon("font"), "Box 2")),
fluidRow(
column(width = 1,
tags$div(HTML('<i class="fa fa-font" style = "color:#D55E00;"></i>'))
),
column(width = 11,
textInput(inputId = "Text", label = "This is a text input")
)
)
)
)
)
)
)
# User Interface
ui <- dashboardPage(
header = header,
sidebar = sidebar,
body = body
)
# Server logic
server <- function(input, output, session){}
# Complete app with UI and server components
shinyApp(ui, server)

plotly html embedded in shiny

I have generated few plots using plotly and saved them as offline html (I don't want to generate them live as it would take so long to generate them in the background). The followings are the two plots taken from plotly site and I saved them as html.
#Graph 1
Animals <- c("giraffes", "orangutans", "monkeys")
SF_Zoo <- c(20, 14, 23)
LA_Zoo <- c(12, 18, 29)
data <- data.frame(Animals, SF_Zoo, LA_Zoo)
p <- plot_ly(data, x = ~Animals, y = ~SF_Zoo, type = 'bar', name = 'SF Zoo') %>%
add_trace(y = ~LA_Zoo, name = 'LA Zoo') %>%
layout(yaxis = list(title = 'Count'), barmode = 'group')
htmlwidgets::saveWidget(p, file="zoo.html")
#Graph 2
x <- c('Product A', 'Product B', 'Product C')
y <- c(20, 14, 23)
text <- c('27% market share', '24% market share', '19% market share')
data <- data.frame(x, y, text)
p <- plot_ly(data, x = ~x, y = ~y, type = 'bar', text = text,
marker = list(color = 'rgb(158,202,225)',
line = list(color = 'rgb(8,48,107)',
width = 1.5))) %>%
layout(title = "January 2013 Sales Report",
xaxis = list(title = ""),
yaxis = list(title = ""))
htmlwidgets::saveWidget(p, file="product.html")
I have written some shiny codes that can show html output from Rmarkdown but not the html that i generated from plotly above. Note that the first choice(sample) in the selectInput() is what I generated from default Rmarkdown html and that works. I also generated multiple rmarkdown html and I could also switch between htmls in the shiny app but not for plotly html.
ui= fluidPage(
titlePanel("opening web pages"),
sidebarPanel(
selectInput(inputId='test',label=1,choices=c("sample","zoo","product"))
),
mainPanel(
htmlOutput("inc")
)
)
server = function(input, output) {
getPage<-function() {
return(includeHTML(paste0("file:///C:/Users/home/Documents/",input$test,".html")))
}
output$inc<-renderUI({getPage()})
}
shinyApp(ui, server)
You can use an iframe for this - also have a look at addResourcePath:
ui = fluidPage(
titlePanel("opening web pages"),
sidebarPanel(selectInput(
inputId = 'test',
label = 1,
choices = c("sample", "zoo", "product")
)),
mainPanel(htmlOutput("inc"))
)
server = function(input, output) {
myhtmlfilepath <- getwd() # change to your path
addResourcePath('myhtmlfiles', myhtmlfilepath)
getPage <- function() {
return(tags$iframe(src = paste0("myhtmlfiles/", input$test, ".html"), height = "100%", width = "100%", scrolling = "yes"))
}
output$inc <- renderUI({
req(input$test)
getPage()
})
}
shinyApp(ui, server)

R/Shiny : RenderUI in a loop to generate multiple objects

After the success of the dynamic box in shiny here : R/Shiny : Color of boxes depend on select I need you to use these boxes but in a loop.
Example :
I have an input file which give this :
BoxA
BoxB
BoxC
I want in the renderUI loop these values as a variable to generate dynamically a Box A, B and C. (if I have 4 value, i will have 4 boxes etC.)
Here is my actually code:
for (i in 1:nrow(QRSList))
{
get(QRSOutputS[i]) <- renderUI({
column(4,
box(title = h3(QRSList[1], style = "display:inline; font-weight:bold"),
selectInput("s010102i", label = NULL,
choices = list("Non commencé" = "danger", "En cours" = "warning", "Terminé" = "success"),
selected = 1) ,width = 12, background = "blue", status = get(QRSIntputS[i])))
})
column(4,
observeEvent(input$s010102i,{
get(QRSOutputS[i]) <- renderUI({
box(title = h3(QRSList[1], style = "display:inline; font-weight:bold"),
selectInput("s010102i", label = NULL,
choices = list("Not good" = "danger", "average" = "warning", "good" = "success"),
selected = get(QRSIntputS[i])) ,width = 12, background = "blue",status = get(QRSIntputS[i]))
})
The aim is to replace these box names to a variable like input$s010102 for example. But get and assign function does not exist.
Any idea ?
Thanks a lot
Here is an example how to generate boxes dynamically
library(shinydashboard)
library(shiny)
QRSList <- c("Box1","Box2","Box3","Box4","Box5")
ui <- dashboardPage(
dashboardHeader(title = "render Boxes"),
dashboardSidebar(
sidebarMenu(
menuItem("Test", tabName = "Test")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "Test",
fluidRow(
tabPanel("Boxes",uiOutput("myboxes"))
)
)
)
)
)
server <- function(input, output) {
v <- list()
for (i in 1:length(QRSList)){
v[[i]] <- box(width = 3, background = "blue",
title = h3(QRSList[i], style = "display:inline; font-weight:bold"),
selectInput(paste0("slider",i), label = NULL,choices = list("Not good" = "danger", "average" = "warning", "good" = "success"))
)
}
output$myboxes <- renderUI(v)
}
shinyApp(ui = ui, server = server)

Positioning of shiny widets like box and selectInputs in R

Please run the R shiny script below, I shall attach two screens and need a little assistance with positioning of the widgets here:
Screen 1:
I want to increase the width of the selectInput widget such that the options are clearly visible with equal spacing from the KPI boxes.
I want same width and height for the two big boxes such that it entirely covers the screen from left to right.
Note: The left border of the box should coincide with the left border of selectInput widget.
Screen 2:
1. Please help with shifting of the first and second selectInput widget, and kpi boxes above such that the box plots width can be increased like the requirement in the above screen. Please help.
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Iris Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
tags$head(tags$style(HTML('.info-box {min-height: 45px;} .info-box-icon
{height: 45px; line-height: 45px;} .info-box-content {padding-top: 0px;
padding-bottom: 0px;}
'))),
fluidRow(
column(1,
selectInput("Position", "",
c("User_Analyses","User_Activity_Analyses"),selected = "Median", width =
"400"),
conditionalPanel(
condition = "input.Position == 'User_Analyses'",
selectInput("stats", "", c("Time","Cases"),selected = "Median", width =
"400"))),
tags$br(),
column(10,
infoBox("User1", paste0(10), icon = icon("credit-card"), width = "3"),
infoBox("User2",paste0(10), icon = icon("credit-card"), width =
"3"),
infoBox("User3",paste0(10), icon = icon("credit-card"), width =
"3"),
infoBox("User4",paste0(16), icon = icon("credit-card"), width =
"3")),
column(10,
conditionalPanel(
condition = "input.Position == 'User_Analyses'",
box(title = "Plot1", status = "primary",height = "537" ,solidHeader = T,
plotOutput("case_hist",height = "466")),
box(title = "Plot2", status = "primary",height = "537" ,solidHeader = T,
plotOutput("trace_hist",height = "466"))
),
conditionalPanel(
condition = "input.Position == 'User_Activity_Analyses'",
box(title = "Plot3",status = "primary",solidHeader = T,height = "537",width = "6",
plotOutput("sankey_plot")),
box(title = "Plot4",status = "primary",solidHeader = T,height = "537",width = "6",
plotOutput("sankey_table"))
)
)
)
)
)
server <- function(input, output)
{
output$case_hist <- renderPlot(
plot(iris$Sepal.Length)
)
output$trace_hist <- renderPlot(
plot(mtcars$mpg)
)
output$sankey_plot <- renderPlot({
plot(diamonds$carat)
})
#Plot for Sankey Data table
output$sankey_table <- renderPlot({
plot(iris$Petal.Length)
})
}
shinyApp(ui, server)
Is this somewhat what you want.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Iris Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
tags$head(tags$style(HTML('.info-box {min-height: 45px;} .info-box-icon
{height: 45px; line-height: 45px;} .info-box-content {padding-top: 0px;
padding-bottom: 0px;}
'))),
fluidRow(
column(
width = 12,
column(
width = 2,
selectInput("Position", "",
c("User_Analyses","User_Activity_Analyses"),selected = "Median", width =
"400"),
conditionalPanel(
condition = "input.Position == 'User_Analyses'",
style = "margin-top:-22px;",
selectInput("stats", "", c("Time","Cases"),selected = "Median", width = "400"))
),
column(
style = "padding-top:20px;",
width = 10,
infoBox("User1", paste0(10), icon = icon("credit-card"), width = "3"),
infoBox("User2",paste0(10), icon = icon("credit-card"), width ="3"),
infoBox("User3",paste0(10), icon = icon("credit-card"), width ="3"),
infoBox("User4",paste0(16), icon = icon("credit-card"), width ="3"))
),
column(
width = 12,
conditionalPanel(
condition = "input.Position == 'User_Analyses'",
box(title = "Plot1", status = "primary",height = "537" ,solidHeader = T,
plotOutput("case_hist",height = "466")),
box(title = "Plot2", status = "primary",height = "537" ,solidHeader = T,
plotOutput("trace_hist",height = "466"))
),
conditionalPanel(
condition = "input.Position == 'User_Activity_Analyses'",
box(title = "Plot3",status = "primary",solidHeader = T,height = "537",width = "6",
plotOutput("sankey_plot")),
box(title = "Plot4",status = "primary",solidHeader = T,height = "537",width = "6",
plotOutput("sankey_table"))
)
)
)
)
)
server <- function(input, output)
{
output$case_hist <- renderPlot(
plot(iris$Sepal.Length)
)
output$trace_hist <- renderPlot(
plot(mtcars$mpg)
)
output$sankey_plot <- renderPlot({
plot(diamonds$carat)
})
#Plot for Sankey Data table
output$sankey_table <- renderPlot({
plot(iris$Petal.Length)
})
}
shinyApp(ui, server)

How to set the sizes and specific layouts in shiny

I am trying to make the following layout in shiny:
This is what I achieved so far by the help of this answer :
My ui.R:
library(shiny)
library(ggplot2)
shinyUI(fluidPage(
# fluidRow(
# title = "My title",
# column(6,plotOutput('plot1', height="200px"))
# #plotOutput('plot1'),
# #plotOutput('plot2'),
# #plotOutput('plot3')
# ),
fluidRow(
column(6,div(style = "height:200px;background-color: gray;", "Topleft")),
column(6,div(style = "height:400px;background-color: gray;", "right"))),
fluidRow(
column(6,div(style = "height:100px;background-color: gray;", "Bottomleft"))
),
hr(),
fluidRow(
column(7,
h4("Control Panel"),
fileInput('file', 'Select an CSV file to read',
accept=c('text/csv','text/comma-separated- values,text/plain','.csv')),
br(),
sliderInput('sampleSize', 'Sample Size',
min=1, max=100, value=min(1, 100),
step=500, round=0),
br(),
actionButton("readButton", "Read Data!")
)
)
))
My server.R:
function(input, output) {
}
I don't know how to plug int he plotOutput into the boxes?
How can I control the sizes of the box to look like the layout given above?
Don't make things too complicated, just work with rows, columns and the height attribute of plots:
library(shiny)
ui <- shinyUI(fluidPage(fluidRow(
column(
width = 3,
plotOutput('plot1', height = 200),
plotOutput('plot2', height = 200)
),
column(width = 8, plotOutput('plot3', height = 400))
),
hr(),
wellPanel(fluidRow(
column(
width = 11,
align = "center",
h3("Control Panel"),
column(width = 3, fileInput('file','Select an CSV file to read', accept = c('text/csv', 'text/comma-separated-values,text/plain', '.csv'))),
column(width = 3, offset = 1, sliderInput('sampleSize','Sample Size', min = 1, max = 100, value = min(1, 100), step = 500,round = 0)),
column(width = 1, offset = 1, actionButton("readButton", "Read Data!"))
)
))))
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(mtcars$mpg, mtcars$cyl)
})
output$plot2 <- renderPlot({
plot(mtcars$mpg, mtcars$carb)
})
output$plot3 <- renderPlot({
plot(mtcars$mpg, mtcars$disp)
})
}
shinyApp(ui, server)