Neue Scripte hinzugefügt (58e86a51) · Commits · Johannes Bleher / SBDA_public

02_code/R/CLT/functions/get_my_sample.R

0 → 100755

+32 −0

Original line number	Diff line number	Diff line
		get_my_sample <- function(nn,NN,theseed,correlated,pos_correlated){
		set.seed(theseed)
		# Draw nn observations from a standard normal distribution
		Sample_list <- lapply(1:NN,function(x) rnorm(nn))
		# Concatenate the lists to a data frame then cast the data.frame into a matrix
		samples_indep <- as.matrix(do.call("rbind",Sample_list))
		if(correlated){
		# Generate a random correlation matrix:
		# runif(nn^2)*2-1 generates nn² draws from the uniform distribution and
		# changes the support to -1 to 1 by multiplying by 2 and subtracting 1
		# One could also us another distribution it really doesn't matter for our purpose.
		# BB%*%BB will be the covariance variance matrix of the joint distribution of our realizations.
		# Nonetheless, if we would like to have only positive correlations then we would need to change the support
		# here to some positive interval (i.e. 0 to 1)
		if(!pos_correlated){
		BB <- matrix(runif(nn^2)*2-1, ncol=nn)
		}else{
		# Comment this line in if you would like to see only positive correlations
		BB <- matrix(runif(nn^2), ncol=nn)
		}
		Sigma <- t(BB)%*%BB
		# In any case, we need to standardise the variables so that the variance is between 0 and 1
		CC <- BB/matrix(sqrt(diag(Sigma)),nn,nn,byrow = TRUE)
		Sigma_std <- t(CC)%*%CC

		# Transform the iid standard normally observations into correlated normal distributions
		samples_corr <- (samples_indep%*%CC)

		return(samples_corr)
		}
		return(samples_indep)
		}

0 → 100755

+11 −0

Original line number	Diff line number	Diff line
		vline <- function(x = 0, color = "darkgreen") {
		list(
		type = "line",
		y0 = 0,
		y1 = 1,
		yref = "paper",
		x0 = x,
		x1 = x,
		line = list(color = color, dash="dot")
		)
		}
		No newline at end of file

0 → 100755

+21 −0

Original line number	Diff line number	Diff line
		#++++++++++++++++++++++++++++++++++++++
		#Load libraries
		#++++++++++++++++++++++++++++++++++++++
		library("shiny")
		library("tidyverse")
		library("plotly")
		# Further libraries would go here

		#+++++++++++++++++++++++++++++++++++++++++++++++++++
		# Read in all functions in the functions folder
		#+++++++++++++++++++++++++++++++++++++++++++++++++++

		list.files("functions") %>%
		purrr::map(~ source(paste0("functions/", .)))

		#+++++++++++++++++++++++++++++++++++++++++++++++++++
		# Read in all modules in the modules folder
		#+++++++++++++++++++++++++++++++++++++++++++++++++++
		list.files("modules") %>%
		purrr::map(~ source(paste0("modules/", .)))

0 → 100644

+65 −0

Original line number	Diff line number	Diff line
		input_parameter_UI <- function (id) {
		ns <- NS (id)
		tagList (
		# Here go your UI elements
		sliderInput(inputId = ns("theseed"),
		label = "Set a seed number",
		min = 0,
		max = 1000,
		value = 815,
		step = 1),
		sliderInput(inputId = ns("nn"),
		label = "Number of observations",
		min = 10,
		max = 1000,
		value =100 ,
		step =10 ),
		sliderInput(inputId = ns("NN"),
		label = "Number of samples",
		min = 10,
		max = 500,
		value =100 ,
		step =1 ),
		checkboxInput(inputId=ns("correlated"),
		label="Should sample draws be correlated?",
		value = FALSE
		),
		conditionalPanel("input['input_parameters-correlated']==1",
		checkboxInput(inputId=ns("pos_correlated"),
		label="Only positively?",
		value = FALSE
		)
		),
		)
		}
		input_parameter_server <- function (
		id
		# possibly further arguments
		# can be added here
		){
		moduleServer (
		id ,
		function ( input , output , session ) {
		# Here goes your server function
		return(
		list(
		theseed = reactive({
		input$theseed
		}),
		NN =reactive({
		input$NN
		}),
		nn =reactive({
		input$nn
		}),
		correlated =reactive({
		input$correlated
		}),
		pos_correlated = reactive({
		input$pos_correlated
		})
		)
		)
		}
		)
		}
		No newline at end of file

0 → 100644

+55 −0

Original line number	Diff line number	Diff line

		output_density_UI <- function(id){
		ns <- NS(id)
		tagList(
		plotlyOutput(ns("output_density"))
		)
		}


		output_density_server <- function(id,
		nn,
		NN,
		themeans
		){
		moduleServer(
		id,
		function(input,output,session){

		output$output_density <- renderPlotly({

		# These are the theoretical 2.5%-bounds for the normal distribution
		# around the sample mean. I.e. only 5% of observations should lie outside these bounds.
		lb <- 0+qnorm(0.025)*1/sqrt(nn())
		ub <- 0+qnorm(0.975)*1/sqrt(nn())
		# Get the kernel density estimate of the calculated means
		dens <- density(themeans())


		#Plot the kernel density estimates
		fig <- plot_ly(x = dens$x, y = dens$y,
		name = 'Kernel Density Estimate'
		, type = 'scatter'
		, mode = 'lines'
		, line = list(color="black")) %>%
		add_trace(
		name = 'Mean Estimates from Samples',
		type = 'scatter',
		mode = 'markers',
		inherit = FALSE,
		x = themeans(),
		y = rep(0,NN()),
		marker = list(color="red")
		) %>%
		layout(shapes=list(vline(lb,color="red"),
		vline(0),
		vline(ub,color="red")
		),
		xaxis = list(range = c(-2.1,2.1)))

		})


		}
		)
		}
		No newline at end of file