Related
I want a code to find the initial guesses to put into the multiroot function in R, such that the output of the codes,
tr.mean(0.5,5.5,mu5,sigma5)
tr.var(0.5,5.5,mu5, sigma5)
gives 5 and 1 respectively.
Here,
tr.mean<-function(a,b,mu,sigma){
alpha<-(a-mu)/sigma
beta<-(b-mu)/sigma
dalpha<-dnorm(alpha,0,1)
dbeta<-dnorm(beta,0,1)
palpha<-pnorm(alpha,0,1)
pbeta<-pnorm(beta,0,1)
mubar<-mu-sigma*((dbeta-dalpha)/(pbeta-palpha))
mubar
}
tr.var<-function(a,b,mu,sigma){
alpha<-(a-mu)/sigma
beta<-(b-mu)/sigma
dalpha<-dnorm(alpha,0,1)
dbeta<-dnorm(beta,0,1)
palpha<-pnorm(alpha,0,1)
pbeta<-pnorm(beta,0,1)
v1<-(beta*dbeta-alpha*dalpha)/(pbeta-palpha)
v2<-((dbeta-dalpha)/(pbeta-palpha))^2
sigmabar<-(sigma^2)*(1-v1-v2)
sigmabar
}
I want to know a way to get the initial guesses (,) to put in ss5,
model5 <- function(x) c(F1 = 5-tr.mean(0.5,5.5,x[1],x[2]),
F2 = 1-tr.var(0.5,5.5,x[1],x[2]))
ss5 <- multiroot(f = model5, start = c(*,*))
(roots5<-ss5$root)
parameters
(mu5<-roots5[1])
(sigma5<-roots5[2])
validation
tr.mean(0.5,5.5,mu5,sigma5) # this should give 5
tr.var(0.5,5.5,mu5, sigma5) # this should give 1
I'm creating a shiny app and i'm letting the user choose what data that should be displayed in a plot and a table. This choice is done through 3 different input variables that contain 14, 4 and two choices respectivly.
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectInput(inputId = "DataSource", label = "Data source", choices =
c("Restoration plots", "all semi natural grasslands")),
selectInput(inputId = "Variabel", label = "Variable", choices =
choicesVariables)),
#choicesVariables definition is omitted here, because it's very long but it
#contains 14 string values
selectInput(inputId = "Factor", label = "Factor", choices = c("Company
type", "Region and type of application", "Approved or not approved
applications", "Age group" ))
),
dashboardBody(
plotOutput("thePlot"),
tableOutput("theTable")
))
This adds up to 73 choices (yes, i know the math doesn't add up there, but some choices are invalid). I would like to do this using a lookup table so a created one with every valid combination of choices like this:
rad1<-c(rep("Company type",20), rep("Region and type of application",20),
rep("Approved or not approved applications", 13), rep("Age group", 20))
rad2<-choicesVariable[c(1:14,1,4,5,9,10,11, 1:14,1,4,5,9,10,11, 1:7,9:14,
1:14,1,4,5,9,10,11)]
rad3<-c(rep("Restoration plots",14),rep("all semi natural grasslands",6),
rep("Restoration plots",14), rep("all semi natural grasslands",6),
rep("Restoration plots",27), rep("all semi natural grasslands",6))
rad4<-1:73
letaLista<-data.frame(rad1,rad2,rad3, rad4)
colnames(letaLista) <- c("Factor", "Variabel", "rest_alla", "id")
Now its easy to use subset to only get the choice that the user made. But how do i use this information to plot the plot and table without using a 73 line long ifelse statment?
I tried to create some sort of multidimensional array that could hold all the tables (and one for the plots) but i couldn't make it work. My experience with these kind of arrays is limited and this might be a simple issue, but any hints would be helpful!
My dataset that is the foundation for the plots and table consists of dataframe with 23 variables, factors and numerical. The plots and tabels are then created using the following code for all 73 combinations
s_A1 <- summarySE(Samlad_info, measurevar="Dist_brukcentrum",
groupvars="Companytype")
s_A1 <- s_A1[2:6,]
p_A1=ggplot(s_A1, aes(x=Companytype,
y=Dist_brukcentrum))+geom_bar(position=position_dodge(), stat="identity") +
geom_errorbar(aes(ymin=Dist_brukcentrum-se,
ymax=Dist_brukcentrum+se),width=.2,position=position_dodge(.9))+
scale_y_continuous(name = "") + scale_x_discrete(name = "")
where summarySE is the following function, burrowed from cookbook for R
summarySE <- function(data=NULL, measurevar, groupvars=NULL, na.rm=TRUE,
conf.interval=.95, .drop=TRUE) {
# New version of length which can handle NA's: if na.rm==T, don't count them
length2 <- function (x, na.rm=FALSE) {
if (na.rm) sum(!is.na(x))
else length(x)
}
# This does the summary. For each group's data frame, return a vector with
# N, mean, and sd
datac <- ddply(data, groupvars, .drop=.drop,
.fun = function(xx, col) {
c(N = length2(xx[[col]], na.rm=na.rm),
mean = mean (xx[[col]], na.rm=na.rm),
sd = sd (xx[[col]], na.rm=na.rm)
)
},
measurevar
)
# Rename the "mean" column
datac <- rename(datac, c("mean" = measurevar))
datac$se <- datac$sd / sqrt(datac$N) # Calculate standard error of the mean
# Confidence interval multiplier for standard error
# Calculate t-statistic for confidence interval:
# e.g., if conf.interval is .95, use .975 (above/below), and use df=N-1
ciMult <- qt(conf.interval/2 + .5, datac$N-1)
datac$ci <- datac$se * ciMult
return(datac)
}
The code in it's entirety is a bit to large but i hope this may clarify what i'm trying to do.
Well, thanks to florian's comment i think i might have found a solution my self. I'll present it here but leave the question open as there is probably far neater ways of doing it.
I rigged up the plots (that was created as lists by ggplot) into a list
plotList <- list(p_A1, p_A2, p_A3...)
tableList <- list(s_A1, s_A2, s_A3...)
I then used subset on my lookup table to get the matching id of the list to select the right plot and table.
output$thePlot <-renderPlot({
plotValue<-subset(letaLista, letaLista$Factor==input$Factor &
letaLista$Variabel== input$Variabel & letaLista$rest_alla==input$DataSource)
plotList[as.integer(plotValue[1,4])]
})
output$theTable <-renderTable({
plotValue<-subset(letaLista, letaLista$Factor==input$Factor &
letaLista$Variabel== input$Variabel & letaLista$rest_alla==input$DataSource)
skriva <- tableList[as.integer(plotValue[4])]
print(skriva)
})
I'm trying to assign reactive variable based on my input using loop. For example, I want to select the column (from input) in iris data set. Then get the unique value from that column. And I want to do this in the loop. I find it works for my 'joke' variable, but not for my 'Group[[paste0('Gcol',i)]]' variable. I've been searching answer for this for days.
Thank you for your help in advance!
library(shiny)
data=iris
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(9,wellPanel(lapply(1:5, function(i) {
selectizeInput(paste0('GroupVar',i), paste0('Group ',i), choices = sort(colnames(data)),
options = list(placeholder = 'Select one',
onInitialize = I('function() {
this.setValue(""); }')))
})
)))
),
mainPanel(
fluidRow(column(6, wellPanel(
lapply(1:5, function(i) {
uiOutput(paste0('GroupOpt', i))
})
))),
textOutput("try4"),
textOutput("try2"),
textOutput("try21"),
textOutput("try3"),
textOutput("try")
)
)
)
server <- function(input, output) {
Group=reactiveValues()
for (i in 1:5){
Group[[paste0('Gcol',i)]]=reactive({
data[,which(colnames(data)==
input[[paste0('GroupVar',i)]])]})
}
joke=reactive({data[,which(colnames(data)==input[[paste0('GroupVar',1)]])]})
lapply(1:5, function(i) { output[[paste0('GroupOpt',i)]] = renderUI({
selectInput(paste0("GroupOpt",i), "Select group",multiple=TRUE,
sort(as.character(unique(Group[[paste0('Gcol',i)]])))
)
})})
output$try4 = renderText({print(paste0('it
is',input[[paste0('GroupVar',1)]]))})
output$try2 = renderText({print(dim( Group[[paste0('Gcol',1)]]()))})
output$try21 = renderText({print(class( Group[[paste0('Gcol',1)]]()))})
output$try3 =
renderText({print(which(colnames(data)==input[[paste0('GroupVar',1)]]))})
output$try = renderText({print(unique(as.character(joke())))})
}
# Run the application
shinyApp(ui = ui, server = server)
data[, which(colnames(data)=="Species")] is not a dataframe, this is the column Species, a factor. If you want to allow a one-column dataframe, do data[, which(colnames(data)=="Species"), drop=FALSE]
Replace your loop with the following one, and your app works (but maybe not as you expect; I'm not sure to understand what you want).
for (i in 1:5){
local({
ii <- i
Group[[paste0('Gcol',ii)]]=reactive({
data[,which(colnames(data)==input[[paste0('GroupVar',ii)]])]})
})
}
I have merged different sources of code to make an app that allows one to upload a file (data frame).
However, beyond this I would also like to make it possible to select specific columns from the data frame and analyse them. This is difficult however as one must predefine the given data frame in order to be able to refer to it in the ui.R script....
So when a previously undefined data frame is uploaded to the site, one can not revere to it in the ui.R as it is defined in the server....
predefined variables
vchoices <- 1:ncol(mtcars)
names(vchoices) <- names(mtcars)
ui.R
runApp(
ui = basicPage(
h2('The uploaded file data'),
dataTableOutput('mytable'),
fileInput('file', 'Choose info-file to upload',
accept = c(
'text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain',
'.csv',
'.tsv'
)
),
actionButton("choice", "incorporate external information"),
selectInput("columns", "Select Columns", choices=vchoices, inline = T),
#notice that the 'choices' in selectInput are set to the predefined
#variables above whereas I would like to set them equal to the
#not yet defined uploaded file below in server.R
tableOutput("table_display")
))
Notice that the 'choices' in selectInput are set to the predefined variables above whereas I would like to set them equal to the not yet defined uploaded file below in server.R
server.R
server = function(input, output) {
info <- eventReactive(input$choice, {
inFile <- input$file
if (is.null(inFile))
return(NULL)
isolate(f<-read.table(inFile$datapath, header = T,
sep = "\t"))
f
})
output$table_display<-renderTable({
f<-info()
f<-subset(f, select=input$columns) #subsetting takes place here
head(f)
})
}
Does anyone know of a way to refer to a variable that's defined in in the server, in the ui and thus allow for interactive manipulation?
You can use a family of functions update*Input - in this case updateSelectInput. Its first argument has to be session and you also have to add session to server <- function(input, output) to be able to update your widget.
You could make an update of the widget immediately after clicking on the actionButton - so, you had to use updateSelectInput within eventReactive.
Let's take a look how we can do that:
First, you can save the names of columns of the new uploaded dataset in a variable, say, vars and then pass it to the function updateSelectInput.
(The choices of the selectInput are initially set to NULL - we don't need to specify them before because they are going to be updated anyway)
info <- eventReactive(input$choice, {
inFile <- input$file
# Instead # if (is.null(inFile)) ... use "req"
req(inFile)
# Changes in read.table
f <- read.table(inFile$datapath, header = input$header, sep = input$sep, quote = input$quote)
vars <- names(f)
# Update select input immediately after clicking on the action button.
updateSelectInput(session, "columns","Select Columns", choices = vars)
f
})
I've added a small upload interface to your code.
The other way would be to define widgets on the server side and then to pass them to the client side via renderUI function. You can find here an example.
Full example:
library(shiny)
ui <- fluidPage(
h2('The uploaded file data'),
dataTableOutput('mytable'),
fileInput('file', 'Choose info-file to upload',
accept = c(
'text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain',
'.csv',
'.tsv'
)
),
# Taken from: http://shiny.rstudio.com/gallery/file-upload.html
tags$hr(),
checkboxInput('header', 'Header', TRUE),
radioButtons('sep', 'Separator',
c(Comma=',',
Semicolon=';',
Tab='\t'),
','),
radioButtons('quote', 'Quote',
c(None='',
'Double Quote'='"',
'Single Quote'="'"),
'"'),
################################################################
actionButton("choice", "incorporate external information"),
selectInput("columns", "Select Columns", choices = NULL), # no choices before uploading
tableOutput("table_display")
)
server <- function(input, output, session) { # added session for updateSelectInput
info <- eventReactive(input$choice, {
inFile <- input$file
# Instead # if (is.null(inFile)) ... use "req"
req(inFile)
# Changes in read.table
f <- read.table(inFile$datapath, header = input$header, sep = input$sep, quote = input$quote)
vars <- names(f)
# Update select input immediately after clicking on the action button.
updateSelectInput(session, "columns","Select Columns", choices = vars)
f
})
output$table_display <- renderTable({
f <- info()
f <- subset(f, select = input$columns) #subsetting takes place here
head(f)
})
}
shinyApp(ui, server)
Can someone help me with this piece of code. In a loop I'm saving p-values in f and then I want to write the p-values to a file but I don't know which function to use to write to file. I'm getting error with write function.
{
f = fisher.test(x, y = NULL, hybrid = FALSE, alternative = "greater",
conf.int = TRUE, conf.level = 0.95, simulate.p.value = FALSE)
write(f, file="fisher_pvalues.txt", sep=" ", append=TRUE)
}
Error in cat(list(...), file, sep, fill, labels, append) :
argument 1 (type 'list') cannot be handled by 'cat'
The return value from fisher.test is (if you read the docs):
Value:
A list with class ‘"htest"’ containing the following components:
p.value: the p-value of the test.
conf.int: a confidence interval for the odds ratio. Only present in
the 2 by 2 case and if argument ‘conf.int = TRUE’.
etc etc. R doesn't know how to write things like that to a file. More precisely, it doesn't know how YOU want it written to a file.
If you just want to write the p value, then get the p value and write that:
write(f$p.value,file="foo.values",append=TRUE)
f is an object of class 'htest', so writing it to a file will write much more than just the p-value.
If you do want to simply save a written representation of the results to a file, just as they appear on the screen, you can use capture.output() to do so:
Convictions <-
matrix(c(2, 10, 15, 3),
nrow = 2,
dimnames =
list(c("Dizygotic", "Monozygotic"),
c("Convicted", "Not convicted")))
f <- fisher.test(Convictions, alternative = "less")
capture.output(f, file="fisher_pvalues.txt", append=TRUE)
More likely, you want to just store the p-value. In that case you need to extract it from f before writing it to the file, using code something like this:
write(paste("p-value from Experiment 1:", f$p.value, "\n"),
file = "fisher_pvalues.txt", append=TRUE)