I am trying to use R/Shiny router to link .R pages that I have already coded but don't know how to get the router to work with my HTML links. I have a custom header Home.html, that I want to link to screen1.R using shiny router. Can someone help with this?
<!DOCTYPE HTML>
<html>
<head>
<title>PPI Sampling System</title>
<style type="text/css">
body{background-color:white;}
#PPI-title{
font: 2em times, sans-serif;
color: white;
text-shadow: 1px 1px black;
}
.header{
padding: 0px 0px 0px 15px;
background: linear-gradient(#b4c9dd, white);
border: 1px solid black;
}
#nav-one{
background-color:white;
color: black;
font: 14 px arial, sans-serif;
border: 1px solid black;
width: 100%
}
#nav-two{
background-color: white;
font: 14px verdana;
font-weight: bold;
border: 1px solid black;
top-border: 0px;
color: blue;
width: 100%
}
#nav-three{
background-color: #b4c9dd;
border: 1px solid black;
font: 14px arial, sans-serif;
font-weight: regular;
width: 100%
}
.dropbtn1 {
background-color: transparent;
color: black;
font: 14px arial, sans-serif;
font-weight: bold;
border: none;
cursor: pointer;
display: inline-block;
z-index:1000;
}
.dropbtn2 {
background-color: #ffffff;
color: black;
font: 14px arial, sans-serif;
font-weight: bold;
border: none;
cursor: pointer;
display: inline-block;
}
.dropdown {
position: relative;
display: inline-block;
}
.dropdown-content {
display: none;
position: absolute;
background-color: #f9f9f9;
border-style: solid;
border-width: 1px;
min-width: 160px;
}
.dropdown-content a {
color: black;
font: 12px arial, sans-serif;
text-decoration: none;
display: block;
font-weight:regular;
padding: 2px;
z-index:1;
}
.dropdown a:hover {background-color: #a4a4a4}
.dropdown:hover .dropdown-content {display: block;}
.show {display:block;}
#first-box{
border-style: solid;
border-width: 1px;
}
.panes-container {
display: flex;
width: 100%;
overflow: hidden;
}
.left-pane {
width: 45%;
border-style: solid;
border-width: 1px;
}
.panes-separator {
width: 1px;
background: black;
position: relative;
cursor: col-resize;
}
.right-pane {
flex: auto;
border-style: solid;
border-width: 1px;
}
.panes-container,
.panes-separator,
.left-pane,
.right-pane {
margin: 5px;
padding: 5px;
}
.blue { color: blue; }
.tiny-button{
background-color: transparent;
color: black;
font: 12px arial, sans-serif;
font-weight: bold;
border: none;
cursor: pointer;
display: inline-block;
width:10px;
height:15px;
}
.white-button{
background-color: #ffffff;
color: black;
font: 12px arial, sans-serif;
border: none;
cursor: pointer;
display: inline-block;
}
.button-style{
background-color: #ffffff;
color: black;
border-style:solid;
font: 12px arial, sans-serif;
cursor: pointer;
display: inline-block;
padding:4px;
box-shadow: 0 1 2 0 black;
}
body {
font-size:12px;
}
.tit {
font-size:3em;
}
.sub {
font-size:2em;
}
.cont {
font-size:1em;
}
.button {
position:relative;
top:0;
font-size:15px;
cursor: pointer;
}
</style>
</head>
<!--Same as Previous Cycle Mockup 1, attempting to add split screen-->
<body onload="script();">
<!-- header of site -->
<div id="colorchange" class="header">
<div id="PPI-title">
<img src="http://www.conferenceharvester.com/uploads/harvester/photos/-ExhibitorLogo-45716.png" width="75" style="display:inline-block;">
<!-- image source: http://www.conferenceharvester.com/uploads/harvester/photos/-ExhibitorLogo-45716.png -->
<h2 id="header" style="display:inline-block; padding:0 0 0 10px;">PPI: Sampling System</h2>
</div>
<!-- Table for username, database, role-->
<table style="position:absolute; right:250px; top:20px;font:12px arial, sans-serif;" cellspacing="5px">
<tr>
<td><b>User:</b> Doe_j</td>
<td><b>DB:</b> ips-udb-samp</td>
</tr>
<tr>
<td><b>Role:</b> IA</td>
</tr>
</table >
<!-- Table for changing font size/header color -->
<table style="position:absolute; right:20px; top:20px; font:12px arial, sans-serif;">
<tr>
<td><b> Font:
<div class="button" style="display:inline-block; font:12px arial;"> <a class="inc" > + </a> </div>
<div class="button" style="display:inline-block; font:12px arial;"> <a class="dec" > - </a> </div>
<div class="button" style="display:inline-block; font:12px arial;"> <a class="reset"> Reset </a> </b> </div>
</td>
</tr>
<tr>
<td><b>Color Scheme:</b>
<button class="tiny-button" style="background:linear-gradient(to right,white,#b4c9dd,black)" onclick="document.getElementById('colorchange').style.background = 'linear-gradient(#b4c9dd,white)'"></button>
<button class="tiny-button" style="background:linear-gradient(to right,white,#b4ddb5,black)" onclick="document.getElementById('colorchange').style.background = 'linear-gradient(#b4ddb5,white)'"></button>
<button class="tiny-button" style="background:linear-gradient(to right,white,#f5ce6c,black)" onclick="document.getElementById('colorchange').style.background = 'linear-gradient(#f5ce6c,white)'"></button>
</td>
<td>
<button class="tiny-button" style="background:linear-gradient(to right,white,#b4c9dd,black)" onclick="document.getElementById('nav-three').style.background = '#b4c9dd'"></button>
<button class="tiny-button" style="background:linear-gradient(to right,white,#b4ddb5,black)" onclick="document.getElementById('nav-three').style.background = '#b4ddb5'"></button>
<button class="tiny-button" style="background:linear-gradient(to right,white,#f5ce6c,black)" onclick="document.getElementById('nav-three').style.background = '#f5ce6c'"></button>
</td>
</tr>
</table>
</div>
<!-- first navigation bar -->
<div>
<table id="nav-one" cellspacing="10">
<tr>
<th> Home </th>
<th>
<div class="dropdown">
<button class="dropbtn2">Sampling Process</button>
<div class="dropdown-content">
<a href="#">Browse Frame</a>
<a href="#">Frame Refinement</a>
<a href="#">Approve Sample Parameters</a>
<a href="#">Sample Refinement Round I</a>
<a href="#">Sample Refinement Round II</a>
<a href="#">Browse Sample</a>
</div>
</div>
</th>
<th> Tools</th>
<th> Help </th>
<th width="50%"></th>
<th><a style="font:12px arial, sans-serif; float:right;">Go To: <input type="text"></a></th>
<th><button class="white-button">Logout</button><th>
</tr>
</table>
</div>
<!--second naviagtion bar-->
<div>
<table id="nav-two" cellspacing="10">
<tr>
<th> Frame Refinement </th>
<th> Sample - 99 </th>
<th> Industry - 311311 </th>
<th> Cycle - F </th>
<th> Status Code - 2 </th>
<th width="30%"></th>
</tr>
</table>
</div>
<!--third navigation bar-->
<div class="ex1">
<table id="nav-three" cellspacing="10">
<tr>
<th> <a class="item1" href="#" target="main" >Search Frame </th>
<th> <a class="item2" href="#" target="main" > View Detail </th>
<!-- link not working -->
<th> <a class="item3" href="source(file://filer1/ppi/SamplingProject/2SampleSelection/screen1.R)" target="main" > Clustering </a> </th>
<th> <a class="item4" href="/page2" target="main"> Reports </a> </th>
<th> <a class="item5" href="" target="main" > View Changes </th>
<th> <a class="item6" href="#" target="main" > Search Universe </th>
<th>
<div class="dropdown">
<button class="dropbtn1"> Search Previous</button>
<div class="dropdown-content">
<a href="#" target="main"> Selected Industry</a>
<a href="#" target="main"> Any Industry</a>
</div>
</div>
</th>
<th> Industry Status </th>
<th width="25%"></th>
</tr>
</table>
</div>
<iframe name="main" src="http://www.yahoo.com" width="1570" height="560" scrolling="auto" > <p>Your browser does not support iframes.</p></iframe>
<script src="https://cdn.rawgit.com/lingtalfi/simpledrag/master/simpledrag.js"></script>
<script src="https://ajax.googleapis.com/ajax/libs/jquery/1.9.1/jquery.min.js"></script>
<script>
$(document).ready(function(){
var fontSize = parseInt($('body').css('font-size'),10);
$('.inc').on('click',function(){
fontSize++;
$('body').css('font-size',fontSize+'px');
})
$('.dec').on('click',function(){
fontSize--;
$('body').css('font-size',fontSize+'px');
})
$('.reset').on('click',function(){
$('body').css('font-size',"12px");
})
})
</script>
</body>
</html>
library(shiny)
#devtools::install_github("Appsilon/shiny.router")
library(shiny.router)
Home <- includeHTML('//filer1/ppi/SamplingProject/Home.html')
router <- make_router(
route("/page2", page2))
ui <- shinyUI(fluidPage(
Home,
router_ui()
))
# Plug router into Shiny server.
server <- shinyServer( function(input, output) {
router(input,output)
})
# Run server in a standard way.
shinyApp(ui=ui, server=server)
library(shiny)
library(data.table)
library(DT)
library(dplyr)
library(shinyjs)
library(shinycssloaders)
# List of BLS 2017 Index items
codes <- read.csv("//filer1/ppi/SamplingProject/2017_index_items.csv", header = TRUE, sep = ",", fill=TRUE)
ui = fluidPage(
tags$div(class="flex-container",
# App title
titlePanel("Select NAICS code"),
sidebarLayout(
sidebarPanel(
# Drop down menu of NAICS codes. 337920 is a good example.
selectizeInput("industry", "Search", choices = codes, options = list(placeholder = "Search NAICS", onInitialize = I('function() { this.setValue(""); }')), width = "10em"),
h6("Click button below to Cluster by EIN"),
actionButton('action', 'Cluster by EIN')
),
# Display the datatable
mainPanel(DT::dataTableOutput('tbl1'), HTML(' ') ,DT::dataTableOutput('tbl2'), width = 9 )
)
)
)
#Start Server
server = function(input, output, session) {
# Universe file
universe <- fread("//filer1/ppi/SamplingProject/universe.csv", header = TRUE, sep = ",", fill = TRUE)
#Frame Universe
withProgress(message = "Reading file", {
frame_codes <- Reduce(function(x, y) full_join(x, y, by='NAICS'), list(codes,universe))
})
withProgress(message = "Reading file", {
Tail <- fread("//filer1/ppi/SamplingProject/Tail.csv", header = TRUE, sep = ",")
})
# Make a subset of the universe using the industry code that was inputted
datatableInput1 <- reactive(subset(frame_codes, NAICS == input$industry))
# Use the DataTables library and the buttons extension to create the datatable.
# Filter adds a search bar to each column. If the columns are numeric, its a range slider, needs to be characters to be a search bar.
# Add buttons and the ability to reorder the columns by drag and drop.
output$tbl1 = renderDataTable(
datatableInput1(),
filter = "top",
class = "cell-border stripe",
extensions = list("Buttons" = NULL, "ColReorder" = NULL),
options = list(dom = "Bfrt",
paging = FALSE,
scrollX = TRUE,
scrollY = "80vh",
colReorder = TRUE,
buttons = list(list(extend = "colvis", text = "Show/Hide Columns"), "copy", "csv", "print")),
server = TRUE
)
output$tbl2 <- DT::renderDataTable(
datatableInput2(),
filter = "top",
class = "cell-border stripe",
extensions = list("Buttons" = NULL, "ColReorder" = NULL),
options = list(dom = "Bfrt",
paging = FALSE,
scrollX = TRUE,
scrollY = "80vh",
colReorder = TRUE,
buttons = list(list(extend = "colvis", text = "Show/Hide Columns"), "copy", "csv", "print")),
server = TRUE
)
# Function to Cluster by EIN
datatableInput2 <- eventReactive(input$action, {
# Your arbitrary R code goes here
test<-subset(frame_codes[c("LDB_NUM", "EIN", "NAICS", "TOT_WAGES","TOT_EMP")], NAICS == input$industry )
#### Begin Clustering by EIN ####
newdata<-arrange(test, desc(TOT_EMP))
cluster <- arrange(newdata, EIN, desc(TOT_EMP), desc(TOT_WAGES))
# Seperate into Headers, Singles, and Members
myid.uni <- unique(cluster$EIN)
a<-length(myid.uni)
headers <- c()
members<-c()
singles<-c()
d<-c()
w<-c()
# Function to seperate the different Rec_Types
for (i in 1:a) {
temp<-subset(cluster, EIN==myid.uni[i])
if ( (dim(temp)[1] < 2 ) | myid.uni[i]==0 )
{
singles.temp<-temp
singles<-rbind(singles, singles.temp)
}
else
{
header.temp<-temp[1,]
headers<-rbind(headers, header.temp)
members.temp <-temp[1:dim(temp)[1],]
members<-rbind(members, members.temp)
d.temp<- sum(temp[1:dim(temp)[1],]$TOT_EMP)
d<-rbind(d,d.temp)
w.temp<- sum(temp[1:dim(temp)[1],]$TOT_WAGES)
w<-rbind(w,w.temp)
}
}
h<-headers[order(headers$EIN, -headers$TOT_EMP),]
m<-members[order(members$EIN, -members$TOT_EMP),]
s<-singles[order(singles$EIN, -singles$TOT_EMP, -singles$TOT_WAGES),]
h.chars<-replicate(dim(headers)[1],"H")
m.chars<-replicate(dim(members)[1],"M")
s.chars<-replicate(dim(singles)[1],"S")
# Make Headers with Total Header Employment
comb.headers<-data.frame(h,w,d,h.chars)
drops<-c("TOT_EMP", "TOT_WAGES")
comb.headers<-comb.headers[,!(names(comb.headers) %in% drops) ]
colnames(comb.headers)[4]<-"TOT_WAGES"
colnames(comb.headers)[5]<-"TOT_EMP"
colnames(comb.headers)[6]<-"Rec_Type"
# Make Members with their individual employment
comb.members<-data.frame(m,m.chars)
colnames(comb.members)[6]<-"Rec_Type"
# Make Singles with their individual employment
comb.singles<-data.frame(s,s.chars)
colnames(comb.singles)[6]<-"Rec_Type"
comb.singles<-arrange(comb.singles, desc(TOT_EMP), desc(TOT_WAGES))
hs.cluster<-rbind(comb.headers,comb.singles)
hs.cluster<-arrange(hs.cluster, desc(TOT_EMP))
# Add cluster IDs
# Actual clustering function
df<-hs.cluster
a<-dim(df)[1]
b<-dim(comb.headers)[1]
count<-1
temp4<-c()
for(i in 1:a)
{
temp.s<-c()
temp.h<-c()
temp2<-c()
temp3<-c()
if(grepl( 'S', df[i,6]))
{
temp.s<-rbind(temp.s,df[i,])
temp.s$Cluster_ID<-NA
temp.s<-temp.s[c(7,1:6)]
temp4<-rbind(temp4,temp.s)
}
else
{
temp.h<-df[i,]
temp2<-merge(temp.h, comb.members, by='EIN', all.x=TRUE)
temp2<-temp2[-c(2:6)]
colnames(temp2)[2]<-"LDB_NUM"
colnames(temp2)[3]<-"NAICS"
colnames(temp2)[4]<-"TOT_WAGES"
colnames(temp2)[5]<-"TOT_EMP"
colnames(temp2)[6]<-"Rec_Type"
temp2<-temp2[order(-temp2$TOT_EMP),]
temp3<-rbind(temp.h,temp2)
e<-c()
e<-dim(temp3)[1]
temp3$Cluster_ID<-rep(count,e)
temp3<-temp3[c(7,1:6)]
count<-count+1
temp4<-rbind(temp4,temp3)
}
}
temp5 <-c()
temp5 <-temp4
temp5$Rank<-c(1:dim(temp4)[1])
temp5 <- merge(temp5,Tail, by="LDB_NUM", all.x=TRUE)
temp5 <- arrange(temp5, Rank)
count<-1
for(i in 1:dim(temp5)[1])
{
if(grepl('H',temp5[i,7]))
{
temp5[i,1]=count
count<-count+1
}
}
final.cluster<-temp5 # Contains Clustered Frame
return(final.cluster) # Return Clustered Frame
}) # End Function to Cluster by EIN
} # End Server
shinyApp(ui, server)
React
Typescript
Django
Laravel
Facebook
Microsoft
Google
Alibaba
D3
Tencent