I want to have the output of slider changing when the user drags while a particular feature is selected. When the user switches from the current feature to any other feature - the latest value of the slider should be displayed on the output space. BUT HERE IS THE WEIRD PROBLEM I AM FACING.
I am trying to do the above with the first two features - Feature1 and Feature2.
PROBLEM AREA - PLEASE SEE output$textFE and output$textVIS.
My desire - When I have if and else if conditions till 70 (in output$textVIS) then I get what I want. BUT AS SOON AS I INCLUDE THE else if command till 80 (JUST SOME EXTRA 4 lines with everything being the same), then the output goes crazy and I see TWO OUTPUTS BEING DISPLAYED AT PARALLEL which I DON"T WANT.
I have lost my hair thinking what is wrong with the code but at the end I have arrived at the conclusion that something is wrong with the SHINY PACKAGE - RSTUDIO in general.
PLEASE prove me wrong by sharing your valuable insights. I AM DEVASTATED.
Here is the ui.R
library(shiny)
library(shinydashboard)
shinyUI(
fluidPage(
# Creating the notifications at the center of the page instead of bottom right corner
tags$head(
tags$style(
HTML(".shiny-notification {
position:fixed;
top: calc(50%);;
left: calc(50%);;
width: 425px ;;
font-size: 24px ;;
}
"
)
)
),
dashboardPage(
dashboardHeader(title = "Feature Dependency", titleWidth = 400),
dashboardSidebar(
box(
h6("", textOutput("errorMessage")),
#Creating the navy blue box and puttig background color of navy,
width = 400, height = 350, background = "navy",
#Increasing font size of radio buttons
tags$style(type = "text/css", "label { font-size: 16px; }"),
# First ask which feature/bar should be modified
radioButtons("feature", "Modify",
choices = c("Feature1", " Feature2", " Feature3", " Feature4",
" Feature5", "Feature6", " Feature7",
" Feature8", " Feature9", " Feature10"),
selected = NULL)
),
box (
# Then specify by what amount
sliderInput("slider", "WEIGHT", 0, 100, value = 0, step = 5),
align = "center", width = 400, background = "navy"
), #Box for slider Input ends here
box (
# Apply changes
actionButton("go", "Apply changes"),
br(),
actionButton("reset", "Reset"),
align = "center", width = 400, background = "navy"
), width = 400 #(this is the width for the whle sidebar)
), #sideBar ends here
dashboardBody(
#fluidRow so that as the size of window changes the contents change
fluidRow(
mainPanel(
#Making teh mainPanel which consists of 12 columns to soan the full length of window
width = 12,
#Box so that the graph could be accurately resized whenever wanted
box( height = 600, width = 1200, align = "center",
plotOutput("bar_plot",
#Increasing the size of output graph so that it looks good visually
height = 500)
), #Box for the main graph ends here
box (
column (1,
align = "center", infoBoxOutput("recordofchanges")
),#1st column of nothing
column (2,
align = "center",
h5("Feature1"), verbatimTextOutput("textFE"),
h5("Feature2"), verbatimTextOutput("textVIS")
),#2nd column ends here
column (2,
align = "center",
h5("Feature3"), verbatimTextOutput("textDPOS"),
h5("Feature4"), verbatimTextOutput("textM")
), #3rd column ends here
column (2,
align = "center",
h5("Feature5"), verbatimTextOutput("textRIC"),
h5("Feature6"), verbatimTextOutput("textDRI")
), #4th column ends here
column (2,
align = "center",
h5("Feature7"), verbatimTextOutput("textRC"),
h5("Feature8"), verbatimTextOutput("textCS")
), #5th column ends here
column (2,
align = "center",
h5("Feature9"), verbatimTextOutput("textQI"),
h5("Feature10"), verbatimTextOutput("textREL")
),#6th column ends here
column (1,
align = "center",
h5("Number of clicks"), textOutput("clickCount")
),#7th column ends here
align = "center", width = 1000 )# Box for current values of features end here
)#mainPanel ends here
)#fluidRow ends here
)
)
)
)
Here is the server.R
library(shiny)
library(shinydashboard)
shinyServer(function(input,output)
{
Create a dynamic vector with 4 elements. Each one corresponds to the
length to the bar: (I called it "L" so that I don't have to type much 
)
L <- reactiveValues(vec = c("Feature1" = 100, " Feature2" = 100,
" Feature3" = 100, " Feature4" = 100,
" Feature5" = 100, " Feature6" = 100,
" Feature7" = 100, " Feature8" = 100,
" Feature9" = 100, " Feature10" = 100))
observeEvent(input$go, {
# After the button is pressed input$checkbox gives either
cat("\n")
print(paste0("Changing radioButtons to: ", input$feature))
# and input$slider gives
print(paste0("Changing the value of the slider to: ", input$slider))
# So basically we can use again observeEvent to modify the
# dynamic matrix which will be then passed to barplot function
})
observeEvent(input$go, {
cat("\nChanging values of the dynamic matrix\n")
# Every time you press the button, the matrix will be modified.
# (In this way we avoid simultaneous dependency on 4 different inputs)
# To modify the matrix we can use if-statements
slider <- input$slider
if (input$feature == " Feature1") {
#EXTRA CONDITION that prevents the other features from being negative while this feature is moved
#The number 230 is found manually through trial error beyond which one of the features become negative
if (L$vec["Feature1"] > 230) {
output$errorMessage <- renderText({
paste("You cannot increase further")
})
}
else {
L$vec[1] <- L$vec[1] + slider * 0.975
L$vec[2] <- L$vec[2] - slider * 0.731
L$vec[3] <- L$vec[3] - slider * 0.523
L$vec[4] <- L$vec[4] - slider * 0.370
L$vec[5] <- L$vec[5] - slider * 0.258
L$vec[6] <- L$vec[6] - slider * 0.180
L$vec[7] <- L$vec[7] - slider * 0.125
L$vec[8] <- L$vec[8] - slider * 0.088
L$vec[9] <- L$vec[9] - slider * 0.064
L$vec[10] <- L$vec[10] - slider * 0.047
# Creating The notifications for the feature metrics
if (L$vec["Feature1"] > 210.5 & L$vec["Feature1"] < 226) {
showNotification("Feature1is * AMONG THE BEST *", duration = 10, closeButton = TRUE,
type ="warning")
}
if (L$vec["Feature1"] > 226.55) {
showNotification("Feature1 is * BEST IN CLASS *", duration = 10, closeButton = TRUE,
type ="message")
}
}
} else if (input$feature == " Feature2") {
#EXTRA CONDITION that prevents the other features from being negative while this feature is moved
#The number 175 is found manually through trial error beyond which one of the features become negative
if (L$vec["Feature2"] > 173) {
output$errorMessage <- renderText({
paste("You cannot increase further")
})
} else {
L$vec[1] <- L$vec[1] - slider * 0.975
L$vec[2] <- L$vec[2] + slider * 0.731
L$vec[3] <- L$vec[3] - slider * 0.523
L$vec[4] <- L$vec[4] - slider * 0.370
L$vec[5] <- L$vec[5] - slider * 0.258
L$vec[6] <- L$vec[6] - slider * 0.180
L$vec[7] <- L$vec[7] - slider * 0.125
L$vec[8] <- L$vec[8] - slider * 0.088
L$vec[9] <- L$vec[9] - slider * 0.064
L$vec[10] <- L$vec[10] - slider * 0.047
# Creating The notifications for the feature metrics
if (L$vec["Feature2"] > 164.4 & L$vec["Feature2"] < 172) {
showNotification("Feature2 is * AMONG THE BEST *", duration = 10, closeButton = TRUE,
type ="warning")
}
if (L$vec["Feature2"] > 172.375) {
showNotification("Feature2 is * BEST IN CLASS *", duration = 10, closeButton = TRUE,
type ="message")
}
}
} else if (input$feature == " Feature3") {
#EXTRA CONDITION that prevents the other features from being negative while this feature is moved
#The number 154 is found manually through trial error beyond which one of the features become negative
if (L$vec["Feature3"] > 152) {
output$errorMessage <- renderText({
paste("You cannot increase further")
})
} else {
L$vec[1] <- L$vec[1] - slider * 0.975
L$vec[2] <- L$vec[2] - slider * 0.731
L$vec[3] <- L$vec[3] + slider * 0.523
L$vec[4] <- L$vec[4] - slider * 0.370
L$vec[5] <- L$vec[5] - slider * 0.258
L$vec[6] <- L$vec[6] - slider * 0.180
L$vec[7] <- L$vec[7] - slider * 0.125
L$vec[8] <- L$vec[8] - slider * 0.088
L$vec[9] <- L$vec[9] - slider * 0.064
L$vec[10] <- L$vec[10] - slider * 0.047
# Creating The notifications for the feature metrics
if (L$vec["Feature3"] > 145.61 & L$vec["Feature3"] < 151.69 ) {
showNotification("Feature3 is * AMONG THE BEST *", duration = 10, closeButton = TRUE,
type ="warning")
}
if (L$vec["Feature3"] > 151.69 ) {
showNotification("Feature3 is * BEST IN CLASS *", duration = 10, closeButton = TRUE,
type ="message")
}
}
} else if (input$feature == " Feature4") {
#EXTRA CONDITION that prevents the other features from being negative while this feature is moved
#The number 137 is found manually through trial error beyond which one of the features become negative
if (L$vec["Feature4"] > 135.5) {
output$errorMessage <- renderText({
paste("You cannot increase further")
})
} else {
L$vec[1] <- L$vec[1] - slider * 0.975
L$vec[2] <- L$vec[2] - slider * 0.731
L$vec[3] <- L$vec[3] - slider * 0.523
L$vec[4] <- L$vec[4] + slider * 0.370
L$vec[5] <- L$vec[5] - slider * 0.258
L$vec[6] <- L$vec[6] - slider * 0.180
L$vec[7] <- L$vec[7] - slider * 0.125
L$vec[8] <- L$vec[8] - slider * 0.088
L$vec[9] <- L$vec[9] - slider * 0.064
L$vec[10] <- L$vec[10] - slider * 0.047
# Creating The notifications for the feature metrics
if (L$vec["Feature4"] > 130.205 & L$vec["Feature4"] < 134.945) {
showNotification("Feature4 is * AMONG THE BEST *", duration = 10, closeButton = TRUE,
type ="warning")
}
if (L$vec["Feature4"] > 134.945 ) {
showNotification("Feature4 is * BEST IN CLASS *", duration = 10, closeButton = TRUE,
type ="message")
}
}
} else if (input$feature == " Feature5") {
#EXTRA CONDITION that prevents the other features from being negative while this feature is moved
#The number 126 is found manually through trial error beyond which one of the features become negative
if (L$vec["Feature5"] > 124.8) {
output$errorMessage <- renderText({
paste("You cannot increase further")
})
} else {
L$vec[1] <- L$vec[1] - slider * 0.975
L$vec[2] <- L$vec[2] - slider * 0.731
L$vec[3] <- L$vec[3] - slider * 0.523
L$vec[4] <- L$vec[4] - slider * 0.370
L$vec[5] <- L$vec[5] + slider * 0.258
L$vec[6] <- L$vec[6] - slider * 0.180
L$vec[7] <- L$vec[7] - slider * 0.125
L$vec[8] <- L$vec[8] - slider * 0.088
L$vec[9] <- L$vec[9] - slider * 0.064
L$vec[10] <- L$vec[10] - slider * 0.047
# Creating The notifications for the feature metrics
if (L$vec["Feature5"] > 118.59 & L$vec["Feature5"] < 124) {
showNotification("Feature5 is * AMONG THE BEST *", duration = 10, closeButton = TRUE,
type ="warning")
}
if (L$vec["Feature5"] > 124.11 ) {
showNotification("Feature5 is * BEST IN CLASS *", duration = 10, closeButton = TRUE,
type ="message")
}
}
} else if (input$feature == " Feature6") {
#EXTRA CONDITION that prevents the other features from being negative while this feature is moved
#The number 118 is found manually through trial error beyond which one of the features become negative
if (L$vec["Feature6"] > 116.8) {
output$errorMessage <- renderText({
paste("You cannot increase further")
})
} else {
L$vec[1] <- L$vec[1] - slider * 0.975
L$vec[2] <- L$vec[2] - slider * 0.731
L$vec[3] <- L$vec[3] - slider * 0.523
L$vec[4] <- L$vec[4] - slider * 0.370
L$vec[5] <- L$vec[5] - slider * 0.258
L$vec[6] <- L$vec[6] + slider * 0.180
L$vec[7] <- L$vec[7] - slider * 0.125
L$vec[8] <- L$vec[8] - slider * 0.088
L$vec[9] <- L$vec[9] - slider * 0.064
L$vec[10] <- L$vec[10] - slider * 0.047
# Creating The notifications for the feature metrics
if (L$vec["Feature6"] > 113.87 & L$vec["Feature6"] < 116 ) {
showNotification("Feature6 is * AMONG THE BEST *", duration = 10, closeButton = TRUE,
type ="warning")
}
if (L$vec["Feature6"] > 116.23 ) {
showNotification("Feature6 is * BEST IN CLASS *", duration = 10, closeButton = TRUE,
type ="message")
}
}
} else if (input$feature == " Feature7") {
#EXTRA CONDITION that prevents the other features from being negative while this feature is moved
#The number 112 is found manually through trial error beyond which one of the features become negative
if (L$vec["Feature7"] > 111) {
output$errorMessage <- renderText({
paste("You cannot increase further")
})
} else {
L$vec[1] <- L$vec[1] - slider * 0.975
L$vec[2] <- L$vec[2] - slider * 0.731
L$vec[3] <- L$vec[3] - slider * 0.523
L$vec[4] <- L$vec[4] - slider * 0.370
L$vec[5] <- L$vec[5] - slider * 0.258
L$vec[6] <- L$vec[6] - slider * 0.180
L$vec[7] <- L$vec[7] + slider * 0.125
L$vec[8] <- L$vec[8] - slider * 0.088
L$vec[9] <- L$vec[9] - slider * 0.064
L$vec[10] <- L$vec[10] - slider * 0.047
# Creating The notifications for the feature metrics
if (L$vec["Feature7"] > 107 & L$vec["Feature7"] < 110 ) {
showNotification("Feature7 is * AMONG THE BEST *", duration = 10, closeButton = TRUE,
type ="warning")
}
if (L$vec["Feature7"] > 110.32 ) {
showNotification("Feature7 is * BEST IN CLASS *", duration = 10, closeButton = TRUE,
type ="message")
}
}
} else if (input$feature == " Feature8") {
#EXTRA CONDITION that prevents the other features from being negative while this feature is moved
#The number 109 is found manually through trial error beyond which one of the features become negative
if (L$vec["Feature8"] > 108) {
output$errorMessage <- renderText({
paste("You cannot increase further")
})
} else {
L$vec[1] <- L$vec[1] - slider * 0.975
L$vec[2] <- L$vec[2] - slider * 0.731
L$vec[3] <- L$vec[3] - slider * 0.523
L$vec[4] <- L$vec[4] - slider * 0.370
L$vec[5] <- L$vec[5] - slider * 0.258
L$vec[6] <- L$vec[6] - slider * 0.180
L$vec[7] <- L$vec[7] - slider * 0.125
L$vec[8] <- L$vec[8] + slider * 0.088
L$vec[9] <- L$vec[9] - slider * 0.064
L$vec[10] <- L$vec[10] - slider * 0.047
# Creating The notifications for the feature metrics
if (L$vec["Feature8"] > 105.185 & L$vec["Feature8"] < 107 ) {
showNotification("Feature8 is * AMONG THE BEST *", duration = 10, closeButton = TRUE,
type ="warning")
}
if (L$vec["Feature8 "] > 107.365 ) {
showNotification("Feature8 is * BEST IN CLASS *", duration = 10, closeButton = TRUE,
type ="message")
}
}
} else if (input$feature == " Feature9 ") {
#EXTRA CONDITION that prevents the other features from being negative while this feature is moved
#The number 106 is found manually through trial error beyond which one of the features become negative
if (L$vec["Feature9"] > 104.6) {
output$errorMessage <- renderText({
paste("You cannot increase further")
})
} else {
L$vec[1] <- L$vec[1] - slider * 0.975
L$vec[2] <- L$vec[2] - slider * 0.731
L$vec[3] <- L$vec[3] - slider * 0.523
L$vec[4] <- L$vec[4] - slider * 0.370
L$vec[5] <- L$vec[5] - slider * 0.258
L$vec[6] <- L$vec[6] - slider * 0.180
L$vec[7] <- L$vec[7] - slider * 0.125
L$vec[8] <- L$vec[8] - slider * 0.088
L$vec[9] <- L$vec[9] + slider * 0.064
L$vec[10] <- L$vec[10] - slider * 0.047
# Creating The notifications for the feature metrics
if (L$vec["Feature9"] > 102.29 & L$vec["Feature9"] < 104 ) {
showNotification("Feature9 is * AMONG THE BEST *", duration = 10, closeButton = TRUE,
type ="warning")
}
if (L$vec["Feature9 "] > 104.41 ) {
showNotification("Feature9 is * BEST IN CLASS *", duration = 10, closeButton = TRUE,
type ="message")
}
}
} else {
#EXTRA CONDITION that prevents the other features from being negative while this feature is moved
#The number 104.5 is found manually through trial error beyond which one of the features become negative
if (L$vec["Feature10"] > 103) {
output$errorMessage <- renderText({
paste("You cannot increase further")
})
} else {
L$vec[1] <- L$vec[1] - slider * 0.975
L$vec[2] <- L$vec[2] - slider * 0.731
L$vec[3] <- L$vec[3] - slider * 0.523
L$vec[4] <- L$vec[4] - slider * 0.370
L$vec[5] <- L$vec[5] - slider * 0.258
L$vec[6] <- L$vec[6] - slider * 0.180
L$vec[7] <- L$vec[7] - slider * 0.125
L$vec[8] <- L$vec[8] - slider * 0.088
L$vec[9] <- L$vec[9] - slider * 0.064
L$vec[10] <- L$vec[10] + slider * 0.047
# Creating The notifications for the feature metrics
if (L$vec["Feature10"] > 101.5 & L$vec["Feature10"] < 102 ) {
showNotification("Feature10 is * AMONG THE BEST *", duration = 10, closeButton = TRUE,
type ="warning")
}
if (L$vec["Feature10"] > 102.935 ) {
showNotification("Feature10 is * BEST IN CLASS *", duration = 10, closeButton = TRUE,
type ="message")
}
}
}
cat("\n")
print(L$vec)
})
observeEvent(input$reset, {
output$errorMessage <- renderText({paste("Let's start again.")})
output$textFE <- renderText({ if ( input$slider && input$feature == " Feature1") {
paste(" Current Wt.", input$slider)
}
})
cat("\n", "Reset", "\n")
L$vec <- c("Feature1" = 100, " Feature2" = 100, " Feature3" = 100,
" Feature4" = 100, " Feature5" = 100, " Feature6" = 100,
" Feature7" = 100, " Feature8" = 100, " Feature9" = 100, " Feature10" = 100)
})
Creating the live output of slider
image2 sends pre-rendered images
output$textFE <- renderText({
if (input$slider && input$feature == " Feature1") {
paste("Current Wt.", input$slider)
} else {
if (input$slider == 10 ) {
output$textFE <- renderText({
paste("10")
})
} else if (input$slider == 20 ) {
output$textFE <- renderText ({
paste("20")
})
} else if (input$slider == 30 ) {
output$textFE <- renderText ({
paste("30")
})
} else if (input$slider == 40 ) {
output$textFE <- renderText ({
paste("40")
})
} else if (input$slider == 50 ) {
output$textFE <- renderText ({
paste("50")
})
} else if (input$slider == 60 ) {
output$textFE <- renderText ({
paste("60")
})
} else if (input$slider == 70 ) {
output$textFE <- renderText ({
paste("70")
})
} else if (input$slider == 80 ) {
output$textFE <- renderText ({
paste("80")
})
} else if (input$slider == 90 ) {
output$textFE <- renderText ({
paste("90")
})
} else if (input$slider == 100 ) {
output$textFE <- renderText ({
paste("100")
})
}
}
})
output$textVIS <- renderText({
if (input$feature == " Feature2") {
paste("Current Wt.", input$slider)
} else {
if (input$slider == 10 ) {
output$textVIS <- renderText({
paste("10")
})
} else if (input$slider == 20 ) {
output$textVIS <- renderText ({
paste("20")
})
} else if (input$slider == 30 ) {
output$textVIS <- renderText ({
paste("30")
})
} else if (input$slider == 40 ) {
output$textVIS <- renderText ({
paste("40")
})
} else if (input$slider == 50 ) {
output$textVIS <- renderText ({
paste("50")
})
} else if (input$slider == 60 ) {
output$textVIS <- renderText ({
paste("60")
})
}
}
})
output$textDPOS <- renderText({
if (input$slider && input$feature == " Feature3") {
paste("Current Wt.", input$slider)
} else {
paste(" ")
}
})
output$textM <- renderText({
if (input$slider && input$feature == " Feature4") {
paste("Current Wt.", input$slider)
} else {
paste(" ")
}
})
output$textRIC <- renderText({
if (input$slider && input$feature == " Feature5") {
paste("Current Wt.", input$slider)
} else {
paste(" ")
}
})
output$textDRI <- renderText({
if (input$slider && input$feature == " Feature6") {
paste("Current Wt.", input$slider)
} else {
paste(" ")
}
})
output$textRC <- renderText({
if (input$slider && input$feature == " Feature7") {
paste("Current Wt.", input$slider)
} else {
paste(" ")
}
})
output$textCS <- renderText({
if (input$slider && input$feature == " Feature8") {
paste("Current Wt.", input$slider)
} else {
paste(" ")
}
})
output$textQI <- renderText({
if (input$slider && input$feature == " Feature9") {
paste("Current Wt.", input$slider)
} else {
paste(" ")
}
})
output$textREL <- renderText({
if (input$slider && input$feature == " Feature9") {
paste("Current Wt.", input$slider)
} else {
paste(" ")
}
})
output$clickCount <- renderText({
input$go
})
output$bar_plot <- renderPlot({
#setting the margin size so everything is visible on x axis labels
par(mar = c(9.5, 4, 5, 2))
#Creating the bar plot
barplot(
#reducing the width of bars in a bar plot
space = 0.5,
#Creating the bar plot with colors
ylim=c(0,250),
#Creating interactive bar plot
t(as.matrix(L$vec)),
main = 'Sample Feature Dependency Plot',
ylab = "Operability",
xlab = "",
#Making the x axis labels vertical instead of horizontal
las = 2,
#increasing the size of x axis labels
cex.names = 1.2,
# Creating a little tab box for colors at the top,
args.legend = list(title = "Pop-up meaning", x = "topright", cex = .9),
# Giving 3 different colors to feature metric increments - Best in class, competetive, above average
legend = c("Competitive", "Among the best", "Best in class"),
col = c("lightgrey", "gold", "skyblue4")
)
})
}
)