A txt.file data contaning a matrix of integers with 5 integers for each column and 1000 rows.
So if we press
data
we get this output
96520
69850
...
36884
We can get a random row by this
getnumbers <- sample(data,1, replace=FALSE)
By getting a random row in data the task is to enter the next row (by press a,b,c,d,e) and check if it's correct. So if we have the kth entry in data we want to get the k+1 entry in data by pressing the digits and see if it's correct.
check <- function(a,b,c,d,e){
if( identical( data[k+1] , c(a,b,c,d,e)) == TRUE ) {
return("Correct") }
else{return("Not correct")}
How can I implement this R code in Shiny so I can make it interactive using ubuntu ?
Hopefully I understood your question correctly but here's how you could do it:
library(shiny)
data <- matrix(round(runif(5*3)),ncol=3)
ui <- shinyUI(fluidPage(
fluidRow(
column(6, h4("Randomly Selected Row [k]")),
column(6, h4("Nex Row [k+1]"))
),
fluidRow(
column(6, textOutput("selRow")),
column(6, textOutput("nxtRow"))
),
fluidRow(
column(8, textInput("guessStr","Gues row: ")),
column(4, actionButton("guess","guess"))
),
textOutput("guessRes")
))
server <- shinyServer(function(input, output, session) {
# Make the current rownumber a reactive
r.num <<- 0
makeReactiveBinding('r.num')
# If rownumber changes update UI
observe({
if(is.null(r.num)) return(NULL)
output$selRow <- renderPrint({data[r.num,]})
output$nxtRow <- renderPrint({data[r.num+1,]})
})
# Get a row number by random, can't select last row
randomRow <- function(){
r.num <<- sample(1:nrow(data)-1, 1)
}
# If user presses guess button
observeEvent(input$guess, {
# I convert to numerical but this can be modified to work with characters to
input.str <- as.numeric(strsplit(input$guessStr,',')[[1]])
msg <- sprintf("You guessed that the next row is: %s",input$guessStr)
if( identical(data[r.num+1,], input.str)){
msg <- paste(msg," , this was correct!")
}
else{
msg <- paste(msg," , this was wrong")
}
output$guessRes <- renderPrint({msg})
})
# Initiate the guessing by randmozing a row
randomRow()
})
shinyApp(ui = ui, server = server)
Related
How can i run a r shiny app, which print the top features based on user's choice?
I tried the following but I want the user to select, not putting it manually the top 3 for example
library(KEGGgraph)
library(xml2)
library(Rgraphviz)
ui <- fluidPage(
sidebarLayout(
sliderInput("range",
label = "Range of interest:",
min = 0, max = 10, value = c(0, 100))
),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plots", plotOutput(outputId="genePlot", width = 1300, height=900)),
tabPanel("Edges", verbatimTextOutput("out_tops")),
tabPanel("Compounds", tableOutput("out_compounds")))
)
)
)
server <- function(input, output) {
output$out_tops <- renderPrint({
mapkGall <- parseKGML2Graph(read_xml(sprintf("%s.xml", input$geneInput)), genesOnly=FALSE)
mapkGsub <- subGraphByNodeType(mapkGall, "gene")
graphs <- list(mapk=mapkGsub, wnt=mapkGall)
merged <- mergeGraphs(graphs)
merged
outs <- sapply(edges(merged), length) > 0
ins <- sapply(inEdges(merged), length) > 0
ios <- outs | ins
mapkGoutdegrees <- sapply(edges(mapkGall), length)
mapkGindegrees <- sapply(inEdges(mapkGall), length)
topouts <- sort(mapkGoutdegrees, decreasing=T)
topins <- sort(mapkGindegrees, decreasing=T)
if(require(org.Hs.eg.db)) {
top_nodes_out <- translateKEGGID2GeneID(names(topouts))
tmp <- c()
for (i in top_nodes_out) {
if (is.na(mget(sprintf("%s",i), org.Hs.egSYMBOL, ifnotfound = NA))) {
tmp <- append(tmp,sprintf("%s",i))
}
else {
tmp <- append(tmp,mget(sprintf("%s",i), org.Hs.egSYMBOL))
}
}
nodesNames_outs <- sapply(tmp, "[[",1)
} else {
nodesNames_outs <- names(topouts)
}
how can I let the user specify the printings by the slider bar?
names(nodesNames_outs) <- names(topouts)
print("top genes with out connections")
print(nodesNames_outs[1:3]) ### Here like something for the slider bar print[:,sliderbar$input]
I would like not to print manually the top 3 but the user to select how many he wants. the code should sort the top genes and print them accordingly when user uses the slidebar
Can you please suggest something?
New to Shiny, I am trying to create a very simple app respecting the following sequence of events:
(1) Upload a dataframe,
(2) Wait until the user set the filtering parameter (Category in the example below),
(3) Press a Go! button,
(4) Display the first rows of the subset data frame.
Let's say I have a file df.tab to upload and process.
df <- data.frame(Category=c("A","A","A","B","B","B"), X=c(1,2,3,1,2,3), Y=c(1,2,3,34,21,1))
df
Category X Y
1 A 1 1
2 A 2 2
3 A 3 3
4 B 1 34
5 B 2 21
6 B 3 1
write.table(df, file="df.tab", row.names=F, quote=F, sep="\t")
My app.R looks like:
library(shiny)
# Define UI ----
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("input_df",label=h4("Dataset")),
selectInput("category",h4("Category"), choices = list("A" = 1,"B" = 2),selected = 1),
actionButton("goButton",label = "Go!")
),
mainPanel(
tableOutput("view")
)
)
)
# Define server logic ----
server <- function(input, output) {
data <- eventReactive(
input$input_df,
{
File <- input$input_df
if(is.null(File)){
return(NULL)
}else{
df <- read.table(File$datapath, header = T, sep = "\t")
}
}
)
data_sub <- eventReactive(
input$category,
{
df_sub <- subset(data(), Category == input$category)
}
)
output$view <- renderTable(
{
head(data_sub())
}
)
}
# Run the app ----
shinyApp(ui = ui, server = server)
However, the app is either not responsive or does not display any rows.
Note that I created 2 distinct reactive events data and data_sub in order to avoid loading the file every time I select a different category (and potentially to avoid stack errors with a recursive function).
Any help would be greatly appreciated.
Here is a working server function. Use reactive, not eventReactive and it is quite straightforward.
NOTE that your example assumes you have a Category column, I modified below to make it work with anything.
# Define server logic ----
server <- function(input, output) {
dataset <- reactive({
File <- input$input_df
req(File)
read.table(File$datapath, header = TRUE, sep = "\t")
})
data_sub <- reactive({
if("Category" %in% names(dataset())){
subset(dataset(), Category == input$category)
} else {
dataset()
}
})
output$view <- renderTable({
head(data_sub())
})
}
data(mtcars)
library(stats)
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectizeInput("mtcarsid", "Nehme eine MT Cars category.", choices = colnames(mtcars), selected = colnames(mtcars)[2], multiple = FALSE)
),
# Show a plot of the generated distribution
mainPanel(
tableOutput("model"),
textOutput("text123")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$text123 <- renderText({
})
output$model <- renderTable ({
z <- factor(input$mtcarsid)
# #print(mtcars[[z]])
#
# print(length(mtcars$mpg))
#
# print(length(mtcars[[z]]))
x <- aov(mpg ~ factor(mtcars[[z]]), data=mtcars)
x <- TukeyHSD(x)
print(x)
x <- as.data.frame(x[[1]][,4] > 0.05)
x
})
}
# Run the application
shinyApp(ui = ui, server = server)
This is my App and based on the input of my input$mtcarsid I want to perform an anova incl. a post-hoc test. However, my model seems to totally wrong input with my code. Can anybody tell me why?
aov(mpg ~ factor(cyl), data = mtcars)
This code works fine. But when i just use factor(input$mtcarsid) i get an error that length of input differs (1 vs 32).
One solution is to convert the selected variable to a factor outside of the call to aov().
output$model <- renderTable ({
mtcars[["selected"]] = factor(mtcars[[input$mtcarsid]])
x <- aov(mpg ~ selected, data=mtcars)
x <- TukeyHSD(x)
print(x)
x <- as.data.frame(x[[1]][,4] > 0.05)
x
})
I want to perform some actions like writing in a dataframe post i close the modaldialogue. Consider below example.
obs8<-observe({ req(input$Continue) if(input$password3 > 0 & input$password4 > 0 & (input$password3==input$password4)==TRUE & (is.validpw(input$password3))==TRUE & (is.validpw(input$password4))==TRUE){
showModal(modalDialog(
title=tags$h4(tags$strong("Password Changed Successfully")),
easyClose=FALSE,
footer=modalButton("Close")
))
I am trying to execute below code post the if condition is true and modal is displayed but no luck.
PASSWORD$Passord <- as.character(PASSWORD$Passord)
PASSWORD$Passord[PASSWORD$Passord==pwd] <- input$password3
PASSWORD$Passord <- as.factor(PASSWORD$Passord)
write.csv(PASSWORD,"<PATH>",row.names=FALSE)
I rewrote it as pure Shiny without all the password stuff and it works fine:
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
obs8<-observe({
req(input$bins)
if(input$bins > 40){
showModal(modalDialog(
title=tags$h4(tags$strong("Password Changed Successfully")),
easyClose=FALSE,
footer=modalButton("Close")
))
write.csv("1, 2, 1, 2", "<PATH>", row.names = FALSE)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
There's something wrong with the other stuff you're doing, but I can't tell what it is without a reproducible example
I am developing a table which does some calculations each time that an action button is used. One column of my table depends on its previous value,
C_new <- C_old + B_new - A_new
For instance, if A=4, B=A+2 and C= C(-1) + B - A my expected results are
A B C
1 2 3
4 6 5
I have tried to save the previous value of column C using reactiveValue, as mentioned in How to “remember” information from the previous iteration when using reactiveTimer in Shiny?, but it doesn't work. I don't know where I am getting wrong.
Here is my code
library(shiny)
ui <- fluidPage(
sidebarPanel(textInput("c1","Example"),
actionButton("update", "Update Table")),
mainPanel(tableOutput("example"))
)
server <- function(input, output) {
C_old <- reactive(x=3)
values <- reactiveValues(df = data.frame(A=1, B=2, C=3))
newEntry <- observeEvent(input$update,{
A_new <- as.numeric(input$c1)
B_new <- A_new + 2
C_new <- isolate (C_old$x + B_new - A_new)
C_old$x <<- C_new
new <- data.frame(A=A_new,B=B_new, C=C_new)
# attach the new line to the old data frame here:
values$df <- rbind(values$df, new)
})
# Print the content of values$df
output$example <- renderTable({
return(values$df)
})
}
shinyApp(ui = ui, server = server)
Important to know, observeEvents (similar to observes) don't have outputs. You just observe a change and do something in their body, but nothing is supposed to be returned (this is different to reactive({ }), which also observes changes but has return values), useful link.
Isolate is not needed in observeEvent , because nothing triggers an update except for input$update (this is different to observe and reactive, where all changeable items in the body trigger an update).
Below is the solution to your problem. I used reactiveVal which stores one single updateable value (see ?reactiveVal for help). After clicking the action button, I retrieve the old table by calling values(), calculate all new values (beware, I need to use tail to get only the last C value) and attach the result to the old value before storing the extended table into values by calling values(new_df):
library(shiny)
ui <- fluidPage(
sidebarPanel(numericInput("c1","Example", 0),
actionButton("update", "Update Table")),
mainPanel(tableOutput("example"))
)
server <- function(input, output) {
# stores the current data frame, called by values() and set by values(new_data_table)
values <- reactiveVal(data.frame(A=1, B=2, C=3))
# update values table on button click
observeEvent(input$update,{
old_values <- values()
A_new <- input$c1
B_new <- A_new + 2
C_new <- tail(old_values$C, 1) + B_new - A_new # tail to get the last C value
new_values <- data.frame(A=A_new, B=B_new, C=C_new)
# attach the new line to the old data frame here:
new_df <- rbind(old_values, new_values)
#store the result in values variable
values(new_df)
})
# Print the content of values$df
output$example <- renderTable({
return(values())
})
}
shinyApp(ui = ui, server = server)