source("./ETL/country_data.r")
source("./Graphing/ggplot/common_graphs.r")

italy_data <- ReadDataForCountry("Italy")
italy_data

# Prep Italy data
italy <- ConvertCommunityToNational(italy_data)

lombardy_data <- subset(italy_data, italy_data$region_code=="3")

#ggplot(italy_data, aes_string(x="date", y="total_cases", col="region_code")) + geom_line()

#plot(italy$date, italy$total_deaths, type="b")
#plot(italy$date, italy$daily_deaths, type="b", col="red")

#plot(lombardy_data$date, lombardy_data$total_hospitalized, type="l")
#plot(lombardy_data$date, lombardy_data$daily_hospitalized, type="l", col="red")

#OutputAllDimensionsAsPng(italy_data, italy, "Italy")


# 3. faza: Vizualizacija podatkov
# Graf
library(ggplot2)
library(dplyr)
library(digest)
library(maptools)

#1.Graf bo prikazoval stopnjo prenaseljenosti v Sloveniji(STOPNJA PRENASELJENOSTI STANOVANJA (2005-2016))
graf1 <- ggplot(data =tabela2, aes(x =Leto, y =(odstotek_oseb),colour = Spol ))+
  geom_point(shape=1)+
  geom_smooth(method=lm , color="red", se=TRUE)+
  xlab("Leto") + ylab("Odstotek oseb") +
  ggtitle("Stopnja prenaseljenosti stanovanja (2005-2016)")

#2.Graf : stanovanjske prikrajsanosti
naslov_graf2 <- "Stanovanjske prikrajšanosti"
Encoding(naslov_graf2)<- "UTF-8"
oznake <- c("Slabo stanje stanovanja" = "Slabo stanje\nstanovanja",
            "Kad ali prha v stanovanju" = "Kad ali prha\nv stanovanju",
            "Stranišče na izplakovanje za lastno uporabo" = "Stranišče na\nizplakovanje za\nlastno uporabo",
            "Pretemno stanovanje" = "Pretemno stanovanje")
Encoding(oznake) <- "UTF-8"
Encoding(names(oznake)) <- "UTF-8"
status.skupaj <- "Status tveganja revščine -SKUPAJ"
Encoding(status.skupaj) <- "UTF-8"

graf2 <- ggplot(data = tabela1 %>%
                  filter(starost == "Starostne skupine - SKUPAJ",
                         status == status.skupaj,
                         spol != "Spol - SKUPAJ"),
                aes(x = leto, y = stopnja, fill = spol))+
  geom_col(position = "dodge") +
  facet_grid(. ~ oznake[element], space = "free")+
  ggtitle(naslov_graf2)

#3.Graf: samoocene splosnega zadovoljstva življenja
naslov_graf3 <- "Samoocena splošnega zadovoljstva življenja"
Encoding(naslov_graf3)<-"UTF-8"
graf3 <- ggplot(data = tabela_zadovoljstvo, aes(x=leto, y = odstotek, colour = ocena ))+
  geom_line()+
  xlab("Leto") + ylab("Odstotek") +
  ggtitle(naslov_graf3)

#4.Graf : Breme stanovanjskih stroškov
naslov_graf4 <- "Breme stanovanjskih stroškov"
Encoding(naslov_graf4)<- "UTF-8"
graf4 <- ggplot(data = breme_stanovanjskih_stroskov,
                aes(x = leto, y = odstotek, color = velikost.bremena)) +
  geom_line() + facet_grid(. ~ gospodinjstvo) + xlab("Leto") + ylab("Odstotek") +
  ggtitle(naslov_graf4) + guides(color = guide_legend("Velikost bremena")) +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5))

#4.2 Graf: delež prebivalcev katerim stanovanjski stroški predstavljajo preveliko breme:
naslov_graf42 <- "Delež prebivalcev katerim stanovanjski stroški predstavljajo preveliko breme"
Encoding(naslov_graf42)<- "UTF-8"
graf42 <- ggplot(data= delez, aes(x =leto, y = stopnja))+
  geom_line()+
  facet_grid(. ~ drzava)+
  ggtitle(naslov_graf42)

graf123 <- ggplot(data = delez %>% filter(drzava == "Slovenia"),
                  aes(x = leto, y = stopnja))+
  geom_point()
#5.Graf: Stopnje prenaseljenosti v eu

graf5 <- ggplot(data= prenaseljenost, aes(x = timegeo, y = stopnja))+
  geom_col() + facet_grid(. ~ leto)

# Uvozimo zemljevid.
svet <- uvozi.zemljevid("http://www.naturalearthdata.com/http//www.naturalearthdata.com/download/50m/cultural/ne_50m_admin_0_countries.zip",
                        "ne_50m_admin_0_countries", encoding = "UTF-8") %>%
  pretvori.zemljevid() %>%  filter(CONTINENT %in% c("Europe"))

#NASLOVA
naslov <- "Stopnja prenaseljenosti za moške v Evropi"
Encoding(naslov) <- "UTF-8"
naslov2 <- "Stopnja prenaseljenosti za ženske v Evropi"
Encoding(naslov2)<- "UTF-8"
#ZEMLJEVID: Stopnja prenaseljenosti za moske
zemljevid_moski <-ggplot() + geom_polygon(data = prenaseljenost%>% filter(spol == "moski", leto == "2016") %>%
                                            mutate(SOVEREIGNT = parse_factor(timegeo,levels(svet$SOVEREIGNT)))%>%
                                            right_join(svet, by = c("timegeo" = "NAME_LONG")),
                                          aes(x= long, y = lat,
                                              group = group,
                                              fill = stopnja)) +
  coord_cartesian(xlim = c(-22, 40), ylim = c(30, 70)) +
  ggtitle(naslov)
# ZEMLJEVID: Stopnja prenaseljenosti za ženske

zemljevid_zenske <-ggplot() + geom_polygon(data = prenaseljenost%>% filter(spol == "zenske", leto == "2016") %>%
                                             mutate(SOVEREIGNT = parse_factor(timegeo,levels(svet$SOVEREIGNT)))%>%
                                             right_join(svet, by = c("timegeo" = "NAME_LONG")),
                                           aes(x= long, y = lat,
                                               group = group,
                                               fill = stopnja)) +
  coord_cartesian(xlim = c(-22, 40), ylim = c(30, 70)) +
  ggtitle(naslov2)


library(TMB)
library(mvtnorm)
library(matrixcalc)
library(corpcor)

load("pitTotal_Snake_condensed.Rdata") #Load the pit tag data.

#Subset the data based on the input variables
pitTotal$year <-
  as.numeric(as.character(pitTotal$year))
pitTotal <- pitTotal[pitTotal$year<=lastYr,]

if(!is.null(myTrans)){
  pitTotal <-
    pitTotal[pitTotal$trans_dam==myTrans,]
}
if(!is.null(rear)){
  pitTotal <-
    pitTotal[pitTotal$rear_type==rear,]
}
k_name <- paste(pitTotal$trans_dam,pitTotal$rear_type)
pitTotal$k <- as.numeric(as.factor(k_name))-1
pitTotal$yr <- pitTotal$year - eStartYr

#Load the data, subset it and transform is based on the input in the wrapper_modelRuns.r
load("envData.rData")
tmpenv <- envdata[envdata$year>=eStartYr & envdata$year<=eLastYr,]
if(eLastYr>max(envdata$year)){
  projEnv <- as.data.frame(matrix(NA,eLastYr-max(envdata$year),ncol(tmpenv)))
  projEnv[,1] <- (max(envdata$year)+1):eLastYr
  names(projEnv) <- names(tmpenv)
  tmpenv <- rbind(tmpenv,projEnv)
}
names(tmpenv)[1] <- "Year"

# Jinky step to get the most recent coastal summer data
load(paste0("envData_7302018.Rdata"))
tmpenv$ersstWAcoast.sum[tmpenv$year%in%envdata$Year] <- envdata$ersstWAcoast.sum[tmpenv$year%in%envdata$Year]

#Get the scaling data
env_mu <- apply(tmpenv,2,function(x){return(mean(na.omit(x)))})
env_sc <- apply(tmpenv,2,function(x){return(sd(na.omit(x)))})
# env_sc <- rep(1,ncol(tmpenv))
env_mu_2000_2015 <- apply(tmpenv[tmpenv$Year>=2000 & tmpenv$Year<=2015,],2,function(x){mean(na.omit(x))})
env_sc_2000_2015 <- apply(tmpenv[tmpenv$Year>=2000 & tmpenv$Year<=2015,],2,function(x){sd(na.omit(x))})
env_mu_1980_2015 <- apply(tmpenv[tmpenv$Year>=1980 & tmpenv$Year<=2015,],2,function(x){mean(na.omit(x))})
env_sc_1980_2015 <- apply(tmpenv[tmpenv$Year>=1980 & tmpenv$Year<=2015,],2,function(x){sd(na.omit(x))})
Stationary_baseline_difference <- env_mu_1980_2015[myVars] - env_mu_2000_2015[myVars]

#Z-score variables and years
tmpenv[,names(tmpenv)!="Year"] <- t((t(tmpenv[,names(tmpenv)!="Year"]) - env_mu[names(tmpenv)!="Year"])/env_sc[names(tmpenv)!="Year"])

#Index years starting with zero
tmpenv$Year <- tmpenv$Year - eStartYr

#Get rid of NAs
subData <- tmpenv[,myVars]
subData[is.na(subData)] <- -10000

#Create increment limit
nte = nrow(subData)
nvar = ncol(subData)

k_name <- k_name[pitTotal$julian>=minJ & pitTotal$julian<=maxJ]
pitTotal <- pitTotal[pitTotal$julian>=minJ & pitTotal$julian<=maxJ,]

#marine variables for pit analysis using only 2000-2015 mean and standard deviation
xm <- t((t(pitTotal[,marVars])-env_mu_2000_2015[marVars])/
    env_sc_2000_2015[marVars])

load("gridData.rData")
#Timing across days and years
retroTiming <- apply(gridData["inriver",,,,],c(2,1),sum)
retroTiming <- t(retroTiming)/colSums(retroTiming)
retroTiming <- t(retroTiming[gridYears%in%eStartYr:(startYr-1),1:365%in%minJ:maxJ])

#This is the calibration timing for Lisa's calibration from ~1998:2015
calibration_timing <- NA
calibration_years <- NA
if(calibration_flag==1){
  calibration_timing <- read.table(calibration_file, header=TRUE)
  if(myTrans=="In-river"){
    calibration_timing <- calibration_timing[calibration_timing$MigrationType=="inriver",]
  }
  if(myTrans=="Transport"){
    calibration_timing <- calibration_timing[calibration_timing$MigrationType=="transportation",]
  }
  calibration_years <- calibration_timing$Year[calibration_timing$Year<=lastYr]-eStartYr

  calibration_timing <- calibration_timing[calibration_timing$Year<=lastYr,minJ:maxJ+3]
  calibration_timing <- calibration_timing/rowSums(calibration_timing)
}

#This is for projecting into the future.
obsTiming <- matrix(0,length(minJ:maxJ),length(startYr:lastYr))
for(j in minJ:maxJ){
  for(yy in startYr:lastYr){
    obsTiming[j-minJ+1,yy-startYr+1] <- sum(pitTotal$Total[pitTotal$year==yy & pitTotal$julian==j])
  }
}
obsTiming <- t(t(obsTiming)/colSums(obsTiming))
timing <- cbind(retroTiming,obsTiming)
projTiming <- matrix(rowSums(timing)/sum(timing),length(minJ:maxJ),length((lastYr+1):eLastYr))
timing <- cbind(timing,projTiming)

#You need and offest for years if you are doing the projection
if(retro)
  yShift <- 0
if(!retro)
  yShift <- startYr-eStartYr

#Data list
data <- list( yShift = yShift
             ,yr = pitTotal$yr
             ,j = pitTotal$julian-minJ
             ,s_n = pitTotal$Total
             ,s_k = pitTotal$resMatrix[,1] #pitTotal.txt
             ,k = pitTotal$k
             ,nvar = nvar
             ,env = as.matrix(subData)
             ,timing = timing
             ,xm = as.matrix(xm)
             ,marVars = tmpMarVars-1
             ,sd=0.0001
             ,re_j = re_j
             ,re_t = re_t
             ,re_jt = re_jt
             ,cov_pars = cov_pars
             ,retro = retro
             ,env_mu = as.vector(env_mu[myVars])
             ,env_sc = as.vector(env_sc[myVars])
             ,env_mu_2000_2015 = as.vector(env_mu_2000_2015[myVars])
             ,env_sc_2000_2015 = as.vector(env_sc_2000_2015[myVars])
             ,calibration_flag = calibration_flag
             ,calibration_timing = as.matrix(calibration_timing)
             ,calibration_years = calibration_years
             ,Stationary_baseline_difference=Stationary_baseline_difference
)

# env_mu <- apply(tmpenv,2,function(x){return(mean(na.omit(x)))})
# env_sc <- apply(tmpenv,2,function(x){return(sd(na.omit(x)))})
# # env_sc <- rep(1,ncol(tmpenv))
# env_mu_2000_2015 <- apply(tmpenv[tmpenv$Year>=2000 & tmpenv$Year<=2015,],2,function(x){mean(na.omit(x))})
# env_sc_2000_2015 <- apply(tmpenv[tmpenv$Year>=2000 & tmpenv$Year<=2015,],2,function(x){sd(na.omit(x))})

nk_dim <- max(data$k)+1
#Parameter list
parameters <- list(mu_s  = rep(0,nk_dim)
                   ,frho_j = rep(0,nk_dim)
                   ,frho_t = rep(0,nk_dim)
                   ,frho1_jt = rep(0,nk_dim)
                   ,frho2_jt = rep(0,nk_dim)
                   ,fpsi_j = rep(0,nk_dim)
                   ,fpsi_t = rep(0,nk_dim)
                   ,fpsi_jt = rep(0,nk_dim)
                   ,eps_j = matrix(0,length(minJ:maxJ),nk_dim)
                   ,eps_t = matrix(0,length(eStartYr:eLastYr)-yShift,nk_dim)
                   ,eps_jt = array(0,c(nk_dim,length(minJ:maxJ),length(eStartYr:eLastYr)-yShift))
                   ,beta_mar = matrix(0,length(tmpMarVars),nk_dim)
                   ,frho_x = rep(0)
                   ,frho_Rx = rep(0,nvar*(nvar-1)/2)
                   ,fpsi_x = rep(0,nvar)
                   ,eps_x = matrix(0,nvar,length(eStartYr:eLastYr))
)


require(shiny)
require(shinyWidgets)
require(tidyverse)
require(sf)
require(data.table)
require(ggplot2)
require(viridis)

# Read and wrangle the case data
x <- fread("ltla_2021-05-17_Cases.csv")
x[, Lacode := areaCode]
x[, `% Change In Number Of New Cases` := newCasesBySpecimenDateChangePercentage]

# Read and prep the shape data
Background <- st_read(
  "LocalAuthorities-lowertier.gpkg",
  layer="7 Background")

# Prep the label alignment
Group_labels <- st_read(
  "LocalAuthorities-lowertier.gpkg",
  layer="1 Group labels") %>%
  mutate(just=if_else(LabelPosit=="Left", 0, 1))

# merge on the case data to the shapes
ltladata <- st_read(
  "LocalAuthorities-lowertier.gpkg",
  layer="4 LTLA-2019") %>%
  left_join(x, by="Lacode")

setDT(ltladata)

# Define UI for app that draws a histogram ----
ui <- fluidPage(
  shinyWidgets::setBackgroundColor("#19323C"),
  shinyWidgets::chooseSliderSkin("Modern", color = "#19323C"),
  tags$head(tags$style(
    HTML('
         #sidebar {
            background-color: white;
        }

        body, label, input, button, select {
          font-family: "Arial";
        }')
  )),
  # App title ----

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(width = 2, id = 'sidebar',

      # Input: Slider for the number of bins ----
      sliderInput(inputId = "date",
                  label = "Date:",
                  min = as.Date("2020-02-01","%Y-%m-%d"),
                  max = as.Date(Sys.Date(),"%Y-%m-%d"),
                  value = as.Date("2020-12-01"),
                  timeFormat="%Y-%m-%d")

    ),

    # Main panel for displaying outputs ----
    mainPanel(

      # Output: Histogram ----
      plotOutput(outputId = "distPlot")

    )
  )
)

# Define server logic required to draw a histogram ----
server <- function(input, output) {

  # Histogram of the Old Faithful Geyser Data ----
  # with requested number ofs bins
  # This expression that generates a histogram is wrapped in a call
  # to renderPlot to indicate that:
  #
  # 1. It is "reactive" and therefore should be automatically
  #    re-executed when inputs (input$bins) change
  # 2. Its output type is a plot
  output$distPlot <- renderPlot({

    ggplot()+
      geom_sf(
        data = Background,
        aes(geometry = geom),
        fill = NA, size = .5, color = 'grey40')+
      geom_sf(
        data=ltladata[date == input$date],  # subset the data table
        aes(geometry=geom, fill=`% Change In Number Of New Cases`),
        colour="Black",
        size=.35)+
      geom_sf_text(
        data=Group_labels,
        aes(geometry=geom, label= Group.labe, hjust=just),
        size=rel(2.4),
        colour="white",
        family = 'DIN Next LT Pro Light') +
      guides(fill = guide_colourbar(
        ticks = FALSE,
        barwidth = 15,
        barheight = 0.5,
        title.position = 'top')) +
      theme_void() +
      labs(title = 'Percentage Change In Daily Covid-19 Infections\nBy Lower Tier Local Authority',
           caption = "Visualisation by Joe O'Reilly (josephedwardoreilly.github.com)") +
      theme(
        plot.background = element_rect(fill = '#19323C',color = NA),
        panel.background = element_rect(fill = '#19323C', color = NA),
        legend.justification = 'top',
        plot.margin = margin(10, 20, 10, 20),
        legend.position = 'bottom',
        legend.title = element_text(
          size = 8, hjust = 0.5,
          family = 'DIN Next LT Pro Bold',
          color = 'white'),
        legend.text = element_text(
          size = 7,
          family = 'DIN Next LT Pro Light',
          color = 'white'),
        plot.title = element_text(
          family = 'DIN Next LT Pro Bold',
          color = 'white',
          size = 11),
        plot.title.position = "plot",
        plot.caption = element_text(
          family = 'DIN Next LT Pro Light',
          color = 'white',
          size = 7,
          hjust = 1,
          margin = margin(10, 0, 0, 0)),
        plot.caption.position = 'plot') +
      scale_fill_viridis(
        option = "turbo",
        breaks = c(-100, 0, 100),
        labels = c('Less than -100 %', '0 %', 'Greater than 100 %'),
        limits = c(-100, 100), oob = scales::squish)

  }, width = 500, height = 717.5175)

}

shinyApp(ui, server)


#!/usr/bin/env Rscript

# Copyright (C) 2017 by
# Thomas E. Gorochowski <tom@chofski.co.uk>, Voigt Lab, MIT
# All rights reserved
# Released under MIT license (see LICENSE.txt)

# Arguments:
# 1. count_matrix_filename
# 2. group1, e.g., 1,2,5,6
# 3. group2, e.g., 3,4,7,8
# 4. library_size_matrix
# 5. output_file_prefix
args <- commandArgs(TRUE)
arg_count_matrix <- args[1]
arg_group1 <- as.integer(unlist(strsplit(args[2], ",")))
arg_group2 <- as.integer(unlist(strsplit(args[3], ",")))
arg_library_size_matrix <- args[4]
arg_output_file_prefix <- args[5]

# We use edgeR for DE analysis
library(edgeR)

# Load the data file
count_matrix <- read.table(arg_count_matrix, header=T, row.names=1, com='')

# Extract those columns we are interested in
col_ordering <- c(arg_group1, arg_group2)
count_matrix <- count_matrix[,col_ordering]
conditions <- factor(c(rep("group_1", length(arg_group1)), rep("group_2", length(arg_group2))))

# Load the actual mapped reads
library_size_matrix <- read.table(arg_library_size_matrix, header=T, row.names=1, com='')

# Get the library sizes (total counts in annotated genes)
lib_sizes <- as.vector(library_size_matrix$total_mapped_reads)[col_ordering]

# Calculate normalisation factors using TMM
expr <- DGEList(counts=count_matrix, group=conditions, lib.size=lib_sizes)
expr <- calcNormFactors(expr)
expr <- estimateCommonDisp(expr)
expr <- estimateTagwiseDisp(expr)
de_data <- exactTest(expr)
de_results <- topTags(de_data, n=length(count_matrix[,1]))

# write the output to a text file
write.table(as.matrix(de_results$table), col.names=NA, quote=FALSE, file=paste0(arg_output_file_prefix, ".de.analysis.txt"), sep="\t")


# This is code to run analyses for the protocol for ParkProReakt;
# https://innovationsfonds.g-ba.de/projekte/neue-versorgungsformen/parkproreakt-proaktive-statt-reaktive-symptomerkennung-bei-parkinson-patientinnen-und-patienten.432
# Code developed by David Pedrosa

# Version 1.0 # 2021-12-27

## First specify the packages of interest
packages = c("readxl", "tableone", "dplyr", "tidyverse", "rstatix", "Hmisc") #

## Now load or install&load all
package.check <- lapply(
  packages,
  FUN = function(x) {
    if (!require(x, character.only = TRUE)) {
      install.packages(x, dependencies = TRUE)
      library(x, character.only = TRUE)
    }
  }
)

## In case of multiple people working on one project, this helps to create an automatic script
username = Sys.info()["login"]

if (username == "dpedr") {
	wdir = "D:/innofonds_protocol"
} else if (username == "david") {
	wdir = "/media/storage/innofonds_protocol/"
}
setwd(wdir)
df 				    <- read_excel(file.path(wdir, "ambulanz.G20.2019to2021.xlsx")) # read data frame from xlsx-file

df$gender 			<- as.factor(df$gender)
levels(df$gender) 	<- c("male", "female")

df$icd 					<- as.factor(df$icd) # factors according to: https://gesund.bund.de/en/icd-code-search/g20-9
df$icd_cat 		<- as.factor(df$icd) # factors according to: https://gesund.bund.de/en/icd-code-search/g20-9
levels(df$icd_cat) 		<- c(	"Primary Parkinson disease with no or mild impairment - with no fluctuations",
							"Primary Parkinson disease with no or mild impairment - with fluctuations",
							"Primary Parkinson disease with moderate to severe impairment - with no fluctuation ",
							"Primary Parkinson disease with moderate to severe impairment - with fluctuations",
							"Primary Parkinson disease with severest impairment - with no fluctuation ",
							"Primary Parkinson disease with severest impairment - with fluctuations",
							"Primary Parkinson disease, unspecified - with no fluctuation",
							"Primary Parkinson disease, unspecified - with fluctuations")

# ==================================================================================================
## Create TableOne for specific values
Vars 			<- c("icd", "age", "gender", "h&y", "bdi", "moca", "pdq8")
nonnormalVars 	<- c("h&y") # avoids returning mean in favor of median
factVars 		<- c("gender", "icd", "h&y") # Here only values with categorial (ordinal distribution should be added)
tableOne 		<- CreateTableOne(vars=Vars, factorVars=factVars, data=df)
print(tableOne, nonnormal=c("h&y"))

#
df_corr <- df %>%
  select(c("h&y", "age", "bdi", "moca", "pdq8"))
rcorr(as.matrix(sapply(df_corr, as.numeric)))


library(dplyr)
library(purrr)

species <- read.csv("data/MasterSpeciesList_clean.csv", header=TRUE, stringsAsFactors = FALSE) %>%
    filter(!is.na(species))

bycity <- species %>%
    split(.$City) %>%
    map(select, species)

#all cities

inallcities <- Reduce(intersect, bycity) #species that occur in all cities - the most common city community
#
# > inallcities
# species
# 1             Acer negundo
# 2     Achillea millefolium
# 3  Ambrosia artemisiifolia
# 4            Arctium minus
# 5        Calystegia sepium
# 6  Campanula rapunculoides
# 7  Capsella bursa-pastoris
# 8          Cirsium arvense
# 9     Convolvulus arvensis
# 10       Cornus canadensis
# 11          Cornus sericea
# 12         Corylus cornuta
# 13    Eleocharis palustris
# 14       Equisetum arvense
# 15     Erigeron canadensis
# 16   Euphorbia cyparissias
# 17   Euthamia graminifolia
# 18      Glechoma hederacea
# 19       Helianthus annuus
# 20     Hesperis matronalis
# 21         Hordeum jubatum
# 22         Humulus lupulus
# 23    Leucanthemum vulgare
# 24        Linaria vulgaris
# 25        Linnaea borealis
# 26      Lotus corniculatus
# 27       Lythrum salicaria
# 28   Maianthemum stellatum
# 29    Matricaria discoidea
# 30       Medicago lupulina
# 31         Medicago sativa
# 32         Melilotus albus
# 33   Melilotus officinalis
# 34       Panicum capillare
# 35    Phalaris arundinacea
# 36          Plantago major
# 37     Polygonum aviculare
# 38     Populus tremuloides
# 39      Portulaca oleracea
# 40         Prunus serotina
# 41       Rorippa palustris
# 42         Rudbeckia hirta
# 43       Sambucus racemosa
# 44        Senecio vulgaris
# 45        Sinapis arvensis
# 46   Sisymbrium altissimum
# 47     Solidago canadensis
# 48        Sonchus arvensis
# 49    Symphoricarpos albus
# 50       Tanacetum vulgare
# 51    Taraxacum officinale
# 52      Trifolium hybridum
# 53        Trifolium repens
# 54         Viburnum opulus
# 55            Vicia cracca

# what % of the total species in a city is the most common species list
percent_common <- species %>%
    select(-quadrat) %>%
    distinct() %>%
    group_by(City) %>%
    summarize(percent_common = (nrow(inallcities)/n())*100) %>%
    arrange(desc(percent_common))

vulgar <- ggplot(percent_common, aes(x=City, y=percent_common, fill=City)) +
    geom_col() +
    labs(x="", y="Vulgarity index") +
    ylim(c(0,100)) +
    theme_classic(base_size=18) +
    theme(legend.position = "none")

ggsave("figures/city_vulgarity.png", vulgar, width = 16, height=9, units="in")

# Percent of a city's species that are in the set of species that occur in all cities
# City      percent_common
# <chr>              <dbl>
# 1 Winnipeg           16.4
# 2 Edmonton            9.15
# 3 Halifax             5.11
# 4 Toronto             4.31
# 5 Montreal            3.56
# 6 Vancouver           2.10

# all species that occur in more than one quadrat
morethan1 <- species %>%
    group_by(species) %>%
    summarize(count=n()) %>% # how many quadrats does a species occur in
    filter(count > 1)


# plot_scatter.r
#
# Copyright (c) 2020 VIB (Belgium) & Babraham Institute (United Kingdom)
#
# Software written by Carlos P. Roca, as research funded by the European Union.
#
# This software may be modified and distributed under the terms of the MIT
# license. See the LICENSE file for details.

# Makes scatter plots of compensated and uncompensated data, with regression
# and reference lines, and a label showing slope error.

plot.scatter <- function(
    expr.data.unco.x, expr.data.unco.y, expr.data.comp.x, expr.data.comp.y,
    spillover.unco.inte, spillover.unco.coef,
    spillover.comp.inte, spillover.comp.coef, spillover.comp.slop,
    marker.limit.range, marker.proper.limit.range, samp, marker, marker.proper,
    scale.untransformed, figure.file.label, flow.gate, flow.control, asp
)
{
    expr.data.ggp <- data.frame(
        x = c( expr.data.unco.x, expr.data.comp.x ),
        y = c( expr.data.unco.y, expr.data.comp.y ),
        z = factor( rep( c( "unco", "comp" ),
                    each = length( expr.data.unco.x ) ),
                levels = c( "unco", "comp" ) ),
        w = rep( 1 : length( expr.data.unco.x ) %in%
                flow.gate[[ samp ]], 2 )
    )

    marker.slope.unco <- 1 / spillover.unco.coef
    marker.intercept.unco <- - spillover.unco.inte / spillover.unco.coef
    marker.x.intercept.unco <- spillover.unco.inte

    marker.slope.comp <- 1 / spillover.comp.coef
    marker.intercept.comp <- - spillover.comp.inte / spillover.comp.coef
    marker.x.intercept.comp <- spillover.comp.inte

    x.transform <- flow.control$transform[[
        flow.control$marker.original[ match( marker, flow.control$marker ) ] ]]
    y.transform <- flow.control$transform[[
        flow.control$marker.original[ match( marker.proper,
            flow.control$marker ) ] ]]

    x.transform.inv <- flow.control$transform.inv[[
        flow.control$marker.original[ match( marker, flow.control$marker ) ] ]]
    y.transform.inv <- flow.control$transform.inv[[
        flow.control$marker.original[ match( marker.proper,
            flow.control$marker ) ] ]]

    marker.limit.adaptor <- diag( 2 ) +
        matrix( c( 0.01 * c( 1, -1 ), 0.05 * c( -1, 1 ) ),
            nrow = 2, byrow = TRUE )
    marker.limit.plot <- as.vector( marker.limit.adaptor %*%
            marker.limit.range )

    marker.proper.limit.adaptor <- diag( 2 ) +
        matrix( c( 0.01 * c( 1, -1 ), 0.05 * c( -1, 1 ) ),
            nrow = 2, byrow = TRUE )
    marker.proper.limit.plot <- as.vector(
        marker.proper.limit.adaptor %*%
            marker.proper.limit.range )

    if ( ! scale.untransformed )
    {
        marker.limit.plot <- x.transform.inv( marker.limit.plot )
        marker.proper.limit.plot <- y.transform.inv(
            marker.proper.limit.plot )
    }

    marker.limit.factor <- log(
        max( abs( marker.proper.limit.plot ) ) /
            max( abs( marker.limit.plot ) ) )

    if ( marker.limit.factor > 1 )
        marker.limit.plot <- as.vector(
            matrix( c(
                ( marker.limit.factor + 1 ) / 2,
                ( 1 - marker.limit.factor ) / 2,
                ( 1 - marker.limit.factor ) / 2,
                ( marker.limit.factor + 1 ) / 2 ),
                nrow = 2, byrow = TRUE ) %*%
                marker.limit.plot )

    if ( ! scale.untransformed )
    {
        marker.limit.plot <- x.transform( marker.limit.plot )
        marker.proper.limit.plot <- y.transform(
            marker.proper.limit.plot )
    }

    for ( scale.same in c( TRUE, FALSE ) )
        if ( scale.same || asp$scatter.plot.scale.other )
        {
            if ( xor( scale.same, ! scale.untransformed ) )
            {
                if ( scale.untransformed ) {
                    gg.scale.x <- scale_x_continuous(
                        limits = marker.limit.plot )
                    gg.scale.y <- scale_y_continuous(
                        limits = marker.proper.limit.plot )
                }
                else {
                    gg.scale.x <- scale_x_continuous(
                        limits = x.transform.inv( marker.limit.plot ) )
                    gg.scale.y <- scale_y_continuous(
                        limits = y.transform.inv( marker.proper.limit.plot ) )
                }
            }
            else
            {
                if ( scale.untransformed ) {
                    marker.limit.plot.untr <- marker.limit.plot
                    marker.limit.plot.tran <- x.transform(
                        marker.limit.plot )
                }
                else {
                    marker.limit.plot.untr <- x.transform.inv(
                        marker.limit.plot )
                    marker.limit.plot.tran <- marker.limit.plot
                }

                marker.breaks.exp <- min( floor( log10( max( abs(
                    marker.limit.plot.untr ) ) /
                        asp$scatter.scale.breaks.coef ) ), 3 )
                marker.breaks.untr <-
                    get.scale.breaks.untransformed(
                        marker.limit.plot.untr,
                        marker.breaks.exp )
                marker.breaks.tran <- x.transform(
                    marker.breaks.untr )

                if ( scale.untransformed ) {
                    marker.proper.limit.plot.untr <-
                        marker.proper.limit.plot
                    marker.proper.limit.plot.tran <- y.transform(
                        marker.proper.limit.plot )
                }
                else {
                    marker.proper.limit.plot.untr <-
                        y.transform.inv( marker.proper.limit.plot )
                    marker.proper.limit.plot.tran <-
                        marker.proper.limit.plot
                }

                marker.proper.breaks.exp <- min( floor( log10( max(
                    abs( marker.proper.limit.plot.untr ) ) /
                        asp$scatter.scale.breaks.coef ) ), 3 )
                marker.proper.breaks.untr <-
                    get.scale.breaks.untransformed(
                        marker.proper.limit.plot.untr,
                        marker.proper.breaks.exp )
                marker.proper.breaks.tran <- y.transform(
                    marker.proper.breaks.untr )

                gg.scale.x <- scale_x_continuous(
                    breaks = marker.breaks.tran,
                    labels = marker.breaks.untr,
                    limits = marker.limit.plot.tran )

                gg.scale.y <- scale_y_continuous(
                    breaks = marker.proper.breaks.tran,
                    labels = marker.proper.breaks.untr,
                    limits = marker.proper.limit.plot.tran )
            }

            if ( marker == marker.proper )
            {
                if ( asp$scatter.ref.line.unco )
                    gg.ref.line.unco <- geom_abline( slope = 1,
                        intercept = 0,
                        color = asp$scatter.ref.line.color,
                        linetype = "dashed",
                        size = asp$scatter.ref.line.size.factor *
                            asp$figure.scatter.line.size )
                else
                    gg.ref.line.unco <- geom_blank()

                gg.ref.line.comp <- geom_abline( slope = 1,
                    intercept = 0,
                    color = asp$scatter.ref.line.color,
                    linetype = "dashed",
                    size = asp$scatter.ref.line.size.factor *
                        asp$figure.scatter.line.size )
            }
            else
            {
                if ( asp$scatter.ref.line.unco )
                {
                    if ( scale.same )
                        marker.x.intercept.unco.plot <- marker.x.intercept.unco
                    else
                        marker.x.intercept.unco.plot <- ifelse(
                            scale.untransformed,
                            x.transform( marker.x.intercept.unco ),
                            x.transform.inv( marker.x.intercept.unco )
                        )

                    gg.ref.line.unco <- geom_vline(
                        xintercept = marker.x.intercept.unco.plot,
                        color = asp$scatter.ref.line.color,
                        linetype = "dashed",
                        size = asp$scatter.ref.line.size.factor *
                            asp$figure.scatter.line.size )
                }
                else
                    gg.ref.line.unco <- geom_blank()

                if ( scale.same )
                    marker.x.intercept.comp.plot <- marker.x.intercept.comp
                else
                    marker.x.intercept.comp.plot <- ifelse(
                        scale.untransformed,
                        x.transform( marker.x.intercept.comp ),
                        x.transform.inv( marker.x.intercept.comp )
                    )

                gg.ref.line.comp <- geom_vline(
                    xintercept = marker.x.intercept.comp.plot,
                    color = asp$scatter.ref.line.color,
                    linetype = "dashed",
                    size = asp$scatter.ref.line.size.factor *
                        asp$figure.scatter.line.size )
            }

            if ( scale.same )
            {
                if ( is.infinite( marker.slope.unco ) )
                    gg.slope.line.unco <- geom_vline(
                        xintercept = marker.x.intercept.unco,
                        color = asp$scatter.expr.color.unco,
                        size = asp$figure.scatter.line.size
                    )
                else
                    gg.slope.line.unco <- geom_abline(
                        slope = marker.slope.unco,
                        intercept = marker.intercept.unco,
                        color = asp$scatter.expr.color.unco,
                        size = asp$figure.scatter.line.size
                    )

                if ( is.infinite( marker.slope.comp ) )
                    gg.slope.line.comp <- geom_vline(
                        xintercept = marker.x.intercept.comp,
                        color = asp$scatter.expr.color.comp,
                        size = asp$figure.scatter.line.size
                    )
                else
                    gg.slope.line.comp <- geom_abline(
                        slope = marker.slope.comp,
                        intercept = marker.intercept.comp,
                        color = asp$scatter.expr.color.comp,
                        size = asp$figure.scatter.line.size )
            }
            else
            {
                gg.slope.line.unco <- geom_blank()
                gg.slope.line.comp <- geom_blank()
            }

            gg.error.label <- annotate(
                "label",
                label = sprintf( "%.4g", spillover.comp.slop ),
                size = asp$figure.scatter.error.label.size,
                x = sum( c( 1 - asp$figure.scatter.error.label.pos.x,
                            asp$figure.scatter.error.label.pos.x ) *
                        gg.scale.x$limits ),
                y = sum( c( 1 - asp$figure.scatter.error.label.pos.y,
                            asp$figure.scatter.error.label.pos.y ) *
                        gg.scale.y$limits ),
                label.size = NA,
                alpha = 0.8
            )

            gg.label <- labs(
                x = flow.control$scatter.and.marker.label[ marker ],
                y = flow.control$scatter.and.marker.label[ marker.proper ]
            )

            gg.scale.color <- scale_color_manual(
                values = c( asp$scatter.expr.color.unco,
                    asp$scatter.expr.color.comp ),
                guide = "none"
            )

            data.ggp <- expr.data.ggp

            if ( ! scale.same )
            {
                if ( scale.untransformed )
                {
                    data.ggp$x <- x.transform( data.ggp$x )
                    data.ggp$y <- y.transform( data.ggp$y )
                }
                else
                {
                    data.ggp$x <- x.transform.inv( data.ggp$x )
                    data.ggp$y <- y.transform.inv( data.ggp$y )
                }
            }

            the.plot <- ggplot( data.ggp, aes( .data$x, .data$y,
                    color = .data$z ) ) +
                geom_point(
                    size = 0.9 * asp$figure.scatter.point.size,
                    stroke = 0.1 * asp$figure.scatter.point.size,
                    alpha = ifelse( data.ggp$w,
                        asp$figure.scatter.alpha.gate.in,
                        asp$figure.scatter.alpha.gate.out ) ) +
                gg.slope.line.unco +
                gg.ref.line.unco +
                gg.slope.line.comp +
                gg.ref.line.comp +
                gg.error.label +
                gg.scale.x +
                gg.scale.y +
                gg.label +
                gg.scale.color +
                theme_bw() +
                theme( plot.margin = margin( asp$figure.margin,
                    asp$figure.margin, asp$figure.margin,
                    asp$figure.margin ),
                    axis.ticks = element_line(
                        size = asp$figure.panel.line.size ),
                    axis.text = element_text(
                        size = asp$figure.scatter.axis.text.size ),
                    axis.title = element_text(
                        size = asp$figure.scatter.axis.title.size ),
                    panel.border = element_rect(
                        size = asp$figure.panel.line.size ),
                    panel.grid.major = element_blank(),
                    panel.grid.minor = element_blank() )

            figure.file.name <- sprintf(
                "%s_%s_%s.png", marker, figure.file.label,
                ifelse( xor( scale.same, ! scale.untransformed ),
                    "linear", "bi-exp" )
            )

            ggsave(
                file.path( flow.control$figure.scatter.dir[ samp ],
                    figure.file.name ),
                plot = the.plot, width = asp$figure.width,
                height = asp$figure.height
            )

            if ( asp$make.thumbnail )
            {
                if ( scale.same )
                {
                    if ( marker == marker.proper )
                    {
                        if ( asp$scatter.ref.line.unco )
                            gg.ref.line.unco$aes_params$size <-
                                asp$scatter.ref.line.size.factor *
                                    asp$thumbnail.scatter.line.size

                        gg.ref.line.comp$aes_params$size <-
                            asp$scatter.ref.line.size.factor *
                                asp$thumbnail.scatter.line.size
                    }
                    else
                    {
                        if ( asp$scatter.ref.line.unco )
                            gg.ref.line.unco$aes_params$size <-
                                asp$scatter.ref.line.size.factor *
                                    asp$thumbnail.scatter.line.size

                        gg.ref.line.comp$aes_params$size <-
                            asp$scatter.ref.line.size.factor *
                                asp$thumbnail.scatter.line.size
                    }
                }

                if ( scale.same )
                {
                    if ( is.infinite( marker.slope.unco ) )
                        gg.slope.line.unco$aes_params$size <-
                            asp$thumbnail.scatter.line.size
                    else
                        gg.slope.line.unco$aes_params$size <-
                            asp$thumbnail.scatter.line.size

                    if ( is.infinite( marker.slope.comp ) )
                        gg.slope.line.comp$aes_params$size <-
                            asp$thumbnail.scatter.line.size
                    else
                        gg.slope.line.comp$aes_params$size <-
                            asp$thumbnail.scatter.line.size
                }

                gg.error.label$aes_params$size <-
                    asp$thumbnail.scatter.error.label.size
                gg.error.label$data$x <- sum(
                    c( 1 - asp$thumbnail.scatter.error.label.pos.x,
                            asp$thumbnail.scatter.error.label.pos.x ) *
                    gg.scale.x$limits
                )
                gg.error.label$data$y <- sum(
                    c( 1 - asp$thumbnail.scatter.error.label.pos.y,
                        asp$thumbnail.scatter.error.label.pos.y ) *
                    gg.scale.y$limits
                )

                the.plot <- ggplot( data.ggp, aes( .data$x, .data$y,
                        color = .data$z ) ) +
                    geom_point(
                        size = 0.9 * asp$thumbnail.scatter.point.size,
                        stroke = 0.1 * asp$thumbnail.scatter.point.size,
                        alpha = ifelse( data.ggp$w,
                            asp$thumbnail.scatter.alpha.gate.in,
                            asp$thumbnail.scatter.alpha.gate.out ) ) +
                    gg.slope.line.unco +
                    gg.ref.line.unco +
                    gg.slope.line.comp +
                    gg.ref.line.comp +
                    gg.error.label +
                    gg.scale.x +
                    gg.scale.y +
                    gg.label +
                    gg.scale.color +
                    theme_bw() +
                    theme( plot.margin = margin( asp$thumbnail.margin,
                        asp$thumbnail.margin, asp$thumbnail.margin,
                        asp$thumbnail.margin ),
                        axis.ticks = element_line(
                            size = asp$thumbnail.panel.line.size ),
                        axis.text = element_text(
                            size = asp$thumbnail.scatter.axis.text.size ),
                        axis.title = element_text(
                            size = asp$thumbnail.scatter.axis.title.size ),
                        panel.border = element_rect(
                            size = asp$thumbnail.panel.line.size ),
                        panel.grid.major = element_blank(),
                        panel.grid.minor = element_blank() )

                figure.file.name <- sprintf(
                    "%s_%s_%s_thumbnail.png", marker, figure.file.label,
                    ifelse( xor( scale.same, ! scale.untransformed ),
                        "linear", "bi-exp" )
                )

                ggsave(
                    file.path( flow.control$figure.scatter.dir[ samp ],
                        figure.file.name ),
                    plot = the.plot, width = asp$thumbnail.width,
                    height = asp$thumbnail.height
                )
            } # make.thumbnail
        } # scale.same TRUE or FALSE
}


#'### Functions to plot p-values for a set of pairwise differences
#+
"plotPvalues.data.frame" <- function(object, p = "p",  x, y,
                                     gridspacing = 0, show.sig = FALSE, alpha = 0.10,
                                     sig.size = 3, sig.colour = "black",
                                     sig.face = "plain", sig.family = "",
                                     triangles = "both",
                                     title = NULL, axis.labels = NULL, axis.text.size = 12,
                                     colours = RColorBrewer::brewer.pal(3, "Set2"),
                                     ggplotFuncs = NULL, printPlot = TRUE, ...)
  #Plots a data.frame of p-values that has columns x, y, p
{
  if (!all(c(p,x,y) %in% names(object)))
    stop("One or more of the columns p, x and y are not in object")
  options <- c("both", "upper", "lower")
  tri.opt <- options[check.arg.values(triangles, options)]
  if (!(alpha %in% c(0.05, 0.10)))
    stop("alpha must be either 0.05 or 0.10")
  plt <- NULL

  if (all(is.na(object[[p]])))
    warning("All p-values are NA for this plot")
  else
  {
    object <- na.omit(object)
    object[x] <- factor(object[[x]])
    object[y] <- factor(object[[y]])
    labs <- sort(levels(object[[x]]))
    #  if (any(labs != sort(levels(object[[y]]))))
    #    stop("The row and column labels of differences are not the same")
    plt <- ggplot(object, aes_string(x = x, y = y, fill=p)) +
      geom_tile() +
      scale_fill_gradientn(colours=colours,
                           values = c(0, 0.001, 0.01, 0.05, 0.10, 1),
                           limits=c(0,1)) +
      labs(x=axis.labels, y=axis.labels, title=title) +
      theme_bw() +
      theme(axis.text.x=element_text(angle=90, hjust=1, vjust=0.5, size=axis.text.size),
            axis.text.y=element_text(size=axis.text.size),
            plot.title=element_text(face="bold"),
            panel.grid = element_blank(),
            legend.position = "right",
            legend.key.height=unit(2,"lines"), legend.key.width=unit(1.5,"lines"),
            aspect.ratio = 1) +
      guides(fill=guide_colourbar(title = "p", nbin=50))
    if (show.sig)
    {
      object$sig <- ifelse(object[p] > alpha, "",
#                           ifelse(object[p] > 0.05, ".",
                                  ifelse(object[p] > 0.01, "*",
                                         ifelse(object[p] > 0.001, "**",
                                                "***")))#)
      if (alpha == 0.1)
        if (any(object[p] <= alpha & object[p] > 0.05))
          object$sig[(object[p] <= alpha & object[p] > 0.05)] <- "."
      plt <- plt + geom_text(data=object, aes_string(label="sig"),
                             size=sig.size, colour = sig.colour,
                             fontface = sig.face, family = sig.family)
    }

    if (gridspacing[1] > 0)
    {
      if (length(gridspacing) > 1)
      {
        grids <- cumsum(gridspacing)+0.5
      } else
      {
        nlabs <- length(labs)
        grids <- seq(gridspacing + 0.5, nlabs, gridspacing)
      }
      if (tri.opt == "lower")
        plt <- plt + geom_hline(yintercept = grids) + geom_vline(xintercept = grids - 1)
      else
      {
        if (tri.opt == "upper")
          plt <- plt + geom_hline(yintercept = grids - 1) + geom_vline(xintercept = grids)
        else
          plt <- plt + geom_hline(yintercept = grids) + geom_vline(xintercept = grids)
      }
    }

    if (!is.null(plt) && !is.null(ggplotFuncs))
      for (f in ggplotFuncs)
        plt <- plt + f

    if (!is.null(plt) && printPlot)
      print(plt)
  }
  invisible(plt)
}

"plotPvalues.alldiffs" <- function(object, sections = NULL,
                                   gridspacing = 0, factors.per.grid = 0,
                                   show.sig = FALSE, alpha = 0.10,
                                   sig.size = 3, sig.colour = "black",
                                   sig.face = "plain", sig.family = "",
                                   triangles = "both",
                                   title = NULL, axis.labels = TRUE, axis.text.size = 12,
                                   sep=",", colours = RColorBrewer::brewer.pal(3, "Set2"),
                                   ggplotFuncs = NULL, printPlot = TRUE,
                                   sortFactor = NULL, sortParallelToCombo = NULL,
                                   sortNestingFactor = NULL, sortOrder = NULL, decreasing = FALSE,
                                   ...)
  #Plots a matrix of p-values or, when  predictions are for combinations of two
  #factors, produces a plot for each levels combination of  nominated section factors
  #object is an all.diffs object with p.differences to be plotted
  #show.sig is a logical indicating whether to put stars onto plot
  #title is a character string giving the plot main title
{
  #Check that a valid object of class alldiffs
  validalldifs <- validAlldiffs(object)
  if (is.character(validalldifs))
    stop(validalldifs)
  object <- renameDiffsAttr(object)

  if (is.null(object$p.differences))
    stop("The p.differences component of object cannot be NULL")
  if (all(is.na(object$p.differences)))
    stop("All p.differences are NA")
  options <- c("both", "upper", "lower")
  tri.opt <- options[check.arg.values(triangles, options)]

  #Sort alldiffs components, if required
  if (!is.null(sortFactor))
    object <- sort(object, decreasing = decreasing, sortFactor = sortFactor,
         sortParallelToCombo = sortParallelToCombo, sortNestingFactor = sortNestingFactor,
         sortOrder = sortOrder)

  classify <- attr(object, which = "classify")
  #Get differences and convert to a data.frame
  if (tri.opt == "upper")
    object$p.differences[lower.tri(object$p.differences)] <- NA
  else
  {
    if (tri.opt == "lower")
      object$p.differences[upper.tri(object$p.differences)] <- NA
  }
  p <- object$p.differences
  rownames(p) <- colnames(p) <- NULL #needed because reshape::melt throws a warning re type.convert
  p <- within(reshape::melt(p),
              {
                X1 <- factor(X1, labels=dimnames(object$p.differences)[[1]])
                X2 <- factor(X2, labels=levels(X1))
              })
  names(p)[match("value", names(p))] <- "p"

  #prepare for plotting
  n <- nrow(p)
  facs <- fac.getinTerm(classify)
  if (any(is.na(match(facs, names(object$predictions)))))
    stop("Some factors in the classify for object are not in the predictions")
  else
    facs[match(facs, names(object$predictions))] <- facs
  nfacs <- length(facs)
  #Function to calculate gridspacing
  autogridspace <- function(object, plotfacs, factors.per.grid = 0)
  {
    gridspace = 0
    if (length(plotfacs) > 1) #only compute gridspace for more than one factor per section
    {
      gridfacs <- plotfacs[order(1:(length(plotfacs)-factors.per.grid), decreasing = TRUE)]
      gridspace <- as.vector(table(object[gridfacs]))
      gridspace <- gridspace[-length(gridspace)]
    }
    return(gridspace)
  }

  #Do plots
  if (is.null(sections))
  {
    pairname <- NULL
    if (axis.labels)
    {
      pairname <-  fac.getinTerm(classify)
      pairname <- paste(pairname, collapse = ", ")

    }
    #Do single plot
    if (factors.per.grid > 0)
      gridspacing <- autogridspace(object = object$predictions, plotfacs = facs,
                                   factors.per.grid = factors.per.grid)
    if (is.null(title))
      plotPvalues.data.frame(object = p, x = "X1", y = "X2",
                             gridspacing = gridspacing, show.sig = show.sig, alpha = alpha,
                             sig.size = sig.size, sig.colour = sig.colour,
                             sig.face = sig.face, sig.family = sig.family,
                             triangles = triangles,
                             axis.labels = pairname, colours = colours,
                             printPlot = printPlot,
                             axis.text.size = axis.text.size, ggplotFuncs = ggplotFuncs)
    else
      plotPvalues.data.frame(object = p, x = "X1", y = "X2",
                             gridspacing = gridspacing, show.sig = show.sig, alpha = alpha,
                             sig.size = sig.size, sig.colour = sig.colour,
                             sig.face = sig.face, sig.family = sig.family,
                             triangles = triangles,
                             title = title, axis.labels = pairname,
                             colours = colours, printPlot = printPlot,
                             axis.text.size = axis.text.size, ggplotFuncs = ggplotFuncs)
  } else #have sections
  {
    #Prepare for sectioning
    sec.pos <- match(sections, facs)
    pairdiffs <- facs[-match(sections, facs)]
    pd.pos <- match(pairdiffs, facs)
    facOrg <- function(p.fac, p, object, facs, sections, pairdiffs, sep)
    {
      facs.levs <- strsplit(as.character(p[[p.fac]]), split=sep, fixed=TRUE)
      facs.levs <- as.data.frame(do.call(rbind, facs.levs), stringsAsFactors = FALSE)
      names(facs.levs) <- facs
      facs.levs <- as.data.frame(lapply(facs,
                                        function(fac, facs.levs, predictions)
                                        {
                                          levs <- levels(factor(predictions[[fac]]))
                                          new.fac <- factor(facs.levs[[fac]], levels = levs)
                                          return(new.fac)
                                        },
                                        facs.levs = facs.levs,
                                        predictions = object$predictions
                                        ), stringsAsFactors = FALSE)
      names(facs.levs) <- facs
      p$sections <- fac.combine(facs.levs[sections], combine.levels = TRUE)
      p[p.fac] <- fac.combine(facs.levs[pairdiffs], combine.levels = TRUE)
      return(p)
    }

    p <- facOrg("X1", p, object, facs, sections = sections, pairdiffs = pairdiffs, sep = sep)
    names(p)[match(c("sections"), names(p))] <- "sections1"
    p <- facOrg("X2", p, object, facs, sections = sections, pairdiffs = pairdiffs, sep = sep)
    names(p)[match(c("sections"), names(p))] <- "sections2"

    sect.lev <- levels(p$sections1)
    if (!all(sect.lev == levels(p$sections2)))
      stop("Sectioning levels in rows and columns of p.differences do not match")

    #Do plot for each section
    sec.name <- pairname <- NULL
    if (axis.labels)
    {
      secname <- paste(sections, collapse = ', ')
      pairname <- paste(pairdiffs, collapse = ', ')
    }
    if (factors.per.grid > 0)
       object$predictions$sections <- fac.combine(object$predictions[sections],
                                                 combine.levels = TRUE)
    for (j in sect.lev)
    {
      psect <- p[p$sections1==j & p$sections2==j, ]
      if (factors.per.grid > 0)
      {
        objsect <- object$predictions[object$predictions$sections == j,]
        gridspacing <- autogridspace(object = objsect, plotfacs = pairdiffs,
                                     factors.per.grid = factors.per.grid)
      }
      if (is.null(title))
        plotPvalues.data.frame(object = psect, x = "X1", y = "X2",
                               gridspacing = gridspacing, show.sig = show.sig, alpha = alpha,
                               sig.size = sig.size, sig.colour = sig.colour,
                               sig.face = sig.face, sig.family = sig.family,
                               triangles = triangles,
                               title = paste("Plot of p-values for ",
                                             secname," = ",j, sep = ""),
                               axis.labels = pairname, colours = colours,
                               printPlot = printPlot,
                               axis.text.size = axis.text.size, ggplotFuncs = ggplotFuncs)
      else
        plotPvalues.data.frame(object = psect, x = "X1", y = "X2",
                               gridspacing = gridspacing, show.sig = show.sig, alpha = alpha,
                               sig.size = sig.size, sig.colour = sig.colour,
                               sig.face = sig.face, sig.family = sig.family,
                               triangles = triangles,
                               title = paste(title," - ", secname," = ", j, sep=""),
                               axis.labels = pairname, colours = colours,
                               printPlot = printPlot,
                               axis.text.size = axis.text.size, ggplotFuncs = ggplotFuncs)

    }
  }
  invisible(p)
}


library(ggplot2)
library(ggvis)
library(plotly)
# 3. faza: Vizualizacija podatkov

# Uvozimo zemljevid.
#zemljevid <- uvozi.zemljevid("http://baza.fmf.uni-lj.si/OB.zip", "OB",
#                             pot.zemljevida="OB", encoding="Windows-1250")
#levels(zemljevid$OB_UIME) <- levels(zemljevid$OB_UIME) %>%
#  { gsub("Slovenskih", "Slov.", .) } %>% { gsub("-", " - ", .) }
#zemljevid$OB_UIME <- factor(zemljevid$OB_UIME, levels=levels(obcine$obcina))
#zemljevid <- fortify(zemljevid)

# IzraĂ„Ĺ¤unamo povpreĂ„Ĺ¤no velikost druÄąÄľine
#povprecja <- druzine %>% group_by(obcina) %>%
#  summarise(povprecje=sum(velikost.druzine * stevilo.druzin) / sum(stevilo.druzin))

######
ggplot(t1) + aes(x=igralec, y=cleanSheet) + geom_bar(stat="identity")
g1 <- ggplot(t1) + aes(igralec=igralec, ekipa=ekipa, x=appearances, y=cleanSheet, color=drzava) + geom_point() + ggtitle("Tekme brez prejetega zadetka") + xlab("Število nastopov") + ylab("Tekme brez prejetega zadetka")+labs(colour= "država")
g11 <- ggplotly(g1)
ggplot(t2) + aes(x=penaltyFaced, y=penaltySave, color=drzava) + geom_point() + geom_text(aes(label=igralec),hjust=0, vjust=0, size=3) + ggtitle("Posredovanje pri enajstmetrovkah") + xlab("Ĺ tevilo enajstmetrovk") + ylab("Ĺ tevilo obranjenih enajstmetrovk") # + geom_line(data=t2, aes(x=penaltyFaced, y=penaltySave), color="green")
ggplot(t2) + aes(x=savedShotsFromInsideTheBox, y=goalsConcededInsideTheBox, color=drzava) + geom_point() + geom_text(aes(label=igralec),hjust=0, vjust=0, size=3) + ggtitle("Posredovanje pri strelih znotraj kazenskega prostora") + xlab("Obranjeni streli znotraj kazenskega prostora") + ylab("Prejeti zadetki znotraj kazenskega prostora")
ggplot(t2) + aes(x=savedShotsFromOutsideTheBox, y=goalsConcededOutsideTheBox, color=drzava) + geom_point() + geom_text(aes(label=igralec),hjust=0, vjust=0, size=3) + ggtitle("Posredovanje pri strelih izven kazenskega prostora") + xlab("Obranjeni streli izven kazenskega prostora") + ylab("Prejeti zadetki izven kazenskega prostora")
ggplot(t3) + aes(x=runsOut, y=successfulRunsOut, color=drzava) + geom_point() + geom_text(aes(label=ifelse(successfulRunsOut>18,as.character(igralec),'')),hjust=0, vjust=0, size=3) + ggtitle("Iztekanja") + xlab("Ĺ tevilo iztekov") + ylab("Ĺ tevilo uspeĹˇnih iztekov")
ggplot(t3) + aes(x=highClaims, y=crossesNotClaimed, color=drzava) + geom_point() + geom_text(aes(label=igralec),hjust=0, vjust=0, size=3) + ggtitle("Posredovanje pri predloĹľkih") + xlab("Ĺ tevilo ujetih predloĹľkov") + ylab("Ĺ tevilo napak pri predloĹľkih")
ggplot(t4) + aes(x=ekipa, y=totalPasses, size=accuratePassesPercentage, color=drzava) + geom_point() + geom_text(aes(label=igralec),hjust=0, vjust=0, size=3) + ggtitle("Podaje") + xlab("Ekipa") + ylab("Ĺ tevilo podaj")
ggplot(t4) + aes(x=accurateLongBallsPercentage, y=accurateLongBalls, size=accurateLongBallsPercentage, color=drzava) + geom_point() + geom_text(aes(label=igralec),hjust=0, vjust=0, size=3) + ggtitle("Dolge Ĺ˝oge") + xlab("Odstotek natanÄŤnosti pri dolgih Ĺľogah") + ylab("Ĺ tevilo dolgih Ĺľog")

t5 <- t1 %>% group_by(drzava) %>% summarise(cleanSheet_drzava=sum(cleanSheet))
ggplot(t5) + aes(x=drzava, y=cleanSheet_drzava, fill=drzava) + geom_bar(stat="identity") + guides(fill=FALSE) + ggtitle("Tekme brez prejetega zadetka, glede na drĹľave") + xlab("") + ylab("Tekme brez prejetega zadetka")

t6 <- t2 %>% group_by(drzava) %>% summarise(penaltySave_drzava=sum(penaltySave))
ggplot(t6) + aes(x=drzava, y=penaltySave_drzava, fill=drzava) + geom_bar(stat="identity") + guides(fill=FALSE) + ggtitle("Obranjena enajstmetrovke, glede na drĹľave") + xlab("") + ylab("Ĺ tevilo obranjenih enajstmetrovk")

t6.2 <- t2 %>% group_by(drzava) %>% summarise(penaltyFaced_drzava=sum(penaltyFaced))
penaltyFaced_drzava <- t6.2[[2]]
t6.3 <- cbind(t6, penaltyFaced_drzava)
t6.3[,2] <- ifelse(t6.3$drzava == 'Germany', t6.3[,2] * (380/340), t6.3[,2])
t6.3[,3] <- ifelse(t6.3$drzava == 'Germany', t6.3[,3] * (380/340), t6.3[,3])
ggplot(t6.3) + aes(x=penaltyFaced_drzava, y=penaltySave_drzava) + geom_point() + geom_text(aes(label=drzava),hjust=0, vjust=0) + ggtitle("Enajstmetrovke, glede na drĹľave") #+ geom_smooth(method = "lm")

ggplot(t6.3, aes(x=drzava)) +
  geom_col(aes(y=penaltyFaced_drzava, fill="Neobranjene enajstmetrovke")) +
  geom_col(aes(y=penaltySave_drzava, fill="Obranjene enajstmetrovke")) +
  xlab("") + ylab("Vse enajstmetrovke v ligi") + ggtitle("Enajstmetrovke glede na drĹľave")

t7 <- t2 %>% group_by(drzava) %>% summarise(goalsConcededOutsideTheBox_drzava=sum(goalsConcededOutsideTheBox))
ggplot(t7) + aes(x=drzava, y=goalsConcededOutsideTheBox_drzava, fill=drzava) + geom_bar(stat="identity") + guides(fill=FALSE)

t8 <- t2 %>% group_by(drzava) %>% summarise(goalsConcededInsideTheBox_drzava=sum(goalsConcededInsideTheBox))
ggplot(t8) + aes(x=drzava, y=goalsConcededInsideTheBox_drzava, fill=drzava) + geom_bar(stat="identity") + guides(fill=FALSE)

goalsConcededInsideTheBox_drzava<- t8[[2]]
t9 <- cbind(t7, goalsConcededInsideTheBox_drzava)

t9[,2] <- ifelse(t9$drzava == 'Germany', t9[,2] * (380/340), t9[,2])
t9[,3] <- ifelse(t9$drzava == 'Germany', t9[,3] * (380/340), t9[,3])

ggplot(t9, aes(x=drzava)) +
  geom_col(aes(y=goalsConcededOutsideTheBox_drzava+goalsConcededInsideTheBox_drzava, fill="Zadetki izven 16m")) +
  geom_col(aes(y=goalsConcededInsideTheBox_drzava, fill="Zadetki znotraj 16m")) +
  xlab("") + ylab("Ĺ tevilo vseh zadetkov v ligi") + ggtitle("Prejeti zadetki glede na drĹľave")

# #tortni diagram za ita, za cleansheete
# bp<- ggplot(podatki_v_ap_cs_ita, aes(x="", y=cleanSheet, fill=igralec))+
#   geom_bar(width = 1, stat = "identity")
# bp
# pie <- bp + coord_polar("y", start=0)
# pie
#za vse
bp<- ggplot(t6, aes(x="", y=penaltySave_drzava, fill=drzava))+
 geom_bar(width = 1, stat = "identity")
bp
pie <- bp + coord_polar("y", start=0)
pie

# Uvozimo zemljevid.
zemljevid <- uvozi.zemljevid("https://www.naturalearthdata.com/http//www.naturalearthdata.com/download/110m/cultural/110m_cultural.zip",
                             "ne_110m_admin_0_countries", encoding="UTF-8")

# a <- data.frame(zemljevid) %>% filter(CONTINENT=="Europe")
#  tm_shape(merge(a,
#                 t2 %>% group_by(drzava) %>% summarise(penaltySave=sum(penaltySave)),
#                 by.x="SOVEREIGNT", by.y="drzava")) +
#    tm_polygons("penaltySave") + ggtitle("Obranjena enajstmetrovke, glede na drĹľave")
#
#
# tm_shape(merge(zemljevid,
#                t1 %>% group_by(drzava) %>% summarise(cleanSheet=sum(cleanSheet)),
#                by.x="SOVEREIGNT", by.y="drzava")) +
#   tm_polygons("cleanSheet") + ggtitle("Tekme brez prejetega zadetka, glede na drĹľave")

zemljevid1 <- zemljevid[zemljevid$CONTINENT == "Europe",]
tm_shape(merge(zemljevid1,
               t1 %>% group_by(drzava) %>% summarise(cleanSheet=sum(cleanSheet)),
               by.x="SOVEREIGNT", by.y="drzava"), xlim=c(-15, 35), ylim=c(32, 72)) +
  tm_polygons("cleanSheet") + ggtitle("Tekme brez prejetega zadetka, glede na drĹľave")

tm_shape(merge(zemljevid1,
               t2 %>% group_by(drzava) %>% summarise(penaltySave=sum(penaltySave)),
               by.x="SOVEREIGNT", by.y="drzava"), xlim=c(-15, 35), ylim=c(32, 72)) +
  tm_polygons("penaltySave") + ggtitle("Obranjene enajstmetrovke, glede na drĹľave")

ggplotly(ggplot(t1) + aes(igralec=igralec, ekipa= ekipa, x=appearances, y=cleanSheet, color=drzava) + geom_point() + ggtitle("Tekme brez prejetega zadetka") + xlab("Ĺ tevilo nastopov") + ylab("Tekme brez prejetega zadetka") + geom_smooth(aes(group=drzava), method = "lm", se=FALSE) +labs(colour= "država"))

# gg <- ggplotly(p)
# gg


context("Creating aesthetic mappings")

test_that("function aes", {
  expect_equal(aes(x = mpg, y = wt),
               structure(list(x = bquote(mpg), y = bquote(wt)), class = "uneval"))

  expect_equal(aes(x = mpg ^ 2, y = wt / cyl),
               structure(list(x = bquote(mpg ^ 2), y = bquote(wt / cyl)), class = "uneval"))

})

test_that("function aes_string", {
  expect_equal(aes_string(x = "mpg", y = "wt"),
               structure(list(x = bquote(mpg), y = bquote(wt)), class = "uneval"))

  expect_equal(aes_string(x = "mpg ^ 2", y = "wt / cyl"),
               structure(list(x = bquote(mpg ^ 2), y = bquote(wt / cyl)), class = "uneval"))
})

test_that("function aes_all", {
  expect_equal(aes_all(names(mtcars)),
               structure(
                 list(
                   mpg = bquote(mpg),
                   cyl = bquote(cyl),
                   disp = bquote(disp),
                   hp = bquote(hp),
                   drat = bquote(drat),
                   wt = bquote(wt),
                   qsec = bquote(qsec),
                   vs = bquote(vs),
                   am = bquote(am),
                   gear = bquote(gear),
                   carb = bquote(carb)),
                 class = "uneval"))

  expect_equal(aes_all(c("x", "y", "col", "pch")),
               structure(list(x = bquote(x), y = bquote(y), colour = bquote(col), shape = bquote(pch)), class = "uneval"))
})

test_that("function aes_auto", {
  df <- data.frame(x = 1, y = 1, colour = 1, label = 1, pch = 1)
  expect_equal(aes_auto(df),
               structure(list(colour = bquote(colour), label = bquote(label), shape = bquote(pch), x = bquote(x), y = bquote(y)), class = "uneval"))

  expect_equal(aes_auto(names(df)),
               structure(list(colour = bquote(colour), label = bquote(label), shape = bquote(pch), x = bquote(x), y = bquote(y)), class = "uneval"))

  df <- data.frame(xp = 1:3, y = 1:3, colour = 1:3, txt = letters[1:3], foo = 1:3)
  expect_equal(aes_auto(df, x = xp, label = txt),
               structure(list(colour = bquote(colour), y = bquote(y), x = bquote(xp), label = bquote(txt)), class = "uneval"))
  expect_equal(aes_auto(names(df), x = xp, label = txt),
               structure(list(colour = bquote(colour), y = bquote(y), x = bquote(xp), label = bquote(txt)), class = "uneval"))
  expect_equal(aes_auto(x = xp, label = txt, data = df),
               structure(list(colour = bquote(colour), y = bquote(y), x = bquote(xp), label = bquote(txt)), class = "uneval"))

  df <- data.frame(foo = 1:3)
  expect_equal(aes_auto(df, x = xp, y = yp),
               structure(list(x = bquote(xp), y = bquote(yp)), class = "uneval"))
  expect_equal(aes_auto(df), structure(setNames(list(), character(0)), class = "uneval"))
})


# Convert the output GeoTIFF to KMZ

library(raster)

InputFile = "../data/pixel-based/predictions/randomforest-median-threestep-walltowall.tif"
OutputFile = "../output/global-lc-fraction-map.kmz"

TIFFFile = brick(InputFile)
TIFFFile = TIFFFile[[-1]]
KML(TIFFFile, OutputFile, maxpixels = ncell(TIFFFile), blur=1, col=gray.colors(101, 0, 1), zlim=c(0, 100), overwrite=TRUE)


REBOL []

name: 'Crypt
loadable: no ;tls depends on this, so it has to be builtin
source: %crypt/mod-crypt.c
includes: reduce [
    ;
    ; Added so `#include "bigint/bigint.h` can be found by %rsa.h
    ; and `#include "rsa/rsa.h" can be found by %dh.c
    ;
    src-dir/extensions/crypt
    %prep/extensions/crypt ;for %tmp-extensions-crypt-init.inc
]
depends: [
    [
        %crypt/aes/aes.c

        ; May 2018 update to MSVC 2017 added warnings about Spectre
        ; mitigation.  The JPG code contains a lot of code that would
        ; trigger slowdown.  It is not a priority to rewrite, given
        ; that some other vetted 3rd party JPG code should be used.
        ;
        <msc:/wd5045> ;-- https://stackoverflow.com/q/50399940
    ]

    [
        %crypt/bigint/bigint.c

        ; See above remarks on Spectre.  This may be a priority to
        ; address, if bigint is used in INTEGER!.
        ;
        <msc:/wd5045> ;-- https://stackoverflow.com/q/50399940
    ]

    %crypt/dh/dh.c
    %crypt/rc4/rc4.c
    %crypt/rsa/rsa.c
    %crypt/sha256/sha256.c
]


library(ggplot2)

tabledir <- './tables'
figdir <- './figures'

# Note: These plots are generated from 5kb bins files, and intersections of
# bigWig files with bed files provided as supplementary data: IAPEz_consensus,
# ChromHMM17, RepMasker_lt200bp_all and TSS_hi.

# These tables can be downloaded from the extra data folder.

# Figure 6F - 5kb bins Scatterplot H3.3 wildtype vs Smarcad1KD vs H3K9me3,
# IAP-overlapping bins highlighted

bins.df <- read.csv(paste(tabledir,
                          'fig06_f_H33WT_vs_Smarcad1KD_vs_H3K9me3_5kb_bins.csv',
                          sep='/'))

iap.bins.df <- read.csv(paste(tabledir,
                              'fig06_f_H33WT_vs_Smarcad1KD_vs_H3K9me3_5kb_bins_at_IAP.csv',
                              sep='/'))

# Drop zeros in the input
bins.df <- bins.df[bins.df$Navarro2020_WT_Input > 0 & bins.df$Navarro2020_Smarcad1KD_Input > 0, ]

bins.df$H33wt_norm <- bins.df$Navarro2020_WT_H33 / bins.df$Navarro2020_WT_Input
bins.df$H33smarcad1KD_norm <- bins.df$Navarro2020_Smarcad1KD_H33 / bins.df$Navarro2020_Smarcad1KD_Input

# Drop zeros in smarcad1KD norm, if any
bins.df <- bins.df[bins.df$H33smarcad1KD_norm > 0, ]

bins.df$H33fc_norm <- log2(bins.df$H33wt_norm / bins.df$H33smarcad1KD_norm)

iap.bins.df$H33wt_norm <- iap.bins.df$Navarro2020_WT_H33 / iap.bins.df$Navarro2020_WT_Input
iap.bins.df$H33smarcad1KD_norm <- iap.bins.df$Navarro2020_Smarcad1KD_H33 / iap.bins.df$Navarro2020_Smarcad1KD_Input
iap.bins.df$H33fc_norm <- log2(iap.bins.df$H33wt_norm / iap.bins.df$H33smarcad1KD_norm)

ggplot(bins.df, aes(x=H33fc_norm, y=Shi2019_H3K9me3)) +
  geom_bin2d(binwidth=c(0.02,0.02)) +
  geom_point(data=iap.bins.df, aes(x=H33fc_norm, y=Shi2019_H3K9me3), color='#32a472', size=0.8, alpha=0.6) +
  scale_fill_gradient(low='#dddddd', high='#333333') + #, high='#bb3215') +
  theme_classic() +
  xlim(-3, 3) +
  ylim(0, 30) +
  xlab("log2(H33 WT/ Smarcad1KD)") +
  ylab("Shi2019 H3K9me3 RPGC") +
  geom_vline(xintercept=0, linetype='dashed') +
  ggtitle("Smarcad1 vs H33 WT / Smarcad1KD (5kb bins)")

ggsave(paste(figdir, 'fig06_f_H33wt_vs_Smarcad1KD_vs_H3K9me3_scatterplot.png', sep='/'))


# 2. faza: Uvoz podatkov

source("lib/libraries.r")

sl <- locale("sl", decimal_mark=",", grouping_mark=".")

#1. Tabela najemniških poslov:

for (i in 2013:2020){

  najem.delistavb = read_csv2(sprintf("podatki/ETN_SLO_NAJ_%s_20211127/ETN_SLO_NAJ_%s_delistavb_20211127.csv",i, i),
                              col_types = cols(
                                .default = col_guess(),
                                "Uporabna površina dela stavbe" = col_double()
                              ))

  najem.posli = read_csv2(sprintf("podatki/ETN_SLO_NAJ_%s_20211127/ETN_SLO_NAJ_%s_posli_20211127.csv", i, i))

  zdruzeno = left_join(najem.posli, najem.delistavb, by="ID Posla")

  zdruzeno = zdruzeno %>% relocate(
    "id.posla" = "ID Posla",
    "obcina" = colnames(zdruzeno)[22],
    "mesecna.najemnina" = "Pogodbena najemnina",
    "povrsina" = "Površina oddanih prostorov",
    "uporabna.povrsina" = "Uporabna površina dela stavbe",
    "tip.stavbe" = "Vrsta oddanih prostorov",
    "leto.izgradnje" = "Leto izgradnje stavbe",
    )

  #odstranimo veckratne vnose in odstranimo nezeljene podatke:
  prestej.vnose = function(v){
    stetje = c()
    vektor = v
    for (el in vektor){
      stetje = c(stetje, length(which(vektor == el)))
    }
    return(stetje)
  }

  zdruzeno = zdruzeno %>% filter(prestej.vnose(id.posla) == 1) %>%
    select(id.posla, obcina, mesecna.najemnina, povrsina, uporabna.povrsina, tip.stavbe, leto.izgradnje) %>%
    drop_na()

  #dodamo letnico:

  zdruzeno = zdruzeno %>% mutate(leto.posla = i)

  if (i == 2013){
    tabela.najemnin = zdruzeno
  } else{
    tabela.najemnin = rbind(tabela.najemnin, zdruzeno)
  }

}

tabela.najemnin = tabela.najemnin %>% mutate(obcina = tolower(obcina)) %>% mutate(obcina = str_to_sentence(obcina)) %>%
  select(-id.posla)

etn.sifrant.najemnine = tibble(
  "tip.stavbe" = c(1:16),
  "etn.tip.prostora" = c(
    "Stanovanjska hisa",
    "Stanovanje",
    "Parkirni prostor",
    "Garaza",
    "Pisarniski prostori",
    "Prostori za poslovanje s strankami",
    "Prostori za zdravstveno dejavnost",
    "Trgovski ali storitveni lokal",
    "Gostinski lokal",
    "Prostori za sport, kulturo ali izobrazevanje",
    "Industrijski prostori",
    "Turisticni nastanitveni objekt",
    "Kmetijski objekt",
    "Tehnicni ali pomozni prostori",
    "Drugo",
    "Stanovanjska soba ali sobe")
               )

tabela.najemnin = tabela.najemnin %>% left_join(etn.sifrant.najemnine, by="tip.stavbe") %>% select(
  obcina, mesecna.najemnina, povrsina, uporabna.povrsina, tip.prostora = etn.tip.prostora, leto.izgradnje, leto.posla
)

tabela.najemnin = tabela.najemnin %>%  filter(tip.prostora != "Stanovanjska soba ali sobe") %>% mutate(uporabna.povrsina = as.numeric(uporabna.povrsina)) %>%
  mutate(tip.prostora = as.factor(tip.prostora))

#odstranjevanje nesmiselnih vnosov:

tabela.najemnin = tabela.najemnin %>% filter(povrsina >= (uporabna.povrsina) & uporabna.povrsina >= 0.7 * povrsina) %>%
  filter(povrsina != 0)  %>%
  mutate(najemnina.na.kvadratni.meter = mesecna.najemnina / povrsina) %>%
  filter(najemnina.na.kvadratni.meter < 100 & najemnina.na.kvadratni.meter > 0.5) %>% select(-najemnina.na.kvadratni.meter)

#print(tabela.najemnin)

#2. Tabela kupoprodajnih poslov:

for (i in 2013:2020){

  nakup.delistavb = read_csv2(sprintf("podatki/ETN_SLO_KUP_%s_20211127/ETN_SLO_KUP_%s_delistavb_20211127.csv",i, i))

  nakup.posli = read_csv2(sprintf("podatki/ETN_SLO_KUP_%s_20211127/ETN_SLO_KUP_%s_posli_20211127.csv", i, i))

  zdruzeno = left_join(nakup.posli, nakup.delistavb, by="ID Posla")

  zdruzeno = zdruzeno %>% relocate(
    "id.posla" = "ID Posla",
    "obcina" = colnames(zdruzeno)[18],
    "prodajna.cena" = colnames(zdruzeno)[5],
    "povrsina" = colnames(zdruzeno)[34],
    "uporabna.povrsina" = colnames(zdruzeno)[47],
    "tip.stavbe" = "Vrsta dela stavbe",
    "leto.izgradnje" = "Leto izgradnje dela stavbe",
  )

  #odstranimo veckratne vnose in odstranimo nezeljene podatke:
  prestej.vnose = function(v){
    stetje = c()
    vektor = v
    for (el in vektor){
      stetje = c(stetje, length(which(vektor == el)))
    }
    return(stetje)
  }

  zdruzeno = zdruzeno %>% filter(prestej.vnose(id.posla) == 1) %>%
    select(id.posla, obcina, prodajna.cena, povrsina, uporabna.povrsina, tip.stavbe, leto.izgradnje) %>%
    drop_na()

  #dodamo letnico:

  zdruzeno = zdruzeno %>% mutate(leto.posla = i)

  if (i == 2013){
    tabela.nakupov = zdruzeno
  } else{
    tabela.nakupov = rbind(tabela.nakupov, zdruzeno)
  }

}

etn.sifrant.nakupi = tibble(
  "tip.stavbe" = c(1:15),
  "etn.tip.prostora" = c(
    "Stanovanjska hisa",
    "Stanovanje",
    "Parkirni prostor",
    "Garaza",
    "Pisarniski prostori",
    "Prostori za poslovanje s strankami",
    "Prostori za zdravstveno dejavnost",
    "Trgovski ali storitveni lokal",
    "Gostinski lokal",
    "Prostori za sport, kulturo ali izobrazevanje",
    "Industrijski prostori",
    "Turisticni nastanitveni objekt",
    "Kmetijski objekt",
    "Tehnicni ali pomozni prostori",
    "Drugo")
)

tabela.nakupov = tabela.nakupov %>% mutate(obcina = tolower(obcina)) %>%mutate(obcina = str_to_sentence(obcina)) %>%
  select(-id.posla)

tabela.nakupov = tabela.nakupov %>% left_join(etn.sifrant.nakupi, by="tip.stavbe") %>%
  select(obcina, prodajna.cena, povrsina, uporabna.povrsina, tip.prostora = etn.tip.prostora, leto.izgradnje, leto.posla)

tabela.nakupov = tabela.nakupov %>% mutate(tip.prostora = as.factor(tip.prostora))

#odstranjevanje nesmiselnih vnosov:
tabela.nakupov = tabela.nakupov %>% filter(povrsina >= (uporabna.povrsina) & uporabna.povrsina >= 0.7 * povrsina) %>%
  filter(prodajna.cena >= 10) %>% filter(prodajna.cena / povrsina <= 10000)

#3 Tabela občin:

obcine = read_csv(
  "podatki/obcine.csv",
  skip = 2,
  locale = locale(encoding = "Windows-1250"),
  col_types = cols(
    .default = col_guess(),
    "2008" = col_double(),
    "2009" = col_double(),
    "2010" = col_double(),
    "2011" = col_double(),
    "2012" = col_double(),
    "2013" = col_double(),
    "2014" = col_double(),
    "2021" = col_double()
  )
  )

obcine = pivot_longer(obcine,
                      cols = (colnames(obcine)[3:16]),
                      names_to = "leto",
                      values_to = "vrednost"
                      )

obcine_meritve1 = obcine %>% filter(MERITVE == "Površina (km2) - 1. januar") %>% mutate(povrsina = vrednost) %>% select(leto, obcina = colnames(obcine)[2], povrsina = vrednost)
obcine_meritve2 = obcine %>% filter(MERITVE == "Število prebivalcev - 1. januar") %>% mutate(povrsina = vrednost) %>% select(leto, obcina = colnames(obcine)[2], stevilo.prebivalcev = vrednost)
obcine_meritve3 = obcine %>% filter(MERITVE == "Skupni prirast") %>% mutate(povrsina = vrednost) %>% select(leto, obcina = colnames(obcine)[2], skupni.prirast = vrednost)
obcine_meritve4 = obcine %>% filter(MERITVE == "Indeks staranja - 1. januar") %>% mutate(povrsina = vrednost) %>% select(leto, obcina = colnames(obcine)[2], indeks.staranja = vrednost)
obcine_meritve5 = obcine %>% filter(MERITVE == obcine$MERITVE[14264]) %>% mutate(povrsina = vrednost) %>% select(leto, obcina = colnames(obcine)[2], stevilo.studentov = vrednost)
obcine_meritve6 = obcine %>% filter(MERITVE == "Stopnja delovne aktivnosti (%)") %>% mutate(povrsina = vrednost) %>% select(leto, obcina = colnames(obcine)[2], stopnja.delovne.aktivnosti = vrednost)
obcine_meritve7 = obcine %>% filter(MERITVE == obcine$MERITVE[20873]) %>% mutate(povrsina = vrednost) %>% select(leto, obcina = colnames(obcine)[2], bruto.mesecna.placa = vrednost)

zdruzi = obcine_meritve1
zdruzi = left_join(zdruzi, obcine_meritve2, by = c("leto", "obcina"))
zdruzi = left_join(zdruzi, obcine_meritve3, by = c("leto", "obcina"))
zdruzi = left_join(zdruzi, obcine_meritve4, by = c("leto", "obcina"))
zdruzi = left_join(zdruzi, obcine_meritve5, by = c("leto", "obcina"))
zdruzi = left_join(zdruzi, obcine_meritve6, by = c("leto", "obcina"))
tabela.obcin = left_join(zdruzi, obcine_meritve7, by = c("leto", "obcina"))

tabela.obcin = tabela.obcin %>% filter(leto != 2021) %>% filter(leto >= 2013) %>%
  mutate(obcina = str_to_sentence(obcina)) %>% filter(obcina != "Slovenija")

tabela.obcin = tabela.obcin %>% mutate(obcina = str_replace(obcina, "([:alpha:]*)/[:alpha:]*", "\\1")) %>%
  mutate(obcina = str_replace(obcina, "([:alpha:]*)\\s-\\s([:alpha:]*)", "\\1-\\2"))


#rm(list=ls(all=TRUE))
#data_fn="tmp/"
#folder_fn="results-benchmark-binary"
#results_fn=paste(data_fn,folder_fn,"/raw",sep="")
#output_fn=paste(data_fn,folder_fn,"/results-bars.pdf",sep="")
#outtxt_fn=paste(data_fn,folder_fn,"/results-text.txt",sep="")

configs.threads=1
#configs.loop=10
#configs.recursion=c(10)
#configs.labels=c("No Probe","Inactive Probe","Collecting Data","Writing Data")
configs.count=length(configs.labels)
#results.count=2000000
#results.skip=1000000

#bars.minval=500
#bars.maxval=600

## "[ recursion , config , loop ]"
resultsBIG <- array(dim=c(length(configs.recursion),configs.count,configs.threads*configs.loop*(results.count-results.skip)),dimnames=list(configs.recursion,configs.labels,c(1:(configs.threads*configs.loop*(results.count-results.skip)))))
for (cr in configs.recursion) {
  for (cc in (1:configs.count)) {
    for (cl in (1:configs.loop)) {
      results_fn_temp=paste(results_fn, "-", cl, "-", cr, "-", cc, ".csv", sep="")
      for (ct in (1:configs.threads)) {
        results=read.csv2(results_fn_temp,nrows=(results.count-results.skip),skip=(ct-1)*results.count+results.skip,quote="",colClasses=c("NULL","numeric"),comment.char="",col.names=c("thread_id","duration_nsec"),header=FALSE)
        resultsBIG[(1:length(configs.recursion))[configs.recursion==cr],cc,c(((cl-1)*configs.threads*(results.count-results.skip)+1):(cl*configs.threads*(results.count-results.skip)))] <- results[["duration_nsec"]]/(1000)
      }
      rm(results,results_fn_temp)
    }
  }
}

pdf(output_fn, width=8, height=5, paper="special")
plot.new()
plot.window(xlim=c(min(configs.recursion)-0.5,max(configs.recursion)+0.5),ylim=c(bars.minval,bars.maxval))
axis(1,at=configs.recursion)
axis(2)
title(xlab="Recursion Depth (Number of Executions)",ylab=expression(paste("Execution Time (",mu,"s)")))
for (cr in configs.recursion) {
  printvalues = matrix(nrow=6,ncol=configs.count,dimnames=list(c("mean","ci95%","md25%","md50%","md75%","through"),c(1:configs.count)))
  for (cc in (1:configs.count)) {
    printvalues["mean",cc]=mean(resultsBIG[(1:length(configs.recursion))[configs.recursion==cr],cc,c(1:(results.count-results.skip))])
    printvalues["ci95%",cc]=qnorm(0.975)*sd(resultsBIG[(1:length(configs.recursion))[configs.recursion==cr],cc,c(1:(results.count-results.skip))])/sqrt(length(resultsBIG[(1:length(configs.recursion))[configs.recursion==cr],cc,c(1:(results.count-results.skip))]))
    printvalues[c("md25%","md50%","md75%"),cc]=quantile(resultsBIG[(1:length(configs.recursion))[configs.recursion==cr],cc,c(1:(results.count-results.skip))],probs=c(0.25,0.5,0.75))
    printvalues["through",cc]=((results.count-results.skip) * 1000*1000) / sum(resultsBIG[(1:length(configs.recursion))[configs.recursion==cr],cc,c(1:(results.count-results.skip))])
  }
  #meanvalues
  for (cc in (configs.count:2)) {
    rect(cr-0.3,printvalues["mean",cc-1],cr+0.5,printvalues["mean",cc])
  }
  rect(cr-0.3,0,cr+0.5,printvalues["mean",1])
  for (cc in (1:configs.count)) {
    lines(c(cr+0.41,cr+0.49),c(printvalues["mean",cc]+printvalues["ci95%",cc],printvalues["mean",cc]+printvalues["ci95%",cc]),col="red")
    lines(c(cr+0.45,cr+0.45),c(printvalues["mean",cc]-printvalues["ci95%",cc],printvalues["mean",cc]+printvalues["ci95%",cc]),col="red")
    lines(c(cr+0.41,cr+0.49),c(printvalues["mean",cc]-printvalues["ci95%",cc],printvalues["mean",cc]-printvalues["ci95%",cc]),col="red")
  }
  #median
  for (cc in (configs.count:2)) {
    rect(cr-0.4,printvalues["md50%",cc-1],cr+0.4,printvalues["md50%",cc],col="white",border="black")
    rect(cr-0.4,printvalues["md50%",cc-1],cr+0.4,printvalues["md50%",cc],angle=45,density=cc*10)
  }
  rect(cr-0.4,0,cr+0.4,printvalues["md50%",1],col="white",border="black")
  rect(cr-0.4,0,cr+0.4,printvalues["md50%",1],angle=45,density=10)
  for (cc in (1:configs.count)) {
    lines(c(cr-0.39,cr-0.31),c(printvalues["md75%",cc],printvalues["md75%",cc]),col="red")
    lines(c(cr-0.35,cr-0.35),c(printvalues["md25%",cc],printvalues["md75%",cc]),col="red")
    lines(c(cr-0.39,cr-0.31),c(printvalues["md25%",cc],printvalues["md25%",cc]),col="red")
  }
  for (cc in (2:configs.count)) {
    labeltext=formatC(printvalues["md50%",cc]-printvalues["md50%",cc-1],format="f",digits=1)
      rect(cr-(strwidth(labeltext)*0.5),printvalues["md50%",cc]-strheight(labeltext),cr+(strwidth(labeltext)*0.5),printvalues["md50%",cc],col="white",border="black")
      text(cr,printvalues["md50%",cc],labels=labeltext,cex=0.75,col="black",pos=1,offset=0.1)
  }
  resultstext=formatC(printvalues,format="f",digits=4,width=8)
  print(resultstext)
  write(paste("Recursion Depth: ", cr),file=outtxt_fn,append=TRUE)
  write.table(resultstext,file=outtxt_fn,append=TRUE,quote=FALSE,sep="\t",col.names=FALSE)
}
invisible(dev.off())


####################################################################################################
#
# Mark Cembrowski, Janelia Research Campus, April 15 2015
#
# This script plots a scatterplot, coming the gene expression across two different populations.
# Additional options allow labeling of specific genes.
#
# INPUT:
# sampleX: character. String corresponding to the sample_name, plotted on x axis.
# sampleY: character. String corresponding to the sample_name, plotted on y axis.
#
# OPTIONAL INPUT:
# gsnList=vector(): character vector.  A list of specific genes to highlight.
# fdr=-1: numeric.  FDR value to use if using DE as a means of labeling data points.
# foldThres=-1: numeric.  Minimum fold change between populations in order to label points.
# fpkmThres=-1: numeric.  Minimum FPKM value for a gene to be considered enriched.
# avgPass=T: logical.  If T, allows genes to be enriched whenever the average value between the
#	two samples exceeds provided threshold.  If F, requires enrichment to be present across
#	all replicates, instead of the average, a stricter comparison.
# maxX,maxY,minX,minY=-1: numerics.  Override axis limits on x and y axes.
# label=T: logical.  Switch to control whether highlighted genes are labeled.
#
# OUTPUT:
# A scatterplot is rendered and the corresponding matrix is returned.
#
#####################################################################################################

fpkmScatter <- function(sampleX,sampleY,gsnList=vector(),fdr=-1,foldThres=-1,fpkmThres=-1,avgPass=T,
				maxX=-1,maxY=-1,minX=-1,minY=-1,label=T){

	# Set parameters corresponding to the type of analysis.
	apriori <- F
	explore <- F
	if(length(gsnList)>0.1){ apriori <- T }
	if(fdr>0||foldThres>0){ explore <- T }
	if(apriori&&explore){
		# Check to make sure that the user also has not supplied a list of genes to plot.
		if(length(gsnList)>0.1){
			stop('Cannot simultaneously do exploratory and a priori labeling')
		}
	}

	# Produce an empty output, if not labeling any genes.
	if( (!apriori) && (!explore) ){
		enrX <- c()
		enrY <- c()
	}

	# Obtain enrichment for provided genes, if doing a priori analysis.
	if(apriori){
		expX <- fpkmPoolMat[unlist(symToId(gsnList)),sampleX]
		expY <- fpkmPoolMat[unlist(symToId(gsnList)),sampleY]
		priorRat <- expX/expY
		enrX <- unlist(symToId(gsnList[priorRat>1]))
		enrY <- unlist(symToId(gsnList[priorRat<1]))
	}

	# Recover list of genes to plot, if doing an exploratory analysis.
	if(explore){
		enrX <- getEnrGenes(sampleX,sampleY,fdr=fdr,foldThres=foldThres,fpkmThres=fpkmThres,
			avgPass=avgPass)
		enrY <- getEnrGenes(sampleY,sampleX,fdr=fdr,foldThres=foldThres,fpkmThres=fpkmThres,
			avgPass=avgPass)
	}

	# Generate an informative table for output.
	enrichedRegion <- c(rep(sampleX,length(enrX)),rep(sampleY,length(enrY)))

	geneId <- c(enrX,enrY)
	geneShortName <- idToSym(geneId)
	foldDiff <- fpkmPoolMat[geneId,sampleX]/fpkmPoolMat[geneId,sampleY]
	foldDiff <- pmax(foldDiff,1/foldDiff) # Take convention that is >1.
	sampleXFpkm <- fpkmPoolMat[geneId,sampleX]
	sampleYFpkm <- fpkmPoolMat[geneId,sampleY]

	enrOut <- as.data.frame(cbind(enrichedRegion,geneId,geneShortName,foldDiff,
		sampleXFpkm,sampleYFpkm))
	enrOut$foldDiff <- as.numeric(as.character(enrOut$foldDiff))
	enrOut <- enrOut[with(enrOut,order(enrichedRegion,-foldDiff)),]
	colnames(enrOut)[5] <- paste(sampleX,'Fpkm',sep='')
	colnames(enrOut)[6] <- paste(sampleY,'Fpkm',sep='')

	if(apriori){
		toHighlight <- unlist(symToId(gsnList))
	}else{
		if(explore){
			toHighlight <- enrOut$geneId
		}else{
			toHighlight <- vector()
		}
	}
	highlight <- rownames(fpkmPoolMat)%in%toHighlight

	# Prep matrix for plotting.
	df <- fpkmPoolMat[,c(sampleX,sampleY)]
	df <- cbind(df,highlight)

	# Do additive smoothing for logarithmic plot.
	df[,sampleX] <- df[,sampleX] + 1
	df[,sampleY] <- df[,sampleY] + 1

	# Sort so that highlighted genes show up on top layers of plot.
	df <- df[order(df$highlight),]

	# Attach gene short names to data frame.
	df[,'gene_short_name'] <- idToSym(rownames(df))

	# Adjust column names to properly interact with aes_string.
	colnames(df)[c(1,2)] <- c('fpkmX','fpkmY')

	# Determine correlation coefficient.
	xCorr <- round(cor(x=df[,'fpkmX'],y=df[,'fpkmY']),digits=2)

	# Plot.  NOTE: need to use aes_string, as we're plotting inside a function!
	scatPlot <- ggplot(df,aes_string(x='fpkmX',y='fpkmY'))
	scatPlot <- scatPlot + scale_colour_manual(values=c("black","red"))
	scatPlot <- scatPlot + geom_abline(slope=1,linetype='dashed',weight=0.1)

	# Plot most points as transparent, highlighted genes as nontransparent
	scatPlot <- scatPlot + geom_point(data=subset(df,highlight==0),aes(colour=factor(highlight)),size=1,alpha=0.1)
	scatPlot <- scatPlot + geom_point(data=subset(df,highlight==1),aes(colour=factor(highlight)),size=1)

	theMax <- max(df[,c('fpkmX','fpkmY')])
	theMin <- 0.9
	theMaxX <- theMax
	theMaxY <- theMax
	theMinX <- theMin
	theMinY <- theMin
	if (maxX>0){theMaxX <- maxX}
	if (maxY>0){theMaxY <- maxY}
	if (minX>0){if (minX<maxX){theMinX <- minX}}
	if (minY>0){if (minY<maxY){theMinY <- minY}}

	scatPlot <- scatPlot + scale_x_log10() + scale_y_log10()
	scatPlot <- scatPlot + coord_cartesian(xlim=c(theMinX,theMaxX),ylim=c(theMinY,theMaxY))
	scatPlot <- scatPlot+geom_hline(aes(yintercept=11))
	scatPlot <- scatPlot+geom_vline(aes(xintercept=11))

	if(label){
		scatPlot <- scatPlot + geom_text(data=subset(df,highlight==1),
			aes_string(label="gene_short_name"),hjust=0,vjust=0,size=2,colour="black")
	}
	scatPlot <- scatPlot + labs(x=paste('FPKM+1, ',sampleX,sep=""),y=paste('FPKM+1, ',sampleY,sep=""),
		title=paste('FPKM scatter plot, selected genes in blue; CC=',xCorr,sep=""))
	scatPlot <- scatPlot + theme_bw()
	scatPlot <- scatPlot + theme(legend.position='none')

	print(scatPlot)

	invisible(enrOut)
}


load("experimental_data.Rdat")

plot.ablines <- function() {
    abline(h=750)
    abline(h=750*1.15,lty=3)
    abline(h=750*0.85,lty=3,col="red")

    abline(v=50.5,lty=3)
    abline(v=100.5,lty=3)
    abline(v=150.5,lty=3)
}

plot_rt <- function(plotdat)
{

    plot(plotdat$Trial_Nr, plotdat$mRT, type="b", ylim=c(min(plotdat$mRT)-10,max(plotdat$mRT)+10), xlab="Trials", ylab="Mean Response Time [ms]", main="Response Times", col = "indianred1")
    points(experimental_data$Trial_Nr, experimental_data$mRT, type="b", ylim=c(min(experimental_data$mRT)-10,max(experimental_data$mRT)+10), xlab="Trials", ylab="Mean Response Time [ms]", main="Response Times", col = "cadetblue2", pch = 3)

    plot.ablines()
    for (i in 1:4)
    {
        lines(lowess(plotdat$Trial_Nr[plotdat$Cond==i], plotdat$mRT[plotdat$Cond==i]),lwd=2,col="red")
        lines(lowess(experimental_data$Trial_Nr[experimental_data$Cond==i], experimental_data$mRT[experimental_data$Cond==i]),lwd=2,col="blue")
    }
    plot.ablines()
    legend('topleft', 'top', c("Simulated Data", "Experimental Data"), col=c('red','blue'), lty=c(1,1), bty = 'n', cex = 0.6)

}

plot_sd <- function(plotdat)
{

    plot(plotdat$Trial_Nr, plotdat$sdRT, type="b", ylim=c(min(plotdat$sdRT)-10,max(plotdat$sdRT)+10), xlab="Trials", ylab="Mean Response Time SD [ms]", main="Response Times SD", col = "indianred1")
    points(experimental_data$Trial_Nr, experimental_data$sdRT, type="b", ylim=c(min(experimental_data$sdRT)-10,max(experimental_data$sdRT)+10), xlab="Trials", ylab="Mean Response Time SD [ms]", main="Response Times SD", col = "cadetblue2", pch = 3)

    plot.ablines()
    for (i in 1:4)
    {
        lines(lowess(plotdat$Trial_Nr[plotdat$Cond==i], plotdat$sdRT[plotdat$Cond==i]),lwd=2,col="red")
        lines(lowess(experimental_data$Trial_Nr[experimental_data$Cond==i], experimental_data$sdRT[experimental_data$Cond==i]),lwd=2,col="blue")
    }
    plot.ablines()
    legend('topleft', 'top', c("Simulated Data", "Experimental Data"), col=c('red','blue'), lty=c(1,1), bty = 'n', cex = 0.6)

}

plot_mScore <- function(plotdat)
{

    plot(plotdat$Trial_Nr, plotdat$mScore, type="b", ylim=c(min(plotdat$mScore) - 10, max(plotdat$mScore) + 10), xlab="Trials", ylab="Mean Score", main="Mean Scores")
    for (i in 1:4) {lines(lowess(plotdat$Trial_Nr[plotdat$Cond==i], plotdat$mScore[plotdat$Cond==i]),lwd=2,col="red")}
    plot.ablines()

}

plot_mCurPoints <- function(plotdat)
{

    plot(plotdat$Trial_Nr, plotdat$mCurPoints, type="b", ylim=c(min(plotdat$mCurPoints) - 10, max(plotdat$mCurPoints) + 10), xlab="Trials", ylab="Mean Point Increase", main="Mean Point Increase")
    plot.ablines()
    for (i in 1:4) {lines(lowess(plotdat$Trial_Nr[plotdat$Cond==i], plotdat$mCurPoints[plotdat$Cond==i]),lwd=2,col="red")}
    plot.ablines()
    abline(h=5, lty=3)
    abline(h=-5, lty=3)
    abline(h=-25, lty=3)
    axis(side = 2, at = c(-25, -5, 5))

}

plot_mCorrect <- function(plotdat)
{

    plot(plotdat$Trial_Nr, plotdat$mCorrect, type="b", ylim=c(min(plotdat$mCorrect) - 0.5, max(plotdat$mCorrect) + 0.5), xlab="Trials", ylab="Proportion of Correct Trials", main="Proportion of Correct Trials", col = "indianred1")
    points(experimental_data$Trial_Nr, experimental_data$mCorrect, type="b", ylim=c(min(experimental_data$mCorrect)-10,max(experimental_data$mCorrect)+10), col = "cadetblue2", pch = 3)

    plot.ablines()
    for (i in 1:4)
    {
        lines(lowess(plotdat$Trial_Nr[plotdat$Cond==i], plotdat$mCorrect[plotdat$Cond==i]),lwd=2,col="red")
        lines(lowess(experimental_data$Trial_Nr[experimental_data$Cond==i], experimental_data$mCorrect[experimental_data$Cond==i]),lwd=2,col="blue")
    }
    plot.ablines()
    legend('topleft', 'top', c("Simulated Data", "Experimental Data"), col=c('red','blue'), lty=c(1,1), bty = 'n', cex = 0.6)

}


# Tabela 1: Kazalniki bolniškega staleža po starosti

# Graf po starosti glede na povprečno trajanje bolniške odsotnosti

g1 <- ggplot() +
  geom_line(data = tabela1_obrnjena %>% filter(tabela1_obrnjena == "15 do 19 let"), aes(x = LETO, y = POVPRECNO_TRAJANJE_ENE_ODSOTNOSTI, color="15 do 19 let")) +
  geom_line(data = tabela1_obrnjena %>% filter(tabela1_obrnjena == "25 do 29 let"), aes(x = LETO, y = POVPRECNO_TRAJANJE_ENE_ODSOTNOSTI, color = "25 do 29 let")) +
  geom_line(data = tabela1_obrnjena %>% filter(tabela1_obrnjena == "50 do 54 let"), aes(x = LETO, y = POVPRECNO_TRAJANJE_ENE_ODSOTNOSTI, color="50 do 54 let")) +
  geom_line(data = tabela1_obrnjena %>% filter(tabela1_obrnjena == "60 do 64 let"), aes(x = LETO, y = POVPRECNO_TRAJANJE_ENE_ODSOTNOSTI, color = "60 do 64 let")) +
  ggtitle("Povprečno trajanje ene odsotnosti glede na starost") +
  xlab("Leto") + ylab("Povprečno trajanje ene odsotnosti") + scale_x_continuous(breaks = c(2005:2020)) +
  scale_color_manual(name = "Legenda", values = c("15 do 19 let" = "red","25 do 29 let" = "green", "50 do 54 let" = "blue", "60 do 64 let"="black")) +
  theme(axis.text.x=element_text(angle=90, vjust=0.5, hjust=1))

#----------------------------------------------------------------------------------------

#Tabela 2: Kazalniki po razlogih bolniškega staleža

# Tortni diagram glede na razloge

tortni.diagram <- ggplot(tabela2_obrnjena2020) +
  aes(x="", y=PRIMERI, fill= RAZLOGI) +
  geom_col(width=1) +
  coord_polar(theta="y") +
  xlab("") + ylab("") +
  scale_fill_manual(values=c("darkgreen", terrain.colors(10)), name = "Razlogi po številu primerov (deljeno s 1000)",
                    guide = guide_legend(reverse = TRUE)) +
  labs(title = "Razlogi bolniške odsotnosti v letu 2020")

#primerjava razloga - bolezni skozi leta

g3 <- ggplot(tabela2_obrnjena_bolezen)+
  aes(x = LETO, y = PRIMERI) +
  geom_col(position = 'dodge', fill = "slategray3")  +
  labs(x = "Leto", y = "Število primerov bolezni (deljeno s 1000)",
       title = "Število primerov bolezni po letih")

#----------------------------------------------------------------------------------------

#Tabela 3: Kazalniki bolniškega staleža po statističnih regijah

# Zemljevid

zemljevid <- uvozi.zemljevid("https://biogeo.ucdavis.edu/data/gadm3.6/shp/gadm36_SVN_shp.zip", "gadm36_SVN_1",
                             encoding="UTF-8")
zemljevid1 <- tm_shape(merge(zemljevid, regije , by.x="NAME_1", by.y="REGIJA" )) +
  tm_polygons("STEVILO_PRIMEROV_NA_100_ZAPOSLENIH",title="Število primerov",palette="PuRd") +
  tm_style("white") +
  tm_layout(main.title="Število primerov na 100 zaposlenih v letu 2020") +
  tm_text(text='NAME_1', size=0.6)

#----------------------------------------------------------------------------------------
#Tabela 4: Izgubljeni koledarski dnevi po gospodarskih dejavnosti

g4 <- ggplot(tabela4_obrnjena2020,
              aes(x=GOSPODARSKA_DEJAVNOST, y=ODSTOTEK_BS)) +
  geom_col(position = 'dodge', fill="violetred3")  +
  coord_flip() +
  labs(x = "Gospodarska dejavnost", y = "Odstotek BS",
       title = "Bolniški stalež v gospodarskih dejavnostih") +
    theme(plot.caption = element_text(hjust = 0, face= "italic"),
          plot.title.position = "plot")


# This function is pretty broken because it doesn't consider the difference in scale between axes.
# It also probably doesn't need to always (ever) shorten both ends at least for margin labels...
shorten <- function (x0, y0, x1, y1, rad) {
  line.lengths <- sqrt((x1-x0)^2+(y1-y0)^2)
  pct.short <- rad/line.lengths

  new.pt <- list()
  new.pt$x1 <- x0+(x1-x0)*pct.short
  new.pt$x0 <- x1+(x0-x1)*pct.short
  new.pt$y1 <- y0+(y1-y0)*pct.short
  new.pt$y0 <- y1+(y0-y1)*pct.short

  return (new.pt)
}

#' Label points from the margin
#'
#' Labels are sorted according to the axis along which they are labeled.
#' This could be made a lot better since this often ends up in crossed lines..
#'
#' @examples
#' y <- rnorm(100)
#' x <- runif(100)
#' plot(x, y, pch=20, bty='n')
#' label.pts <- tail(order(y), 10)
#' marginlabels(x[label.pts], y[label.pts], margin=3, lty=3, rad=0.05)
#' @export
marginlabels <- function(x, y = NULL, labels=seq_along(x), margin=4,
                         col='black', lty=1, lwd=1, pch=1, pch.cex=1, las=2,
                         rad=0.15, ...) {

  len <- length(labels)

  if ( missing(y) || is.null(y) ) {
    y <- seq_along(labels)
  }

  if ( length(x) != len ) x <- rep(x, len)
  if ( length(y) != len ) y <- rep(y, len)

  if ( margin == 1 || margin == 3 ) {
    new.order <- order(x)
    x <- x[new.order]
    y <- y[new.order]
    labels <- labels[new.order]
    if ( !missing(col) && length(col) == len ) col <- col[new.order]
    label.x <- seq(par('usr')[1], par('usr')[2], length.out=len+2)[-c(1, len+2)]
    label.y <- par('usr')[if ( margin ==  2) 3 else 4]
    tick.pos <- label.x
  } else {
    new.order <- order(y)
    x <- x[new.order]
    y <- y[new.order]
    labels <- labels[new.order]
    if ( !missing(col) && length(col) == len ) col <- col[new.order]
    label.y <- seq(par('usr')[3], par('usr')[4], length.out=len+2)[-c(1, len+2)]
    label.x <- par('usr')[if ( margin ==  1) 1 else 2]
    tick.pos <- label.y
  }

  points(x, y, pch=pch, col=col, cex=pch.cex)

  connect.lines <- shorten(x, y, label.x, label.y, pch.cex*rad)
  connect.lines$lty <- lty
  connect.lines$lwd <- lwd
  connect.lines$x0 <- label.x
  connect.lines$y0 <- label.y

  do.call(segments, connect.lines)

  axis(margin, at=tick.pos, labels, las=las, lwd=0, lwd.tick=lwd, lty=lty, line=0)
}


code 'cf_reprice_gap_freq_cross'
name '重定价缺口、周期交叉'
dimensions {
	accbook {
		fetchParents true
		subDimension 'repriceFreq'
	}
	repriceGap null
}
dataRequest {
	table 'repriceGap'
	contextParams (['date','organ','currency','staticModel'])
}
heads {
	accbook {
		params {
			reprice true
		}
	}
}
dataGrids {
	apply selectRows({children!=null}),{
		formula {sumChildren()}
	}
}


###
# calculates the age distribution of
# all speakers in the sample, both Subjects and Elders
# and plots as a histogram of decades of birth,
# with color coding of Subject vs. Elder
###

rm(list=ls())
library(dplyr)
library(tidyr)
library(ggplot2)
source('inread.r')

# read in data
everybody <- inread("data/mbc_everybody.csv")
# prepare variables
everybody$role <- factor(everybody$role,
	ordered = TRUE, levels = c("gen1", "gen2"))
everybody$Birthdecade=as.factor(floor((everybody$Birthyear)/10)*10)

# make long table for plot
tallies <- as.data.frame(
	tally(na.omit(everybody) %>%
	group_by(Birthdecade, role)))
# save out underlying data
write.csv(tallies,
	file = "analysis/age_dist.csv",
	fileEncoding = "UTF-8", row.names = FALSE)

# elements for plot
gen1col <- "#dea73a" # elders - gold
gen2col <- "#404096" # interviewees - blue
gen1lab <- "Interviewee's caregiver"
gen2lab <- "Direct interviewee"
colors <- c(gen1col, gen2col)
n2 <- length(everybody$PersonID[everybody$role %in% "gen2"])
n1 <- length(everybody$PersonID[everybody$role == "gen1"])
nn <- length(everybody$PersonID)
nphrase <- paste("N =", nn,
	"(", n2, "interviewees and",
	n1, "elders/caregivers)", sep=" ")
caption <- "Birthyear Distribution in Sample"

# plot
aplot <- ggplot(data = tallies,
    aes(x = Birthdecade, y = n, fill = role)) +
    geom_col() +
    scale_fill_manual(values = colors, name = "Role",
        labels = c(gen1lab, gen2lab),
        guide = guide_legend()) +
    labs(title=paste(caption, nphrase, sep="\n"),
         x = "Decade of Birth", y = "Number of People") +
    theme(axis.text=element_text(size=12),
          axis.title=element_text(size=12))

# save plot
ggsave(plot=aplot, file="figures/age_dist.pdf", width=8, height=5, units="in")
ggsave(plot=aplot, file="figures/age_dist.jpg", width=8, height=5, units="in")


load("Figure3.RData")

pdf("Figure3.pdf", width=6, height=6)
  plot(x=as.numeric(xi), y=as.numeric(yi), main=ti, type="n", xlim=c(-1,1), ylim=c(7,13),
     xlab = "Intensity Contrast", ylab="Intensity Average")
  text(x=as.numeric(xi), y=as.numeric(yi), as.character(vi), cex=0.4, col=pal[as.character(vi)])
  text(x=contj, y=avgj, texti, cex=0.8)
  coveredj = texti == "13"
  points(x=contj[coveredj], y=avgj[coveredj], pch=19, col="red", cex=1.6)
dev.off()