Linking sidebarPanels in shiny for SelectizeInput function - shiny

Assume I have a drop down in sidebarPanel - location from which I can select a maximum of 2 options. I want to create an if loop where in - chosing 'Saddle Joint' and 'Gliding Joint' from the drop down leads to selection of objects 'x' and 'y' in another sidebarPanel - datasets - basically creating a linkage.
I tried this piece of code, but it doesn't work:
if (input$location== "Saddle Joint" & input$location== "Gliding Joint") {
updateCheckboxGroupInput(session,
"datasets", "Datasets:", choices = c("x","y"),
selected= c("x","y"))
}
Do take a look at the screenshot for better picture!
Thanks!
Screenshot

Issue was with the boolean in your if statement. Use this:
"Saddle Joint" %in% input$location & "Gliding Joint" %in% input$location
Also could use:
all(c("Saddle Joint","Gliding Joint") %in% input$location)

Related

Use map inside map?

I have two lists: One with some tidy data and another with models made with tidymodels package
data_list <- list(train,test)
model_fits <- list(tree,forest,xgb)
I want to make a new list with a confusion matrix for train and test for every model.
The function that calculates confusion matrix:
ConfMat <-
function(df,data){
df <-
predict(df,new_data = data, type = "class") %>%
mutate(truth = data$NetInc) %>%
conf_mat(truth,.pred_class)}
I have tried to do this (x,y is arbitrary).:
map(data_list,map(model_fits,ConfMat(x,y)))
My problem is that I have no idea how to actually set "x" and "y" right.
PS: double for loop works. I'm asking specifically for map solution or equivalent.
Appreciate all help i can get! cheers
Use an anonymous function -
library(purrr)
result <- map(data_list,function(x) map(model_fits,function(y) ConfMat(x,y)))
result

Shiny conditionalPanel always appears

I built a small application making use of a conditional Panel which worked out of the box.
A second attempt has been less satisfying. The issue is that the conditional panels both show up no matter whether the conditions are met or not.
Here's what I have in a stripped down version:
library(shiny)
source('distplot.r')
ui<-fluidPage(
fluidRow(
radioButtons("intype", 'Data or Statistics?',
c(Data="d", Statistics="s")),
#Only show this if sample data are to be entered
conditionalPanel(
condition = "input$intype == 'd'",
textInput('x', 'Sample Data (Comma Separated)', value='')),
#Only shows this panel for summary statitics (sd or sigma if known)
conditionalPanel(
condition = "input$intype == 'r'",
numericInput('m','Sample Mean',value=''),
numericInput('sd','SD (Population or Sample)',value=''),
numericInput('n','Sample size',value=''))
)
)
server<-function(input, output){
DTYPE<-eventReactive(input$go,{input$dtype})
output$plot<-renderPlot({hist(runif(1000))})
}
shinyApp(ui=ui, server=server)
The two conditional panels always appear no matter the value of input$intype.
You need to use input.intype and not input$intype in your condition. Moreover intype can only be 'd' or 's' in your example, and you use 'r' in your condition.
Details section from ?shiny::conditionalPanel :
In the JS expression, you can refer to input and output JavaScript objects that contain the current values of input and output. For example, if you have an input with an id of foo, then you can use input.foo to read its value. (Be sure not to modify the input/output objects, as this may cause unpredictable behavior.)

R Shiny- Contingency Tables

I am unable to create Contingency table in Shiny. It results in both columns side by side rather than in cross tab.
output$currtarget<-renderTable({
currtgt<- cstable %>%
select(parent_id,tutor_id,status_name,first_name) #%>%
xtabs(as.formula(paste0("~",status_name,"+",first_name),currtgt)
})
This just happened to me too, after updating all my packages today--it worked fine last week. Not sure why it changed, but it's very annoying!
Anyway, my workaround was to use as.data.frame.matrix and then set include.rownames=TRUE between the curly brace and last parenthesis.
renderTable = ({
...
my_tbl = addmargins(table(one_group, another_group))
printed_tbl = as.data.frame.matrix(my_tbl)
print_tbl
}, include.rownames=TRUE)

Scoping between output functions

I have been through (hopefully thoroughly enough) the shiny help article on scoping, and have also seen the answer regarding setting a global object here. Neither addresses, however, what I think (emphasis on "think") I need to do. If a variable is only created in an output function, can it be seen in another? Using action buttons, I'm trying to control lengthy calculations and some will only happen on condition of other things happening. As a minimal example,
library(shiny)
library(stringr)
fruitref <- c("apple","peach","pear","plum","banana","kiwi")
textareaInput <- function(inputID, label, value="", rows=10, columns=30) {
HTML(paste0('<div class="form-group shiny-input-container">
<label for="', inputID, '">', label,'</label>
<textarea id="', inputID, '" rows="', rows,'" cols="',
columns,'">', value, '</textarea></div>'))
}
ui <- fluidPage(titlePanel("minimal example"),
sidebarLayout(
sidebarPanel(
textareaInput("inputfruit", "Enter some fruits:"),
actionButton("checkfruit", "Check fruits"),
verbatimTextOutput("fruitstat")
),
mainPanel(
textOutput("fruits")
)
)
)
server <- function(input,output){
flag <- F
inputs <- eventReactive(input$checkfruit,{input$inputfruit})
continue <- reactive(flag)
output$fruitstat <- renderText({
inputs <- inputs()
inputs <- str_trim(unlist(strsplit(inputs,split="\n")),side="both")
if(length(setdiff(inputs,fruitref)) != 0 | length(inputs) == 0){
flag <- F
paste(paste(setdiff(inputs,fruitref), collapse=", "),"not in table.")
} else {
flag <- T
"All fruits ok."
}
})
output$fruits <- renderText({
paste("Continue? ",continue())
})
}
shinyApp(ui = ui, server = server)
There's a reference table and user input is checked against that table. User enters list in pieces until hitting the check button, then gets feedback whether all are OK, or if there's a mismatch. Only if all are okay do I want to continue. I tried setting a "continue" flag in the output function, but that didn't work, and setting it in the server outside of the output function would not update the value. I also tried creating an environment in the server function and using assign, but that too did not update the value when I tried to retrieve it for renderText later. Since it's not an input, accessible through input$, I figured I cannot use any of the update* functions.
This may not be the best way to set this kind of conditional. I saw in the tutorial the conditional pane, but that depends on an input, rather than something created in the function. More generally, there are more complicated objects to be created in the output functions (there will be four large tables and a plot at most; all or some subset will actually be output) that then other output functions should see, I did not think I could define them as reactive global objects, because until some later things happen, they can't be calculated.
Define continue as an eventReactive:
continue <- eventReactive(input$checkfruit, flag)
And also use the global assignment operator inside function
flag <<- F
flag <<- T
Then it will work. Tested.

Parameterize pattern match as function argument in R

I've a directory with csv files, about 12k in number, with the naming format being
YYYY-MM-DD<TICK>.csv
. The <TICK> refers to ticker of a stock, e.g. MSFT, GS, QQQ etc. There are total 500 tickers, of various length.
My aim is to merge all the csv for a particular tick and save as a zoo object in individual RData file in a separate directory.
To automate this I've managed to do the csv manipulation, setup as a function which gets a ticker as input, does all the data modification. But I'm stuck in making the file listing stage, passing the pattern to match the ticker being processed. I'm unable to make the pattern to be matched dependent on the ticker.
Below is the function i've tried to make work, doesn't work:
csvlist2zoo <- function(symbol){
csvlist=list.files(path = "D:/dataset/",pattern=paste("'.*?",symbol,".csv'",sep=""),full.names=T)
}
This works, but can't make it work in function
csvlist2zoo <- function(symbol){
csvlist=list.files(path = "D:/dataset/",pattern='.*?"ibm.csv',sep=""),full.names=T)
}
Searched in SO, there are similar questions, not exactly meeting my requirement. But if I missed something please point out in the right direction. Still fighting with regex.
OS: Win8 64bit, R version-3.1.0 (if needed)
Try:
csvlist2zoo <- function(symbol){
list.files(pattern=paste0('\\d{4}-\\d{2}-\\d{2}',symbol, ".csv"))
}
csvlist2zoo("QQQ")
#[1] "2002-12-19QQQ.csv" "2008-01-25QQQ.csv"
csvlist2zoo("GS")
#[1] "2005-05-18GS.csv"
I created some files in the working directory (linux)
v1 <- c("2001-05-17MSFT.csv", "2005-05-18GS.csv", "2002-12-19QQQ.csv", "2008-01-25QQQ.csv")
lapply(v1, function(x) write.csv(1:3, file=x))
Update
Using paste
csvlist2zoo <- function(symbol){
list.files(pattern=paste('\\d{4}-\\d{2}-\\d{2}',symbol, ".csv", sep=""))
}
csvlist2zoo("QQQ")
#[1] "2002-12-19QQQ.csv" "2008-01-25QQQ.csv"