Skip to content
Extraits de code Groupes Projets
Valider 83d8dd6c rédigé par Eugen Pircalabelu's avatar Eugen Pircalabelu
Parcourir les fichiers

Delete server.r

parent cd260861
Aucune branche associée trouvée
Aucune étiquette associée trouvée
Aucune requête de fusion associée trouvée
Pipeline #30 annulé
Étape : build
Étape : test
Masquer les modifications d'espaces
En ligne Côte à côte
Affichage de
avec 0 ajout et 343 suppressions
server.r supprimé 100644 → 0
+ 0
− 343
Voir le fichier @ cd260861
# Define a server for the Shiny app
function(input, output,session) {
# Create values which will contain the changing values
myvalues <- reactiveValues()
values <- reactiveValues(tx_star_b=c())
values2 <- reactiveValues(sigmax_star_b=c())
values3 <- reactiveValues(tx_star_bMINUStheta_fn=c())
values4 <- reactiveValues(u_star_b=c())
values5 <- reactiveValues(xbar=c())
# Create an empty dataframe (within values) which will contain the generated data
myvalues$df <- data.frame(Low= integer(0),Up = numeric(0), stringsAsFactors = FALSE)
res <- reactive({
mu=input$mu
n=input$n
B=input$B
N=20
b=input$bb
xbar = NULL
tx_star_b=NULL
sigmax_star_b=NULL
u_star_b=NULL
tx_star_bMINUStheta_fn=NULL
nrow = N; ncol = N;lambda=1/mu; p.col = c("deepskyblue", "red"); p.cex = c(1, 3)
set.seed(2018+as.numeric(input$submit_model))
population <- rexp(nrow*ncol,rate=lambda)
population <- matrix(population,nrow,ncol)
par(mar=c(0.5, 0.5, 0.5, 0.5))
x = cbind(rep(1:ncol, nrow), gl(nrow, ncol))
populationIndex = cbind(rep(1:ncol, nrow), gl(nrow, ncol))
set.seed(2018+as.numeric(input$submit_model))
myx=x[sample(nrow * ncol, n), ]
myxx=population[myx]
set.seed(2018+as.numeric(input$submit_model))
originalsampleIndex=x[sample(nrow * ncol, n), ]
for (b in 1:B){
set.seed(2018+b+(B*n*as.numeric(input$submit_model)))
BootSampleIndex=sample(1:n, n,replace = T)
mypcex=rep(p.cex[2],length(originalsampleIndex))
mypcex2=seq(0,100,by=2)
freq_vec=rep(NA,length(BootSampleIndex))
mypcex3=rep(NA,length(BootSampleIndex))
for (j in 1:length(unique(BootSampleIndex))){
mylength=length(freq_vec[which(BootSampleIndex==unique(BootSampleIndex)[j])])
freq_vec[which(BootSampleIndex==unique(BootSampleIndex)[j])]=1:mylength
mypcex3[which(BootSampleIndex==unique(BootSampleIndex)[j])]=mypcex2[1:mylength]
}
mypcex4=mypcex+mypcex3
mypcex4
BootSampleIndexMatrix=originalsampleIndex[BootSampleIndex, ]
BootSample=population[BootSampleIndexMatrix]
# cat(file=stderr(), " ", as.numeric(guessInput5()), " ", "\n")
orig.mean = mean(population[originalsampleIndex])
orig.var = var(population[originalsampleIndex])*((n-1)/n)
# cat(file=stderr(), " ", as.numeric(orig.mean), " ", "\n")
tx_star_b <- c(tx_star_b,mean(population[BootSampleIndexMatrix]))
sigmax_star_b=c(sigmax_star_b,sqrt(var(population[BootSampleIndexMatrix])*(n-1)/n))
tx_star_bMINUStheta_fn=c(tx_star_bMINUStheta_fn,mean(population[BootSampleIndexMatrix])-mean(population[originalsampleIndex]))
u_star_b=c(u_star_b,sqrt(n)*(mean(population[BootSampleIndexMatrix])-mean(population[originalsampleIndex]))/sqrt(var(population[BootSampleIndexMatrix])*(n-1)/n))
xbar=c(xbar, as.numeric(mean(BootSample)))
}
cat(file=stderr(), " ", as.numeric(tx_star_b), " ", "\n")
CIboot=c(orig.mean-quantile(tx_star_bMINUStheta_fn,1-0.05/2),orig.mean-quantile(tx_star_bMINUStheta_fn,0.05/2))
CIboot2=c(2*orig.mean-quantile(tx_star_b,1-0.05/2),2*orig.mean-quantile(tx_star_b,0.05/2))
CItboot=c(orig.mean-sqrt(orig.var)*quantile(u_star_b,1-0.05/2)/sqrt(n),orig.mean-sqrt(orig.var)*quantile(u_star_b,0.05/2)/sqrt(n))
CIpboot=c(orig.mean+quantile(tx_star_bMINUStheta_fn,0.05/2),orig.mean+quantile(tx_star_bMINUStheta_fn,1-0.05/2))
CIasymp=c(orig.mean-qnorm(1-0.05/2,mean=0,sd=sqrt(orig.var))/sqrt(n),orig.mean-qnorm(0.05/2,mean=0,sd=sqrt(orig.var))/sqrt(n))
return(c(as.numeric(CIboot[1]),as.numeric(CIboot[2]),as.numeric(b)))
})
newEntry <- observe({
if(input$submit_model >= 0) {
isolate(
myvalues$df[nrow(myvalues$df) + 1,] <- c(isolate(res())[1],isolate(res())[2])
)}
})
output$res_table <- renderTable({
myvalues$df
})
observeEvent( input$refresh, {
updateSliderInput(session, "bb", label="", value=1, min=1, max=input$B, step=1)
set.seed(2018+as.numeric(input$submit_model))
tx_star_b=c()
sigmax_star_b=c()
tx_star_bMINUStheta_fn=c()
u_star_b=c()
xbar=c()
})
observeEvent( input$submit_model, {
tx_star_b=c()
sigmax_star_b=c()
tx_star_bMINUStheta_fn=c()
u_star_b=c()
xbar=c()
})
# Fill in the spot we created for a plot
output$Plot <- renderPlot({
par(mfrow=c(4,2))
mu=input$mu
n=input$n
B=input$B
b=input$bb
N=20
xbar = NULL
tx_star_b=NULL
sigmax_star_b=NULL
u_star_b=NULL
tx_star_bMINUStheta_fn=NULL
nrow = N; ncol = N;lambda=1/mu; p.col = c("deepskyblue", "red"); p.cex = c(1, 3)
set.seed(2018+as.numeric(input$submit_model))
population <- rexp(nrow*ncol,rate=lambda)
population <- matrix(population,nrow,ncol)
par(mar=c(0.5, 0.5, 0.5, 0.5))
x = cbind(rep(1:ncol, nrow), gl(nrow, ncol))
populationIndex = cbind(rep(1:ncol, nrow), gl(nrow, ncol))
set.seed(2018+as.numeric(input$submit_model))
myx=x[sample(nrow * ncol, n), ]
myxx=population[myx]
mycol<-NULL
mycol<-c(mycol,"red")
mycol[]<-"gray"
mycol[1]<-"red"
plot(x, pch = 19, col = "deepskyblue", cex = p.cex[1], axes = FALSE, ann = FALSE, xlab = "", ylab = "",bty="n")
points(myx, col = p.col[1], pch = 19, cex = p.cex[1])
points(myx, col = p.col[2], cex = p.cex[2])
set.seed(2018+as.numeric(input$submit_model))
originalsampleIndex=x[sample(nrow * ncol, n), ]
orig.mean = mean(population[originalsampleIndex])
par(mar=c(0,0,0,0))
plot(x, pch = 19, col = "white", cex = p.cex[1], axes = FALSE, ann = FALSE, xlab = "", ylab = "",bty="n")
points(originalsampleIndex, col = p.col[1], pch = 19, cex = p.cex[1])
set.seed(2018+b+(B*n*as.numeric(input$submit_model)))
BootSampleIndex=sample(1:n, n,replace = T)
mypcex=rep(p.cex[2],length(originalsampleIndex))
mypcex2=seq(0,100,by=2)
freq_vec=rep(NA,length(BootSampleIndex))
mypcex3=rep(NA,length(BootSampleIndex))
for (j in 1:length(unique(BootSampleIndex))){
mylength=length(freq_vec[which(BootSampleIndex==unique(BootSampleIndex)[j])])
freq_vec[which(BootSampleIndex==unique(BootSampleIndex)[j])]=1:mylength
mypcex3[which(BootSampleIndex==unique(BootSampleIndex)[j])]=mypcex2[1:mylength]
}
mypcex4=mypcex+mypcex3
mypcex4
BootSampleIndexMatrix=originalsampleIndex[BootSampleIndex, ]
BootSample=population[BootSampleIndexMatrix]
points(BootSampleIndexMatrix, col = p.col[2], cex = mypcex4)
# xb[b,]=BootSample
guessInput <- reactive({
isolate({
values$tx_star_b <- c(values$tx_star_b, as.numeric(mean(population[BootSampleIndexMatrix])))
return(values$tx_star_b)
})
})
guessInput2 <- reactive({
isolate({
values2$sigmax_star_b <- c(values2$sigmax_star_b, as.numeric(sqrt(var(population[BootSampleIndexMatrix])*(n-1)/n)))
return(values2$sigmax_star_b)
})
})
guessInput3 <- reactive({
isolate({
values3$tx_star_bMINUStheta_fn <- c(values3$tx_star_bMINUStheta_fn, as.numeric(mean(population[BootSampleIndexMatrix])-mean(population[originalsampleIndex])))
return(values3$tx_star_bMINUStheta_fn)
})
})
guessInput4 <- reactive({
isolate({
values4$u_star_b <- c(values4$u_star_b, as.numeric(sqrt(n)*(mean(population[BootSampleIndexMatrix])-mean(population[originalsampleIndex]))/sqrt(var(population[BootSampleIndexMatrix])*(n-1)/n)))
return(values4$u_star_b)
})
})
# cat(file=stderr(), " ", as.numeric(guessInput()), " ", "\n")
# cat(file=stderr(), " ", as.numeric(guessInput2()), " ", "\n")
# cat(file=stderr(), " ", as.numeric(guessInput3()), " ", "\n")
# cat(file=stderr(), " ", as.numeric(guessInput4()), " ", "\n")
tx_star_b <- c(tx_star_b,mean(population[BootSampleIndexMatrix]))
sigmax_star_b=c(sigmax_star_b,sqrt(var(population[BootSampleIndexMatrix])*(n-1)/n))
tx_star_bMINUStheta_fn=c(tx_star_bMINUStheta_fn,mean(population[BootSampleIndexMatrix])-mean(population[originalsampleIndex]))
u_star_b=c(u_star_b,sqrt(n)*(mean(population[BootSampleIndexMatrix])-mean(population[originalsampleIndex]))/sqrt(var(population[BootSampleIndexMatrix])*(n-1)/n))
mycol2<-c(rep("gray",length(as.numeric(guessInput()))-1),"red")
plot(0,type="n",main="",ylab='',yaxt='n',xaxt='n',bty='n')
plot(0,type="n",main="",ylab='',yaxt='n',xaxt='n',bty='n')
par(mar=c(2, 3, 0, 1),mgp=c(5,1,0))
hist(as.numeric(guessInput()),freq = TRUE,xlim=c(0,mu+100),main="",ylab='',xaxt='n',bty='n',cex.axis=2)
points(as.numeric(guessInput()),rep(0,length(as.numeric(guessInput()))),cex.lab=2.2,xlim=c(0,mu+100),
xlab='',ylab='',pch=17,col=mycol2,cex=1.4, xaxt='n',bty='n')
axis(1, seq(0,mu+100,length=5), cex.axis=2, tck=-.01)
mtext("Frequency",at=-100,side=1,line =-22,cex=2,las=2)
points(50,0,cex.lab=2.2,xlim=c(1,3),ylim=c(0,150),xlab='',ylab='',pch=15,col="blue",cex=1.4, yaxt='n', xaxt='n',bty='n')
points(mean(population[originalsampleIndex]),0,cex.lab=2.2,xlim=c(1,3),xlab='',ylab='',pch=18,col="magenta",cex=1.8, yaxt='n', xaxt='n',bty='n')
points(mean(as.numeric(guessInput())),0,cex.lab=2.2,xlim=c(1,3),xlab='',ylab='',pch=19,col="green",cex=1.4, yaxt='n', xaxt='n',bty='n')
CIboot=c(orig.mean-quantile(as.numeric(guessInput3()),1-0.05/2),orig.mean-quantile(as.numeric(guessInput3()),0.05/2))
plot(0,type="n",main="",ylab='',yaxt='n',xaxt='n',bty='n')
legend("center",legend=c(
as.expression(bquote(mu*"="*.(50))),
as.expression(bquote(theta*"("*F[n]*")"*"="*.(format(mean(population[originalsampleIndex]), digits = 0)))),
as.expression(bquote(T({{chi^"*("}^.(format(b, digits = 0))}^")")*"="*.(format(mean(population[BootSampleIndexMatrix]), digits = 0)))),
as.expression(bquote(T(chi^"*")*"="*.(format(mean(as.numeric(guessInput())), digits = 0)))),
paste("[",round(CIboot[1],2)," ; ",round(CIboot[2],2), "]",sep="")
),col=c("blue","magenta","red","green"),pch=c(15,18,17,19,NA),bty="n",cex=1.8)
})
observeEvent( input$refresh, {
updateSliderInput(session, "bb", label="", value=1, min=1, max=input$B, step=1)
set.seed(2018+as.numeric(input$submit_model))
values$tx_star_b=c()
values2$sigmax_star_b=c()
values3$tx_star_bMINUStheta_fn=c()
values4$u_star_b=c()
values5$xbar=c()
})
observeEvent( input$submit_model, {
values$tx_star_b=c()
values2$sigmax_star_b=c()
values3$tx_star_bMINUStheta_fn=c()
values4$u_star_b=c()
values5$xbar=c()
})
observeEvent( input$n, {
values$tx_star_b=c()
values2$sigmax_star_b=c()
values3$tx_star_bMINUStheta_fn=c()
values4$u_star_b=c()
values5$xbar=c()
})
observeEvent( input$B, {
updateSliderInput(session, "bb", label="", value=1, min=1, max=input$B, step=1)
values$tx_star_b=c()
values2$sigmax_star_b=c()
values3$tx_star_bMINUStheta_fn=c()
values4$u_star_b=c()
values5$xbar=c()
})
}
0% ou .
You are about to add 0 people to the discussion. Proceed with caution.
Terminez d'abord l'édition de ce message.
Veuillez vous inscrire ou vous pour commenter