 ZPPSVX Example Program Results

 Solution(s)
                    1                 2
 1  ( 1.0000,-1.0000) (-1.0000, 2.0000)
 2  (-0.0000, 3.0000) ( 3.0000,-4.0000)
 3  (-4.0000,-5.0000) (-2.0000, 3.0000)
 4  ( 2.0000, 1.0000) ( 4.0000,-5.0000)

 Backward errors (machine-dependent)
       1.1E-16    7.9E-17

 Estimated forward error bounds (machine-dependent)
       6.1E-14    7.4E-14

 Estimate of reciprocal condition number
       6.6E-03

 A has not been equilibrated


a <- c(1:10)
b <- 3*a -0.43*a^2
plot(a,b, type = 'l', col = 'magenta')

data_sf <- sf::st_as_sf(data.frame(xcoord = c(1,1,1), ycoord = c(2,3,4)),coords = c("xcoord", "ycoord"), crs = 4326)
plot(sf::st_difference(sf::st_buffer(data_sf,3)), col = c("red", "orange", "yellow"))


buildGrid <- function(XY_sp, gridStep){

  x_grid <- seq(min(XY_sp[,1]) - (1.5) * gridStep,
                max(XY_sp[,1]) + (1.5) * gridStep, by = gridStep)
  y_grid <- seq(min(XY_sp[,2]) - (1.5) * gridStep,
                max(XY_sp[,2]) + (1.5) * gridStep, by = gridStep)

  pointInGrid <- matrix(T, nrow = length(x_grid), ncol = length(y_grid))

  for (i in 2:(length(x_grid) - 1)) {

    for (j in 2:(length(y_grid) - 1)) {

      isAnyPointInBandRight <- isPointInBandRight(XY_sp, x_grid, y_grid, i - 1, j - 1)

      isAnyPointInBandLeft <- isPointInBandLeft(XY_sp, x_grid, y_grid, i - 1, j - 1)

      isAnyPointInBandUp <- isPointInBandUp(XY_sp, x_grid, y_grid, i - 1, j - 1)

      isAnyPointInBandDown <- isPointInBandDown(XY_sp, x_grid, y_grid, i - 1, j - 1)

      if(!isAnyPointInBandRight | !isAnyPointInBandLeft | !isAnyPointInBandUp | !isAnyPointInBandDown){
        pointInGrid[i,j] <- F
      }

    }

  }

  pointInGrid <- pointInGrid[-c(1,nrow(pointInGrid)),]
  pointInGrid <- pointInGrid[,-c(1,ncol(pointInGrid))]
  x_grid <- x_grid[-c(1,length(x_grid))]
  y_grid <- y_grid[-c(1,length(y_grid))]

  allPoints <- cbind(expand.grid(x_grid, y_grid), as.vector((pointInGrid)))
  allPoints <- allPoints[allPoints[,3],-3]

  allPoints
}

#' Build spatial grid
#'
#' @description This function shows the spatial grid used in the approximation of the site-specific autocorrelated random effects for a particular value of the grid step.
#' @param X_cov The variable containing the x coordinates of the sites.
#' @param Y_cov The variable containing the y coordinates of the sites.
#' @param gridStep Value of the grid step.
#'
#' @importFrom magrittr %>%
#'
#' @export
#'
#' @return Plot of the grid with number of points used in the approximation.
#'
#' @examples
#'
#' buildSpatialGrid(sampleData$X, sampleData$Y, gridStep = .3)
#'
buildSpatialGrid <- function(X_cov, Y_cov, gridStep){

  meanXsp <- mean(X_cov)
  sdXsp <- stats::sd(X_cov)
  meanYsp <- mean(Y_cov)
  sdYsp <- stats::sd(Y_cov)
  X_sp <- (X_cov - mean(X_cov)) / stats::sd(X_cov)
  Y_sp <- (Y_cov - mean(Y_cov)) / stats::sd(Y_cov)

  # cluster the sites

  uniqueIndexesSite <- which(!duplicated(cbind(X_cov,Y_cov)))
  X_sp_unique <- X_sp[uniqueIndexesSite]
  Y_sp_unique <- Y_sp[uniqueIndexesSite]

  # numCenters <- 400
  # kmeansclustering <- kmeans(cbind(X_sp_unique, Y_sp_unique), centers = numCenters, iter.max = 100)
  # X_tilde <- kmeansclustering$centers
  # X_psi$Center <- as.factor(kmeansclustering$cluster[k_s$Site])
  # X_psi_s <- model.matrix( ~ . - 1, data = X_psi[,c("Center"),drop = F])
  # X_s_index <- kmeansclustering$cluster[k_s$Site]

  XY_sp <- cbind(X_sp_unique, Y_sp_unique)
  X_tilde <- as.matrix(buildGrid(XY_sp, gridStep))
  XY_centers <- findClosestPoint(XY_sp, X_tilde)
  X_tilde <- X_tilde[unique(XY_centers),]
  XY_centers <- findClosestPoint(XY_sp, X_tilde)
  numCenters <- nrow(X_tilde)

  X_tilde_original <- X_tilde
  X_tilde_original[,1] <- X_tilde[,1] * sdXsp + meanXsp
  X_tilde_original[,2] <- X_tilde[,2] * sdXsp + meanXsp

  ggplot2::ggplot() +
    ggplot2::geom_point(data = NULL, ggplot2::aes(x = X_tilde_original[,1],
                                                  y = X_tilde_original[,2]), color = "black", size = 3, shape = 15) +
    ggplot2::ylab("Y") + ggplot2::scale_x_continuous(name = "X") +
    ggplot2::ggtitle(label = paste("Number of points = ",nrow(X_tilde))) +
    ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5, size = 13),
                   axis.title = ggplot2::element_text(size = 13, face = "bold"),
                   axis.text = ggplot2::element_text(size = 13, face = "bold", angle = 90),
                   panel.grid.major = ggplot2::element_line(colour="grey", size=0.015),
                   panel.background = ggplot2::element_rect(fill = "white", color = "black"))

}


if (length(commandArgs(TRUE)) == 0) {
  system("Rscript barplot.r -h", intern = F)
  q("no")
}

# load packages that are provided in the conda env
options( show.error.messages=F,
       error = function () { cat( geterrmessage(), file=stderr() ); q( "no", 1, F ) } )
loc <- Sys.setlocale("LC_MESSAGES", "en_US.UTF-8")
warnings()
library(optparse)
library(ggplot2)
library(ggrepel)
library(RColorBrewer)

#Arguments
option_list = list(
  make_option(
    c("-i", "--input"),
    default = NA,
    type = 'character',
    help = "Input file that contains count data (no header)"
  ),
  make_option(
    c("-o", "--barplot"),
    default = NA,
    type = 'character',
    help = "PDF output file"
  )
)

opt = parse_args(OptionParser(option_list = option_list),
                 args = commandArgs(trailingOnly = TRUE))

##
annotations = read.delim(opt$input, header=F)
colnames(annotations) = c("sample", "class", "percent_of_reads", "total")
annotations$percent=round(annotations$percent_of_reads/annotations$total*100, digits=2)
# ggplot2 plotting

# Define the number of colors you want
Sasha.Trubetskoy.Palette <- c('#e6194b', '#3cb44b', '#ffe119', '#4363d8', '#f58231',
                              '#911eb4', '#46f0f0', '#f032e6', '#bcf60c',
                              '#008080', '#e6beff', '#9a6324', '#fffac8', '#800000',
                              '#aaffc3', '#808000', '#ffd8b1', '#000075', '#808080')
nb.cols <- 19  # 10 with colorRampPalette
# mycolors <- colorRampPalette(brewer.pal(8, "Paired"))(nb.cols)
mycolors <- Sasha.Trubetskoy.Palette[1:nb.cols]

ggtitle('Class proportions')
ggplot(annotations, aes(x=total/2, y = percent_of_reads, fill = class, width = total)) +
       geom_bar(position="fill", stat="identity") +
       facet_wrap(~sample, ncol=3 ) +
       geom_label_repel(aes(label = percent), position = position_fill(vjust = 0.5), size=2,show.legend = F) +
       coord_polar(theta="y") +
       labs(x = "Class fractions (%)") +
       scale_fill_manual(values = mycolors) +
       theme(axis.text = element_blank(),
             axis.ticks = element_blank(),
             panel.grid  = element_blank(),
             axis.title.y = element_blank(),
             legend.position="bottom") +
       geom_text(aes(x = total/2, y= .5, label = paste(round(total/1000000, digits=3), "M"), vjust = 4, hjust=-1), size=2)
ggsave(file=opt$barplot, device="pdf")


#!/usr/bin/Rscript

arg <- commandArgs(trailingOnly=TRUE)

rate_summary <- function(filepath)
{

require(MASS, quietly=TRUE, warn.conflicts=FALSE)
require(TeachingDemos, quietly=TRUE, warn.conflicts=FALSE)
require(hdrcde, quietly=TRUE, warn.conflicts=FALSE)

cat("  reading log-file...\n")

tdat <- read.table(filepath, header=T)
headernames <- names(tdat)

if (any(headernames == "net.diversification")) {
	a <- grep("speciation.rate", headernames)
	b <- grep("extinction.rate", headernames)
	c <- grep("net.diversification", headernames)
	d <- grep("extinction.fraction", headernames)
	} else if (any(headernames == "sp.rate_1")) {
		a <- grep("^sp.rate_", headernames)
		b <- rep(0, length(a))
		c <- rep(0, length(a))
		d <- rep(grep("ext.frac", headernames), length(a))
		} else {
			a <- grep("^speciation_", headernames)
			b <- grep("^extinction_", headernames)
			c <- grep("^net_div_", headernames)
			d <- grep("^ext_frac_", headernames)
	}

if (any(headernames == "net.diversification" | headernames == "sp.rate_1")) {
	clade.name <- NULL
	} else {
	clade.name <- headernames[c]
	clade.name <- gsub("net_div_", "", clade.name)
	}

df <- data.frame(a,b,c,d)

l <- c("speciation rate", "extinction rate", "net diversification", "extinction fraction")
cat("  computing HPDs and printing pdf...\n")

output <- gsub ("\\.log$", ".pdf", filepath)

pdf (file=output)

# check if all models are pb
if (sum(tdat[,d]) == 0) {
	for (n in 1:length(a)) {
			var_name <- l[1]
			cred_int <- emp.hpd (tdat[,a[n]], conf=0.95)
			map <- round(hdr(tdat[,a[n]], all.modes=F)$mode, digits=3)
			minX <- floor(10*min(tdat[,a[n]]))/10
			maxX <- ceiling(10*max(tdat[,a[n]]))/10
			ahist <- hist(tdat[,a[n]], plot=F)
			rate <- round(mean(tdat[,a[n]]), digits=3)
			if (length(a) > 1) {
				hist(tdat[,a[n]], xlab = paste(sprintf("%s", var_name), "- mean:", rate[1], "/ MAP:", map), sub = paste("95% HPD:", sprintf("%.3f-%.3f", cred_int[1], cred_int[2])), main = sprintf("rate %s", n), ylim = c(0, max(ahist$counts+(ahist$counts/3))), xlim = c(minX, maxX))
			} else {
				hist(tdat[,a[n]], xlab = paste(sprintf("%s", var_name), "- mean:", rate[1], "/ MAP:", map), sub = paste("95% HPD:", sprintf("%.3f-%.3f", cred_int[1], cred_int[2])), main = "speciation rate", ylim = c(0, max(ahist$counts+(ahist$counts/3))), xlim = c(minX, maxX))
			}
		}

	} else {

par(mfrow=c(2,2))
for (n in 1:length(a)) {
	if (sum(tdat[,d[n]]) == 0) {
		var_name <- l[1]
		cred_int <- emp.hpd (tdat[,a[n]], conf=0.95)
		map <- round(hdr(tdat[,a[n]], all.modes=F)$mode, digits=3)
		minX <- floor(10*min(tdat[,a[n]]))/10
		maxX <- ceiling(10*max(tdat[,a[n]]))/10
		ahist <- hist(tdat[,a[n]], plot=F)
		rate <- round(mean(tdat[,a[n]]), digits=3)
		hist(tdat[,a[n]], xlab = paste(sprintf("%s", var_name), "- mean:", rate[1], "/ MAP:", map), sub = paste("95% HPD:", sprintf("%.3f-%.3f", cred_int[1], cred_int[2])), main = sprintf("clade: %s", clade.name[n]), ylim = c(0, max(ahist$counts+(ahist$counts/3))), xlim = c(minX, maxX))
	for (m in 1:3){
		frame()
		}

	} else {

	j = 1
	coln <- as.vector(df[n,])
		for(i in coln){
			var_name <- l[j]
			cred_int <- emp.hpd (tdat[,i], conf=0.95)
			map <- round(hdr(tdat[,i], all.modes=F)$mode, digits=3)
			minX <- floor(10*min(tdat[,i]))/10
			maxX <- ceiling(10*max(tdat[,i]))/10
				if(j==4){
					minX=0
					maxX=1}
			ahist <- hist(tdat[,i], plot=F)
			rate <- round(mean(tdat[,i]), digits=3)
			hist(tdat[,i], xlab = paste(sprintf("%s", var_name), "- mean:", rate[1], "/ MAP:", map), sub = paste("95% HPD:", sprintf("%.3f-%.3f", cred_int[1], cred_int[2])), main = sprintf("clade: %s", clade.name[n]), ylim = c(0, max(ahist$counts+(ahist$counts/3))), xlim = c(minX, maxX), cex.lab=0.8, cex.sub=0.8, cex.main=0.9, cex.axis=0.9)
	j <- j+1
			}
		}
	}
}

dev.off()
cat("  results are saved in: ", sprintf("%s", output), "\n\n")
}

rate_summary(as.character(arg[1]))


library(extRemes)
library(glue)

# File name: gev_fit
# Author: Tania Paola Lopez Cantu
# E-mail: tlopez@andrew.cmu.edu
# Date created: 11.02.2020
# Date last modified: 11.02.2020

# ##############################################################
# Purpos:

# Fit GEV using GMLE to PDS/AMS

# returns: csv file of GEV model parameters with a 95% CI interval using GMLE
# and depth for 2-,5-,10-,25-,50-,100-year ARI only estimated taking the best parameter estimate

args = commandArgs(trailingOnly=TRUE)

path = args[1]
savepath = args[2]
bound = args[3]

dir.create(file.path(savepath))

for (f in list.files(path)) {

    savefile_params = glue('{savepath}/param_{f}')
    #message(savefile_params)

    savefile_depth =glue('{savepath}/depth_{f}')
    params_estimated = FALSE
    if (file.exists(savefile_params) == FALSE){

        params_estimated = TRUE

        pds <- read.csv(file=glue('{path}/{f}'), header=T, sep=',')
        pds2 <- pds[ , apply(pds, 2, function(x) !any(is.na(x)))]
        pds3 <- pds2[, colSums(pds2 != 0) > 0]

        message('Finished reading...')

        model.name <- colnames(pds3)

        f = (length(model.name))

        model.name <- colnames(pds3)[c(2:f)]
        params <- data.frame(matrix(ncol = 10, nrow = length(model.name)))
        colnames(params) <- c("models", "L_loc", "loc", "U_loc",
                            "L_scale", "scale", "U_scale",
                            "L_shape", "shape", "U_shape")
        params[1] <- as.vector(model.name)
        message('Starting fit...')
        for (model in 2:f) {
            md = as.vector(pds3[, (model)])
            id_ <- model.name[model-1]
            tryCatch({
                fit_mle <- fevd(md, method='GMLE', type='GEV')

                param.loc <- as.vector(ci(fit_mle, alpha=0.05, type='parameter')[1,])
                param.scale <- as.vector(ci(fit_mle, alpha=0.05, type='parameter')[2,])
                param.shape <- as.vector(ci(fit_mle, alpha=0.05, type='parameter')[3,])

                params.single <- c(param.loc,param.scale, param.shape)
                params[model-1, c(2:10)] <- params.single},
                error = function(e){ message(" ", glue('There was an error at: {id_}'))
                })
            }
        message('End fit, writing csv')
        write.csv(params, savefile_params)}
    if (file.exists(savefile_depth) == FALSE){

        if (params_estimated == FALSE){
            params <- read.csv(file=savefile_params, header=T, sep=',')
        }

        message("Estimating precipitation depth...")

        if (bound == 'U_'){
            df = subset(params, select = -c(L_loc, loc, L_scale, scale, L_shape,shape))
        } else if (bound == 'L_'){
            df = subset(params, select = -c(U_loc, loc, U_scale, scale, U_shape,shape) )
        } else if (bound == 'best'){
            df = subset(params, select = -c(U_loc, L_loc, U_scale, L_scale, U_shape, L_shape))
        }
        params <- t(df)
        model.name <- params["models", ]

        #message(" ", model.name)

        f = (length(model.name))
        depth.cals <- data.frame(matrix(ncol = 7, nrow =length(model.name) ))
        colnames(depth.cals) <- c("models", "2-yr", "5-yr",
                                            "10-yr", "25-yr", "50-yr",
                                            "100-yr")
        depth.cals[1] <- as.vector(model.name)

        for (model in 1:f){

            pmodel <- params[, (model)]
            pmodel <- pmodel[!is.na(pmodel)]
            tryCatch({
                if (params_estimated == FALSE){
                    loc = as.double(pmodel[3])
                    scale = as.double(pmodel[4])
                    shape = as.double(pmodel[5])
                } else if (params_estimated == TRUE){
                    loc = as.double(pmodel[2])
                    scale = as.double(pmodel[3])
                    shape = as.double(pmodel[4])
                }
            depth.cals.single <- as.vector(rlevd(period=c(2,5,10,25,50,100),
                loc = loc, scale=scale, shape=shape))
            depth.cals[model, c(2:7)] <- depth.cals.single
            }, error = function(e){})
        }
        message("End estimation, writing csv")
        write.csv(depth.cals, savefile_depth)

    }

    }


equity.twri.test <- function() {
    security <- c('SPY', 'T')
    adjdates <- c('2020-01-29', '2020-02-26', '2020-03-24', '2020-03-31')
    out <- equity.twri(security, adjdates=adjdates)
    return(out)
}

equity.twri <- function(security, refresh=TRUE, file=NA, period='months', adjdates=NULL) {

    ## Returns an xts object with twri for vector of securities.
    ## Defaults returns twri for all available dates.
    ## Period option can be used to select days, weeks, months, or years.
    ## Dates option overrides period and extracts adjusted closing costs for
    ## the vector of dates used to determine twri
    ## (note: "date" option returns twri for all but the first date)

    if (isTRUE(refresh)) {
        ## get incremental twr for each security
        ## twri <- equity.history(security, period='months')  # security[1:50] works, [1:60] does not
        alltwri <- NA
        if (!is.null(adjdates)) {
            ## create xts object of requested dates
            df           <- data.frame(Date=adjdates)
            rownames(df) <- df$Date
            df$keep      <- 1
            df$Date      <- NULL
            adjdates     <- xts::as.xts(df, order.by=as.Date(rownames(df)))
        }
        for (i in 1:length(security)) {
            ## equity.history works for list of 50 symbols but not 60
            ## maybe just do 1 at a time for now to keep simple

            cat('i = ', i, 'security =', security[i], '\n')

            if (security[i] == 'Cash') {
                ## cannot download price info  with tiny variation so statistics work later
                ## this will probably bomb if Cash is the first security
                Cash <- rnorm(nrow(alltwri), mean=0, sd=0.00001)
                alltwri <- cbind(alltwri, Cash)

            } else {
                if (is.null(adjdates[1])) {
                    ## specific dates not provided so use period
                    new <- equity.history(security[i], period=period)  # 50 works, 60 does not
                    alltwri <- cbind(alltwri, new$twri)     # xts cbind nicely lines up dates

                } else {
                    ## specific dates are provided so use period=days
                    new <- equity.history(security[i], period='days')
                    ## extract adjusted prices
                    adjprice <- new$adjprice[,1]
                    ## combine dates with adjprice
                    adjprice <- cbind(adjprice, adjdates)
                    ## strip unused dates
                    adjprice      <- na.omit(adjprice)
                    ## eliminate placeholer column
                    adjprice$keep <- NULL
                    ## calculate incremental TWR
                    twri  <- adjprice / xts::lag.xts(adjprice, 1) - 1
                    ## remove 1st row since NA
                    twri <- twri[-1,]

                    alltwri <- cbind(alltwri, twri)

                }
            }
        }

        ## correct symbols to be consistent with allprice if needed
        symbols <- gsub("\\.|\\/", "-", names(alltwri))
        names(alltwri) <- symbols
        ## strip off 1st column
        alltwri$alltwri <- NULL
        tail(alltwri)

        ## write file of incremental twr values
        if (!is.na(file)) zoo::write.zoo(alltwri, file, sep=',')

    } else {
        ## read historical incremental twr info from file
        alltwri <- readall(file)
        rownames(alltwri) <- alltwri$Index
        alltwri$Index     <- NULL
        alltwri <- xts::as.xts(alltwri)

    }

    return(twri=alltwri)
}
## equity.twri(c('SPY', 'AAPL'))


library(corrplot)

message("start PCA")
#f_table= f_table_ori

f_table_new = f_table
f_table2 =f_table_new
#colnames(f_table_new)
#
##firstpaperorder
# colnames(f_table2)=c ("AA_id","AB_group","H_speeds","N_distance_traveled","D_turning_angle","E_meander",
                       # "O_activitytime_ST",
                     # "K_act_bouts_ST","C_pause_length_ST","I_#pauses_ST","P_activitytime_timeT",
                     # "L_act_bouts_DtimeT","B_pause_length_timeT","J_#pauses_timeT", "F_thigmotaxis_moving", "G_thigmotasix_pause","M_#walks","AC_stripe_deviation")

if (MINCOL==4){
	colnames(f_table2)= c("AA_id","AB_group","ZE_date","ZF_timeofday","ZG_experiment_duration","H_speeds","N_distance_traveled","D_turning_angle","E_meander","XA_activitytime_ST","XB_act_bouts_ST","XC_pause_length_ST","XD_#pauses_ST","P_activitytime_timeT","L_act_bouts_DtimeT","B_pause_length_timeT","J_#pauses_timeT","F_thigmotaxis_moving", "G_thigmotasix_pause","M_#walks","AC_stripe_deviation")
}

if (MINCOL==8){
	colnames(f_table2)= c("AA_id","AB_group","ZA_genotype",  "ZB_treatment", "ZC_machine","ZD_other", "ZE_date","ZF_timeofday","ZG_experiment_duration","H_speeds","N_distance_traveled","D_turning_angle","E_meander","XA_activitytime_ST","XB_act_bouts_ST","XC_pause_length_ST","XD_#pauses_ST","P_activitytime_timeT","L_act_bouts_DtimeT","B_pause_length_timeT","J_#pauses_timeT","F_thigmotaxis_moving", "G_thigmotasix_pause","M_#walks","AC_stripe_deviation")
}
###add this to make the pca over the genotype group only

# if (MINCOL==8){
	# colnames(f_table2)= c("AA_id","ZA_group2","AB_group",  "ZB_treatment", "ZC_machine","ZD_other", "ZE_date","ZF_timeofday","H_speeds","N_distance_traveled","D_turning_angle","E_meander","XA_activitytime_ST","XB_act_bouts_ST","XC_pause_length_ST","XD_#pauses_ST","P_activitytime_timeT","L_act_bouts_DtimeT","B_pause_length_timeT","J_#pauses_timeT","F_thigmotaxis_moving", "G_thigmotasix_pause","M_#walks","AC_stripe_deviation")
# }

data.frame(names(f_table),names(f_table2))
## get linearity score out
#f_table2=f_table2[,-16]

## reorder variables following the free walk analysis
f_table2= f_table2[,order(colnames(f_table2))]

### gives output if not all calculation are made
#if(length(f_table_new) != 19)  f_table2=f_table_new

#### ENTER HERE MANUALLY A NEW DATA AS ENTRY FOR THE PCA ANALYSIS
# f_table2= f_table

i_table =na.omit(f_table2)
h_table<-f_table2[,c(3:(length(f_table2)-MINCOL+2-4))] #+2 from group and id, -4 to take ST out
rownames (h_table) = paste (c(1:length(f_table2[,1])),f_table2[,2])
#h_table<-f_table2[,c(3:13,16:length(f_table2))]
g_table <- na.omit(h_table)
 head(g_table)
mydata.pca <- prcomp(g_table, retx= TRUE, center= TRUE, scale.=TRUE)

sd <- mydata.pca$sdev
loadings <- mydata.pca$rotation
rownames(loadings) <- colnames(g_table)
scores <- mydata.pca$x

t=mydata.pca$sdev^2 / sum(mydata.pca$sdev^2)
t2= cumsum(t)
plot(t2*10, main= "variance explained cumulative")

PCA_res= data.frame(scores)
PCA_res$group = as.factor(i_table[,2])

#PCA_res$group = i_table[,19]

#Plot PC1 and 2 info on one graph
PCA1to3 = data.frame(PCA_res$PC1,PCA_res$PC2,PCA_res$PC3,PCA_res$group)

Mean_PCA = create.mean.table(PCA1to3,levels(PCA1to3$PCA_res.group),1:2)
Mean_PCA2 = create.mean.table(PCA1to3,levels(PCA1to3$PCA_res.group),c(1,3))
#################################################
###################################################
##################################################
setwd(outputpath)
scalingfact=7
scalingaxis=1

###prepare mean tables
PCA1to3 = data.frame(PCA_res$PC1,PCA_res$PC2,PCA_res$PC3,PCA_res$group)
Mean_PCA_3d = create.mean.table(PCA1to3,levels(PCA1to3$PCA_res.group),1:3)
Mean_PCA = create.mean.table(PCA1to3,levels(PCA1to3$PCA_res.group),1:2)

abc= c(1:8, rgb(202,100,20,maxColorValue = 255),rgb(100,0,200,maxColorValue = 255))

 plot(scores[,1], scores[,2], xlab="PCA 1", ylab="PCA 2",
   type="n", main="distance biplot",xlim=c(-max(scores[,1:2]*scalingaxis), max(scores[,1:2]*scalingaxis)),
   ylim=c(-max(scores[,1:2]*scalingaxis), max(scores[,1:2]*scalingaxis)))

for (i in 1:length(levels(PCA_res$group))){
  X = subset(PCA_res,PCA_res$group == levels(PCA_res$group)[i])
	points(X$PC2~ X$PC1, col=abc[i])
	#legend(list(x=-6,y=-i/2+5), legend=(levels(PCA_res$group)[i]), fill= i, bty="n")
	 #text(x+1,y-0.1, levels(PCA_res$group)[i], col=i,  cex=0.7)
legend("topleft", legend=(levels(PCA_res$group)[i]), fill= abc[i], bty="n", inset = c(0,i/30))

   x=Mean_PCA$means$PCA_res.PC1[i]
y=Mean_PCA$means$PCA_res.PC2[i]
x2=Mean_PCA$ses$PCA_res.PC1[i]
y2=Mean_PCA$ses$PCA_res.PC2[i]
segments (x-x2,y,x+x2,y, col=abc[i])
segments (x,y-y2,x,y+y2, col=abc[i])
	}
	abline (v=0, h=0)

 plot(scores[,1], scores[,3], xlab="PCA 1", ylab="PCA 3",
   type="n", main="distance biplot",xlim=c(-max(scores[,1:3]*scalingaxis), max(scores[,1:3]*scalingaxis)),
   ylim=c(-max(scores[,1:3]*scalingaxis), max(scores[,1:3]*scalingaxis)))

for (i in 1:length(levels(PCA_res$group))){
	X = subset(PCA_res,PCA_res$group == levels(PCA_res$group)[i])
	points(X$PC3~ X$PC1, col=abc[i])
	#legend(list(x=-6,y=-i/2+5), legend=(levels(PCA_res$group)[i]), fill= i, bty="n")
	 #text(x+1,y-0.1, levels(PCA_res$group)[i], col=i,  cex=0.7)
legend("topleft", legend=(levels(PCA_res$group)[i]), fill= abc[i], bty="n", inset = c(0,i/30))

   x=Mean_PCA2$means$PCA_res.PC1[i]
y=Mean_PCA2$means$PCA_res.PC3[i]
x2=Mean_PCA2$ses$PCA_res.PC1[i]
y2=Mean_PCA2$ses$PCA_res.PC3[i]
segments (x-x2,y,x+x2,y, col=abc[i])
segments (x,y-y2,x,y+y2, col=abc[i])
	}
	abline (v=0, h=0)

##########################################
## plot data pc1 and 2 / 1 and 3 without points
M=max(Mean_PCA$means)+max(Mean_PCA$ses)*1.1
 plot(scores[,1], scores[,2], xlab="PCA 1", ylab="PCA 2",
   type="n", main="distance biplot",xlim=c(-M, M),
   ylim=c(-M, M))

#plot(PCA_res$PC2~PCA_res$PC1, type= "n", add=TRUE)
for (i in 1:length(levels(PCA_res$group))){
  X = subset(PCA_res,PCA_res$group == levels(PCA_res$group)[i])
	#points(X$PC2~ X$PC1, col=i, pch= i+10)
legend("topleft", legend=(levels(PCA_res$group)[i]), fill= abc[i], bty="n", inset = c(0,i/30))
	 #text(x+1,y-0.1, levels(PCA_res$group)[i], col=i,
#   cex=0.7)
   x=Mean_PCA$means$PCA_res.PC1[i]
y=Mean_PCA$means$PCA_res.PC2[i]
x2=Mean_PCA$ses$PCA_res.PC1[i]
y2=Mean_PCA$ses$PCA_res.PC2[i]
segments (x-x2,y,x+x2,y, col=abc[i])
segments (x,y-y2,x,y+y2, col=abc[i])
	}
	abline (v=0, h=0)

 plot(scores[,1], scores[,3], xlab="PCA 1", ylab="PCA 3",
   type="n", main="distance biplot",xlim=c(-M, M),
   ylim=c(-M, M))

for (i in 1:length(levels(PCA_res$group))){
	X = subset(PCA_res,PCA_res$group == levels(PCA_res$group)[i])
	#points(X$PC3~ X$PC1, col=i)
	#legend(list(x=-6,y=-i/2+5), legend=(levels(PCA_res$group)[i]), fill= i, bty="n")
	 #text(x+1,y-0.1, levels(PCA_res$group)[i], col=i,  cex=0.7)
legend("topleft", legend=(levels(PCA_res$group)[i]), fill= abc[i], bty="n", inset = c(0,i/30))

   x=Mean_PCA2$means$PCA_res.PC1[i]
y=Mean_PCA2$means$PCA_res.PC3[i]
x2=Mean_PCA2$ses$PCA_res.PC1[i]
y2=Mean_PCA2$ses$PCA_res.PC3[i]
segments (x-x2,y,x+x2,y, col=abc[i])
segments (x,y-y2,x,y+y2, col=abc[i])
	}
	abline (v=0, h=0)

################
############### plot loadings
M= max (loadings[,1:3])*1.25
 plot(scores[,1], scores[,2], xlab="PCA 1", ylab="PCA 2",
   type="n", main="distance biplot",xlim=c(-M, M),
   ylim=c(-M, M))

for (k in c(1: nrow(loadings))){
  arrows(0,0,loadings[k,1],loadings[k,2], length=0.1,
  angle=20, col=k)
# note that this scaling factor of 10 may need to be changed,
# depending on the data set
  text(loadings[k,1]*1.2,loadings[k,2]*1.2,
  rownames(loadings)[k], col=k, cex=0.7)
}

# 1.2 scaling insures that labels are plotted just beyond
# the arrows
# text(scores[,1],scores[,2], rownames(scores), col="blue",
#   cex=0.7)

#plot(scores[,1], scores[,3], xlab="PCA 1", ylab="PCA 3",
 #   type="n", main=paste ("distance biplot",levels((f_table$group))[i] ),xlim=c(-max(scores[,1:3]*scalingaxis), max(scores[,1:3]*scalingaxis)),
  #    ylim=c(-max(scores[,1:3]*scalingaxis), max(scores[,1:3]*scalingaxis)))

 plot(scores[,1], scores[,3], xlab="PCA 1", ylab="PCA 3",
   type="n", main="distance biplot",xlim=c(-M, M),
   ylim=c(-M, M))

for (k in c(1: nrow(loadings))){
  arrows(0,0,loadings[k,1],loadings[k,3], length=0.1,
  angle=20, col=k)
# note that this scaling factor of 10 may need to be changed,
# depending on the data set
  text(loadings[k,1]*1.2,loadings[k,3]*1.2,
  rownames(loadings)[k], col=k, cex=0.7)
}

###########
########## correlation matrices under is all correlation, up only the significant one (p< 0.05)

cor.prob3 <- function(X, dfr = nrow(X) - 2) {
   R <- cor(X)
   T=R

   above <- row(R) < col(R)
   r2 <- R[above]^2
   Fstat <- r2 * dfr / (1 - r2)
	 R[above] <-  pf(Fstat, 1, dfr)
   G = R[above]
   i = c(1:length(R[above]))
    G[i]=ifelse(R[above][i]>0.95 ,1,0)
    G[i]=ifelse(R[above][i]>0.99 ,1,G[i])
   R[above][i] =G[i]*T[above][i]

	 R
}

f_table2 =na.omit(f_table2)
#f_table2$AB_group =f_table2$group
for(i in 1:length(levels((f_table2$AB_group)))){
  totest= f_table2[f_table2$AB_group==levels((f_table2$AB_group))[i],]
  totestdata= totest[,c(3:(length(totest)-(MINCOL-1)))]

  CORRMATRIX= cor.prob3 (totestdata)

  #corrplot.number(CORRMATRIX, title=paste(levels((f_table2$AB_group))[i], "n=", nrow(totest)), diag=
  #  FALSE)
  #col1 <- colorRampPalette(c("#7F0000","red","#FF7F00","yellow","white",
#"cyan", "#007FFF", "blue","#00007F"))
  col3 <- colorRampPalette(c("green", "white", "red"))

  corrplot(CORRMATRIX, method = "circle",title=paste(levels((f_table2$AB_group))[i], "n=", nrow(totest)), diag= FALSE, col=col3(30) )

#   corrplot.circle(CORRMATRIX, title=paste(levels((f_table$group))[i]), diag=
#    FALSE)
  #CORRMATRIX2= cor (g_table[A:B,])
 # corrplot.circle(CORRMATRIX, title=paste("stripes",levels((f_table$group))[i]), order="alphabet")

}
###
###other calculations
#
# R <- cor(g_table)
# myEig <- eigen(R)
# sdLONG <- sqrt(myEig$values)
# loadingsLONG <- myEig$vectors
# rownames(loadingsLONG) <- colnames(g_table)
#  standardize <- function(x) {(x - mean(x))/sd(x)}
#  X <- apply(g_table, MARGIN=2, FUN=standardize)
# # transforming data to zero mean and unit variance
#  scoresLONG <- X %*% loadingsLONG
# # calculating scores from eigenanalysis results
#
#  range(sd - sdLONG)
#  range(loadings - loadingsLONG)
#  range(scores - scoresLONG)
#
# scalingfact=7.5
# scalingaxis=1
# plot.new()
#  plot(scores[,1], scores[,2], xlab="PCA 1", ylab="PCA 2",
#    type="n", main="distance biplot",xlim=c(-max(scores[,1:3]*scalingaxis), max(scores[,1:3]*scalingaxis)),
#    ylim=c(-max(scores[,1:3]*scalingaxis), max(scores[,1:3]*scalingaxis)))
#    arrows(0,0,loadings[,1]*scalingfact,loadings[,2]*scalingfact, length=0.1,
#    angle=20, col="red")
# # note that this scaling factor of 10 may need to be changed,
# # depending on the data set
#  text(loadings[,1]*scalingfact*1.2,loadings[,2]*scalingfact*1.2,
#    rownames(loadings), col="red", cex=0.7)
# 1.2 scaling insures that labels are plotted just beyond
# the arrows
# text(scores[,1],scores[,2], rownames(scores), col="blue",
#   cex=0.7)

#
#  plot(scores[,1], scores[,3], xlab="PCA 1", ylab="PCA 3",
#    type="n", main="distance biplot",xlim=c(-max(scores[,1:3]*scalingaxis), max(scores[,1:3]*scalingaxis)),
#    ylim=c(-max(scores[,1:3]*scalingaxis), max(scores[,1:3]*scalingaxis)))
#  arrows(0,0,loadings[,1]*scalingfact,loadings[,3]*scalingfact, length=0.1,
#    angle=20, col="red")
# # note that this scaling factor of 10 may need to be changed,
# # depending on the data set
#  text(loadings[,1]*scalingfact*1.2,loadings[,3]*scalingfact*1.2,
#    rownames(loadings), col="red", cex=0.7)
# # 1.2 scaling insures that labels are plotted just beyond
# # the arrows
# # text(scores[,1],scores[,2], rownames(scores), col="blue",
# #   cex=0.7)
#
#
#
# # biplot(scores[,1:2], loadings[,1:2], xlab=rownames(scores),
#   # ylab=rownames(loadings), cex=0.7, main="distance biplot using built-in biplot function")
# # using built-in biplot function : not working here??
#
# #correlation biplot
#
# #  plot(scores[,1]/sd[1], scores[,3]/sd[3], xlab="PCA 1",
# #    ylab="PCA 3", type="n", main ="correlation biplot")
# #  arrows(0,0,loadings[,1]*sd[1],loadings[,3]*sd[3],
# #
# #    length=0.1, angle=20, col="red")
# #  text(loadings[,1]*sd[1]*1.2,loadings[,3]*sd[3]*1.2,
# #    rownames(loadings), col="red", cex=0.7)
# #  text(scores[,1]/sd[1],scores[,3]/sd[3], rownames(scores),
# #    col="blue", cex=0.7)
# # # 1.2 scaling insures that labels are plotted just beyond
# # # the arrows
# #   plot(scores[,2]/sd[2], scores[,3]/sd[3], xlab="PCA 2",
# #    ylab="PCA 3", type="n", main ="correlation biplot")
# #  arrows(0,0,loadings[,2]*sd[2],loadings[,3]*sd[3],
# #
# #    length=0.1, angle=20, col="red")
# #  text(loadings[,2]*sd[2]*1.2,loadings[,3]*sd[3]*1.2,
# #    rownames(loadings), col="red", cex=0.7)
# #  text(scores[,2]/sd[2],scores[,3]/sd[3], rownames(scores),
# #    col="blue", cex=0.7)
# # # 1.2 scaling insures that labels are plotted just beyond
# # # the arrows
# #
# #  plot(scores[,1]/sd[1], scores[,2]/sd[2], xlab="PCA 1",
# #    ylab="PCA 2", type="n", main ="correlation biplot")
# #  arrows(0,0,loadings[,1]*sd[1],loadings[,2]*sd[2],
# #
# #    length=0.1, angle=20, col="red")
# #  text(loadings[,1]*sd[1]*1.2,loadings[,2]*sd[2]*1.2,
# #    rownames(loadings), col="red", cex=0.7)
# #  text(scores[,1]/sd[1],scores[,2]/sd[2], rownames(scores),
# #    col="blue", cex=0.7)
# # # 1.2 scaling insures that labels are plotted just beyond
# # # the arrows
#
#
#  biplot(mydata.pca, main ="using biplot pcaresult")
#
#  #analysis
# correlations <- cor(scores,g_table)
#
#
#
# plot(log(sd^2), xlab="principle component",
#    ylab="log(variance)", type="b", pch=16)
# # using a general plot, with variance on a log scale
#
#  newsd <- sd(scores)
#  max (sd - newsd)
# # finds maximum difference between the standard deviation form
# # prcomp and the standard deviation calculated longhand;
# # should be close to zero
#  eigenvalues <- sd^2
#  sum(eigenvalues)
# # should equal number of variables
# length(g_table)
# # number of variables
#
#
#
#
# PCA_res= data.frame(scores)
# PCA_res$group = i_table[,2]
# class(PCA_res)
# PCA_res$PC1
# i_table =na.omit(f_table2)
# PCA_res$group = i_table[,2]
#
# cor.prob <- function(X, dfr = nrow(X) - 2) {
#    R <- cor(X)
#    above <- row(R) < col(R)
#    r2 <- R[above]^2
# 	 Fstat <- r2 * dfr / (1 - r2)
# 	 R[above] <-   pf(Fstat, 1, dfr)
# 	 R
# }
# cor.prob2 <- function(X, dfr = nrow(X) - 2) {
#    R <- cor(X)
#    T=R
#
# 	 above <- row(R) < col(R)
# 	 r2 <- R[above]^2
# 	 Fstat <- r2 * dfr / (1 - r2)
# 	 R[above] <-  pf(Fstat, 1, dfr)
#    G = R[above]
#    i = c(1:length(R[above]))
#     G[i]=ifelse(R[above][i]>0.95 ,-0.5,0)
#     G[i]=ifelse(R[above][i]>0.99 ,1,G[i])
#    R[above] =G
# 	 R
# }
# library(corrplot)
        setwd(rgghome)


library(tidyverse)
library(jsonlite)
library(lubridate)
library(zoo)
library(scales)

library(ggplot2)

Sys.setlocale("LC_TIME", "hr_HR.UTF-8")

# get data from owid
data <- read_csv('https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/owid-covid-data.csv')  %>%
  filter(location %in% "Croatia")

data$date <- as.Date(data$date, format="%Y-%m-%d")

# read latest data we fetched from koronavirus.hr
diff_df <- read_csv('data/latest/diff_df.csv')
avg7_df <- as.data.frame(rollapply(diff_df[, 1:ncol(diff_df) - 1], 7, mean, fill=NA, align="right"))

diff_df$date <- diff_df$Datum
avg7_df$Hrvatska_avg7 <- avg7_df$Hrvatska
avg7_df$date <- diff_df$date

# get last_date_
load('data/latest/last_date_.Rda')

# hospitalisation data
hospitalisation_data <- read.csv(file ='data/latest/last_hzjz_data.csv')

hospitalisation_data$date <- as.Date(hospitalisation_data$datum, format="%d/%m/%Y")

data_sorted <- data[order(data$date),]
hospitalisation_data_sorted <- hospitalisation_data[order(hospitalisation_data$date),]

merged_data <- merge(data_sorted, hospitalisation_data_sorted, by="date", all=TRUE) %>%
  select(date, new_cases, new_deaths, people_fully_vaccinated, population,
         pozitivne.osobe, new_hospitalised=hospitalizirani.u.zadnja.24.sata,
         new_on_respirator=na.respiratoru.u.zadnja.24.sata,
         new_deaths_hospital=preminuli.u.bolnici,
         new_tests=učinjeni.testovi) %>%
  mutate(new_cases_7da = zoo::rollmean(new_cases, k = 7, fill = NA, align = "right")) %>%
  mutate(new_deaths_7da = zoo::rollmean(new_deaths, k = 7, fill = NA, align = "right"))  %>%
  mutate(new_on_respirator_7da = zoo::rollmean(new_on_respirator, k = 7, fill = NA, align = "right"))  %>%
  mutate(new_hospitalised_7da = zoo::rollmean(new_hospitalised, k = 7, fill = NA, align = "right")) %>%
  mutate(death_ratio = lead(new_deaths_7da, n=15, default=NA) / new_cases_7da) %>%
  mutate(hospitalisation_ratio = lead(new_hospitalised_7da, n=7, default=NA) / new_cases_7da) %>%

  mutate(pozitivne.osobe_7da = zoo::rollmean(pozitivne.osobe, k = 7, fill = NA, align = "right")) %>%
  mutate(new_tests_7da = zoo::rollmean(new_tests, k = 7, fill = NA, align = "right")) %>%

  mutate(positive_percentage = pozitivne.osobe / new_tests) %>%
  mutate(positive_percentage_7da = pozitivne.osobe_7da / new_tests_7da)

only_perc <- merged_data %>% select(positive_percentage_7da, date) %>% drop_na()

last_date_perc <- format(as.Date(only_perc[nrow(only_perc), 'date']), '%d.%m.%Y.')

g <- ggplot() +
  geom_point(data=merged_data, aes_string(x='date', y="positive_percentage"), colour='red', size=1) +
  geom_line(data=merged_data, aes_string(x='date', y="positive_percentage_7da"),  size=1) +
  scale_x_date(labels = date_format("%b %Y."), date_breaks = "1 month") +
  scale_y_continuous(labels = scales::percent) +
  ggtitle(paste('Kretanje udjela pozitivnih testova u Hrvatskoj do', last_date_perc, '(crveno - dnevni udio, crno - sedmodnevni prosjek)')) +

  ylab('Udio pozitivnih testova') +
  xlab('Datum') +
  labs(caption = paste('Izvor podataka: hzjz.hr (broj pozitivnih i učinjenih testova). Generirano:', format(Sys.time() + as.difftime(1, units="hours"), '%d.%m.%Y. %H:%M:%S h.'), 'Autor: Petar Palašek, ppalasek.github.io')) +
  theme_minimal() +
  theme(text = element_text(size=18)) +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1))

g

ggsave(paste('img/', last_date_, '_percentage_positive_tests.png', sep = ''),
       plot = g, dpi=300, width=1600*4, height=700*4, units="px",
       bg = "white")

g3 <- ggplot() +
  geom_point(data=diff_df, aes_string(x='date', y="Hrvatska*100000/3888529"), colour="blue", alpha=0.2) +

  geom_point(data=merged_data, aes_string(x='date', y="new_hospitalised*1000000/3888529"), colour="red", alpha=0.2) +
  geom_point(data=merged_data, aes_string(x='date', y="new_on_respirator"), colour="darkolivegreen4", alpha=0.2) +

  geom_point(data=merged_data, aes_string(x='date', y="new_deaths"), colour="black", alpha=0.2) +
  geom_line(data=merged_data, aes_string(x='date', y="new_deaths_7da"), colour="black", size=1.5, alpha=0.7) +
  geom_line(data=merged_data, aes_string(x='date', y="new_hospitalised_7da*1000000/3888529"), colour='red', size=1.5, alpha=0.7) +
  geom_line(data=merged_data, aes_string(x='date', y="new_on_respirator_7da"), colour='darkolivegreen4', size=1.5, alpha=0.7) +
  geom_line(data=avg7_df, aes_string(x='date', y="Hrvatska_avg7*100000/3888529"), colour='blue', size=1.5, alpha=0.7) +

  ylab('Broj novih slučajeva na 100k stanovnika (plavo)\nBroj novih hospitalizacija na 1M stanovnika (crveno)\nBroj novih osoba na respiratoru (zeleno)\nBroj umrlih (crno)') +
  xlab('Datum') +
  ggtitle('Kretanje broja COVID-19 slučajeva na 100 tisuća stanovika (plavo), hospitaliziranih na 1 milijun stanovnika (crveno), osoba na respiratoru (zeleno) i\numrlih (crno) u Hrvatskoj (sedmodnevni prosjek)') +
  scale_x_date(labels = date_format("%b %Y."), date_breaks = "1 month") +
  theme_minimal() +
  theme(text = element_text(size=18)) +
  labs(caption = paste('Izvori podataka: koronavirus.hr (slučajevi), ourworldindata.com (umrli), hzjz.hr (broj na respiratoru, hospitalizacije). Korištena populacija HR: 3888529. Generirano:', format(Sys.time() + as.difftime(1, units="hours"), '%d.%m.%Y. %H:%M:%S h.'), 'Autor: Petar Palašek, ppalasek.github.io')) +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1))
g3

ggsave(paste('img/', last_date_, '_cases_hospitalisations_deaths.png', sep = ''),
       plot = g3, dpi=300, width=1600*4, height=700*4, units="px",
       bg = "white")


# spare linear regression using stan
library(distbayesianmc)

if(T){
  setwd("~/R_programming/distbayesianmc")
  source("~/R_programming/distbayesianmc/params_simulation/params_gaussian.R")
  stan_code <- readChar(fileName, file.info(fileName)$size)

  mod <- rstan::stan_model(model_code = stan_code, auto_write = T)
  setwd("/scratch/alexander/distbayesianmc_sparselinear/")
  library(doParallel)
  registerDoParallel(cores=6)
  for(dataset in vec_datasets){
    for(ssplits in vec_splits){
      foreach(i_iter = 1:iters) %dopar% {
        #for(i_iter in 1:20){

        dataset_loaded <- f_dataset_loader(dataset, highcorr = highcorr, nobs = nobs)
        splitted_data <- f_pack_split_data(dataset_loaded$X, dataset_loaded$y, Pparams = Pparams, ssplits=ssplits, iseed=i_iter, typesplit=typesplit)
        splitted_data <- f_prep_prior_logistic(splitted_data, scale = scale)
        f_stan_sampling_splitted_data(mod, splitted_data, dataset = dataset, i_seed = i_iter, iter = i_iter, typesplit = typesplit, nchain = nchain, typeprior=typeprior)

      }
    }
  }
}

df <- f_combine_const_data_in_frame(vec_splits, vec_datasets, vec_types_splits, iters)
#f_plot_res_data_frame(df)
f_plot_res_data_frame(df, vec_datasets = vec_datasets)
save(df, file="res_gaussianlinear.Rda")

if(F){
  df_reduced <- df %>% select(c(normconstcombined, iter, splits, dataset))

  true_mean <- df_reduced %>% filter(splits == 1)  %>% group_by(splits, dataset) %>% summarise(true_mean = mean(normconstcombined))
  sd_one_split <- df_reduced %>% filter(splits == 1)  %>% group_by(splits, dataset) %>% summarise(std = var(normconstcombined)**0.5)

  df_reduced <- df_reduced %>% mutate(true_mean = ifelse(dataset ==  vec_datasets[1], (true_mean %>% filter(dataset ==  vec_datasets[1]))$true_mean,
                                                         ifelse(dataset ==  vec_datasets[2], (true_mean %>% filter(dataset ==  vec_datasets[2]))$true_mean, NA)))

  df_reduced <- df_reduced %>% mutate(sqerror = (true_mean-normconstcombined)**2)

  df_true_means <- df_reduced %>% group_by(splits, dataset) %>% summarise(true_mean_all = mean(true_mean))

  average_error <- df_reduced %>% group_by(splits, dataset) %>% summarise(MSE = mean(sqerror), VAR = var(normconstcombined))  %>% mutate(srerror = round(MSE**0.5, 3))

  average_error[['percenterror']] <- round((average_error$srerror/df_true_means$true_mean_all*100), 4)

  average_error[["bias_var_ratio"]] <- round(average_error$MSE/average_error$VAR-1, 2)

  write.table(t(as.matrix(
    average_error %>% filter(dataset == vec_datasets[1]) %>% select(splits, srerror, percenterror, bias_var_ratio)
  )), "table1.txt", quote=FALSE, eol="\\\\\n", sep=" & ")

  write.table(t(as.matrix(
    average_error %>% filter(dataset == vec_datasets[2]) %>% select(splits, srerror, percenterror, bias_var_ratio)
  )), "table2.txt", quote=FALSE, eol="\\\\\n", sep=" & ")

}