Router "True" Issue

[ccwitt]

Anytime I source a .R page that I have created and then Run the app, the App will load but only with have the screen visible and the word "TRUE" at the bottom left side. How do I fix this annoyance. I have uploaded some minimal R code.

library(shiny)

devtools::install_github("Appsilon/shiny.router")

library(shiny.router)

Both sample pages.

page2 <- source("/SamplingProject/7a_Create_Strata_Assing_Default_Single_Stratum.R")

Creates router. We provide routing path and UI for this page.

router <- make_router( route("/page2", page2) )

Creat output for our router in main UI of Shiny app.

ui <- shinyUI(fluidPage( router_ui() ))

Plug router into Shiny server.

server <- shinyServer(function(input, output) { router(input, output) })

Run server in a standard way.

shinyApp(ui, server)

[krystian8207]

Hi! Thank you for using shiny.router. Fast test showed me that assigning source output to variable make it visible as TRUE. Can you perform assignment for page2 variable inside your script: "/SamplingProject/7a_Create_Strata_Assing_Default_Single_Stratum.R", and then just type: source("/SamplingProject/7a_Create_Strata_Assing_Default_Single_Stratum.R") outside server and ui? I think this should help.

Best, Krystian

[ccwitt]

Krystian,

Can you give me a quick example of what you mean exactly? I really appreciate your help.

[ccwitt]

I ran the following code, and still get the same nonsense...

library(shiny)

devtools::install_github("Appsilon/shiny.router")

library(shiny.router)

source("/7a_Create_Strata_Assing_Default_Single_Stratum.R")

ui <- shinyUI(fluidPage( router_ui() ))

Plug router into Shiny server.

server <- shinyServer(function(input, output) { router(input, output)

})

router <- make_router( route("/page2", page2),

page2<- "/7a_Create_Strata_Assing_Default_Single_Stratum.R"

)

Run server in a standard way.

shinyApp(ui, server)

[ccwitt]

However, this does work, just cannot pass it in as variable, thanks for the help.

library(shiny)

devtools::install_github("Appsilon/shiny.router")

library(shiny.router)

ui <- shinyUI(fluidPage( router_ui() ))

Plug router into Shiny server.

server <- shinyServer(function(input, output) { router(input, output)

})

router <- make_router( route("/page2", source("/7a_Create_Strata_Assing_Default_Single_Stratum.R"))

)

Run server in a standard way.

shinyApp(ui, server)

[krystian8207]

Hi. Sure. Assume that your current version of "/SamplingProject/7a_Create_Strata_Assing_Default_Single_Stratum.R" is:

library(shiny)
tags$div("Hello")

Instead of assigning: page2 <- source("/SamplingProject/7a_Create_Strata_Assing_Default_Single_Stratum.R") just type: source("/SamplingProject/7a_Create_Strata_Assing_Default_Single_Stratum.R") And change mentioned above script with:

library(shiny)
page2 <- tags$div("Hello")

I think this should help.

[ccwitt]

What I am trying to do is create a customized header with HTML code that will link to already created .R pages. Unfortunately these .R pages contain their on UI and Server. I was hoping to integrate them in the code by just referencing them. Problem is after solving that one problem I get TRUE appearing again.

For example, library(shiny)

devtools::install_github("Appsilon/shiny.router")

library(shiny.router)

router <- make_router( route("/page2", source("/2SampleSelection/screen1.R")))

ui <- shinyUI(fluidPage( includeHTML("/SamplingProject/Header2.html"), router_ui() ))

Plug router into Shiny server.

server <- shinyServer( function(input, output) { router(input, output) })

Run server in a standard way.

shinyApp(ui, server)

[krystian8207]

Hi I think the problem is that you use source incorrect.

I see now two possible ways:

1. I presented in my previous post.
2. Extract the source value in your example with: source("/2SampleSelection/screen1.R")$value.

[ccwitt]

You are right, the following also works,

library(shiny)

devtools::install_github("Appsilon/shiny.router")

library(shiny.router)

page2 <- "//filer1/ppi/SamplingProject/2SampleSelection/screen1.R"

router<- make_router( route("/page2", source(page2)))

ui <- shinyUI(fluidPage( router_ui() ))

Plug router into Shiny server.

server <- shinyServer( function(input, output) { router(input,output) })

Run server in a standard way.

shinyApp(ui, server)

But now how do I insert a page that I have created in HTML as a header without the TRUE statement appearing

[ccwitt]

I just cannot seem to get a header to display without that "TRUE" statement appearing any thoughts?

[krystian8207]

@ccwitt It would be great if you prepare small example when the issue occurs. For now I cannot help you without knowledge of content of screen1.R script.

[ccwitt]

@krystian8207 thanks again for all your help, here is screen1.R as requested,

library(shinydashboard)

body <- dashboardBody(

  fluidRow(
    box(title = "Select Sort Variables for Stratum", width=2, status="primary", 

        selectInput("select1", label = h5("Sort Variable 1"), choices = list("EMPLOYMENT" = 1, "WAGES" = 2), selected = 1),

        selectizeInput("select2", label = h5("Sort Variable 2"), choices = list(" ","EMPLOYMENT" = 1, "WAGES" = 2), selected = NULL),

        selectizeInput("select3", label = h5("Sort Variable 3"), choices = list(" ","EMPLOYMENT" = 1, "WAGES" = 2), selected = NULL)
        ), # End Box 1

    box( width = 8, 

        HTML('<head>
              <style>
             table, th, td{border: 1px solid black;padding: 10px 20px;}
             </style>
             </head>

             <body>
             <table>
             <tr>
             <th> ASSIGN </th>
             <th> SS </th>
             <th> DESCRIPTION </th>
             <th> SORT ORDER 1 </th>
             <th> SORT ORDER 2 </th>
             <th> SORT ORDER 3 </th>
             </tr>
             <tr><td> <button onclick="myFunction1()"> Assign </button> </td>
             <td><center> -- </center> </td>
             <td> DEFAULT SINGLE </td>
             <td> <center id="demo1"></center> </td>
             <td> <center id="demo2"></center> </td> 
             <td> <center id="demo3"></center> </td>
             </tr>
             </table>

             <script>

             function myFunction1() { 
                 var x = document.getElementById("select1");
                 var y = document.getElementById("select2");
                 var z = document.getElementById("select3");

                  var x1 = x.options[x.selectedIndex].text;
                  var y1 = y.options[y.selectedIndex].text;
                  var z1 = z.options[z.selectedIndex].text;

                  document.getElementById("demo1").innerHTML = x1;
                  document.getElementById("demo2").innerHTML = y1;
                  document.getElementById("demo3").innerHTML = z1;}

             </script>
             </body>') # End HTML

        ) # End box 2
    ),  #End Fluid Row #1 

  fluidRow(
    box( width=12, title="ENTER PARAMETER",

         HTML('<!DOCTYPE html>
               <html>
              <head>
              <style>
              table, th, td{border: 1px solid black;padding: 10px 20px}
              </style>
              </head>

              <body>

              <pre>DIPPI ALLOCATION :                                                                  SMD ALLOCATION :    
SAMPLE ALLOCATION : <input type="text" id="input2" value="">                              SIZE MEASURE FOR ALLOCATION : <select name="allocation">  
              <option value="1"> EMPLOYMENT </option>
              <option value="2"> WAGES  </option>
              </select>  <button  type="button" > PROPORTIONALLY ALLOCATE TO </button>
              </pre> 

              <table>
              <tr>
              <th> STRATA </th>
              <th> DESCRIPTION </th>
              <th> FRAME UNITS </th>
              <th> PRE-SELECT </th>
              <th> HOLD </th>
              <th> ALLOC </th>
              <th> SAMPLE SIZE MEASURE </th>
              <th> MIN </th>
              </tr>
              <tr>
              <td> <center> -- </center> </td>
              <td> Default Single </td>
              <td>  </td>
              <td>  </td>
              <td> <center> <input id="checkbox1" type="checkbox"> </center> </td>
              <td>  <center id="demo4"> </td>
              <td> <center> EMPLOYMENT </center> </td>
              <td> <input id="input2" type="text"> </td>
              </tr>
              </table> 

              <p style="margin:0 0 0 72.5%"> <button onclick="myFunction2()"  type="button" > SAVE </button> </p>  

             <script>

              function myFunction2() { 
              var alloc = document.getElementById("input2").value;
           if((alloc%1) == 0 && (alloc > 0 ))
              {
              document.getElementById("demo4").innerHTML = parseInt(alloc,10);
              alert("Allocation Saved");
              } 
              else 
              {
              alert("The allocation you entered is not an integer > 0, please enter in a valid value");
              }

              }

              </script>

              </body>
              </html>

              ')# End Html

       ) # End Box 
    ) #End Fluid Row #2

  ) # End Dashboard Body

# Server
server <- function(input,output)
{

  # First RoW Outputs
  output$value1 <- renderPrint({ input$select1 })
  output$value2 <- renderPrint({ input$select2 })
  output$value3 <- renderPrint({ input$select3 })

}

# UI 
ui <- dashboardPage(
  dashboardHeader(title = "PPI Sampling System"),
  dashboardSidebar(),
  body
)

# Preview the UI in the console
shinyApp(ui = ui, server = function(input, output) { })

[krystian8207]

Please compare below solution with other examples we prepared in our package to understand how it works better.

Below is correct solution to your problem: app.R

library(shiny)
#devtools::install_github("Appsilon/shiny.router")
library(shiny.router)

source("screen1.R") 

router<- make_router(
  route("/page2", page2)
)

ui <- shinyUI(fluidPage(
  router_ui()
))

# Plug router into Shiny server.
server <- shinyServer( function(input, output) {
  router(input,output)
  output$value1 <- renderPrint({ input$select1 })
  output$value2 <- renderPrint({ input$select2 })
  output$value3 <- renderPrint({ input$select3 })
})

# Run server in a standard way.
shinyApp(ui, server)

screen1.R

library(shiny)
library(shinydashboard)

body <- dashboardBody(

  fluidRow(
    box(title = "Select Sort Variables for Stratum", width=2, status="primary", 

        selectInput("select1", label = h5("Sort Variable 1"), choices = list("EMPLOYMENT" = 1, "WAGES" = 2), selected = 1),

        selectizeInput("select2", label = h5("Sort Variable 2"), choices = list(" ","EMPLOYMENT" = 1, "WAGES" = 2), selected = NULL),

        selectizeInput("select3", label = h5("Sort Variable 3"), choices = list(" ","EMPLOYMENT" = 1, "WAGES" = 2), selected = NULL)
    ), # End Box 1

    box( width = 8, 

         HTML('<head>
              <style>
              table, th, td{border: 1px solid black;padding: 10px 20px;}
              </style>
              </head>

              <body>
              <table>
              <tr>
              <th> ASSIGN </th>
              <th> SS </th>
              <th> DESCRIPTION </th>
              <th> SORT ORDER 1 </th>
              <th> SORT ORDER 2 </th>
              <th> SORT ORDER 3 </th>
              </tr>
              <tr><td> <button onclick="myFunction1()"> Assign </button> </td>
              <td><center> -- </center> </td>
              <td> DEFAULT SINGLE </td>
              <td> <center id="demo1"></center> </td>
              <td> <center id="demo2"></center> </td> 
              <td> <center id="demo3"></center> </td>
              </tr>
              </table>

              <script>

              function myFunction1() { 
              var x = document.getElementById("select1");
              var y = document.getElementById("select2");
              var z = document.getElementById("select3");

              var x1 = x.options[x.selectedIndex].text;
              var y1 = y.options[y.selectedIndex].text;
              var z1 = z.options[z.selectedIndex].text;

              document.getElementById("demo1").innerHTML = x1;
              document.getElementById("demo2").innerHTML = y1;
              document.getElementById("demo3").innerHTML = z1;}

              </script>
              </body>') # End HTML

         ) # End box 2
    ),  #End Fluid Row #1 

  fluidRow(
    box( width=12, title="ENTER PARAMETER",

         HTML('<!DOCTYPE html>
              <html>
              <head>
              <style>
              table, th, td{border: 1px solid black;padding: 10px 20px}
              </style>
              </head>

              <body>

              <pre>DIPPI ALLOCATION :                                                                  SMD ALLOCATION :    
              SAMPLE ALLOCATION : <input type="text" id="input2" value="">                              SIZE MEASURE FOR ALLOCATION : <select name="allocation">  
              <option value="1"> EMPLOYMENT </option>
              <option value="2"> WAGES  </option>
              </select>  <button  type="button" > PROPORTIONALLY ALLOCATE TO </button>
              </pre> 

              <table>
              <tr>
              <th> STRATA </th>
              <th> DESCRIPTION </th>
              <th> FRAME UNITS </th>
              <th> PRE-SELECT </th>
              <th> HOLD </th>
              <th> ALLOC </th>
              <th> SAMPLE SIZE MEASURE </th>
              <th> MIN </th>
              </tr>
              <tr>
              <td> <center> -- </center> </td>
              <td> Default Single </td>
              <td>  </td>
              <td>  </td>
              <td> <center> <input id="checkbox1" type="checkbox"> </center> </td>
              <td>  <center id="demo4"> </td>
              <td> <center> EMPLOYMENT </center> </td>
              <td> <input id="input2" type="text"> </td>
              </tr>
              </table> 

              <p style="margin:0 0 0 72.5%"> <button onclick="myFunction2()"  type="button" > SAVE </button> </p>  

              <script>

              function myFunction2() { 
              var alloc = document.getElementById("input2").value;
              if((alloc%1) == 0 && (alloc > 0 ))
              {
              document.getElementById("demo4").innerHTML = parseInt(alloc,10);
              alert("Allocation Saved");
              } 
              else 
              {
              alert("The allocation you entered is not an integer > 0, please enter in a valid value");
              }

              }

              </script>

              </body>
              </html>

              ')# End Html

         ) # End Box 
    ) #End Fluid Row #2

    ) # End Dashboard Body

# UI 
page2 <- dashboardPage(
  dashboardHeader(title = "PPI Sampling System"),
  dashboardSidebar(),
  body
)

[ccwitt]

Thank you so much, I now fully understand what you mean. I have to admit that this is not intuitive. I really appreciate all your help but may have more follow up questions. This definitely works though.