# 3. faza: Vizualizacija podatkov

#1 Število nazivov igralca tedna po zveznih državah
stevilo_nazivov_zvezne = c(0,0,45,0,44+27+71+23,41,0,0,31,57+17,32,0,0,44,23,0,0,0,17,0,0,43,
                               29,26,0,0,0,0,0,0,0,0,36+36,26,0,59,61,33,37,0,0,0,9,30+56+61,47,0,0,0,0,26,0)
nazivi_zvezne <- statepop
#Dodal bom nov stolpec s številom nazivov
nazivi_zvezne$Nazivi <- stevilo_nazivov_zvezne

graf_zda <- plot_usmap(data = nazivi_zvezne, values = "Nazivi", lines = "black") +
  scale_fill_continuous(name = "Število", label = scales::comma) +
  theme(legend.position = "right") + ggtitle("Število nazivov igralca tedna po zveznih državah v sezonah 1984/85 do 2017/18")

#2 Uspešnost ekip v rednem delu VS Uspešnost ekip v Play-Offih
graf_korelacija_uspesn <- ggplot(data=podatki_ekipe_imensko, aes(x=podatki_ekipe_imensko$Uspesnost_redni_del, y=podatki_ekipe_imensko$Playoff_uspesnost)) +
  geom_jitter(size=(podatki_ekipe_imensko$Stevilo_playoffov)/1.8, shape=21, color="black", fill="dodgerblue4", alpha=0.7) + geom_smooth(method = "lm",size=0.6, alpha= 0.3, color= "dodgerblue2") +
  ggtitle("Korelacija deleža zmag v rednem delu in izločilnih bojih (Play-Offih)") + xlab("Uspešnost v rednem delu") + ylab("Uspešnost v Play-offih") +
  annotate("text", x = 0.63, y = 0.22, label = "Velikost kroga pomeni relativno število uvrstitev v izločilne boje", size=3) + theme_bw()

#3 Število osvojenih nazivov igralca tedna glede na število sezon v ligi (0 = sezona drafta)
graf_sezone <- ggplot(data=tabela_nazivi_po_letih, aes(x=Var1,y=Freq)) + geom_point(size=3, shape=16, color="dodgerblue4", alpha = 0.7) +
  geom_hline(yintercept=mean(tabela_nazivi_po_letih$Freq), color="gray30", size=0.6) + geom_smooth(method="loess", color="dodgerblue2", size=0.6, alpha = 0.3) +
  ggtitle("Število nazivov glede na število sezon v ligi") + xlab("Število sezon v ligi") + ylab("Število nazivov")+ theme_bw()
  annotate("text", x = 14, y = 145, label = "Število sezon pomeni število že zaključenih sezon pred trenutno", size = 3)

#4 Višina nagrajenih igralcev glede na pozicijo
igralci_tedna_pozicijefilt2 <- igralci_tedna[igralci_tedna$Pozicija != "G-F" & igralci_tedna$Pozicija != "F-C" & igralci_tedna$Pozicija != "F",]

graf_visina_pozicija <- ggplot(data=igralci_tedna_pozicijefilt2, aes(x=reorder(Pozicija,igralci_tedna_pozicijefilt2$Visina), y=Visina)) +
  geom_boxplot(alpha=I(0.7), fill="dodgerblue4", outlier.size = 0.3) + ggtitle("Višina nagrajenih košarkarjev glede na pozicijo igranja") +
  xlab("Pozicija igranja") + ylab("Višina igralcev") + theme_bw()

#5 Število osvojenih nazivov igralca tedna glede na pozicijo
#Prirejena tabela - izločeni pozicij G-F in F-C zaradi zelo majhnega števila igralcev:
igralci_tedna_pozicijefilt <- igralci_tedna[igralci_tedna$Pozicija != "G-F" & igralci_tedna$Pozicija != "F-C",]

graf_pozicije_cas <- ggplot(data=igralci_tedna_pozicijefilt, aes(x=igralci_tedna_pozicijefilt$Sezona_okrajsano)) +
  geom_histogram(binwidth=1.1, fill="dodgerblue4", alpha= 0.7) + facet_grid(~Pozicija) + theme_bw() +
  theme(axis.text.x = element_text(angle=90))  + ggtitle("Osvojeni nazivi igralca tedna glede na pozicijo igranja skozi čas") +
  xlab("Leto") + ylab("Število")

#6 --> analiza/analiza.r

#7 --> analiza/analiza.r

#8 Število zmag in število nazivov igralca tedna
podatki.join <- inner_join(x = podatki_ekipe_imensko, y= stevilo_nazivov, by = "Ekipa") # %>% select("Ekipa", "Stevilo", "Uspesnost_redni_del")
join_za_graf <- podatki.join %>% arrange(desc(Zmage_redni_del+Playoff_zmage))
graf_zmage_nazivi <- ggplot(data=join_za_graf, aes(x=reorder(Kratice,desc(Zmage_redni_del+Playoff_zmage)), y=Stevilo, fill=Zmage_redni_del+Playoff_zmage)) +
  theme(axis.text.x = element_text(angle=90)) + geom_col() + xlab("Ekipa") + ggtitle("Število zmag in število osvojenih nazivov igralca tedna po ekipah") +
  xlab("Ekipa") + ylab("Igralec tedna") + labs(fill="Zmage")


# Data Wrangling in R
# Coal Consumption Case Study

# Load the tidyverse
library(tidyverse)

# Read in the coal dataset
coal <- read_csv("http://594442.youcanlearnit.net/coal.csv")
glimpse(coal)

# Skip the first two lines
coal <- read_csv("http://594442.youcanlearnit.net/coal.csv", skip=2)
glimpse (coal)

# Rename the first column as region
colnames(coal)[1] <- "region"
summary(coal)

# Convert from a wide dataset to a long dataset using gather
coal_long <- gather(coal, 'year', 'coal_consumption', -region)
glimpse(coal_long)

# Convert years to integers
coal_long$year <- as.integer(coal_long$year)
summary(coal_long)

# Convert coal consumption to numeric
coal_long$coal_consumption <- as.numeric(coal_long$coal_consumption)
summary(coal_long)


# совемещаем три графика. Располагаем внизу совместную легенду.
library(ggpubr)
#ggarrange function

Regression_Profiles111824 <- ggarrange(Loess_profile11, Loess_profile18, Loess_profile24, labels = c("1", "2", "3"), ncol = 3, nrow = 1, common.legend = TRUE, legend = "bottom")


source("./Tools.r")

suppressMessages(suppressWarnings(InstallAndLoadLibraries()))

dataPath = "../../../data"
dataList = list.files(dataPath,full.names = TRUE)
gridDictSize = 2:12

for(dataPath in dataList){

  absoluteDataPath = paste0(getwd(), "/",dataPath)
  datasetName = basename(dataPath)
  observedClass = unlist(read.csv(paste0(dataPath,"/",datasetName,"_label.csv")))

  ## Segmentation step
  print(absoluteDataPath)
  segmentation(absoluteDataPath)

  ## dictionary and categorical sequence clustering steps

  bestARI = -Inf
  for(dictSize in gridDictSize){
    categoricalSequences = dictionaryConstructionAndRecoding(absoluteDataPath, dictSize)
    ARI = categoricalSequenceClusteringAndARI(categoricalSequences, observedClass)
    print(ARI)
    bestARI = max(ARI, bestARI)
  }

 print(paste0("ARI on dataset ",datasetName,":", bestARI))

}


x <- function(x)
{
  n<-length(x)
  mittelwert<-prod(x)^(1/n)
  return (mittelwert)
}


pdf_file<-"pdf/timeseries_spans.pdf"
cairo_pdf(bg="grey98", pdf_file,width=9,height=9)

par(omi=c(0.75,0.5,1,0.5),mai=c(0.5,1.25,0.5,0.1),mgp=c(4.5,1,0),family="Lato Light",las=1)

# Import data and prepare chart

library(gdata)
myData<-read.xls("myData/histat_studies.xlsx", encoding="latin1")
attach(myData)
n<-nrow(myData)
myColour<-rgb(240,24,24,30,maxColorValue=255)

# Define chart and other elements

plot(1:1,type="n",axes=F,xlab="Study start and end",ylab="number",xlim=c(min(from),max(to)),ylim=c(log10(min(number_timeseries)),log10(max(number_timeseries))))
axis(1,col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
axis(2,at=c(log10(10),log10(100),log10(1000),log10(10000),log10(50000)),labels=c("10","100","1.000","10.000","50.000"),col=par("bg"),col.ticks="grey81",lwd.ticks=0.5,tck=-0.025)
for (i in 1:n) segments(from[i],log10(number_timeseries)[i],to[i],log10(number_timeseries)[i],col=myColour,lwd=8)

# Titling

mtext("histat time series",3,line=2,adj=0,family="Lato Black",outer=T,cex=2)
mtext("Start, end, and number of time series per study, annual firgures",3,line=0,adj=0,cex=1.35,font=3,outer=T)
mtext("Source: gesis.org/histat",1,line=2,adj=1.0,cex=1.1,font=3,outer=T)
dev.off()


# Load Analysis toolbox
#
# Pär Johannesson, 15-Sep-2011, 22-May-2015, 17-Aug-2018
#
# ts2tp           Time signal to Turning Points (optional rainflow filter)
# tp2arfc4p       Calculates asymmetric rainflow cycles from turning points (4-point)
# tp2rfc          Calculates  rainflow cycles from turning points (incl. residual)

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

# =============================================================
# ts2tp           Time signal to Turning Points (optionally rainflow filtered).
#
# CALL:  [y] <- rfcfilter(x,h,def);
#
# Input:
#   x   = Signal.   [nx1] OR [nx2]
#   h   = Threshold for rainflow filter.
#   def = 0: removes cycles with range < h. (default)
#         1: removes cycles with range <= h. (default only if h=0)
# Output:
#   y   = Rainflow filtered signal.
#
# Examples:  # 1. Filtered signal y is the turning points of x.
#      tmp<-read.table(datafil,header=FALSE,stringsAsFactors=FALSE,fill=TRUE)
#      y <- ts2tp(x);
#            # 2. This removes all rainflow cycles with range less than 0.5.
#      y <- ts2tp(x,0.5);
#

ts2tp <- function(x,h=0,def=0)
{

  if(h==0) {
    def <- 1
  }

  # Initiation

  if(is.data.frame(x)) {
    x <- as.matrix(x)                        #  Convert to matrix
  }

  if(is.matrix(x)) {
    n <- nrow(x)                        #  Number of turning points
  }
  else if(is.numeric(x)) {
    n <- length(x)                                  #  Number of turning points
    x <- matrix(c(1:n,x),n,2)
  }
  else {
    #ERROR
  }

  Ind <- rep(0,n)

  j <- 0
  t0 <- 1
  y0 <- x[1,2]
  z0 <- 0
  Ind[1] <- 1

  tmin <- 1
  ymin <- y0
  tmax <- 1
  ymax <- y0

  # The rainflow filter

  for(k in 2:n) {
    fpk <- y0+h
    fmk <- y0-h
    tk <- k
    xk <- x[k,2]

    if(z0 == 0) {
      if(xk>ymax) {tmax <- tk; ymax <- xk }
      if(xk<ymin) {tmin <- tk; ymin <- xk }
      if(def == 0) {
        test <- (ymax-ymin>=h)
      }
      else { # def == 1
        test <- (ymax-ymin>h)
      }

      if(test) {
        if(tmin<tmax) {
          t0 <- tmin; y0 <- tmin
          z1 <- +1; t1 <- tmax; y1 <- ymax
        }
        else {
          t0 <- tmax; y0 <- ymax
          z1 <- -1; t1 <- tmin; y1 <- ymin
        }
      }
      else {
        z1 <- 0; t1 <- tk; y1 <- xk
      }
    }
    else { # z0 != 0
      # Which definition?
      if(def == 0) {
        test1 <- (((z0==+1) & (xk<=fmk)) | ((z0==-1) & (xk<fpk)))
        test2 <- (((z0==+1) & (xk>fmk))  | ((z0==-1) & (xk>=fpk)))
      }
      else { # def == 1
        test1 <- (((z0==+1) & (xk<fmk))  | ((z0==-1) & (xk<=fpk)))
        test2 <- (((z0==+1) & (xk>=fmk)) | ((z0==-1) & (xk>fpk)))
      }

      # Update z1
      if(test1)       { z1 <- -1 }
      else if(test2)  { z1 <- +1 }
      else            {  } # warning(['Something wrong, i=' num2str(i)]);

      # Update y1
      if(z1 != z0) {
        t1 <- tk
        y1 <- xk
      }
      else if(z1 == -1) {
        # % y1 = min([y0 xi]);
        if(y0 < xk) {
          t1 <- t0
          y1 <- y0
        }
        else {
          t1 <- tk
          y1 <- xk
        }
      }
      else if(z1 == +1) {
        # % y1 = max([y0 xi]);
        if(y0 > xk) {
          t1 <- t0
          y1 <- y0
        }
        else {
          t1 <- tk
          y1 <- xk
        }
      }
    }

    # Update y if y0 is a turning point
    #if(abs(z0-z1) == 2) {
    if(abs(z0-z1) > 0) {
      j <- j+1
      Ind[j] <- t0
    }

    # Update t0, y0, z0
    t0 <- t1
    y0 <- y1
    z0 <- z1
  }

  # Update y if last y0 is greater than (or equal) threshold
  if(z0 == 0) { # All ranges below threshold
    j <- 1  # return the first value
  }
  else {
    if(def == 0)  { test <- (abs(y0-x[Ind[j],2]) >= h) }
    else          { test <- (abs(y0-x[Ind[j],2]) > h) } # def == 1
    if(test) {
      j <- j+1
      Ind[j] <- t0
    }
  }
  # Truncate Ind
  Ind <- Ind[1:j]
  y <- matrix(x[Ind,],ncol=2)

  #res <- list(y=y,Ind=Ind)
  y
}
# END: ts2tp
# =============================================================

# =============================================================
# tp2arfc4p        Calculates asymmetric rainflow cycles from turning points (4-point)
#function [ARFC,res] = tp2arfc4p(x,res0,def_time)
#%TP2ARFC4P Calculates asymmetric rainflow cycles from turning points (4-point).
#%
#% CALL:  [ARFC,res] = tp2arfc4p(tp)
#%        [ARFC,res] = tp2arfc4p(tp,res0,def_time)
#%
#% Output:
#% ARFC  = Asymmetric RFC (without residual).       [N,2]/[N,4]
#% res   = Residual.                               [nres,1]/[nres,2]
#%
#% Input:
#% tp       = Turning points.                         [T,1]/[T,2]
#% res0     = Residual.                               [nres0,1]/[nres0,1]
#% def_time = 0: Don't store time of max and min. (default)
#%            1: Store the time when the maxima and minima occured.
#%
#% Calculates the rainflow cycles for the sequence of turning points,
#% by using the so-called 4-point algorithm.
#%
#% Calculate ARFC for turning points, starting from old residual 'res0'
#%   [ARFC,res] = tp2arfc4p(tp,res0)
#%
#% This routine doesn't use MEX, Fortran or C codes, only matlab code.
#%
#% Example:
#%   x = load('sea.dat'); tp=dat2tp(x);
#%   [ARFC,res]=tp2arfc4p(tp);      % Default (min-to-Max cycles in residual)
#%   ccplot(ARFC), res
#%

tp2arfc4p <- function(tp)
{
  if(is.matrix(tp)) { tp <- tp[,2] }

  T <- length(tp)                   #  Number of turrning points
  RFC <- matrix(NaN,floor(T/2),2)   # Rainflow cycles
  N <- 0                            # Number of counted cycles

  res <- tp   # Residual
  nres <- 0   # Number of points in residual

  # Calculate ARFC and res
  for(k in 1:T) {
    nres <- nres+1
    res[nres] <- tp[k]
    cycleFound <- TRUE
    while(cycleFound & nres >=4) {
      A <- sort(res[(nres-2):(nres-1)])
      B <- sort(res[c((nres-3),nres)])
      if(A[1]>=B[1] & A[2]<=B[2]) {
        N <- N+1
        RFC[N,] <- res[(nres-2):(nres-1)]
        res[nres-2] <- res[nres]
        nres <- nres-2
      }
      else  {
        cycleFound <- FALSE
      }
    }
  }

  # Counted rainflow cycles & Residual

  #RFC <- RFC[1:N,]
  #if(N==0)    { RFC <- NULL } else  {RFC <- matrix(RFC[1:N,],ncol=2) }
  #if(nres==0) { res <- NULL } else  {res <- res[1:nres]}
  RFC <- matrix(RFC[1:N,],ncol=2)
  res <- res[1:nres]

  out <- list(RFC=RFC, res=res)

}
# END: tp2rfc4p
#=============================================================

#=============================================================
# tp2rfc          Calculates  rainflow cycles from turning points (incl. residual)
tp2rfc <- function(tp) { # Calculate ARFC0 and res

  R <- tp2arfc4p(tp)

  res2 <- ts2tp(c(R$res,R$res))  # TP of double residual
  Rres <- tp2arfc4p(res2)

  if(is.na(R$RFC[1,1]))    { n <- 0 }    else  { n <- nrow(R$RFC) }
  if(is.na(Rres$RFC[1,1])) { nres <- 0 } else  { nres = nrow(Rres$RFC) }
  if(n+nres==0)       {RFC <- R$RFC}  else { RFC <- matrix(ncol=2, nrow=n+nres) }
  if(n!=0)            { RFC[1:n,] <- R$RFC }
  if(nres!=0)         { RFC[(n+1):(n+nres),] <- Rres$RFC }

  RFC
}
# END: tp2rfc
#=============================================================

#=============================================================
# Extract ranges from rainflow cycles
rfc2ls <- function(RFC, new=FALSE, log="x", title="Load spectrum", xlab="Cumulative number of cycles", ylab="Load range",N=1)
{

  rfc.rang<-data.frame("S"=sort(abs(RFC[,2]-RFC[,1]),decreasing=TRUE), "n"=rep(1,times=length(RFC[,1])))
  rfc.rang<-rbind(rfc.rang,c(0,N))
  #  rfc.rang<-rbind(rfc.rang,c(N,0))
  if (new)
    lines((cumsum(rfc.rang$n)),sort(rfc.rang$S,decreasing=TRUE),type="S",lwd=2,col="red")
  else
  {
    plot(cumsum(rfc.rang$n),sort(rfc.rang$S,decreasing=TRUE), type="S", log=log, lwd=2, col="blue",
         main=title, xlab=xlab, ylab=ylab)
    grid()
  }

  return(rfc.rang)
}
# END: rfc2ls
#=============================================================

#=============================================================
#Find level crossings from rain flow cycles
rfc2lc <- function(RFC, n=200, new=FALSE, log="x", title="Level crossings", xlab="Number of up-crossings", ylab="Load level")
{

  rfc<-RFC

  for (i in 1:length(RFC[,1]))
    rfc[i,]<-sort(RFC[i,])

  levels<-seq(min(rfc[,1]),max(rfc[,2]),len=n)

  lc<-numeric()
  for (j in 1:n)
    lc[j]<-sum((rfc[,2]>levels[j] )& (rfc[,1]<=levels[j]))
  if(new)
    #lines(levels,lc,type="S",lwd=2,col="red")
    lines(lc,levels,type="S",lwd=2, col="red")
  else
  {
    #plot(levels,lc,type="S",lwd=2,ylab="up-crossings",main=title,col="blue")
    plot(lc,  levels, type="S", log=log, lwd=2, col="blue", main=title, xlab="Number of up-crossings", ylab="Load level")
    grid()
  }

  data.frame("S"=levels, "Nup"=lc)
}


Summary <- CustomSummary(df, "rt", c("ProbType", "Condition"))
ggplot(df, aes(x = ProbType, y = rt, color = Condition, group = Condition)) +
    # The line below places the point geoms on the plot which represent the mean value for each condition.
    # Position_dodge determines how far apart different groups within the same category are positioned on the plot. At 0 they are on top of each other and they get progressively further apart as the value increases
    stat_summary(geom="point", fun = mean, size = 3.5, position=position_dodge(width = 0.45)) +
    # geom_errorbar creates errorbars around the 95% confidence intervals defined by Summary.
    geom_errorbar(data=Summary, aes(ymin = rt-ci, ymax = rt+ci), size= 0.75, width=0.25, position=position_dodge(width = 0.45)) +
    scale_color_brewer(palette="Dark2", name="Condition", breaks=c("Descriptive", "Experiential"), labels=c("Descriptive", "Experiential")) +
    scale_x_discrete(name = "Problem Type", labels = c("Mixed Domain", "Risky Risk", "Single Domain")) +
    labs(title = "Differences in Reaction Time by Problem Type and Condition",
       subtitle = "",
       x =NULL,
       y ="Reaction Time (in seconds)",
       caption = "p > 0.05: N.S. \np < 0.05: * \np < 0.01: ** \np < 0.001: ***") +
    coord_cartesian(ylim=c(0.00, 2.00)) +
    theme_classic() +
    theme(plot.title = element_text(face="bold", size=13, hjust = 0.5)) +
    theme(plot.subtitle = element_text(size = 10, hjust = 0.5, face = "italic")) +
    theme(plot.caption = element_text(size = 8, hjust = 0.0, face = "italic")) +
    theme(axis.title = element_text(size = 12)) +
    theme(axis.text.x = element_text(size = 14, color = "Black")) +
    theme(axis.text.y = element_text(size = 14, color = "Black"))
rm(Summary,CustomSummary,aov)


# Install Packages  --------------------------------------------------------------------------------
# install.packages('caTools')
# install.packages('ggplot2')
# install.packages("ggthemes") # Install
# install.packages('plotly')
# install.packages('reshape')
# install.packages("reshape2")
# Load library  ------------------------------------------------------------------------------------
library(caTools)
library(ggplot2)
library(ggthemes) # Load
library(reshape)
library(quantmod)                                                               # Load quantmod
library(tidyquant)                                                              # Loads tidyquant, tidyverse, lubridate, quantmod, TTR, and xts
library(TTR)
# Max and Min Price for Each Quarter  --------------------------------------------------------------
SPL_max_by_qtr <- SPL %>%                                                       # Max for Each Quarter
  tq_transmute(select     = adjusted,
               mutate_fun = apply.quarterly,
               FUN        = max,
               col_rename = "max.close") %>%
  mutate(year.qtr = paste0(year(date), "-Q", quarter(date))) %>%
  select(-date)
SPL_max_by_qtr
# --------------------------------------------------------------------------------------------------
SPL_min_by_qtr <- SPL %>%                                                       # Min for Each Quarter
  tq_transmute(select     = adjusted,
               mutate_fun = apply.quarterly,
               FUN        = min,
               col_rename = "min.close") %>%
  mutate(year.qtr = paste0(year(date), "-Q", quarter(date))) %>%
  select(-date)
SPL_min_by_qtr
# --------------------------------------------------------------------------------------------------
SPL_by_qtr <- left_join(SPL_max_by_qtr, SPL_min_by_qtr,                         # Left Join Min/Max By Quarter
                        by = c("year.qtr" = "year.qtr"))
SPL_by_qtr
# Chart  -------------------------------------------------------------------------------------------
SPL_by_qtr %>%
ggplot(aes(x = year.qtr,  color = "SPL")) +                                     # ggplot
  geom_segment(aes( xend = year.qtr,y = min.close, yend = max.close),
               size = 1) +
  geom_point(aes(y = max.close), size = 2) +
  geom_point(aes(y = min.close), size = 2) +
  theme(plot.background = element_rect(fill = "white")) +
  theme(panel.background = element_rect(fill = 'grey')) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_y_continuous(labels = scales::dollar) +
  scale_color_economist() +
  ggtitle("SPL: Min/Max Price By Quarter")
# redacted ggplot code------------------------------------------------------------------------------
  # labs(title = "SPL: Min/Max Price By Quarter",
  #     y = "Stock Price", color = "") +
  # theme_tq() +
  # theme(panel.background = element_rect(fill = 'green') +
  # theme_tq_green() + scale_color_tq(theme = "green") + scale_fill_tq(theme = "green")  +   #Theme:Green
  # scale_color_tq()  +
  # theme_economist() +
  # theme(axis.title.x = element_text(face="bold", colour="#990000", size=20),
  #     axis.text.x  = element_text(angle=45, vjust=0.5, size=16))


data <- read.csv("summary.csv")
data <- na.omit(data)

names <- c("One Point", "Counter-based", "Zero-lengths", "Map of ones",
           "Counter-based w/ shuffle", "Zero-lengths w/ shuffle",
           "Map of ones w/shuffle")

short_names <- c("OP", "CB", "ZL", "MoO", "CB w/s", "ZL w/s", "MoO w/s")

pdf("boxplot.pdf")
boxplot(data[1:7], names=short_names, ylab="Best fitness at the last generation")
points(jitter(rep(1, 50), amount=0.1), data$noshuffle_cross0, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(2, 50), amount=0.1), data$noshuffle_cross1, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(3, 50), amount=0.1), data$noshuffle_cross2, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(4, 50), amount=0.1), data$noshuffle_cross3, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(5, 50), amount=0.1), data$shuffle_cross1, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(6, 50), amount=0.1), data$shuffle_cross2, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(7, 50), amount=0.1), data$shuffle_cross3, pch=20, col=rgb(0,0,0,0.2))
dev.off()

pdf("histogram.pdf")
colors = c("chocolate", "cornflowerblue", "darkseagreen",
           "goldenrod", "lightblue", "indianred", "mediumpurple")
par("mfcol"=c(2, 2))
breaks = c(floor(min(data)):ceiling(max(data)))
if (length(breaks) > 80) {
    breaks = seq(from=5*floor(min(data)/5), to=5*ceiling(max(data)/5), by=5)
}
if (length(breaks) < 4) {
    breaks = seq(from=floor(min(data)), to=ceiling(max(data)), by=0.5)
}
for (i in 1:7) {
    hist(data[[i]],
         col = colors[i],
         main = names[i],
         xlab="Fitness",
         xlim=c(floor(min(data)),ceiling( max(data))),
         breaks=breaks)
}
par("mfcol"=c(1, 1))
dev.off()

r <- matrix(rep(0, 49), nrow=7, ncol=7)
for (i in 1:7) {
    for (j in 1:7) {
        x <- data[[i]]
        y <- data[[j]]
        r[i,j] <- wilcox.test(x, y)$p.value
    }
}

expanded_names <- append(c(""), short_names)
write.table(r, "pvalues.csv", sep=",",
            col.names=short_names,
            row.names=FALSE)


library(ggplot2)
library(extrafont)
library(sysfonts)
library(showtext)

loadfonts(device = "win")
# add the Arial font
font_add("Arial", regular = "arial.ttf", bold = "arialbd.ttf", italic = "ariali.ttf", bolditalic = "arialbi.ttf")

# function to plot CCM results
plot_ccm_result = function(ccm_result_data, variable, species){
    # AgeDiversity/Abundance xmap fishing mortality
    subdata = subset(ccm_result_data, subset = ccm_result_data$library == variable)
    max_lag = max(abs(subdata$tar.lag))

    plot(x = -max_lag:0, y = subdata$rho, type = 'l', col = 'blue', ylim = c(-0.5,1), xaxt = 'n',
         xlab = expression(paste('Cross map lag (', italic('l'), ')')), main = species,
         ylab = expression(paste('Correlation coefficient ( ', rho, ' )')))
    axis(1, at = seq(-max_lag, 0, 1))
    segments(-max_lag:0, subdata[, 'rho'] - subdata[, 'sd.rho'],
             -max_lag:0, subdata[, 'rho'] + subdata[, 'sd.rho'], col = 'blue')
    segments(-max_lag:0 - 0.1, subdata[, 'rho'] - subdata[, 'sd.rho'],
             -max_lag:0 + 0.1, subdata[, 'rho'] - subdata[, 'sd.rho'], col = 'blue')
    segments(-max_lag:0 - 0.1, subdata[, 'rho'] + subdata[, 'sd.rho'],
             -max_lag:0 + 0.1, subdata[, 'rho'] + subdata[, 'sd.rho'], col = 'blue')
    abline(h = 0)
    legend(x = -max_lag, y = 0.98, legend = paste0(variable, ' xmap fishingM'), text.col = c('blue'))
}

# ggplot function to plot CCM results
gplot_ccm_result = function(species_list){
    # AgeDiversity/Abundance xmap fishing mortality
    data = species_list$ccm
    data[data$kendall.tau >= 0.1 | data$significance >= 0.1, c('rho')] = NA
    var_order = c('AgeDiversity', 'Abundance')
    data$library = factor(data$library, levels=var_order)
    species = species_list$species

    ggplot(aes(x = tar.lag, y = rho, color=library), data = data) +
        geom_hline(aes(yintercept = 0), linetype = 'dashed', color = 'black') +
        geom_point(size = 5) +
        geom_segment(aes(x=tar.lag-0.1, y=rho+sd.rho, xend=tar.lag+0.1, yend=rho+sd.rho), size=1) +
        geom_segment(aes(x=tar.lag-0.1, y=rho-sd.rho, xend=tar.lag+0.1, yend=rho-sd.rho), size=1) +
        geom_segment(aes(x=tar.lag, y=rho-sd.rho, xend=tar.lag, yend=rho+sd.rho), size=1) +
        theme(panel.grid.major = element_blank(),
              panel.grid.minor = element_blank(),
              panel.background = element_blank(),
              panel.border = element_rect(size = 1.1),
              axis.line = element_line(color = 'black'),
              axis.title = element_text(color = 'black', size = 16),
              axis.text = element_text(color = 'black', size = 14),
              plot.title = element_text(hjust = 0.5, vjust = 3, size = 18, face = 'bold.italic'),
              legend.position = c(0.025, 0.9),
              legend.background = element_blank(),
              legend.title = element_blank(),
              legend.text = element_text(size = 14),
              legend.justification = c(0, 0)) +
        scale_y_continuous(limits = c(-1, 1.2)) +
        scale_color_manual(labels = paste0(var_order, ' xmap F'), values = c('red', 'green')) +
        labs(x = 'Lag of fishing mortality', y = expression(rho), title = species)
}

# plot S-map coefficients
plotSmapCoeff = function(
    smap_result_list,
    species,
    colors,
    shapes,
    mode="series")
{
    # extract lags for each variable
    data_for_smap = smap_result_list$data
    library_var = names(data_for_smap)[1]

    target_vars = names(data_for_smap)[-1]
    num_na = colSums(is.na(data_for_smap))
    lag_of_var = as.numeric(num_na[target_vars])

    # coefficients of S-map model without library variable and constant
    data_of_coeff = smap_result_list$coefficients
    N = nrow(na.omit(data_of_coeff))
    data_of_coeff = data_of_coeff[target_vars]

    rho = round(smap_result_list$rho, 2)

    # sort data according to customized order of variables
    order_var = variables[sort(match(names(data_of_coeff), variables))]
    lag_of_var = lag_of_var[order(match(names(data_of_coeff), order_var))]
    data_of_coeff = data_of_coeff[, order_var, drop = FALSE]

    ntime = dim(data_of_coeff)[1]
    nvar = dim(data_of_coeff)[2]
    coeff.melt = cbind(date = rep(1:ntime, nvar), melt(data_of_coeff))

    whichvar = match(names(data_of_coeff), variables)
    cl = rep(colors[whichvar], each = ntime)
    sh = rep(shapes[whichvar], each = ntime)

    if (mode == "series"){
        return(smap_timeseries_plot(data=coeff.melt,
                                    lib_var=library_var,
                                    cl=cl,
                                    sh=sh,
                                    species=species,
                                    rho=rho,
                                    N=N))
    } else if (mode == "box"){
        return(smap_boxplot(data=coeff.melt,
                            lib_var=library_var,
                            cl=cl,
                            sh=sh,
                            n_var=length(unique(colors)),
                            species=species,
                            rho=rho,
                            N=N))
    } else {
        stop("mode must be either 'series' or 'box'")
    }
}

# plot time series
smap_timeseries_plot = function(data, lib_var, cl, sh, species, rho, N){
    max_value = max(abs(data$value), na.rm = TRUE)
    scaleFUN = function(x){sprintf("%.2f", x)}

    smaptime =
        ggplot(data=data, aes(x=date, y=value, shape=variable, color=variable, fill=variable)) +
        geom_point(size=4) +
        geom_line(size=1) +
        geom_hline(yintercept=0, linetype='dashed') +
        theme(plot.title = element_text(hjust = 0.5, size = 24),
              axis.title = element_text(size = 22, face = "bold"),
              axis.text = element_text(size = 20, colour = "black"),
              panel.border = element_rect(size = 1.1, fill = NA, colour = 'black'),
              panel.background = element_blank(),
              panel.grid.major = element_blank(),
              panel.grid.minor = element_blank(),
              aspect.ratio = 0.8,
              legend.position = "none",
              text = element_text(family='Arial')) +
        labs(x = 'Time', y = 'S-map coefficients') +
        ggtitle(bquote(paste(italic(.(species)), ", ", rho, " = ", .(rho), " ",
                             italic("N"), " = ", .(N)))) +
        scale_y_continuous(labels=scaleFUN, limits=c(-max_value, max_value)) +
        scale_shape_manual(values=unique(sh)) +
        scale_color_manual(values=unique(cl)) +
        scale_fill_manual(values=unique(cl))

    return(smaptime)
}

# legend for time series plot
smap_timeseries_legend = function(lib_var, colors, shapes){
    data = data.frame(cbind(colors, shapes))
    data$x = 0
    data$y = 0
    data$variable = factor(c(1:dim(data)[1]))

    legend_labels = paste0(variables, " effect on ", lib_var)

    smaptime =
        ggplot(data=data, aes(x=x, y=y, shape=variable, color=variable, fill=variable)) +
        geom_point(size=4) +
        geom_line() +
        theme_bw() +
        theme(legend.background = element_blank(),
              legend.text = element_text(size = 16),
              legend.key.size = unit(1, 'cm')) +
        scale_shape_manual(labels=legend_labels, values=shapes) +
        scale_color_manual(labels=legend_labels, values=colors) +
        scale_fill_manual(labels=legend_labels, values=colors)

    return(smaptime)
}

# plot box plot
smap_boxplot = function(data, lib_var, cl, sh, n_var, species, rho, N){
    max_value = max(abs(data$value), na.rm = TRUE)
    tar_vars = levels(data$variable)
    if (length(grep("SST", tar_vars)) > 0){
        limits = c("AgeDiversity", "Abundance", "AMO", "SST", "CVofSST")
    } else {
        limits = c("AgeDiversity", "Abundance", "AMO", "SBT", "CVofSBT")
    }
    print(limits)
    print(tar_vars)
    n = length(unique(data$variable))
    scaleFUN = function(x){sprintf("%.2f", x)}

    smapbox =
        ggplot(data=data, aes(x=variable, y=value)) +
        geom_boxplot(aes(color=variable), na.rm=T, lwd=1, width=0.6, outlier.shape=NA) +
        geom_point(aes(color=variable)) +
        geom_hline(yintercept=0, linetype='dashed') +
        theme(plot.title = element_text(hjust = 0.5, size = 24),
              axis.title = element_text(size = 22, face = 'bold'),
              axis.title.x = element_blank(),
              axis.text = element_text(size = 20, colour = 'black'),
              panel.border = element_rect(size = 1.1, fill = NA, colour = 'black'),
              panel.background = element_blank(),
              panel.grid.major = element_blank(),
              panel.grid.minor = element_blank(),
              aspect.ratio = 1.1,
              legend.position = "none",
              text = element_text(family='Arial')) +
        labs(y = 'S-map coefficients') +
        ggtitle(bquote(paste(italic(.(species)), ", ", rho, " = ", .(rho), " ",
                             italic("N"), " = ", .(N)))) +
        scale_y_continuous(labels=scaleFUN, limits=c(-max_value, max_value)) +
        coord_cartesian(xlim = c(1, 5)) +
        scale_x_discrete(breaks=tar_vars, labels=tar_vars, limits=limits) +
        scale_color_manual(values=unique(cl))
    return(smapbox)
}

# legend for box plot
smap_boxplot_legend = function(lib_var, colors){
    data = data.frame(colors)
    data$y = 0
    data$variable = factor(c(1:dim(data)[1]))

    legend_labels = paste0(variables, " effect on ", lib_var)

    smapbox =
        ggplot(data=data, aes(x=variable, y=y, color=variable)) +
        geom_boxplot(na.rm=T, lwd=1) +
        theme_bw() +
        theme(legend.background = element_blank(),
              legend.text = element_text(size = 16),
              legend.key.size = unit(1, 'cm')) +
        scale_color_manual(labels=legend_labels, values=colors)

    return(smapbox)
}


library(tidyverse)
library(ggpubr)
library(rstatix)

# Eickhoff = '/cubric/data/c1639425/Monkey_Brains/results_df/proportion_eickhoff_streamline_corrected_bst_subic_ncc_ant_thal_extglobpal_df'
# geschwind = /cubric/data/c1639425/Monkey_Brains/results_df/proportion_gschwind_bst_ncc_subic_antthal_globpal_df
# Eichoff cols = Subjects,subic_bst,subic_ant_thal,subic_ncc,subic_ext_glob_pal
#geschwind cols = Subjects,bst_subic,subic_ant_thal,ncc_subic,subic_ext_glob_pal
df_wide = read_csv('/cubric/data/c1639425/Monkey_Brains/results_df/proportion_gschwind_bst_ncc_subic_antthal_globpal_df')

df_wide = df_wide %>%
  select(Subjects,bst_subic,subic_ant_thal,ncc_subic,subic_ext_glob_pal)

print(df_wide)

df <- df_wide %>%
  gather(key = "ROI", value = "proportion",bst_subic,subic_ant_thal,ncc_subic,subic_ext_glob_pal) %>%
  convert_as_factor(Subjects, ROI)
print(df)

sumstats <- df %>%
  group_by(ROI) %>%
  get_summary_stats(proportion, type = "mean_sd")
print(sumstats)

bxp <- ggboxplot(df, x = "ROI", y = "proportion", add = "point")
bxp

# Test for outliers
outliers <- df %>%
  group_by(ROI) %>%
  identify_outliers(proportion)
print(outliers)

# Replace outliers, easier to do this in the wide Df

# Remove completely
# df_outliers_rm <- df_wide %>% filter(subic_ext_glob_pal < 0.0204)

df_outliers_rm <- df_wide %>% mutate(subic_ext_glob_pal=replace(subic_ext_glob_pal, subic_ext_glob_pal>0.03, NA))

print(df_outliers_rm)

df <- df_outliers_rm %>%
  gather(key = "ROI", value = "proportion",bst_subic,subic_ant_thal,ncc_subic,subic_ext_glob_pal ) %>%
  convert_as_factor(Subjects, ROI)
print(df)

bxp <- ggboxplot(df, x = "ROI", y = "proportion", add = "point")
bxp

sumstats <- df %>%
  group_by(ROI) %>%
  get_summary_stats(proportion, type = "mean_sd")
print(sumstats)

# Check normal dist
normal <- df %>%
  group_by(ROI) %>%
  shapiro_test(proportion)
print(normal)

res.aov <- anova_test(data = df, dv = proportion, wid = Subjects, within = ROI)
get_anova_table(res.aov)

# pairwise comparisons
pwc <- df %>%
  pairwise_t_test(
    proportion ~ ROI, paired = TRUE,
    p.adjust.method = "fdr"
    )

pwc

Probabilistic/Run Stats on Results Geschwind.r


library(ggplot2)
theme_set(theme_bw(18))
setwd("~/Dropbox/sinking_marbles/sinking-marbles/models/_results/")
source("rscripts/helpers.r")

load("../varied_alternatives/results/data/hmbasic2.gprior.RData")
load("../complex_prior/results/data/hmbasic2.cprior.RData")
load("data/all_empirical.RData")
summary(all)
head(hmbasic2.gprior)
all$ModelPredictionMeanPrior = hmbasic2.gprior[as.character(round(all$Prior/100,2)),]$PosteriorProbability
all$ModelPredictionPropPrior = hmbasic2.cprior[paste(all$Prior.0,all$Prior.1,all$Prior.2,all$Prior.3),]$PosteriorProbability
head(all)

ggplot(all, aes(x=ModelPredictionMeanPrior,y=ModelPredictionPropPrior)) +
  geom_point()
ggsave("graphs/compared_modelpredictions.pdf")

agr = aggregate(normresponse ~ ModelPredictionMeanPrior + ModelPredictionPropPrior, data=all, FUN=mean)
agr$CILow = aggregate(normresponse ~ ModelPredictionMeanPrior + ModelPredictionPropPrior, data=all, FUN=ci.low)$normresponse
agr$CIHigh = aggregate(normresponse ~ ModelPredictionMeanPrior + ModelPredictionPropPrior, data=all,FUN=ci.high)$normresponse
agr$YMin = agr$normresponse - agr$CILow
agr$YMax = agr$normresponse + agr$CIHigh

ggplot(agr, aes(x=ModelPredictionMeanPrior,y=normresponse)) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  geom_abline(intercept=0,slope=1)
ggsave("graphs/empirical-vs-meanprior.pdf")

ggplot(agr, aes(x=ModelPredictionPropPrior,y=normresponse)) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  geom_abline(intercept=0,slope=1)
ggsave("graphs/empirical-vs-propprior.pdf")

cor(agr$normresponse,agr$ModelPredictionPropPrior) # .50
cor(agr$normresponse,agr$ModelPredictionMeanPrior) # .55


####EDITS MADE: Brandi deleted following text from title of plot \n(axes switched)#############

require(NADA)

##### Plot K-M Curves: ###############################################################################################
K_M <- cenfit(obs=ParamData$new_Result_Value, censored=ParamData$nonDetect_Flag)

KM_data <- summary(K_M)

if (ncol(KM_data) > 3) {
  plot(x=1:10, y=1:10, xlim=c(0,1), ylim=ylimits, type="n", xlab="", ylab=ParamList[i], log="y",
       xaxs="i", yaxs="i", main="\nEmpirical Distribution \nFunction (EDF)", las=2, cex.axis=0.8, xaxt="n")
  axis(side=1, at=c(0, 0.2, 0.4, 0.6, 0.8, 1), labels=c(0, 20, 40, 60, 80, 100))
  mtext(text="Percent Below", side=1, at=0.5, line=2, cex=0.8)

  ##abline(v=0.5, col="lightgreen")
  lines(x=KM_data[, "prob"], y=KM_data[, "obs"], type="s", lty="solid", col="black", lwd=1)

  ymax <- par("usr")[4]
  ymin <- par("usr")[3]
  ymin_legend <- 10^(ymax + 0.01*(ymax-ymin))
  ymax_legend <- 10^(ymax + 0.12*(ymax-ymin))

  legend(x=c(0.8,1.1), y=c(ymin_legend, ymax_legend), legend=c("All Data"),
            lty=c("solid"),
            col=c("black"), xpd=NA, cex=0.8, bty="o", bg="white")
} else {
  plot(x=c(1:10), y=c(1:10), type="n", xaxt="n", yaxt="n", xlab="", ylab="", bty="n")
  text(x=5,y=5,"Not Plotted\n(Too few detects)")

}


# - Preprocess the Data ----
prep = data[1:8]
str(prep)
missing = prep %>% mice::mice(m=5,maxit=50,meth="sample",seed=500,print = FALSE)
missing <- mice::complete(missing, action=as.numeric(2))
prep = na.omit(missing)
prep = prep %>% outlieR::impute(flag = NULL, fill = "mean",
                                level = 0.1, nmax = NULL,
                                side = NULL, crit = "lof",
                                k = 5, metric = "euclidean", q = 3)
preProClean <- preProcess(x = prep, method = c("scale", "center"))
prep <- predict(preProClean, prep %>% na.omit)
print(str(prep))
write.csv(prep,"data/preprocessed_data.csv")


context("credible gradient")

test_that("Test Input Errors", {
  set.seed(1)
  n<-200 ## generate from clustered, skewed, data distribution
  d <- data.frame(y = rnorm(n), x = rnorm(n))
  d$y[1:30] <- 0

  set.seed(1)

  N = 200
  x<-seq(1,10*pi, length.out = N) # confounder
  y<-rnorm(n = length(x), sin(.5*x), .07*x )
  d <- data.frame(x=x, y=y)
  d$x <- as.numeric(scale(d$x))
  d$y <- as.numeric(scale(d$y))

  d_test = data.frame(x=seq(max(d$x), max(d$x+1 ), .01 ))

  res = fDPMix(d_train = d, d_test = d_test, formula = y ~ x,
               iter=100, burnin=50, tau_x = c(.01, .001) )

  plot(d$x,d$y, pch=20, xlim=c(min(d$x), max(d$x)+1 ), col='gray')

  expect_error( credible_gradient(d$x, 'character') )
  expect_error( credible_gradient(d$x, res$train, col_gradient = 1) )
  expect_error( credible_gradient(d$x, res$train, col_mean_line = 1) )
  expect_error( credible_gradient(d$x[1:5], res$train) )
})


# step0. pre-defined parameters and functions
args <- commandArgs(T)
lambda <- as.numeric(args[1])
dataFN <- args[2]
outFN <- args[3]

# step1. read data and limit the maximum
data <- read.table(dataFN, sep = '\t', header = F, skip = 2)
firstRow <- read.table(dataFN, sep = '\t', header = F, nrows = 2)

# step2. balance
data_balanced_k9 <- data[,1]*lambda

# set bins without signal to -1
data_balanced_k9[data_balanced_k9<0] <- -1

# merge into one data frame
data_balanced <- as.data.frame(cbind(as.character(round(data_balanced_k9,5)),as.character(data[,2])))
colnames(data_balanced) <- c('V1','V2')
data_balanced <- rbind(firstRow, data_balanced)

# write to file
write.table(data_balanced, file = outFN, sep = '\t', quote = F, row.names = F, col.names = F)


library(dplyr)
library(broom)
library(ggplot2)
library(AICcmodavg)
library(ggstatsplot)
library(httpgd)

formant.data <- read.csv("/Users/sarah/Git/eesti_regilaul_corpus/formants/formants.csv", header = TRUE, colClasses = c("factor","factor","factor","factor","factor","numeric","numeric","numeric","factor")) # nolint
summary(formant.data)

ictus_vowels <- filter(formant.data, position == "ictus")
off_vowels <- filter(formant.data, position == "off")

means_ick <- ictus_vowels %>%
  group_by(segment_id) %>%
  summarise(F1 = mean(F1),
            F2 = mean(F2)) %>%
print(n = 11)

means_off <- off_vowels %>%
  group_by(segment_id) %>%
  summarise(F1 = mean(F1),
            F2 = mean(F2)) %>%
print(n = 11)

ggplot(ictus_vowels, aes(x = F2, y = F1, color = segment_id, label = segment_id)) + # nolint
geom_point() +
geom_label(data = means_ick) +
scale_x_reverse() + scale_y_reverse() +
  guides(color = "none") +
theme_classic()

ggplot(off_vowels, aes(x = F2, y = F1, color = segment_id, label = segment_id)) + # nolint
geom_point() +
geom_label(data = means_off) +
scale_x_reverse() + scale_y_reverse() +
  guides(color = "none") +
theme_classic()

first_vowels <- filter(formant.data, syllable == "1")
second_vowels <- filter(formant.data, syllable == "2")

means_stress <- first_vowels %>%
  group_by(segment_id) %>%
  summarise(F1 = mean(F1),
            F2 = mean(F2)) %>%
print(n = 11)

means_weak <- second_vowels %>%
  group_by(segment_id) %>%
  summarise(F1 = mean(F1),
            F2 = mean(F2)) %>%
print(n = 11)

ggplot(first_vowels, aes(x = F2, y = F1, color = segment_id, label = segment_id)) + # nolint
geom_point() +
geom_label(data = means_stress) +
scale_x_reverse() + scale_y_reverse() +
  guides(color = "none") +
theme_classic()

ggplot(second_vowels, aes(x = F2, y = F1, color = segment_id, label = segment_id)) + # nolint
geom_point() +
geom_label(data = means_weak) +
scale_x_reverse() + scale_y_reverse() +
  guides(color = "none") +
theme_classic()


#' bdist - Extra Distributions for Bayesian Analysis
#'
#' This package includes statistical functions I have found useful.
#' You are welcome to use it, but you do so at your own risk.
#'
#' @name bdist
#' @docType package
#'
#' @importFrom graphics abline lines mtext par plot
#' @importFrom stats density dnorm dt pgamma pnorm pt
#'             rchisq rexp rgamma rnorm rt runif
NULL


library(tidyverse)
library(rstan)
library(bayesplot)
library(tidybayes)
library(bayestestR)
library(viridis)
library(patchwork)
library(scico)
options(mc.cores = parallel::detectCores())

source('grid.r')

data.fix <- read.csv('../data/test/KKTest1_BlankFixations_report.csv',
                     header=TRUE) %>%
    filter(CURRENT_FIX_INDEX > 1) %>%
    mutate(CURRENT_FIX_X = CURRENT_FIX_X - 1920/2,
           CURRENT_FIX_Y = CURRENT_FIX_Y - 1080/2) %>%
    group_by(TRIAL_INDEX) %>%
    mutate(PREV_FIX_X = lag(CURRENT_FIX_X),
           PREV_FIX_Y = lag(CURRENT_FIX_Y)) %>%
    ungroup()

## generate fake subjects/conditions
data.groups <- data.frame(TRIAL_INDEX=unique(data.fix$TRIAL_INDEX),
                          PAR=as.factor(c(2, 1, 1, 2, 1, 2,
                                          2, 1, 1, 1, 2, 2,
                                          2, 1, 2, 1, 2, 1)),
                          COND=as.factor(c(1, 1, 1, 3, 2, 1,
                                           2, 1, 3, 2, 1, 2,
                                           3, 3, 3, 2, 2, 3)))

data.fix <- data.fix %>% mutate(PAR=data.groups$PAR[TRIAL_INDEX],
                                COND=data.groups$COND[TRIAL_INDEX])

data.fix %>%
    ggplot(aes(x=CURRENT_FIX_X, y=CURRENT_FIX_Y, color=as.factor(PAR))) +
    geom_point(size=.75, show.legend=FALSE) +
    coord_fixed(xlim=c(-450, 550), ylim=c(-200, 300)) +
    ggtitle('Raw Data (by participant)') + xlab('X') + ylab('Y') +
    facet_grid(COND ~ PAR, labeller=label_both) +
    theme_classic()
ggsave('plots/raw_data.png', width=5, height=4)

data.fix %>%
    ggplot(aes(x=CURRENT_FIX_X, y=CURRENT_FIX_Y, color=as.factor(PAR))) +
    geom_point(size=.75, show.legend=FALSE) +
    coord_fixed(xlim=c(-450, 550), ylim=c(-200, 300)) +
    ggtitle('Raw Data (group)') + xlab('X') + ylab('Y') +
    facet_grid(COND ~ ., labeller=label_both) +
    theme_classic()
ggsave('plots/raw_data_group.png', width=5, height=4)

## Bin fixations into hexagons
data.grid <- data.fix %>%
    grid.hex(xmin=-450, xmax=550, xsize=50,
             ymin=-150, ymax=300)

data.hex <- data.fix %>%
    group_by(COND, PAR, TRIAL_INDEX) %>%
    bin.hex(xmin=-450, xmax=550, xsize=50,
            ymin=-150, ymax=300)

plot.data.par <- data.hex %>%
    unnest(c(vi, vx, vy)) %>%
    ggplot(aes(x=vx, y=vy, group=grid_idx, fill=count, color=count)) +
    geom_polygon(size=0.3) + coord_fixed() +
    ggtitle('Raw Data (by participant)') + xlab('X') + ylab('Y') +
    scale_color_viridis(option='magma', name='Count', limits=c(0, NA)) +
    scale_fill_viridis(option='magma', name='Count', limits=c(0, NA)) +
    facet_grid(COND ~ PAR, labeller=label_both) +
    theme_classic()
plot.data.par
ggsave('plots/raw_data_hex.png', width=5, height=4)

plot.data.group <- data.hex %>%
    group_by(COND, bin_x, bin_y, grid_idx, vi, vx, vy) %>%
    summarize(count=mean(count)) %>%
    unnest(c(vi, vx, vy)) %>%
    ggplot(aes(x=vx, y=vy, group=grid_idx, fill=count, color=count)) +
    geom_polygon(size=0.3) + coord_fixed() +
    ggtitle('Raw Data (group)') + xlab('X') + ylab('Y') +
    scale_color_viridis(option='magma', name='Count', limits=c(0, NA)) +
    scale_fill_viridis(option='magma', name='Count', limits=c(0, NA)) +
    facet_grid(COND ~ ., labeller=label_both) +
    theme_classic()
plot.data.group
ggsave('plots/raw_data_group_hex.png', width=5, height=4)

data.stan <- list(N=nrow(data.hex),
                  G=max(data.hex$grid_idx),
                  P=length(unique(data.hex$PAR)),
                  D=2,  ## 2 dimensions (X, Y)
                  C=length(levels(data.hex$COND)),
                  g=data.hex$grid_idx,
                  p=as.integer(data.hex$PAR),
                  c=as.integer(data.hex$COND),
                  grid=select(data.grid, bin_x, bin_y),
                  y=data.hex$count)
str(data.stan)

## Sample the GP prior
gp.prior <- readRDS('gp-prior.rds')
gp.prior <- stan(file='gp-prior.stan', data=data.stan, algorithm='Fixed_param', iter=1000, warmup=0)
saveRDS(gp.prior, 'gp-prior.rds')

## Fit & sample the model posterior
gp.fit <- readRDS('gp.rds')
gp.fit <- stan(file='gp.stan', data=data.stan)
saveRDS(gp.fit, 'gp.rds')

print(gp.prior, prob=c(0.025, 0.5, 0.975),
      pars=c('prior_a', 'prior_rho', 'prior_rho_tilde',
             'prior_alpha', 'prior_alpha_tilde'))
print(gp.fit, prob=c(0.025, 0.5, 0.975),
      pars=c('a', 'rho', 'rho_tilde', 'alpha', 'alpha_tilde', 'lp__'))

plot(gp.prior, pars=c('prior_rho', 'prior_rho_tilde'))
plot(gp.prior, pars=c('prior_alpha', 'prior_alpha_tilde'))
plot(gp.fit, pars=c('rho', 'rho_tilde'))
plot(gp.fit, pars=c('alpha', 'alpha_tilde'))

## extract model fits for each trial
draws.trial <- full_join(spread_draws(gp.prior, prior_lambda[.row]),
                         spread_draws(gp.fit, lambda[.row])) %>%
    bind_cols(., data.hex[.$.row, c('PAR', 'COND', 'grid_idx', 'TRIAL_INDEX',
                                    'bin_x', 'bin_y', 'vi', 'vx', 'vy', 'count')])

## extract group-level model fits for each condition
draws.group <- full_join(spread_draws(gp.prior, prior_a, prior_f[COND, grid_idx]),
                         spread_draws(gp.fit, a, f[COND, grid_idx])) %>%
    mutate(prior_lambda=prior_a+prior_f,
           lambda=a+f,
           BF=1/bayesfactor_pointull(f, prior_f)$BF) %>%
    mutate(BF=max(1/max(.draw), min(1-1/max(.draw), BF))) %>%   ## round BFs to make logs finite
    bind_cols(., data.grid[.$grid_idx, c('bin_x', 'bin_y', 'vi', 'vx', 'vy')])

draws.trial %>%
    group_by(PAR, COND, grid_idx, vx, vy) %>%
    median_hdci(lambda) %>%
    unnest(c(vx, vy)) %>%
    ggplot() + ggtitle('GP Fit (participant-level)') +
    aes(x=vx, y=vy, group=grid_idx) + xlab('X') + ylab('Y') +
    geom_polygon(aes(fill=exp(lambda), color=exp(lambda)), size=0.3) +
    facet_grid(COND ~ PAR, labeller=label_both) +
    scale_fill_viridis(option='magma', name='Rate', limits=c(0, NA)) +
    scale_color_viridis(option='magma', name='Rate', limits=c(0, NA)) +
    theme_classic() + coord_fixed()
ggsave('plots/gp_par.png', width=5, height=4)

draws.trial %>%
    group_by(PAR, COND, grid_idx, vx, vy) %>%
    median_hdci(prior_lambda) %>%
    unnest(c(vx, vy)) %>%
    ggplot() + ggtitle('GP Prior (participant-level)') +
    aes(x=vx, y=vy, group=grid_idx) + xlab('X') + ylab('Y') +
    geom_polygon(aes(fill=exp(prior_lambda), color=exp(prior_lambda)), size=0.3) +
    facet_grid(COND ~ PAR, labeller=label_both) +
    scale_fill_viridis(option='magma', name='Rate', limits=c(0, NA)) +
    scale_color_viridis(option='magma', name='Rate', limits=c(0, NA)) +
    theme_classic() + coord_fixed()
ggsave('plots/gp_par_prior.png', width=5, height=4)

draws.group %>%
    group_by(COND, grid_idx, vx, vy) %>%
    median_hdci(lambda) %>%
    unnest(c(vx, vy)) %>%
    ggplot() + ggtitle('GP Fit') +
    aes(x=vx, y=vy, group=grid_idx) + xlab('X') + ylab('Y') +
    facet_grid(COND ~ ., labeller=label_both) +
    geom_polygon(aes(fill=exp(lambda), color=exp(lambda)), size=0.3) +
    scale_fill_viridis(option='magma', name='Rate', limits=c(0, NA)) +
    scale_color_viridis(option='magma', name='Rate', limits=c(0, NA)) +
    theme_classic() + coord_fixed()
ggsave('plots/gp_fit.png', width=5, height=4)

draws.group %>%
    group_by(COND, grid_idx, vx, vy) %>%
    median_hdci(prior_lambda) %>%
    unnest(c(vx, vy)) %>%
    ggplot() + ggtitle('GP Prior') +
    aes(x=vx, y=vy, group=grid_idx) + xlab('X') + ylab('Y') +
    facet_grid(COND ~ ., labeller=label_both) +
    geom_polygon(aes(fill=exp(prior_lambda), color=exp(prior_lambda)), size=0.3) +
    scale_fill_viridis(option='magma', name='Rate', limits=c(0, NA)) +
    scale_color_viridis(option='magma', name='Rate', limits=c(0, NA)) +
    theme_classic() + coord_fixed()
ggsave('plots/gp_fit_prior.png', width=5, height=4)

draws.group$BF %>% log10 %>% summary
bf.breaks <- seq(-4, 4, 1)
draws.group %>%
    group_by(COND, grid_idx, vx, vy) %>%
    median_hdci(f, BF) %>%
    unnest(c(vx, vy)) %>%
    ggplot() + ggtitle('GP Bayes Factors') +
    aes(x=vx, y=vy, group=grid_idx) + xlab('X') + ylab('Y') +
    facet_grid(COND ~ ., labeller=label_both) +
    geom_polygon(aes(fill=log10(BF), color=log10(BF)), size=0.3) +
    scale_fill_scico(palette='vik', direction=-1,
                     limits=range(bf.breaks), breaks=bf.breaks,
                     labels=10^bf.breaks, name='BF_null') +
    scale_color_scico(palette='vik', direction=-1,
                      limits=range(bf.breaks), breaks=bf.breaks,
                      labels=10^bf.breaks, name='BF_null') +
    theme_classic() + coord_fixed()
ggsave('plots/gp_fit_bf.png', width=5, height=4)

draws.group %>%
    group_by(COND, grid_idx, vx, vy) %>%
    median_hdci(f, BF) %>%
    unnest(c(vx, vy)) %>%
    filter((BF < .1 | BF > 10) & (f.lower > 0 | f.upper < 0)) %>%
    ggplot() + ggtitle('GP Bayes Factors (significant pixels)') +
    aes(x=vx, y=vy, group=grid_idx) + xlab('X') + ylab('Y') +
    facet_grid(COND ~ ., labeller=label_both) +
    geom_polygon(aes(fill=log10(BF), color=log10(BF)), size=0.3) +
    scale_fill_scico(palette='vik', direction=-1,
                     limits=range(bf.breaks), breaks=bf.breaks,
                     labels=10^bf.breaks, name='BF_null') +
    scale_color_scico(palette='vik', direction=-1,
                      limits=range(bf.breaks), breaks=bf.breaks,
                      labels=10^bf.breaks, name='BF_null') +
    theme_classic() +
    coord_fixed(xlim=range(draws.group$vx), ylim=range(draws.group$vy))
ggsave('plots/gp_fit_bf_sig.png', width=5, height=4)

draws.group %>%
    group_by(COND, grid_idx, vx, vy) %>%
    median_hdci(f, lambda) %>%
    filter(f.lower > 0 | f.upper < 0) %>%
    unnest(c(vx, vy)) %>%
    ggplot() + ggtitle('GP Fit (significant pixels)') +
    aes(x=vx, y=vy, group=grid_idx) + xlab('X') + ylab('Y') +
    facet_grid(COND ~ ., labeller=label_both) +
    geom_polygon(aes(fill=exp(lambda), color=exp(lambda)), size=0.3) +
    scale_fill_viridis(option='magma', name='Rate', limits=c(0, NA)) +
    scale_color_viridis(option='magma', name='Rate', limits=c(0, NA)) +
    theme_classic() +
    coord_fixed(xlim=range(draws.group$vx), ylim=range(draws.group$vy))
ggsave('plots/gp_fit_sig.png', width=5, height=4)

## Group-level contrasts
contr.group <- draws.group %>%
    group_by(COND, grid_idx, bin_x, bin_y, vx, vy) %>%
    compare_levels(lambda, by=COND, comparison='control') %>%
    left_join(draws.group %>%
              group_by(COND, grid_idx, bin_x, bin_y, vx, vy) %>%
              compare_levels(prior_lambda, by=COND, comparison='control')) %>%
    group_by(COND, grid_idx, bin_x, bin_y, vx, vy) %>%
    mutate(BF=1/bayesfactor_pointull(lambda, prior_lambda)$BF) %>%
    mutate(BF=max(1/max(.draw), min(1-1/max(.draw), BF)))   ## round BFs to make logs finite

# get ranges of contrasts and BFs
contr.group %>% median_hdci %>% pull(lambda) %>% range
contr.group %>% median_hdci %>% pull(prior_lambda) %>% range
contr.group %>% median_hdci %>% pull(BF) %>% log10 %>% range

contr.group %>%
    median_hdci() %>%
    unnest(c(vx, vy)) %>%
    ggplot(aes(x=vx, y=vy, group=grid_idx, fill=lambda, color=lambda)) +
    facet_grid(COND ~ .) +
    ggtitle('Group-level Fixation Rate Contrasts') +
    geom_polygon(size=0.3) + xlab('X') + ylab('Y') +
    scale_fill_scico(palette='vik', limits=c(-6.1, 6.1), name='Rate') +
    scale_color_scico(palette='vik', limits=c(-6.1, 6.1), name='Rate') +
    theme_classic() + coord_fixed()
ggsave('plots/gp_contrast.png', width=5, height=4)

contr.group %>%
    median_hdci() %>%
    unnest(c(vx, vy)) %>%
    ggplot(aes(x=vx, y=vy, group=grid_idx, fill=prior_lambda, color=prior_lambda)) +
    facet_grid(COND ~ .) +
    ggtitle('Group-level Prior Fixation Rate Contrasts') +
    geom_polygon(size=0.3) + xlab('X') + ylab('Y') +
    scale_fill_scico(palette='vik', limits=c(-.05, .05), name='Rate') +
    scale_color_scico(palette='vik', limits=c(-.05, .05), name='Rate') +
    theme_classic() + coord_fixed()
ggsave('plots/gp_contrast_prior.png', width=5, height=4)

contr.group %>% median_hdci() %>%
    unnest(c(vx, vy)) %>%
    ggplot(aes(x=vx, y=vy, group=grid_idx, fill=log10(BF), color=log10(BF))) +
    facet_grid(COND ~ .) + xlab('X') + ylab('Y') +
    ggtitle('Group-level Fixation Rate Contrast BFs') +
    geom_polygon(size=0.3) +
    scale_fill_scico(palette='vik', direction=-1,
                     limits=range(bf.breaks), breaks=bf.breaks,
                     labels=10^bf.breaks, name='BF_null') +
    scale_color_scico(palette='vik', direction=-1,
                     limits=range(bf.breaks), breaks=bf.breaks,
                     labels=10^bf.breaks, name='BF_null') +
    theme_classic() + coord_fixed()
ggsave('plots/gp_contrast_bf.png', width=5, height=4)

contr.group %>% median_hdci() %>%
    filter((BF < .1 | BF > 10) & (lambda.upper < 0 | lambda.lower > 0)) %>%
    unnest(c(vx, vy)) %>%
    ggplot(aes(x=vx, y=vy, group=grid_idx, fill=log10(BF), color=log10(BF))) +
    facet_grid(COND ~ .) + xlab('X') + ylab('Y') +
    ggtitle('Group-level Fixation Rate Contrast BFs\n(significant pixels)') +
    geom_polygon(size=0.3) +
    scale_fill_scico(palette='vik', direction=-1,
                     limits=range(bf.breaks), breaks=bf.breaks,
                     labels=10^bf.breaks, name='BF_null') +
    scale_color_scico(palette='vik', direction=-1,
                     limits=range(bf.breaks), breaks=bf.breaks,
                     labels=10^bf.breaks, name='BF_null') +
    theme_classic() +
    coord_fixed(xlim=range(contr.group$vx), ylim=range(contr.group$vy))
ggsave('plots/gp_contrast_bf_sig.png', width=5, height=4)

contr.group %>%
    median_hdci() %>%
    filter((BF < .1 | BF > 10) & (lambda.upper < 0 | lambda.lower > 0)) %>%
    unnest(c(vx, vy)) %>%
    ggplot(aes(x=vx, y=vy, group=grid_idx, fill=lambda, color=lambda)) +
    facet_grid(COND ~ .) + xlab('X') + ylab('Y') +
    ggtitle('Group-level Fixation Rate Contrasts\n(significant pixels)') +
    geom_polygon(size=0.3) +
    scale_fill_scico(palette='vik', limits=c(-6.1, 6.1), name='Rate') +
    scale_color_scico(palette='vik', limits=c(-6.1, 6.1), name='Rate') +
    theme_classic() +
    coord_fixed(xlim=range(contr.group$vx), ylim=range(contr.group$vy))
ggsave('plots/gp_contrast_sig.png', width=5, height=4)


#Place your bets - Blackjack
house <- c(20, 15, 21, 20, 20, 17, 19)
player <- c(14, 17, 20, 21, 20, 18, 14)

#subsetting the third score of the player
player_third <- player[3]
print(player_third)

#player's scores where he won. Score of the player should be greater than the score of the house.
winning_scores <- player[player>house]
print(winning_scores)

#poor scores. Scores less than 18
n_low_score <- sum(player < 18)
print(n_low_score)


setwd('/home/pc-752828/Dev/results-search-master/outputs-ecp')

library(ggplot2)
library(dplyr)
library(extrafont)
library(dplyr)
library('EnvStats')
library("tikzDevice")
library(survJamda)

data <- read.csv(file = 'output-ecp-norm.csv', sep = ',', header = T)
data_new <- data
value <- function(x, name) {
  #mym = median(x)
  mysd = sd(x)
  mym = mean(x)

  #mysd = geoSD(x, na.rm = FALSE, sqrt.unbiased = TRUE)
  mysqrt = sqrt(length(x))
  #Q1 <- quantile(x, probs = 0.25)
  #Q2 <- quantile(x, probs = 0.50)
  #Q3 <- quantile(x, probs = 0.75)

  mym =  geoMean(x, na.rm = FALSE)
  #print(mym)
  #print(exp(mean(log(x))))
  #mym = mean(log(x))
  #mysd = geoSD(x, na.rm = FALSE, sqrt.unbiased = TRUE)
  mysd <- ci.gm(x)
  return(c(mn = mym, sd = mysd, bo = name))
}

data_f<-data.frame(data_new[data_new['bo'] == 'bo1',])
bo1 <- aggregate(x = data_f$best,
                 by = list(data_f$ite),
                 FUN = function(x) return(value(x, 'BO-6rnd-EIdef')))
bo1 <- as.data.frame(as.list(bo1))

data_f<-data.frame(data_new[data_new['bo'] == 'bo5',])
bo2 <- aggregate(x = data_f$best,
                 by = list(data_f$ite),
                 FUN = function(x) return(value(x, 'BO-6rnd-EInova')))
bo2 <- as.data.frame(as.list(bo2))

data_f<-data.frame(data_new[data_new['bo'] == 'rs',])
bo3 <- aggregate(x = data_f$best,
                 by = list(data_f$ite),
                 FUN = function(x) return(value(x, 'Ranking Search')))
bo3 <- as.data.frame(as.list(bo3))

data_f<-data.frame(data_new[data_new['bo'] == 'bo4',])
bo4 <- aggregate(x = data_f$best,
                 by = list(data_f$ite),
                 FUN = function(x) return(value(x, 'PB3Opt')))
bo4 <- as.data.frame(as.list(bo4))

data_f<-data.frame(data_new[data_new['bo'] == 'bo3',])
bo5 <- aggregate(x = data_f$best,
                 by = list(data_f$ite),
                 FUN = function(x) return(value(x, 'BO-6sel-EIdef')))
bo5 <- as.data.frame(as.list(bo5))

df <- rbind(bo5, bo4, bo3)

df <- rbind(bo1, bo5, bo2, bo5, bo4, bo3)

df$x.mn = as.numeric(as.character(df$x.mn))
df$Group.1 = as.numeric(as.character(df$Group.1))
df$x.sd1 = as.numeric(as.character(df$x.sd1))
df$x.sd2 = as.numeric(as.character(df$x.sd2))
df$x.sd = as.numeric(as.character(df$x.sd))
df_new <- df
df_new <- df[df['Group.1'] >= 6,]

df_new

ggplot(data=df_new, aes(x=Group.1, y=x.mn, group=x.bo)) +
  #geom_errorbar(aes(ymin=x.sd1, ymax=x.sd2,color=x.bo), width=0.2, size=.3) +
  geom_errorbar(aes(ymin=x.mn-1.96*x.sd, ymax=x.mn+1.96*x.sd,color=x.bo), width=0.2, size=.3) +
  geom_line(aes(color=x.bo), size=1) +
  geom_vline(xintercept=6, linetype="dashed", size=1)+
  #coord_cartesian(ylim=c(1,10), xlim=c(1,30))+
  labs(color = element_blank(), x="Iteração", y="Média do Melhor Custo Normalizado")+
  theme(legend.justification=c(1, 1),legend.position=c(.8, .9),legend.title=element_blank())+
  theme(panel.background = element_rect(fill = 'white', colour = 'gray'),
        panel.grid.major = element_line(color = 'light gray'),
        panel.grid.minor = element_line(color = 'light gray'),
        axis.title.y=element_blank(),
        axis.text.y = element_text(size=8))+
  scale_x_continuous(breaks = seq(1, 30, 1))

p2<-ggplot(data=df_new, aes(x=Group.1, y=x.mn, group=x.bo)) +
  geom_errorbar(aes(ymin=x.sd1, ymax=x.sd2,color=x.bo), width=0.2, size=.3) +
  geom_line(aes(color=x.bo), size=1) +
  geom_vline(xintercept=6, linetype="dashed", size=1)+
  coord_cartesian(ylim=c(1,10), xlim=c(1,30))+
  labs(color = element_blank(), x="Iteração", y="Média do Melhor Custo Normalizado")+
  theme(legend.justification=c(1, 1),legend.position=c(.9, .9),legend.title=element_blank())+
  theme(panel.background = element_rect(fill = 'white', colour = 'gray'),
        panel.grid.major = element_line(color = 'light gray'),
        panel.grid.minor = element_line(color = 'light gray'),
        axis.title.y=element_blank(),
        axis.text.y = element_text(size=8))+
  scale_x_continuous(breaks = seq(1, 30, 1))+
  ggtitle('b) Zoom da Figura a')

p1<-ggplot(data=df_new, aes(x=Group.1, y=x.mn, group=x.bo)) +
  geom_errorbar(aes(ymin=x.sd1, ymax=x.sd2,color=x.bo), width=0.2, size=.3) +
  geom_line(aes(color=x.bo), size=1) +
  geom_vline(xintercept=6, linetype="dashed", size=1)+
  labs(color = element_blank(), x="Iteração", y="Média do Melhor Custo Normalizado")+
  theme(legend.justification=c(1, 1),legend.position=c(.9, .9),legend.title=element_blank())+
  theme(panel.background = element_rect(fill = 'white', colour = 'gray'),
        panel.grid.major = element_line(color = 'light gray'),
        panel.grid.minor = element_line(color = 'light gray'),
        axis.title.y=element_blank(),
        axis.text.y = element_text(size=8),
        legend.background = element_rect(fill=alpha('white', 0.6)))+
  ggtitle('a) Melhor Custo Encontrado')+
  scale_x_continuous(breaks = seq(1, 30, 1))

tikz('fig5.tex')
grid.arrange(p1, p2, nrow = 2, ncol=1, top="", left="Média do Melhor Custo Normalizado")
dev.off()

cols <- c("BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search", "ID")
colnames(df) <- cols
df$ID = as.character(df$ID)
df$ID <- factor(df$ID)
cols <- c("BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search")
new_df <- melt(df, id = c("ID"), measured = cols)

ggplot(new_df, aes(x = value, y= variable,  add = "jitter"))+
  geom_boxplot(alpha=0.7, colour = "black", fill="gray")+
  stat_summary(fun=mean, geom="point", shape=20, size=2, color="red", fill="red") +
  theme(legend.position="none")+
  theme(panel.background = element_rect(fill = 'white', colour = 'gray'),
        panel.grid.major = element_line(color = 'light gray'),
        panel.grid.minor = element_line(color = 'light gray'),
        axis.title.y=element_blank(),
        axis.text.y = element_text(size=8))+
  ggtitle('a) Boxplot do Melhor Custo Encontrado')+
  labs(color = element_blank(), x="Custo Normalizado", y="Frequência")

setwd('/home/pc-752828/Dev/results-search-master/outputs-normal')

data <- read.csv(file = 'output-n-norm.csv', sep = ',', header = T)

data <- read.csv(file = 'output-ecp-norm.csv', sep = ',', header = T)
data_norm <- data

get_df <- function(seed, data) {
  my_ite <- 10
  bo1 <- list()
  bo2 <- list()
  bo3 <- list()
  bo4 <- list()
  rs <- list()
  app <- list()
  seed_l <- list()

  for(i in levels(factor(data$name))) {
    r_bo1 <- data[data['name'] == i & data['bo'] == 'bo1' & data['ite'] == my_ite,][seed,]
    r_bo4 <- data[data['name'] == i & data['bo'] == 'bo4' & data['ite'] == my_ite,][seed,]
    r_bo3 <- data[data['name'] == i & data['bo'] == 'bo3' & data['ite'] == my_ite,][seed,]
    r_bo2 <- data[data['name'] == i & data['bo'] == 'bo5' & data['ite'] == my_ite,][seed,]
    r_rs <- data[data['name'] == i & data['bo'] == 'rs' & data['ite'] == my_ite,][seed,]
    bo1 <- append(bo1, levels(factor(r_bo1$best)))
    bo2 <- append(bo2, levels(factor(r_bo2$best)))
    bo3 <- append(bo3, levels(factor(r_bo3$best)))
    bo4 <- append(bo4, levels(factor(r_bo4$best)))
    rs <- append(rs, levels(factor(r_rs$best)))
    app <- append(app, i)
    seed_l <- append(seed_l, seed)
  }

  df <- cbind(bo1, bo2, bo3, bo4, rs, app)
  df <- data.frame(df)
  df$bo1 = as.numeric(as.character(df$bo1))
  df$bo2 = as.numeric(as.character(df$bo2))
  df$bo3 = as.numeric(as.character(df$bo3))
  df$bo4 = as.numeric(as.character(df$bo4))
  df$rs = as.numeric(as.character(df$rs))

  return(df)
}

df_1 <- get_df(1, data_norm)
df_2 <- get_df(2, data_norm)
df_3 <- get_df(3, data_norm)
df_4 <- get_df(4, data_norm)
df_5 <- get_df(5, data_norm)

df_5

df_norm <- rbind(df_1, df_2, df_3, df_4, df_5)

df <- df_norm

df

summary(df$bo1)
summary(df$bo2)
summary(df$bo3)
summary(df$bo4)
summary(df$rs)

ks.test(df_2$bo1, "pnorm")
ks.test(df_2$bo2, "pnorm")
ks.test(df_2$bo3, "pnorm")
ks.test(df_2$bo4, "pnorm")
ks.test(df_2$rs, "pnorm")

df <- df_5

cols <- c("BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search", "ID")
colnames(df) <- cols
df$ID = as.character(df$ID)
df$ID <- factor(df$ID)
cols <- c("BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search")
new_df <- melt(df, id = c("ID"), measured = cols)
glimpse(new_df)
friedman.test(value ~ variable | ID, data = new_df)
colnames(new_df) <- c("ID", "Abordagem", "Best")
frdAllPairsSiegelTest (new_df$Best, new_df$Abordagem, new_df$ID, p.adjust = "bonferroni")
frdAllPairsConoverTest(new_df$Best, new_df$Abordagem, new_df$ID, p.adjust = "bonferroni")
frdAllPairsNemenyiTest(new_df$Best, new_df$Abordagem, new_df$ID, p.adjust = "bonferroni")

cols <- c("BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search",
          "BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search",
          "BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search",
          "BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search")

cols <- c("<= 1","<= 1","<= 1","<= 1","<= 1",
          "<= 1,2","<= 1,2","<= 1,2","<= 1,2","<= 1,2",
          "<= 1,5","<= 1,5","<= 1,5","<= 1,5","<= 1,5",
          "<= 2","<= 2","<= 2","<= 2","<= 2")

list_id <- cols
list_id2 <- cols
list_value <- list(
  length(which(df$`BO-6rnd-EIdef`==1))/length(df$PB3Opt)*100,
  length(which(df$`BO-6rnd-EInova`==1))/length(df$PB3Opt)*100,
  length(which(df$`BO-6sel-EIdef`==1))/length(df$PB3Opt)*100,
  length(which(df$PB3Opt==1))/length(df$PB3Opt)*100,
  length(which(df$`Ranking Search`==1))/length(df$PB3Opt)*100,
  length(which(df$`BO-6rnd-EIdef`<=1.2))/length(df$PB3Opt)*100,
  length(which(df$`BO-6rnd-EInova`<=1.2))/length(df$PB3Opt)*100,
  length(which(df$`BO-6sel-EIdef`<=1.2))/length(df$PB3Opt)*100,
  length(which(df$PB3Opt<=1.2))/length(df$PB3Opt)*100,
  length(which(df$`Ranking Search`<=1.2))/length(df$PB3Opt)*100,
  length(which(df$`BO-6rnd-EIdef`<=1.5))/length(df$PB3Opt)*100,
  length(which(df$`BO-6rnd-EInova`<=1.5))/length(df$PB3Opt)*100,
  length(which(df$`BO-6sel-EIdef`<=1.5))/length(df$PB3Opt)*100,
  length(which(df$PB3Opt<=1.5))/length(df$PB3Opt)*100,
  length(which(df$`Ranking Search`<=2))/length(df$PB3Opt)*100,
  length(which(df$`BO-6rnd-EIdef`<=2))/length(df$PB3Opt)*100,
  length(which(df$`BO-6rnd-EInova`<=2))/length(df$PB3Opt)*100,
  length(which(df$`BO-6sel-EIdef`<=2))/length(df$PB3Opt)*100,
  length(which(df$PB3Opt<=2))/length(df$PB3Opt)*100,
  length(which(df$`Ranking Search`<=2))/length(df$PB3Opt)*100
)

list_id

list_value

df

df <- cbind(list_id, list_value)
df <- data.frame(df)
df

df <- cbind(list_id2, df)
df <- data.frame(df)
df

df$list_id = as.character(df$list_id)
df$list_value = as.numeric(as.character(df$list_value))
df$list_id2 = as.character(df$list_id2)

glimpse(df)

tikz('bar0-sol.tex')

ggplot(df) +
  geom_bar( aes(x=list_id, y=list_value, fill = list_id2), stat="identity", alpha=0.7, position = "dodge")+
  labs(color = element_blank(), x="Abordagem", y="Frequência da Solução ()")+
  theme_bw()+
  theme(legend.justification=c(1, 1),legend.position=c(.15, .95))+
  theme(panel.background = element_rect(fill = 'white', colour = 'gray'),
        panel.grid.major = element_line(color = 'light gray'),
        panel.grid.minor = element_line(color = 'light gray'),
        #axis.title.y=element_blank(),
        axis.text.y = element_text(size=8))+
  guides(fill=guide_legend(title="Solução"))+
  scale_y_continuous(breaks=seq(0,100,10))

dev.off()

seq(0,100,5)

p1<-ggplot(new_df, aes(x = value, y= variable,  add = "jitter"))+
  geom_boxplot(alpha=0.7, colour = "black", fill="gray")+
  stat_summary(fun=mean, geom="point", shape=20, size=2, color="red", fill="red") +
  theme(legend.position="none")+
  theme(panel.background = element_rect(fill = 'white', colour = 'gray'),
        panel.grid.major = element_line(color = 'light gray'),
        panel.grid.minor = element_line(color = 'light gray'),
        axis.title.y=element_blank(),
        axis.text.y = element_text(size=8))+
  ggtitle('a) Boxplot do Melhor Custo Encontrado')+
  labs(color = element_blank(), x="Custo Normalizado", y="Frequência")

ylim1<- c(1, 500000)
p2<-p1 + coord_cartesian(xlim = ylim1) +
  ggtitle('b) Zoom da Figura a')

tikz('boxplot-test-cost.tex')
grid.arrange(p1, p2, nrow = 2, ncol=1, top="", left="Abordagem")
dev.off()


library(ggplot2)
source("date.r")
source("explore-data.r")

# Can we find houses that have been repeatedly bought and sold?

geo$ad <- paste(geo$street, geo$city, geo$zip)
dups <- tapply(seq_len(nrow(geo)), geo$ad , length)
table(dups)

# There are a total of 68,167 addresses that have been sold more than
# once, for a total of 441,546 sales.
dup_ads <- names(dups)[dups > 1]
multi <- geo[geo$ad %in% dup_ads, ]

# Seems like we should be able to use this to better model the changing
# prices.  But how?  Mixed effects model?


# odds and odds ratios

unadjusted.odds = function( .model, lc, not.factor ) {
    out = NULL
    model.formula = effects.labels( .model )

    for ( kf in  model.formula$effects ) {

      cat("\n")

      print (kf )

      single.factor.model = as.formula( paste(as.character(  eval(model.formula$dep)), "~",  as.character(eval(kf) )) )

      xtab.formula = as.formula( paste("~ ",  as.character(eval(kf) )) )

      indata = remove.na( lc, single.factor.model, not.factor )

      xtab = as.data.frame.table( xtabs(xtab.formula, data=indata) )
      xt = data.frame(Nlevel = t(t(as.vector(xtab$Freq))))
      xt$Level = paste(kf, xtab[,1], sep="")

      logistic.results = glm( single.factor.model, data=indata, family=binomial )

      res = logistic.display.local( logistic.results )

      res2 = merge(xt, res, by="Level", all=T, sort=F)
      res2 = res2[ order( res2$OddsRatio, na.last=F ) , ]

      res2$Covariate = kf
      res2$DepVariable = model.formula$dep

      out = rbind( out, res2)

      print (Anova(logistic.results) )
      cat("\n")

      print( res2 )
      cat("\n\n\n ------------------- \n")

    }
    return(out)

}


 a1<-read.table("A-gene.txt",header=F)
 b1<-read.table("A-mRNA.txt",header=F)
 c1<-read.table("A-STRING.txt",header=F)
 d1<-read.table("A-pearson.txt",header=F)

 a<-read.table("D-gene.txt",header=F)
 b<-read.table("D-mRNA.txt",header=F)
 c<-read.table("D-STRING.txt",header=F)
 d<-read.table("D-pearson.txt",header=F)

 n <- a-a1
 n1<- 0.1*n

 m <- b-b1
 m1<- 0.1*m

 p <- c-c1
 p1<- 0.1*p

 q <- d-d1
 q1<- 0.1*q

 i<-read.table("I.txt",header=F)

 n2 <- -1*n1
 m2 <- -1*m1
 p2 <- -1*p1
 q2 <- -1*q1

 n3 <- i+n2
 m3 <- i+m2
 p3 <- i+p2
 q3 <- i+q2

 n4 <- solve(n3)
 m4 <- solve(m3)
 p4 <- solve(p3)
 q4 <- solve(q3)

 y<-read.table("y.txt",header=F)
 y0<-as.matrix(y)

 ygene <- n4%*% y0
 ymRNA <- m4%*% y0
 ySTRING <- p4%*% y0
 ypearson <- q4%*% y0

 write.table(ygene,"y-gene.txt",quote=F,row.names=F,col.names=F)
 write.table(ymRNA,"y-mRNA.txt",quote=F,row.names=F,col.names=F)
 write.table(ySTRING,"y-STRING.txt",quote=F,row.names=F,col.names=F)
 write.table(ypearson,"y-pearson.txt",quote=F,row.names=F,col.names=F)


library(plm)
options(scipen=999)

Panel <- read.csv("C:/data/car/h1_variables.txt")

fixed <- plm(car_val ~ score + filelate + car_e_val + lnAsset
             + modified + gc + factor(year)
             , data=Panel, index=c("X10", "year")
             , effect = "twoway"
             , model="within")

summary(fixed)


#' Correlation Bubble plot.
#'
#' bubble function will draw bubble plot for correlation analysis.
#' @param data input data.frame
#' @param x x variable
#' @param y y variable
#' @param col.var color variable
#' @param size.var size variable
#' @param title main title
#' @param subtitle subtitle
#' @param xtitle x axis title
#' @param ytitle y axis title
#' @param caption caption
#' @return An object of class \code{ggplot}
#' @examples
#' #prepare data
#' mpg_select <- mpg[mpg$manufacturer %in% c("audi", "ford", "honda", "hyundai"), ]
#'
#' #Bubble plot
#' plot<- bubble(data=mpg_select, x="displ", y="cty", col.var="manufacturer", size.var="hwy")
#' plot
#'
#' @import ggplot2
#' @import scales
#' @import reshape2
#' @import ggthemes
#' @import gganimate
#' @import gapminder
#' @import ggalt
#' @import ggExtra
#' @import ggcorrplot
#' @import dplyr
#' @import treemapify
#' @import ggfortify
#' @import zoo
#' @import ggdendro
#' @export
bubble<-function(data,x,y,col.var,size.var,
                 title=NULL,subtitle=NULL,xtitle=NULL,ytitle=NULL,caption=NULL){
  df<- data
  x<- x
  y<- y
  color<- col.var
  size<- size.var

  p <- ggplot(df, aes_string(x, y)) +
  geom_jitter(aes_string(col=color, size=size)) +
  geom_smooth(aes_string(col=color), method="lm", se=F) +
    theme_fivethirtyeight() +
    theme(axis.title = element_text(),
          legend.title = element_text(face = 4,size = 10),
          legend.direction = "horizontal", legend.box = "horizontal") +
    scale_color_tableau() +
    labs(subtitle=subtitle,
            y=ytitle,
            x=xtitle,
            title=title,
            caption = caption)

  return(p)
}


rm(list = ls())

v1 = c(5, 4, 3, 2, 8)
v2 = c(3, 2, 8, 4, 5)

v1 = sort(v1)
v2 = sort(v2)

saoIguais = all(v1 == v2)

if(saoIguais) {
  print("Permutação: sim")
} else {
  print("Permutação: não")
}


# RGL-Demo: animal abundance
# Authors: Oleg Nenadic, Daniel Adler
# $Id: abundance.r 564 2007-02-22 09:56:01Z dmurdoch $

rgl.demo.abundance <- function()
{
  open3d()
  clear3d("all")               # remove all shapes, lights, bounding-box, and restore viewpoint

  # Setup environment:
  bg3d(col="#cccccc")     # setup background
  light3d()               # setup head-light

  # Importing animal data (created with wisp)
  terrain<-dget(system.file("demodata/region.dat",package="rgl"))
  pop<-dget(system.file("demodata/population.dat",package="rgl"))

  # Define colors for terrain
  zlim <- range(terrain)
  zlen <- zlim[2] - zlim[1] + 1
  colorlut <- terrain.colors(82)
  col1 <- colorlut[9*sqrt(3.6*(terrain-zlim[1])+2)]

  # Set color to (water-)blue for regions with zero 'altitude'
  col1[terrain==0]<-"#0000FF"

  # Add terrain surface shape (i.e. population density):
  surface3d(
      1:100,seq(1,60,length=100),terrain,
      col=col1,spec="#000000", ambient="#333333", back="lines"
  )

  # Define colors for simulated populations (males:blue, females:red):
  col2<-pop[,4]
  col2[col2==0]<-"#3333ff"
  col2[col2==1]<-"#ff3333"

  # Add simulated populations as sphere-set shape
  spheres3d(
    pop[,1],
    pop[,2],
    terrain[cbind( ceiling(pop[,1]),ceiling(pop[,2]*10/6) )]+0.5,
    radius=0.2*pop[,3], col=col2, alpha=(1-(pop[,5])/10 )
  )

}
rgl.demo.abundance()


library(ggplot2)
library(reshape2)

#topic_names <- read.csv("~/r/snapl/topic_names/abs_lda20_all4.txt",header=FALSE,as.is=TRUE)
#betas <- read.table("~/sigplan/lda/2015-01-06_11:06_lda20/final.beta",as.is=TRUE)

topic_names <- read.csv("~/r/snapl/topic_names/final_lda20_fulltext.txt",header=FALSE,as.is=TRUE)
betas <- read.table("~/sigplan/www/backend/fulltext/lda20/final.beta",as.is=TRUE)

bs <- data.matrix(betas)
betas <- data.frame(bs)
names(betas) <- topic_names[1:20,]

dists = matrix(nrow=ncol(betas), ncol=nrow(betas)+1)
dists[,1] <- c(1:ncol(betas))
for (r in c(1:nrow(betas))) {
  topic <- betas[r,]

  p <- sort(topic,decreasing = TRUE)
  p <- t(p)
  dists[,r+1] <- p
}
df <- data.frame(dists)
colnames(df) <- c("Word",topic_names[1:20,])
ll <- melt(df,c(1))
colnames(ll)[2:3] <- c("Topic","Log likelihood")

ggplot(ll,aes(x=Word,y=`Log likelihood`)) + facet_wrap(~ Topic) + geom_point() + theme(text=element_text(size = 28))


# Goal: A histogram with tails shown in red.

# This happened on the R mailing list on 7 May 2004.
# This is by Martin Maechler <maechler@stat.math.ethz.ch>, who was
# responding to a slightly imperfect version of this by
# "Guazzetti Stefano" <Stefano.Guazzetti@ausl.re.it>

x <- rnorm(1000)
hx <- hist(x, breaks=100, plot=FALSE)
plot(hx, col=ifelse(abs(hx$breaks) < 1.669, 4, 2))
         # What is cool is that "col" is supplied a vector.

RFrontEndSolution/Tests Repo/Rscripts All (163 files)/g3.r


library(tidyverse)
source('fwhm.R')

load('LeT_PeakSameSD.RData')

pdf('SameRate.pdf', width = 6, height = 6, pointsize = 12)

  cex = 1.8

  par(#mfrow = c(2,2),
    oma = c(1,1,0,0),
    mgp = c(2, 0.2, 0),
    mar = c(3, 3.8, 1, 1))

  ul = rep(1, 4)
  dr = rep(2, 2)
  ur = rep(3, 3)
  dl = rep(4, 3)

  layout(matrix(c(ul, dr,
                  ul, dr,
                  ul, dr,
                  dl, ur,
                  dl, ur,
                  dl, ur), nrow = 6, byrow = T))

  plot(df_summary$bin,
       (df_summary$r2 - min(df_summary$r2, df_summary$r1)) /
         (max(df_summary$r2, df_summary$r1) - min(df_summary$r2, df_summary$r1)),
       xlab = 'Time in trial',
       ylab = 'Normalized response rate',
       axes = F, lwd = 0.6,
       bg = 'white', pch = 21, cex = cex)

  points(df_summary$bin,
         (df_summary$r1 - min(df_summary$r2, df_summary$r1)) /
           (max(df_summary$r2, df_summary$r1) - min(df_summary$r2, df_summary$r1)),
         bg = '#808080', pch = 21,lwd = 0.6, cex = cex*0.8)
  maxy =  max(df_summary$r1 - min(df_summary$r2, df_summary$r1)) /
    (max(df_summary$r2, df_summary$r1) - min(df_summary$r2, df_summary$r1))

  segments(x0 = which.max(df_summary$r1),
           x1 = which.max(df_summary$r1),
           y0 = 0, y1 = maxy, lty = 1, col = '#808080')

  segments(x0 =  which.max(df_summary$r2),
           x1 =  which.max(df_summary$r2),
           y0 = 0, y1 = 1, lty = 2)
  # arrows(x0 = which.max(df_summary$r1),
  #        x1 = which.max(df_summary$r2),
  #        y0 = 0.5, y1 = 0.5, code = 2,
  #        length = 0.07, lwd = 1.5)

  # text(110, 1, sprintf('Peak = %d', which.max(df_summary$r2)))
  # text(155, 0.4, sprintf('Peak = %d', which.max(df_summary$r1)))

  axis(1, tck = -0.01, lwd = 1.4, at = seq(0, 180, 60))
  axis(2, las = 2, tck = -0.01, lwd = 1.4)

  dfFWHM = data.frame(fwhm = c(fwhm1,fwhm2),
                      r = c(rep(1.8,length(fwhm1)),
                            rep(2,length(fwhm2))))

  plot(jitter(as.numeric(dfFWHM$r)),
       dfFWHM$fwhm,
       pch = 21, cex = cex,lwd = 0.6,
       bg = c('grey80','white')[as.numeric(dfFWHM$r)],
       type = 'p', axes = F, xlim = c(1.7, 2.2), ylim = c(10, 90),
       xlab = 'Components', ylab = 'FWHM')

  points(1.8, median(fwhm1), pch = '-', cex = 6, col = 'black')
  points(2, median(fwhm2),  pch = '-', cex = 6, col = 'grey50')
  axis(side = 1, at = as.numeric(unique(dfFWHM$r)),
       labels = c('Delayed', 'Immediate'),
       tck = -0.01, lwd = 1.4, cex.axis = 0.8)
  axis(2,las = 2, tck = -0.01, lwd = 1.4, at = seq(10, 90, 20))

  # qqplot

  qqplot(i1, #[which(i1>60 & i2 > 60)],
         i2, #[which(i1>60 & i2 > 60)],
         pch = 21,lwd = 0.2, cex = cex,
         bg = 'grey80',
         ylim = c(0, 180), xlim = c(0, 180),
         axes = F,
         xlab = bquote('Delayed reinforced states'~~italic(n)^'+'),
         ylab = bquote('Immediate reinforced states'~~italic(n)^'+'))
  segments(x0 = 0, y0 = 0,
           x1 = 180, y1 = 180, lty =2 )
  axis(1, tck = -0.01, lwd = 1.4, at = seq(0, 180, 45))
  axis(2, las = 2, tck = -0.01, at = seq(0, 180, 45), lwd = 1.4)

  plot(df_summary$wn1,
       xlab = 'Behavioral states (n)',
       ylab = 'W(n)',
       pch = 21, lwd = 0.6,
       axes = F, cex = cex,
       bg = 'grey30',
       ylim = c(0, 0.5),
       xlim = c(0, 180))
  points(x = which.max(df_summary$wn1), y = -0.006,
         pch = 24, bg = 'grey89')
  axis(1, tck = -0.01, lwd = 1.4, at = seq(0, 180, 60))
  axis(2, las = 2, tck = -0.01, lwd = 1.4)

dev.off()

load('LeT_PeakDiffSD.RData')

pdf('DiffRate.pdf', width = 6, height = 6, pointsize = 12)

cex = 1.8

par(#mfrow = c(2,2),
  oma = c(1,1,0,0),
  mgp = c(2, 0.2, 0),
  mar = c(3, 3.8, 1, 1))

ul = rep(1, 4)
dr = rep(2, 2)
ur = rep(3, 3)
dl = rep(4, 3)

layout(matrix(c(ul, dr,
                ul, dr,
                ul, dr,
                dl, ur,
                dl, ur,
                dl, ur), nrow = 6, byrow = T))

plot(df_summary$bin,
     (df_summary$r2 - min(df_summary$r2, df_summary$r1)) /
       (max(df_summary$r2, df_summary$r1) - min(df_summary$r2, df_summary$r1)),
     xlab = 'Time in trial',
     ylab = 'Normalized response rate',
     axes = F, lwd = 0.6,
     bg = 'white', pch = 21, cex = cex)

points(df_summary$bin,
       (df_summary$r1 - min(df_summary$r2, df_summary$r1)) /
         (max(df_summary$r2, df_summary$r1) - min(df_summary$r2, df_summary$r1)),
       bg = '#808080', pch = 21,lwd = 0.6, cex = cex)
maxy =  max(df_summary$r1 - min(df_summary$r2, df_summary$r1)) /
  (max(df_summary$r2, df_summary$r1) - min(df_summary$r2, df_summary$r1))

segments(x0 = which.max(df_summary$r1),
         x1 = which.max(df_summary$r1),
         y0 = 0, y1 = maxy, lty = 1, col = '#808080')

segments(x0 =  which.max(df_summary$r2),
         x1 =  which.max(df_summary$r2),
         y0 = 0, y1 = 1, lty = 2)
arrows(x0 = which.max(df_summary$r1),
       x1 = which.max(df_summary$r2),
       y0 = 0.5, y1 = 0.5, code = 2,
       length = 0.07, lwd = 1.5)

text(110, 1, sprintf('Peak = %d', which.max(df_summary$r2)))
text(155, 0.4, sprintf('Peak = %d', which.max(df_summary$r1)))

axis(1, tck = -0.01, lwd = 1.4, at = seq(0, 180, 60))
axis(2, las = 2, tck = -0.01, lwd = 1.4)

dfFWHM = data.frame(fwhm = c(fwhm1,fwhm2),
                    r = c(rep(1.8,length(fwhm1)),
                          rep(2,length(fwhm2))))

plot(jitter(as.numeric(dfFWHM$r)),
     dfFWHM$fwhm,
     pch = 21, cex = cex,lwd = 0.6,
     bg = c('grey80','white')[as.numeric(dfFWHM$r)],
     type = 'p', axes = F, xlim = c(1.7, 2.2), ylim = c(10, 90),
     xlab = 'Components', ylab = 'FWHM')

points(1.8, median(fwhm1), pch = '-', cex = 6, col = 'black')
points(2, median(fwhm2),  pch = '-', cex = 6, col = 'grey50')
axis(side = 1, at = as.numeric(unique(dfFWHM$r)),
     labels = c('Delayed', 'Immediate'),
     tck = -0.01, lwd = 1.4, cex.axis = 0.8)
axis(2,las = 2, tck = -0.01, lwd = 1.4, at = seq(10, 90, 20))

# qqplot

qqplot(i1, #[which(i1>60 & i2 > 60)],
       i2, #[which(i1>60 & i2 > 60)],
       pch = 21,lwd = 0.2, cex = cex,
       bg = 'grey80',
       ylim = c(0, 190), xlim = c(0, 190),
       axes = F,
       xlab = bquote('Delayed reinforced states'~~italic(n)^'+'),
       ylab = bquote('Immediate reinforced states'~~italic(n)^'+'))
segments(x0 = 0, y0 = 0,
         x1 = 180, y1 = 180, lty =2 )
segments(x0 = 0, y0 = 0,
         x1 = 180, y1 = 180, lty =2 )
axis(1, tck = -0.01, lwd = 1.4, at = seq(0, 180, 45))
axis(2, las = 2, tck = -0.01, at = seq(0, 180, 45), lwd = 1.4)

plot(df_summary$wn1,
     xlab = 'Behavioral states (n)',
     ylab = 'W(n)',
     pch = 21, lwd = 0.6,
     axes = F, cex = cex,
     bg = 'grey30',
     ylim = c(0, 0.5),
     xlim = c(0, 180))
points(x = which.max(df_summary$wn1), y = -0.006,
       pch = 24, bg = 'grey89')
axis(1, tck = -0.01, lwd = 1.4, at = seq(0, 180, 60))
axis(2, las = 2, tck = -0.01, lwd = 1.4)

dev.off()


a=1:10
b=10:100

save(a,"./data.rdata")

rm(a)

load(file="./data.rdata")

var1=1:5
var2=(1:5)/2
var3=c("diego","pacheco","R","ML")

df1=data.frame(var1,var2,var3)
names(df1)=c("Integers","Doubles","Strings")

write.csv(df1,file="d:/data.csv",row.names = FALSE)
df1

df2=read.csv(file="d:/data.csv")
df2

dim(iris)
names(iris)

str(iris)

iris[1:5,]
head(iris)
tail(iris)

summary(iris)
quantile(iris$Sepal.Length)

hist(iris$Sepal.Length)
plot(density(iris$Sepal.Length))
pie(table(iris$Species))
barplot(table(iris$Species))
boxplot(iris$Sepal.Length ~ iris$Species, data = iris)

with(iris,plot(iris$Sepal.Length, iris$Sepal.Width, col = iris$Species, pch=as.numeric(iris$Species)))


Data_Frame <- data.frame (
  Training = c("Strength", "Stamina", "Other"),
  Pulse = c(100, 150, 120),
  Duration = c(60, 30, 45)
)

Data_Frame2 <- data.frame (
  Steps = c(3000, 6000, 2000),
  Calories = c(300, 400, 300)
)

New_Data_Frame <- cbind(Data_Frame, Data_Frame2)
print(New_Data_Frame)
print(summary(New_Data_Frame))


library(snipEM)
library(mvtnorm)
source("codeKfixedLOG.r")
source("chooseD.r")
obj=function(x,lambda,xi,sigma,k,kmax,n,Ti,pi,PI,done) {

if(k[1]>1) {
pi[k[1],2:k[1]]=exp(x[1:(k[1]-1)])/(1+sum(exp(x[1:(k[1]-1)])))
pi[k[1],1]=1-sum(pi[k[1],2:k[1]])
if(any(pi[k[1],1:k[1]]==0)) {
w0=which(pi[k[1],]==0)
pi[k[1],w0]=1e-306
pi[k[1],1:k[1]]=pi[k[1],1:k[1]]/sum(pi[k[1],1:k[1]])}
x=x[-c(1:(k[1]-1))]}
for(itd in 1:nrow(done)) {
j=done[itd,1]
h=done[itd,2]
for(ku in 1:j) {
jnk=x[(ku-1)*(h-1)+1:(h-1)]
PI[j,h,ku,2:h]=exp(jnk)/(1+sum(exp(jnk)))
PI[j,h,ku,1]=1-sum(PI[j,h,ku,2:h])
if(any(PI[j,h,ku,1:h]==0)) {
w0=which(PI[j,h,ku,1:h]==0)
PI[j,h,ku,w0]=1e-306
PI[j,h,ku,1:h]=PI[j,h,ku,1:h]/sum(PI[j,h,ku,1:h])}}
x=x[-c(1:(j*(h-1)))]
}
PI[PI<1e-306]=1e-306
-forw(xi,sigma,pi,PI,k,kmax,n,Ti,lambda)}

forw=function(xi,sigma,pi,PI,k,kmax,n,Ti,lambda) {

qu=array(NA,c(n,Ti,kmax))

for(j in 1:k[1])
{qu[,1,j]=dmvnorm(y[,1,],xi[k[1],j,],diag(sigma[k[1],j,]^2),log=TRUE)+log(pi[k[1],j])}

for(t in 2:Ti) {
for(j in 1:k[t]) {
if(k[t-1]>1) {
qu[,t,j]=(qu[,t-1,1]+log(PI[k[t-1],k[t],1,j]))
for(d in 2:k[t-1]) {
    cb=cbind(qu[,t,j],(qu[,t-1,d]+log(PI[k[t-1],k[t],d,j])))
    cb[cb < -700]=-700
qu[,t,j]=apply(cb,1,sumlog)}
qu[,t,j]=qu[,t,j]+dmvnorm(y[,t,],xi[k[t],j,],diag(sigma[k[t],j,]^2),log=TRUE)}

if(k[t-1]==1) {
qu[,t,j]=dmvnorm(y[,t,],xi[k[t],j,],diag(sigma[k[t],j,]^2),log=TRUE)+qu[,t-1,1]+log(PI[k[t-1],k[t],1,j])
}

}}

    if(k[Ti]>1) {
        cb=qu[,Ti,1:k[Ti]]
        cb[cb < -700]=-700
liks=apply(cb,1,sumlog)}
if(k[Ti]==1) {liks=qu[,Ti,1]}
lik=sum(liks)
jnk=pi[k[1],1:k[1]]
jnk2=jnk[jnk>1e-15]
lik=lik+lambda*n*sum(jnk2*log(jnk2))
for(j in 2:Ti) {
jnk=jnk%*%PI[k[j-1],k[j],1:k[j-1],1:k[j]]
jnk2=jnk[jnk>1e-15]
lik=lik+lambda*n*sum(jnk2*log(jnk2))
}
return(lik)}

likco=function(y,xi,sigma,pi,PI,k,kmax,n,Ti) {

qu=array(NA,c(n,Ti,kmax))

for(j in 1:k[1])
{qu[,1,j]=dmvnorm(y[,1,],xi[k[1],j,],diag(sigma[k[1],j,]^2),log=TRUE)+log(pi[k[1],j])}

for(t in 2:Ti) {
for(j in 1:k[t]) {
if(k[t-1]>1) {
qu[,t,j]=(qu[,t-1,1]+log(PI[k[t-1],k[t],1,j]))
for(d in 2:k[t-1]) {
    cb=cbind(qu[,t,j],(qu[,t-1,d]+log(PI[k[t-1],k[t],d,j])))
    cb[cb< -700]=-700
qu[,t,j]=apply(cb,1,sumlog)}
qu[,t,j]=qu[,t,j]+dmvnorm(y[,t,],xi[k[t],j,],diag(sigma[k[t],j,]^2),log=TRUE)}

if(k[t-1]==1) {
qu[,t,j]=dmvnorm(y[,t,],xi[k[t],j,],diag(sigma[k[t],j,]^2),log=TRUE)+qu[,t-1,1]+log(PI[k[t-1],k[t],1,j])
}

}}

    if(k[Ti]>1) {
        cb=qu[,Ti,1:k[Ti]]
        cb[cb < -700]=-700
liks=apply(cb,1,sumlog)}
if(k[Ti]==1) {liks=qu[,Ti,1]}
res=sum(liks)

qub=qu
qub[,Ti,]=0
for(t in (Ti-1):1) {
for(c in 1:k[t]) {
qub[,t,c]=dmvnorm(y[,t+1,],xi[k[t+1],1,],diag(sigma[k[t+1],1,]^2),log=TRUE)+qub[,t+1,1]+log(PI[k[t],k[t+1],c,1])
if(k[t+1]>1) {
for(j in 2:k[t+1]) {
    jnk=dmvnorm(y[,t+1,],xi[k[t+1],j,],diag(sigma[k[t+1],j,]^2),log=TRUE)+qub[,t+1,j]+log(PI[k[t],k[t+1],c,j])
    cb=cbind(qub[,t,c],jnk)
    cb[cb < -700]=-700
qub[,t,c]=apply(cb,1,sumlog)
}}}}

return(list(lik=res,liks=liks,qub=qub,qu=qu))}

rlm=function(y,lambda,kmax,B=200,Di=NULL,cmax=1,tol=1e-4,maxit=Inf,hits=20,inits=NULL,verbose=FALSE,debug=FALSE) {

n=nrow(y)
Ti=ncol(y)
r=dim(y)[3]

xi=array(NA,c(kmax,kmax,r))
sigma=xi

pi=array(NA,c(kmax,kmax))
PI=array(NA,c(kmax,kmax,kmax,kmax))
## inits ##

if(!is.null(inits)) {
xi=inits$xi
sigma=inits$sigma
PI=inits$PI
pi=inits$pi
k=inits$k
}

if(is.null(inits)) {
library(mclust)
k=rep(round(kmax/2),Ti)
for(j in 1:Ti) {
k[j]=max(min(kmax,Mclust(y[,j,],modelNames="VVI")$G),2)
}
for(j in 1:kmax) {
for(u in 1:r) {
km=kmeans(as.vector(y[,,u]),j,iter.max=1000,nstart=10)
xi[j,1:j,u]=km$centers
sigma[j,1:j,u]=sqrt(km$withinss/km$size)}
if(j>1) {
for(l in 1:r) {
o=order(xi[j,1:j,l])
xi[j,1:j,l]=xi[j,1:j,l][o]
sigma[j,1:j,l]=sigma[j,1:j,l][o]}
}}
}

if(is.null(inits$PI)) {

pi[1,1]=PI[,1,,1]=1
for(j in 2:kmax) {
km=kmeans(y[,1,],j,nstart=10,iter.max=1000)
o=order(km$center[,1])
pi[j,1:j]=prop.table(table(km$cluster))[o]}
for(h in 2:kmax) {
for(j in 1:kmax) {
if(j>1) {
PI[j,h,1:j,1:h]=1
if(h>1 & j>1) {
diag(PI[j,h,1:j,1:h])=8+j
PI[j,h,1:j,1:h]=PI[j,h,1:j,1:h]/apply(PI[j,h,1:j,1:h],1,sum)
}}
if(j==1) {
PI[j,h,1,1:h]=1
PI[j,h,1,1]=8+j
PI[j,h,1:j,1:h]=PI[j,h,1:j,1:h]/sum(PI[j,h,1:j,1:h])
}}}
}
## E-step ##

lst=likco(y,xi,sigma,pi,PI,k,kmax,n,Ti)

qu=lst$qu
lik=lst$lik
liks=lst$liks
qub=lst$qub
V=qu+qub
for(j in 1:kmax) {
V[,,j]=sweep(V[,,j],1,liks)
}
V=exp(V)
jnk=pi[k[1],1:k[1]]
jnk2=jnk[jnk>1e-15]
lik=lik+lambda*n*sum(jnk2*log(jnk2))
for(j in 2:Ti) {
jnk=jnk%*%PI[k[j-1],k[j],1:k[j-1],1:k[j]]
jnk2=jnk[jnk>1e-15]
lik=lik+lambda*n*sum(jnk2*log(jnk2))
}

lkold=lik*2
iters=1
    flagK=TRUE
    Z=array(0,c(kmax,kmax,kmax,kmax))
while(lik-lkold>tol & iters<maxit) {

if(all(k==1)) {

xi=apply(y,3,mean)
sigma=apply(y,3,sd)
lkold=lik
lik=dmvnorm(matrix(y,ncol=r),xi,diag(sigma^2),log=TRUE)

}

if(any(k>1)) {
    if(verbose) {print("## update pi & PI")}

    if(lambda>0) {
done=NULL
initM=log(pi[k[1],2:k[1]]/pi[k[1],1])
for(j in 1:kmax) {
for(h in 1:kmax) {
trans=k[-Ti]==j & k[-1]==h
if(any(trans)) {
if(debug) {print(PI[j,h,,])}
done=rbind(done,c(j,h))
for(ku in 1:j) {
initM=c(initM,log(PI[j,h,ku,2:h]/PI[j,h,ku,1]))
}}}}

op=try(optim(initM,obj,lambda=lambda,xi=xi, sigma=sigma, k=k, kmax=kmax, n=n, Ti=Ti,
pi=pi, PI=PI, done=done, control=list(maxit=hits)),silent=!debug)
x=initM
if(!inherits(op,"try-error")){x=op$par}

pi[k[1],2:k[1]]=exp(x[1:(k[1]-1)])/(1+sum(exp(x[1:(k[1]-1)])))
pi[k[1],1]=1-sum(pi[k[1],2:k[1]])
if(any(pi[k[1],1:k[1]]==0)) {
w0=which(pi[k[1],]==0)
pi[k[1],w0]=1e-16
pi[k[1],1:k[1]]=pi[k[1],1:k[1]]/sum(pi[k[1],1:k[1]])}
x=x[-c(1:(k[1]-1))]
for(itd in 1:nrow(done)) {
j=done[itd,1]
h=done[itd,2]
for(ku in 1:j) {
jnk=x[(ku-1)*(h-1)+1:(h-1)]
PI[j,h,ku,2:h]=exp(jnk)/(1+sum(exp(jnk)))
PI[j,h,ku,1]=1-sum(PI[j,h,ku,2:h])
if(any(PI[j,h,ku,1:h]==0)) {
w0=which(PI[j,h,ku,1:h]==0)
PI[j,h,ku,w0]=1e-16
PI[j,h,ku,1:h]=PI[j,h,ku,1:h]/sum(PI[j,h,ku,1:h])}}
x=x[-c(1:(j*(h-1)))]
}
    }

    if(lambda==0) {

for(j in 1:kmax) {
for(h in 1:kmax) {
trans=k[-Ti]==j & k[-1]==h
if(any(trans)) {
wtrans=which(trans)
for(c in 1:j) {
for(d in 1:h) {
sw=matrix(y[,wtrans+1,],ncol=r)
ap=matrix(dmvnorm(sw,xi[h,d,],diag(sigma[h,d,]^2),log=TRUE),ncol=length(wtrans),byrow=FALSE)
Z[j,h,c,d]=sumlog(log(PI[j,h,c,d])+sweep(qu[,wtrans,c]+qub[,wtrans+1,d]+ap,1,liks))}}
}}}

if(k[1]>1) {
pi[k[1],1:k[1]]=apply(V[,1,1:k[1]],2,sum)
pi[k[1],]=pi[k[1],]/sum(pi[k[1],1:k[1]])
}
for(j in 1:kmax) {
for(h in 1:kmax) {
trans=k[-Ti]==j & k[-1]==h
if(any(trans)) {
if(j>1 & h>1) {
PI[j,h,1:j,1:h]=exp(sweep(Z[j,h,1:j,1:h],1,apply(Z[j,h,1:j,1:h],1,sumlog)))}
if(j==1) {
PI[j,h,1,1:h]=exp(Z[j,h,1,1:h]-sumlog(Z[j,h,1,1:h]))}
}}}

    }
if(verbose) {print("## update xi & sigma")}

for(ks in unique(k)) {
for(l in 1:r) {
for(d in 1:ks) {
xi[ks,d,l]=sum(V[,which(k==ks),d]*y[,which(k==ks),l])/sum(V[,which(k==ks),d])
sigma[ks,d,l]=sqrt(sum(V[,which(k==ks),d]*(y[,which(k==ks),l]-xi[ks,d,l])^2)/(sum(V[,which(k==ks),d])))
}}
if(ks>1) {
o=order(xi[ks,1:ks,1])
xi[ks,1:ks,]=xi[ks,1:ks,][o,]
sigma[ks,1:ks,]=sigma[ks,1:ks,][o,]}
}

#if(debug) {
#lkpartold=lkpartial
#lkpartial=likco(xi,sigma,pi,PI,k,kmax,n,Ti)$lik
#if(lkpartold-lkpartial>0) {print(paste("problems with xi or sigma at iteration",iters,"!!!"))}}

if(verbose) {print("## E-step")}
lst=try(likco(y,xi,sigma,pi,PI,k,kmax,n,Ti),silent=!debug)

if(inherits(lst,"try-error")) {break}

lkold=lik

qu=lst$qu
lik=lst$lik
liks=lst$liks
qub=lst$qub
V=qu+qub
for(j in 1:kmax) {
V[,,j]=sweep(V[,,j],1,liks)
}
V=exp(V)
jnk=pi[k[1],1:k[1]]
jnk2=jnk[jnk>1e-15]
lik=lik+lambda*n*sum(jnk2*log(jnk2))
for(j in 2:Ti) {
jnk=jnk%*%PI[k[j-1],k[j],1:k[j-1],1:k[j]]
jnk2=jnk[jnk>1e-15]
lik=lik+lambda*n*sum(jnk2*log(jnk2))
}}

## MM part ###
if(verbose) {print("## update k")}
if(!flagK) {B=round(B/2)}
flagK=FALSE
    if(B>0) {
        Di2=Di
        if(is.null(Di)) {
        current=list()
        current$pi=pi
        current$PI=PI
        current$xi=xi
        current$sigma=sigma
        current$k=k
       Di2=chooseD(y,lambda,kmax,verbose=FALSE,tol=tol,inits=current)}
for(b in 1:B) {
ti=sample(Ti,1)
u=sample(c(-1,1),1)
inits=list()
inits$xi=xi
inits$sigma=sigma
inits$PI=PI
inits$pi=pi
kc=k
if(k[ti]==1) {kc[ti]=kc[ti]+1}
if(k[ti]==kmax) {kc[ti]=kc[ti]-1}
if(k[ti]>1 & k[ti]<kmax) {kc[ti]=kc[ti]+u}
rl=try(rlm.fixed(y,kc,maxit=cmax,inits=inits,exceed=sum(liks)),silent=!debug)
if(!inherits(rl,"try-error")) {
jnk=rl$pi[kc[1],1:kc[1]]
jnk2=jnk[jnk>1e-15]
likc=rl$lik+lambda*n*sum(jnk2*log(jnk2))
for(j in 2:Ti) {
jnk=jnk%*%rl$PI[kc[j-1],kc[j],1:kc[j-1],1:kc[j]]
jnk2=jnk[jnk>1e-15]
likc=likc+lambda*n*sum(jnk2*log(jnk2))
}

pb=min(c(exp(-log(b+1)*(lik-likc)/Di2),1))
if(runif(1)<pb) {k=kc
flagK=TRUE
xi=rl$xi
sigma=rl$sigma
PI=rl$PI
pi=rl$pi
lik=likc
liks=rl$liks
V=rl$V
if(verbose) {print("kandidate accepted!")
             print(paste("k=",k,sep="",collapse=","))}
}}}}

if(verbose) {print(paste("iters:",iters,sep=" "))}
if(verbose) {print("lk diff")}
if(verbose) {print(c(lkold,lik,lik-lkold))}
iters=iters+1
}

if(all(k==1)) {

xi=apply(y,3,mean)
sigma=apply(y,3,sd)
lik=dmvnorm(matrix(y,ncol=r),xi,diag(sigma^2),log=TRUE)
aic=-2*lik+2*2*r
bic=-2*lik+log(n)*2*r

}

if(any(k>1)) {
np=sum(2*r*unique(k))+k[1]-1

for(j in 1:kmax) {
for(h in 1:kmax) {
trans=k[-Ti]==j & k[-1]==h
if(any(trans)) {
np=np+j*(h-1)
}}}

aic=-2*lik+2*np
bic=-2*lik+log(n)*np}

return(list(V=V,pi=pi,PI=PI,xi=xi,sigma=sigma,lik=lik,aic=aic,bic=bic,k=k))}

library(compiler)

rlm=cmpfun(rlm)


subroutine intri(x,y,u,v,n,okay)
#
# Test whether any of the points (u(i),v(i)) are inside the triangle
# whose vertices are specified by the vectors x and y.
# Called by .Fortran() from triang.list.R.
#

implicit double precision(a-h,o-z)
dimension x(3), y(3), u(n), v(n)
integer okay
logical inside

zero = 0.d0

# Check on order (clockwise or anticlockwise).
s = 1.d0
a = x(2) - x(1)
b = y(2) - y(1)
c = x(3) - x(1)
d = y(3) - y(1)
cp = a*d - b*c
if(cp < 0) s = -s
do i = 1,n {
	inside = .true.
	do j = 1,3 {
        	jp = j+1
        	if(jp==4) jp = 1 # Take addition modulo 3.
		a  = x(jp) - x(j)
		b  = y(jp) - y(j)
		c  = u(i)  - x(j)
		d  = v(i)  - y(j)
		cp = s*(a*d - b*c)
		if(cp <= zero) {
			inside = .false.
			break
		}
	}
	if(inside) {
		okay = 0
		return
	}

}
okay = 1
return
end