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

par(omi=c(0.25,0.25,1.25,0.25),mai=c(1.5,0.85,0,0.5),family="Lato Light",las=1)

# Import data and prepare chart

library(gdata)
myGdp<-read.xls("myData/gapminder/indicatorgapmindergdp_per_capita_ppp.xls", encoding="latin1")
mySelection<-c("X","X2010")
myGdp2010<-myGdp[mySelection]

myExp<-read.xls("myData/gapminder/indicatorlife_expectancy_at_birth.xls", encoding="latin1")
mySelection<-c("Life.expectancy.at.birth","X2010")
myExp2010<-myExp[mySelection]

myGdpExp2010<-merge(myGdp2010,myExp2010,by.x="X",by.y="Life.expectancy.at.birth",all =T)

myPop<-read.xls("myData/gapminder/indicatorgapminderpopulation.xls",dec=".", encoding="latin1")
mySelection<-c("Total.population","X2010")
myPop2010<-myPop[mySelection]

myGdpExpPop2010<-merge(myGdpExp2010,myPop2010,by.x="X",by.y="Total.population",all =T)

myRegions<-read.xls("myData/gapminder/regions.xlsx", encoding="latin1")

myData<-merge(myGdpExpPop2010,myRegions,by.x="X",by.y="Entity",all =T)
myData<-na.omit(myData)

attach(myData)
X2010<-as.numeric(gsub(",","",X2010))/10000000

xmax<-round(max((X2010)),1)
x75<-round(quantile((X2010),probs=0.75),1)
x25<-round(quantile((X2010),probs=0.25),1)

xmax_leg<-round(max((X2010)^0.5)/3,1)
x75_leg<-round(quantile((X2010)^0.5,probs=0.75)/3,1)
x25_leg<-round(quantile((X2010)^0.5,probs=0.25)/3,1)

mySize<-(X2010)^0.5
myData$mySize<-mySize

myOld<-c("Sub-Saharan Africa","South Asia","Middle East & North Africa",
	"America","Europe & Central Asia","East Asia & Pacific")
myNew<-c(rgb(0,115,157,150,maxColorValue=255),
	   rgb(158,202,229,150,maxColorValue=255),
	   rgb(84,196,153,150,maxColorValue=255),
	   rgb(255,255,0,150,maxColorValue=255),
	   rgb(246,161,82,150,maxColorValue=255),
	   rgb(255,0,0,150,maxColorValue=255))
myColours<-as.character(Group)
for (i in 1:length(myOld)) {myColours[myColours == myOld[i]]<-myNew[i]}

# Define chart and other elements

plot(log10(X2010.x),X2010.y,type="n",axes=F,xlab="",ylab="")
points(log10(X2010.x),X2010.y,cex=mySize,pch=19,col=myColours,lwd=0)
axis(1,at=log10(c(200,400,1000,2000,4000,10000,20000,50000)),label=format(c(200,400,1000,2000,4000,10000,20000,50000),big.mark="."))
axis(2)
title(xlab="GDP per Person in US Dollars (purchasing power adjusted) (log scale)",ylab="Life expectancy at birth (years)",font=3)

myFit<-lm(X2010.y ~ log10(X2010.x))
myData$resid<-residuals(myFit)
myData$myFit<-fitted(myFit)

myData.sort<-myData[order(-abs(myData$resid)) ,]
myData.sort_begin<-myData.sort[1:5,]

attach(myData.sort_begin)
text(log10(X2010.x),X2010.y,X,cex=0.95,pos=1,offset=0.8)

# Titling

mtext("Gapminder World Map 2010",3,line=3,adj=0,cex=3,family="Lato Black",outer=T)
mtext("More money often leads to longer lives (i.e. better health). ",3,line=0,adj=0,cex=1.75,font=3,outer=T)
mtext("Source: http://www.gapminder.org/",1,line=5.5,adj=1.0,cex=1.55,font=3)

text(log10(30000),72.5,"Population Size",family="Lato Black",cex=1.35,adj=0)
text(log10(65000),70,paste(10*x25," Mio.",sep=""),adj=0)
text(log10(65000),68,paste(10*x75," Mio.",sep=""),adj=0)
text(log10(65000),66,paste(10*xmax," Mio.",sep=""),adj=0)

# Map Legend

library(mapplots)
legend.bubble(log10(45000),67,z=c(x25_leg,x75_leg,xmax_leg*0.7),maxradius=xmax_leg*0.7,bg=NA,txt.cex=0.01,txt.col=NA,pch=21,pt.bg="#00000020",bty="n",round=1)

# Integration of the chart

par(new=T, mai=c(1,9,3.5,0.75))
library(maptools) # contains  wrld_simpl
library(rgdal) # for spTransform

data(wrld_simpl)
myW<-wrld_simpl[wrld_simpl@data[,"NAME"] != "Antarctica",]
m<-spTransform(myW,CRS=CRS("+proj=merc"))

myCountries<-m@data$ISO2
n<-length(myCountries)
myMapColours<-numeric(n)

myR1<-"Sub-Saharan Africa"
myR2<-"South Asia"
myR3<-"Middle East & North Africa"
myR4<-"America"
myR5<-"Europe & Central Asia"
myR6<-"East Asia & Pacific"

myF1<-rgb(0,115,157,150,maxColorValue=255)
myF2<-rgb(158,202,229,150,maxColorValue=255)
myF3<-rgb(84,196,153,150,maxColorValue=255)
myF4<-rgb(255,255,0,150,maxColorValue=255)
myF5<-rgb(246,161,82,150,maxColorValue=255)
myF6<-rgb(255,0,0,150,maxColorValue=255)

myRegion<-c(myR1,myR2,myR3,myR4,myR5,myR6)
myColour<-c(myF1,myF2,myF3,myF4,myF5,myF6)

myRegions<-read.xls("myData/gapminder/regions.xlsx", encoding="latin1")

for (i in 1:length(myRegion))
{
myRegionSelection<-subset(myRegions$ID,myRegions$Group==myRegion[i])
myCountrySelection<-NULL
for (j in 1:length(myRegionSelection)) myCountrySelection<-c(myCountrySelection, trim(as.character(myRegionSelection[j])))
for (j in 1:length(myCountrySelection))
{
myMapColours[grep(paste("^",myCountrySelection[j],"$",sep=""),myCountries)]<-myColour[i]
}
}

plot(m,col=myMapColours,border=F, bg=NA)
mtext("World Regions",3,line=-2,adj=0.5,cex=1.25,family="Lato Black")

dev.off()


print(max(5, 10, 15))

print(min(5, 10, 15))

print(sqrt(16))

print(abs(-5.1))

print(ceiling(1.4))

print(floor(1.4))


#ddirch covariate selection based on DIC scores.
#clear environment, load packages.
rm(list=ls())
library(runjags)

#### generate pseudo data. ####
#2 informative covariates, an informative intercept, 1 uninformative covariate.
set.seed(1234)
n.obs <- 200
x1 <- runif(n.obs,20,40)
x2 <- runif(n.obs, 2, 4)
x3 <- runif(n.obs,100,110)
#x4 <- runif(n.obs,100,110)
intercept <- rep(1, n.obs)
y1 <- x1*0.5 + x2*3 + 5 + rnorm(n.obs)
y2 <- rep(10, length(y1))
y <- as.matrix(data.frame(y1,y2))
y <- y / rowSums(y)
x <- as.matrix(data.frame(intercept,x1,x2,x3))

#### Define simples ddirch JAGS model. ####
jags.model = "
model {
  #parameter priors for each species.
  alpha ~ dnorm(0, 1.0E-3)
  for(i in 1:N.preds){
    x.mm[i,1] <- 0
    for (j in 2:N.spp) {
      x.mm[i,j] ~ dnorm(0, 1.0E-3)
    }
  }

  #mean center all predictors (except intercept).
  for(i in 1:N){
    x.center[i,1] <- 1
    for(j in 2:N.preds){
      x.center[i,j] <- x[i,j] - mean(x[,j])
    }
  }

  #save mean values for back transforming intercept values.
  for(j in 1:N.preds){x.center.save[j] <- mean(x[,j])}

  #fit species abundances as a linear combination of predictors and parameters.
  for(i in 1:N){
    for(j in 1:N.spp){
      log(a0[i,j]) <- alpha + inprod(x.mm[,j], x.center[i,])
    }
    y[i,1:N.spp] ~ ddirch(a0[i,1:N.spp])
  }

  #map to original parameterization, assuming first column of predictors is intercept.
  for (j in 1:N.spp) {
    x.m[1,j] <- alpha + x.mm[1,j] - inprod(x.mm[2:N.preds,j], x.center.save[2:N.preds])
    for (i in 2:N.preds){
      x.m[i,j] <- x.mm[i,j]
    }
  }
} #close model loop.
"
#### define model for fixed parameters ####
fix.model = "
model{
  #mean center all predictors (except intercept).
  for(i in 1:N){
    x.center[i,1] <- 1
    for(j in 2:N.preds){
      x.center[i,j] <- x[i,j] - mean(x[,j])
    }
  }

  #fit species abundances as a linear combination of predictors and parameters.
  for(i in 1:N){
    for(j in 1:N.spp){
      log(a0[i,j]) <- alpha + inprod(x.mm[,j], x.center[i,])
    }
    y[i,1:N.spp] ~ ddirch(a0[i,1:N.spp])
  }
} #close model loop.
"

#### fit JAGS model, get deviance and pD ####
jags.data <- list(y=y,x=x,N.preds = ncol(x), N.spp=ncol(y), N = nrow(y))
jags.out <- run.jags(model = jags.model, data = jags.data, adapt=100,burnin=300,sample=300,n.chains=3, monitor = c('x.mm','alpha','deviance'))
jags.sum <- summary(jags.out)
jags.dev <- jags.sum[grep('deviance', rownames(jags.sum)),][4]
jags.mm  <- jags.sum[grep('x.mm'    , rownames(jags.sum)),][,4]
jags.alp <- jags.sum[grep('alpha'   , rownames(jags.sum)),][4]
#convert jags.mm to matrix of mean values
dim(jags.mm) <- c(ncol(x),ncol(y))
#get pD with fix model.
pD.data <- list(y=y,x=x,N.preds = ncol(x), N = nrow(y), N.spp = ncol(y), alpha = jags.alp, x.mm = jags.mm)
pD.model <- run.jags(model = fix.model, data = pD.data, adapt=100,burnin=300,sample=300,n.chains=3, monitor = c('deviance'))
pD.sum   <- summary(pD.model)
pD       <- pD.sum[3]
dic      <- 2*jags.dev - pD

#### leave one predictor out at a time, calculate dic. ####
jags.compare.dic   <- list()
jags.compare.sum   <- list()
for(i in 2:ncol(x)){
  new.x <- x[,-i]
  jd <- list(y=y,x=new.x,N.preds = ncol(new.x), N.spp=ncol(y), N = nrow(y))
  jags.out <- run.jags(model = jags.model, data = jd, adapt=100,burnin=300,sample=300,n.chains=3, monitor = c('x.mm','alpha','deviance'))
  jags.sum <- summary(jags.out)
  jags.dev <- jags.sum[grep('deviance', rownames(jags.sum)),][ 4]
  jags.mm  <- jags.sum[grep('x.mm'    , rownames(jags.sum)),][,4]
  jags.alp <- jags.sum[grep('alpha'   , rownames(jags.sum)),][ 4]
  #convert jags.mm to matrix of mean values
  dim(jags.mm) <- c(ncol(new.x),ncol(y))
  #get pD with fix model.
  pD.data <- list(y=y,x=new.x,N.preds = ncol(new.x), N = nrow(y), N.spp = ncol(y), alpha = jags.alp, x.mm = jags.mm)
  pD.model <- run.jags(model = fix.model, data = pD.data, adapt=100,burnin=300,sample=300,n.chains=3, monitor = c('deviance'))
  pD.sum   <- summary(pD.model)
  pD       <- pD.sum[3]
  jags.compare.dic[[i-1]] <- 2*jags.dev - pD
  jags.compare.sum[[i-1]] <- jags.sum
}
jags.compare.dic <- unlist(jags.compare.dic)
names(jags.compare.dic) <- colnames(x[,2:ncol(x)])

#### which model improves DIC the most? ####
#dic says don't you dare remove x1 or x2. Supports removing x3 by 2-3 points.
dic
jags.compare.dic

#### Testing with function. ####
source('NEFI_functions/covariate_selection_JAGS.r')
test <- covariate_selection_JAGS(y=y,x=x)

#### plotting y vs preditor relationships. ####
#just to prove- plot y as a function x1-x3
par(mfrow = c(ncol(x)-1,ncol(y)))
for(i in 2:4){
  plot(y[,1] ~ x[,i], main = paste0('y1 ~ x',i))
  abline(lm(y[,1] ~ x[,i]), lwd =2 , col = 'green')
  plot(y[,2] ~ x[,i], main = paste0('y2 ~ x',i))
  abline(lm(y[,2] ~ x[,i]), lwd =2 , col = 'green')
}


"
Ввести с клавиатуры два числа.
Вывести все числа в диапазоне от большего к меньшему, которые делятся на 3.
"
{

  n1 <- as.integer(readline("Введите меньшее число -> "))
  n2 <- as.integer(readline("Введите большее число -> "))

  for (i in n1:n2){
    if (i %% 3 == 0){
      print(paste("Число", i, "делится на 3 ->", i/3))
    }
  }
}


#' c2f
#'
#' Convert celsius to fahrenheit.
#'
#' @param x A vector of temperature values in celsius
#' @return A vector of fahrenheit values
#'
#' @export
#'
#'
#'

c2f <- function(x) {
  F = (x * 9/5) + 32
  return(F)
}


require("ggplot2")

py <- read.csv("https://raw.githubusercontent.com/climdata/baur/master/csv/baur_monthly.csv", sep=",")
py2 <- subset(py, !is.na(py$temperature))

pt1 <- data.frame()
pt0 <- read.csv("https://raw.githubusercontent.com/climdata/glaser2010/master/csv/t_1500_2xxx.csv", sep=",", na = "NA")
monthNames = c("jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec")
for(i in 1:length(monthNames)) {
  ptnew <- data.frame(year = pt0$year, month = i)
  temp <- pt0[,monthNames[i]]
  ptnew$temperature <- temp
  pt1 <- rbind(pt1, ptnew)
}

pt1$time = pt1$year + (pt1$month+0.5)/12.0
pt1 <- pt1[order(pt1$time),]


123 + 456

123 - 456

123 * 456

123 / 456

pi

x = 12345
print(x)

x <- 123
x

x = 255
sqrt(x)

sqrt(123)

x = 123
log(x)

sin(pi/2)

y = 3:7
print(y)

z = c(1, 2, 5, 4, 7)
print(z)

sqrt(z)

print(z + 1.0)

length(z)

sum(z)

mean(z)

z[1]

z[2:4]


# File:   Scatterplots.R
# Course: R: An Introduction (with RStudio)

# LOAD DATASETS PACKAGES ###################################

library(datasets)  # Load/unload base packages manually

# LOAD DATA ################################################

?mtcars
head(mtcars)

# PLOTS ####################################################

# Good to first check univariate distributions
hist(mtcars$wt)
hist(mtcars$mpg)

# Basic X-Y plot for two quantitative variables
plot(mtcars$wt, mtcars$mpg)

# Add some options
plot(mtcars$wt, mtcars$mpg,
	 pch = 19,         # Solid circle
	 cex = 1.5,        # Make 150% size
	 col = "#cc0000",  # Red
	 main = "MPG as a Function of Weight of Cars",
	 xlab = "Weight (in 1000 pounds)",
	 ylab = "MPG")

# CLEAN UP #################################################

# Clear packages
detach("package:datasets", unload = TRUE)  # For base

# Clear plots
dev.off()  # But only if there IS a plot

# Clear console
cat("\014")  # ctrl+L

# Scatter Plot is easiest way of looking at the association between 2 variables, especially
# when the two variables are quantitative.

# Clear mind :)


getwd()

college<-read.csv("data.csv")

rownames(college)=college [,1]
fix(college)
college =college [,-1] > fix(college)
fix(college)
glimpse(college)
summary(college)
pairs(college[ ,1:10])
ggplot(college, aes(x = private, y = outstate, fill = private)) +
  geom_boxplot() +
  scale_y_continuous(labels = scales::comma_format()) +
  theme(legend.position = "none") +
  labs(title = "Outstate vs Private - Boxplot")
Elite=rep("No",nrow(college ))
Elite[college$top10perc >50]=" Yes"
Elite=as.factor(Elite)
college=data.frame(college , Elite)

summary(college$Elite)
ggplot(college, aes(x = Elite, y = outstate, fill = Elite)) +
  geom_boxplot() +
  scale_y_continuous(labels = scales::comma_format()) +
  theme(legend.position = "none") +
  labs(title = "Outstate vs Elite - Boxplot")
par(mfrow=c(2,2))
hist(college$f_undergrad,
     main="Undergrad - Histogram",
     xlab="undergrad",
     col="deeppink1",breaks=15)
hist(college$phd,
     main="PHD - Histogram",
     xlab="PHD",
     col="#BF87B3",breaks=25)

hist(college$perc_alumni,
     main="Percentage of Alumni - Histogram",
     xlab="Percentage Alumni",
     col="#000080",breaks=40)
hist(college$personal,
     main="Personal - Histogram",
     xlab="personal",
     col="#000080",breaks=20)
range(Auto$mpg)
range(Auto$cylinders)
range(Auto$displacement)
range(Auto$horsepower)
range(Auto$weight)
range(Auto$acceleration)
range(Auto$year)
mean(Auto$mpg)
mean(Auto$cylinders)
mean(Auto$displacement)
mean(Auto$horsepower)
mean(Auto$weight)
mean(Auto$acceleration)
mean(Auto$year)
sd(Auto$mpg)
sd(Auto$cylinders)
sd(Auto$displacement)
sd(Auto$horsepower)
sd(Auto$weight)
sd(Auto$acceleration)
sd(Auto$year)
Auto1<-Auto[-c(10:85), ]
range(Auto1$mpg)
range(Auto1$cylinders)
range(Auto1$displacement)
range(Auto1$horsepower)
range(Auto1$weight)
range(Auto1$acceleration)
range(Auto1$year)
sd(Auto1$mpg)
sd(Auto1$cylinders)
sd(Auto1$displacement)
sd(Auto1$horsepower)
sd(Auto1$weight)
sd(Auto1$acceleration)
sd(Auto1$year)
pairs(Auto[,1:7])
chrel<-ggplot(Auto, aes(x =cylinders , y = horsepower)) +
  geom_point() +
  scale_x_continuous(labels = scales::comma_format()) +
  labs(x = "Cylinders",
       y = "Horsepower",
       title = "Correlation between Cylinders and Horsepower")
chrel
wH<-ggplot(Auto, aes(x =weight , y = horsepower)) +
  geom_point() +
  scale_x_continuous(labels = scales::comma_format()) +
  labs(x = "Weight",
       y = "Horsepower",
       title = "Correlation between Weight and Horsepower")
wH
wa<-ggplot(Auto, aes(x = weight, y = acceleration)) +
  geom_point() +
  theme(legend.position = "none") +
  labs(x = "Weight",
       y = "Acceleration",
       title = "Correlation between weight and acceleration")
wa
Auto$origin <- factor(Auto$origin, labels = c("American", "Australian", "Indian"))
ggplot(Auto, aes(x = weight, y = acceleration, col = origin)) +
  geom_point() +
  geom_smooth(method = "lm") +
  facet_wrap(~ origin) +
  theme(legend.position = "none") +
  labs(x = "Weight",
       y = "Acceleration",
       title = "Correlation between weight and acceleration, by origin")
ggplot(Auto, aes(x = year + 1900, y = acceleration)) +
  geom_jitter() +
  theme(legend.position = "none") +
  labs(x = "Year",
       y = "Acceleration",
       title = "Acceleration (trends over time)")
ggplot(Auto, aes(x = year + 1900, y = acceleration, col = factor(origin))) +
  geom_jitter() +
  geom_smooth(method = "lm") +
  theme(legend.position = "none") +
  labs(x = "Year",
       y = "Acceleration",
       title = "Acceleration (trends over time), by Origin") +
  facet_wrap(~ origin)
boxp<-ggplot(Auto, aes(x = origin, y = mpg, fill = origin)) +
  geom_boxplot() +
  theme(legend.position = "none") +
  labs(title = "Origin vs Mpg - Boxplot",
       x = "Origin",
       y = "MPG")
cylmpg<-ggplot(Auto, aes(x =cylinders , y = mpg)) +
  geom_point() + geom_jitter() +
  geom_smooth(method = "lm") +
  scale_x_continuous(labels = scales::comma_format()) +
  labs(x = "Cylinders",
       y = "MPG",
       title = "Correlation between Cylinders and MPG")
cylmpg

dim(Boston)
g1 <- ggplot(Boston, aes(x = age, y = tax)) + geom_smooth(method = "lm", formula = "y ~ x + I(x^2)") +
  scale_x_continuous(labels = scales::comma_format()) +
  geom_jitter(alpha = 0.1) + labs(title = "Age vs Tax - Jitter Plot",
                                  x = "age",
                                  y = "tax")
g1
summary(lm(age~tax,data=Boston))

best_predictor(Boston, "crim")

ggplot(Boston, aes(x = medv, y = crim)) +
  geom_point(alpha = 0.5) +
  geom_smooth(method = "lm", formula = "y ~ x + I(x^2)", col = "green") +
  labs(title = "Medv vs Crim - Scatter Plot",
       x = "Medv",
       y = "Crim")
ggplot(Boston, aes(x = dis, y = crim)) +
  geom_point(alpha = 0.5) +
  geom_smooth(method = "lm", formula = "y ~ x + I(x^2)", col = "green") +
  labs(title = "Dis vs Crim - Scatter Plot",
       x = "Dis",
       y = "Crim")
ggplot(Boston, aes(x = lstat, y = crim)) +
  geom_point(alpha = 0.5) +
  geom_smooth(method = "lm", formula = "y ~ x + I(x^2)", col = "green") +
  labs(title = "Lstat vs Crim - Scatter Plot",
       x = "Lstat",
       y = "Crim")

sum(Boston$rm > 7)
Boston_gt_8rooms <- Boston[Boston$rm > 8, ]

nrow(Boston_gt_8rooms)
prop.table(table(Boston_gt_8rooms$chas))
Boston_gt_8rooms_perc <- Boston_percentiles[as.numeric(rownames(Boston_gt_8rooms)), ]

glimpse(Boston_gt_8rooms_perc)
sapply(Boston_gt_8rooms_perc, mean)


# Exercise 2

# Setup code

library(tidyverse)

# there is population data built into the tidyr package
population

# and population limited to just Egypt and Finland:
population_fe <- filter(population, country %in% c("Finland", "Egypt"))
population_fe

# here's the same data in two different shapes:

# columns for each year, rows for each country
population_year <- population %>%
  spread(year, population, sep="")
population_year

# and subset to just Finland and Egypt
population_year_fe <- filter(population_year,
                             country %in% c("Finland", "Egypt"))
population_year_fe

# columns for each country, rows for each year
population_country <- population %>%
  spread(country, population)
population_country

# and subset to just Finland and Egypt
population_country_fe <- select(population_country, year, Finland, Egypt)
population_country_fe

# **********************

# Part 1
# Choose the right data set from those created above:
# - population
# - population_fe
# - population_year
# - population_year_fe
# - population_country
# - population_country_fe
# to plot the population of all countries in 1995 vs. 2003
# See: images/fe2.png
# Replace the ___ below with the correct values

ggplot(___, aes(___, ___)) +
  geom_point() +
  geom_abline(aes(slope=1, intercept=0)) + # adds the diagonal line to show equal pop.
  scale_x_log10("1995") + # cleans up the label
  scale_y_log10("2013")   # cleans up the label

# Part 2
# Choose the right data set from those created above:
# - population
# - population_fe
# - population_year
# - population_year_fe
# - population_country
# - population_country_fe
# to make a line plot of population in the two countries over time
# See: images/fe1.png


score <- function(input) {
    if ((input[13]) > (9.725000000000003)) {
        if ((input[13]) > (16.205000000000002)) {
            var0 <- 21.71499740307178
        } else {
            var0 <- 22.322292901846218
        }
    } else {
        if ((input[6]) > (7.418000000000001)) {
            var0 <- 24.75760617150803
        } else {
            var0 <- 23.02910423871904
        }
    }
    if ((input[6]) > (6.837500000000001)) {
        if ((input[6]) > (7.462000000000001)) {
            var1 <- 2.0245964808123453
        } else {
            var1 <- 0.859548540618913
        }
    } else {
        if ((input[13]) > (14.365)) {
            var1 <- -0.7009440524656984
        } else {
            var1 <- 0.052794864734003494
        }
    }
    return((var0) + (var1))
}


REBOL [
    Title:  "Whatever"
    Date:   2-Feb-2000
    File:   %whatever.reb
    Author: "Whatever"
    Version: 1.2.3
]
maxLimit: 1000

factorial: func [n][
	either n > 1 [n * factorial n - 1] [1]
]

for i 0 maxLimit 1 [
	print factorial i
]


library(stringr)
library(sf)
library(dplyr)
library(ggplot2)

extract_data <- function(shape_url=url, level=1){
  # Extract Name
  url_splitted = strsplit(url,split = '/')[[1]]
  file_name = url_splitted[length(url_splitted)]
  # Download File
  zipped <- shape_url
  download.file(zipped,
                destfile=paste0("data/", file_name),
                mode="wb")
  # unzip
  new_folder = str_replace(paste0("data/", file_name), '.zip', '')
  unzip(paste0("data/", file_name),
        exdir = new_folder)
  # Read
  sf_file = paste0(new_folder, "/", str_replace(file_name, 'shp.zip', paste0(level, '.shp')))
  oz <- read_sf(sf_file)

  # Thinning
  oz_sm <- thin(oz)

  # Create Data Frame
  oz_sm <- oz_sm %>% mutate(
    data = 1:length(geometry) %>% purrr::map(.f = function(i) {
      g <- geometry[[i]]
      res <- g %>% purrr::map_df(.id="i", .f = function(gelement) {
        as.data.frame(gelement[[1]])
      })
      res$group <- paste0(i,"-",res$i)
      res
    })
  )

  # Unnest Data Frame
  oz_data <- oz_sm$data[[1]]

  # Change Column Names
  colnames(oz_data) <- c('order', 'long', 'lat', 'group')

  return(oz_data)
}

# For Iran
url <- 'https://biogeo.ucdavis.edu/data/gadm3.6/shp/gadm36_IRN_shp.zip'
iran <- extract_data(url, level = 0)
head(iran)

iran %>%
  ggplot(aes(x =long, y = lat, group = group))+
  geom_polygon() +
  ggtitle('Iran')


library(shiny)

# Define UI
shinyUI(pageWithSidebar(

  # Application title
  headerPanel("Model parameters"),

  # Sidebar with controls to select the variable to plot against mpg
  # and to specify whether outliers should be included
  sidebarPanel(
    selectInput("variable", "Model type:",
                c("Numerical Model"        = "Numer",
                  "Individual-Based Model" = "IBM")),

    sliderInput("time",
                "Number of generations",
                min = 10,
                max = 200,
                step  = 10,
                value = 100),

    sliderInput("N_initial",
                "Initial prey density",
                min   = 0,
                max   = 1,
                step  = 0.01,
                value = 0.4),

    sliderInput("P_initial",
                "Initial predator density",
                min   = 0,
                max   = 1,
                step  = 0.01,
                value = 0.4),

    sliderInput("lambda_N",
                "Prey population growth rate",
                min   = 0,
                max   = 2,
                step  = 0.01,
                value = 0.53),

    sliderInput("lambda_P",
                "Predator population decline rate",
                min   = 0,
                max   = 2,
                step  = 0.01,
                value = 0.5),

    sliderInput("attack",
                "Attack rate of predators",
                min   = 0,
                max   = 2,
                step  = 0.01,
                value = 1.3),

    sliderInput("K",
                "Prey density carrying capacity",
                min   = 0,
                max   = 1,
                step  = 0.01,
                value = 0.8),

    sliderInput("b",
                "Predator births per attack",
                min = 0,
                max = 2,
                step  = 0.01,
                value = 1.6),

    sliderInput("dispY",
                "Prey dispersal (IBM only)",
                min = 0.01,
                max = 1,
                step  = 0.01,
                value = 1),

    sliderInput("dispP",
                "Predator dispersal (IBM only)",
                min = 0.01,
                max = 1,
                step  = 0.01,
                value = 1),

    actionButton("go", "Run"),

    actionButton("finish", "Finish!"),

    actionButton("reset", "Reset")

  ),

  # Show the caption and plot of the requested variable against mpg
   mainPanel(plotOutput(outputId="distPlot"))

))


## 3. Using k-fold Cross-validation ##

set.seed(1)
library(caret)
train_indices <- createDataPartition(y = dc_listings[["tidy_price"]],
                                     p = 0.8,
                                     list = FALSE)
train_listings <- dc_listings[train_indices,]
test_listings <- dc_listings[-train_indices,]
five_fold_control <- trainControl(method = "cv", number = 5)

## 5. To use less or more folds? ##

loocv_has_high <- "bias"
two_fold_has_high <- "variance"

Data Analyst in R/Step 6 - Predictive Modeling and Machine Learning in R/2. Machine Learning Fundamentals in R/4. Cross Validation.r


  (t_test<- t.test(x = df$rt[df$Condition == "Descriptive"],
                  y = df$rt[df$Condition == "Experiential"],
                  paired = TRUE,
                  alternative = "two.sided"))
  report(t_test)
  rm(ttest, t_test)


library(survival)

Args<-commandArgs()
in_file<-Args[6]

data<-read.table(in_file, header=T, com='', sep="\t")
s<-Surv(data$Time, data$Status == 1)
sorted_exp <- sort(data$Exp)
cutoffs <- unique(round(sorted_exp[ceiling(length(sorted_exp)/10):floor(length(sorted_exp)/10*9)], 1))

min_pvalue <- 100;
min_cutoff <- 0;
pvalue <- vector(, length(cutoffs))
for (n in 1:length(cutoffs))
{
	diff <- survdiff(s~(data$Exp > cutoffs[n]))
	pvalue[n] <- 1 - pchisq(diff$chisq, length(diff$n) - 2)
	if (pvalue[n] < min_pvalue) {
		min_pvalue <- pvalue[n]
		min_cutoff <- cutoffs[n]
	}
}

km_all <- survfit(s~1)
km_median <- survfit(s~(data$Exp > median(data$Exp)))
km_min <- survfit(s~(data$Exp > min_cutoff))

diff_median <- survdiff(s~(data$Exp > median(data$Exp)))
pvalue_median <- 1 - pchisq(diff$chisq, length(diff$n) - 1)

png('survival_median.png')
plot(km_median, xlab="Time ( Days )",ylab="Probability of survival")
title(main=paste("Exp-cutoff =  ", round(median(data$Exp),2), " ; p-value = ",  round(pvalue_median,3)))
#plot(km_all)
dev.off()
png('survival_min.png')
plot(km_min, xlab="Time ( Days )",ylab="Probability of survival")
title(main=paste("Exp-cutoff =  ", round(min_cutoff,2), " ; p-value = ",  round(min_pvalue,3)))
dev.off()

df = data.frame(cutoffs, pvalue)
write.table(df, file='out.tsv', sep='\t', col.names=FALSE);


#autor:      Joao Sollari Lopes
#local:      INE, Lisboa
#Rversion:   3.6.1
#criado:     07.07.2017
#modificado: 06.12.2019

fnam <- "../images/svm_10.tiff"
tiff(file=fnam,units="in",width=3.5,height=3,res=300,compression="lzw")
par(mgp=c(2,0.75,0),mar=c(3.1,3.1,0.2,0.2))
x <- seq(-1,1,len=100)
y <- (3/4)*(1-x^2)
plot(x,y,type="l",col=2,lwd=2,xlim=c(-1.5,1.5),xlab="distance",ylab="weights")
lines(c(-1,-2),c(0,0),col=2,lwd=2)
lines(c(1,2),c(0,0),col=2,lwd=2)
dev.off()


ExtractModelSummary <- function(dat, var1, var2, var3 = NULL) {
    # This function has the purpose to extract the important parameters from the
    # model(s). If var3 is given, it means that there is the need to make the
    # model run on the same variable grouped by different rows.
    #
    # ARGS
    # - dat   [data table] is the data we are giving to the model
    # - var1  [character]  the independent variable
    # - var2  [character]  is the column name of the variable we want to put
    #                      in the model in correlation to var1
    # - var3  [character]  is the column name of the variable that we want to
    #                      group by. Default is NULL and means that only one
    #                      model is produced
    # RETURN
    # - dt    [data table] a data table with the statistical values of interest.
    #                      If var3 is not NULL, the number of rows of this data
    #                      table is the same number as the unique values in the
    #                      column given by var3

    if (!is.null(var3)) {
        mod <- dlply(dat, var3, function(dt)
            lm(eval(as.name(var2)) ~ eval(as.name(var1)), data = dt))
        dt <- data.table(formula     = character(),
                         correlation = character(),
                         r2          = double(),
                         pvalue      = character())
        dt[, ((var3)) := character()]
        # For each model, save a data table containing the statistical values
        # of interest
        for (i in 1:length(mod)) {
            # Reassign the correct name of the variable
            names(mod[[i]]$coefficients)[2] <- var2
            formula <- sprintf("y == %.2f % +.2f * x",
                               round(coef(mod[[i]])[1], 5),
                               round(coef(mod[[i]])[2], 5))
            r <- cor(x = dat[eval(as.name(var3)) == names(mod)[i],
                             eval(as.name(var1))],
                     y = dat[eval(as.name(var3)) == names(mod)[i],
                             eval(as.name(var2))])
            correlation <- sprintf("correlation = %.5f", r)
            r2 <- sprintf("R^2 = %.5f", r^2)
            p_value <- summary(mod[[i]])$coefficients[,"Pr(>|t|)"][2]
            pvalue <- ifelse(p_value < 0.0001,
                             "p < 0.0001",
                             sprintf("p = %.4f", p_value))
            beta_coef <- sprintf("Slope coeff. = %.4f",
                                 summary(mod[[i]])$coefficients[, 1][2])
            # Save the data
            dt_tmp <- data.table(formula     = formula,
                                 correlation = correlation,
                                 r2          = r2,
                                 pvalue      = pvalue,
                                 beta_coef   = beta_coef,
                                 stringsAsFactors = FALSE)
            dt_tmp[, ((var3)) :=  names(mod)[i],]
            dt <- rbind(dt, dt_tmp)
        }

    } else {
        mod <- lm(eval(as.name(var2)) ~ eval(as.name(var1)), data = dat)
        # Reassign the correct name of the variable
        names(mod$coefficients)[2] <- var2
        formula <- sprintf("y == %.2f % +.2f * x",
                           round(coef(mod)[1], 5),
                           round(coef(mod)[2], 5))
        r <- cor(x = dat[, eval(as.name(var1))],
                 y = dat[, eval(as.name(var2))])
        correlation <- sprintf("correlation = %.5f", r)
        r2 <- sprintf("R^2 = %.5f", r^2)
        p_value <- summary(mod)$coefficients[,"Pr(>|t|)"][2]
        pvalue <- ifelse(p_value < 0.0001,
                         "p < 0.0001",
                         sprintf("p = %.4f", p_value))
        beta_coef <- sprintf("Slope coeff. = %.4f",
                             summary(mod)$coefficients[, 1][2])
        # Save the data
        dt <- data.table(formula     = formula,
                         correlation = correlation,
                         r2          = r2,
                         pvalue      = pvalue,
                         beta_coef   = beta_coef,
                         stringsAsFactors = FALSE)
    }

    return(dt)
}


R version 3.3.0 (2016-05-03) -- "Supposedly Educational"
Copyright (C) 2016 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

[Workspace loaded from ~/.RData]

 library(tree)

 realEstate <- read.table("d:/RealEstate.txt", header=TRUE)

 dim(realEstate)

 str(realEstate)

 head(realEstate)

 summary(realEstate)

 treeModel <- tree(log(MedianHouseValue) ~ Longitude + Latitude, data=realEstate)

 summary(treeModel)

 plot(treeModel)

 text(treeModel, cex=.75)

 priceDeciles <- quantile(realEstate$MedianHouseValue, 0:10/10)

 priceDeciles

 summary(priceDeciles)

 cutPrices <- cut(realEstate$MedianHouseValue, priceDeciles, include.lowest=TRUE)

 head(cutPrices)

 summary(cutPrices)

 plot(realEstate$Longitude, realEstate$Latitude, col=grey(10:2/11)[cutPrices], pch=20, xlab="Longitude",ylab="Latitude")

 summary(realEstate$Longitude)

 head(realEstate$Longitude)

 summary( realEstate$Latitude)

 head( realEstate$Latitude)

 partition.tree(treeModel, ordvars=c("Longitude","Latitude"), add=TRUE)

 treeModel2 <- tree(log(MedianHouseValue) ~ Longitude + Latitude, data=realEstate, mindev=0.001)

 summary(treeModel2)

 plot(treeModel2)

 text(treeModel2, cex=.65)

 treeModel3 <- tree(log(MedianHouseValue) ~ ., data=realEstate)

 summary(treeModel3)

 plot(treeModel3)

 text(treeModel3, cex=.75)

Chapter 06/2Decision tree learning - Income Based Distribution of Real Estate Value.r


setClassUnion("Linalg", c("vector", "matrix"))

setClassUnion("VecTypes", c("numeric", "logical"))

#' Banded Matrix Classes
#'
#' Class for general and symmetric banded matrices.
#'
#' @slot DATA
#' The data.
#' @slot dim
#' matrix dimension.
#' @slot kl,ku
#' Size of the upper and lower bands (bandwidth) in the general case.
#'
#' @name classes
#' @aliases classes
#' @keywords Classes
#' @docType class
#' @rdname classes
NULL

#' @rdname classes
#' @export
setClass(
  Class="GenBandMat",
  representation=representation(
    Data="VecTypes",
    dim="integer",
    kl="integer",
    ku="integer"
  ),

  prototype=prototype(
    Data=numeric(0),
    dim=c(1L, 1L),
    kl=0L,
    ku=0L
  ),

  validity=valid.GenBandMat
)

#' @slot triangle
#' Size of the bands in the symmetric case.
#'
#' @rdname classes
#' @export
setClass(
  Class="SymMat",
  representation=representation(
    Data="VecTypes",
    dim="integer",
    triangle="character"
  ),

  prototype=prototype(
    Data=numeric(0),
    dim=c(0L, 0L),
    triangle="u"
  ),

  validity=valid.SymMat
)

#' @rdname classes
#' @export
setClass(
  Class="DiagMat",
  representation=representation(
    Data="VecTypes",
    dim="integer"
  ),

  prototype=prototype(
    Data=numeric(0),
    dim=c(1L, 1L)
  ),

  validity=valid.DiagMat
)

#' @rdname classes
#' @export
setClass(
  Class="ZeroMat",
  representation=representation(
    dim="integer"
  ),

  prototype=prototype(
    dim=c(1L, 1L)
  ),

  validity=valid.ZeroMat
)

setClassUnion("BandMat", c("ZeroMat", "DiagMat", "GenBandMat"))


############################################################
# kmer_hist.r
#
# Produce pdf and txt histograms for further analysis.
############################################################

############################################################
# est.mean
#
# Estimate the coverage mean by finding the max past the
# first valley.
############################################################
est.mean = function(d) {
  # make histogram
  hc = hist(d, breaks=seq(0,round(max(d))+1,1), plot=F)$counts

  # find first valley (or right before it)
  valley = hc[1]
  i = 2
  while(hc[i] < valley) {
    valley = hc[i]
    i = i + 1
  }

  # return max over the rest
  max.hist = hc[i]
  max.cov = i
  while(i <= length(hc)) {
    if(hc[i] > max.hist) {
      max.hist = hc[i]
      max.cov = i
    }
    i = i + 1
  }
  return( max.cov )
}

############################################################
# load data
############################################################
cov = scan("kmers.txt")

cov.mean = est.mean(cov)
cov.max = max(cov)

############################################################
# histogram pdf
############################################################
pdf("kmer_hist.pdf")
hc = hist(cov, breaks=seq(0,ceiling(cov.max)), plot=F)$counts
hist(cov, breaks=seq(0,ceiling(cov.max)), xlim=c(0, round(1.7*cov.mean)), ylim=c(0, round(1.2*hc[cov.mean])), xlab="Coverage", main="k-mer counts")
dev.off()

############################################################
# histogram txt
############################################################
hist.max = 2.5*round(cov.mean)
scov = cov[cov < hist.max]
h = hist(scov, breaks=seq(0,hist.max,.1), plot=FALSE)

outf = "kmer_hist.bin10.txt"
cat("", file=outf)
for(i in seq(1,10*hist.max)) {
  cat(i*.1, "\t", h$counts[i], "\n", sep=" ", file=outf, append=TRUE)
}


## scatterplot matrix example
p16 = ggplot(data=d,aes(x=album_popularity, y=track_popularity)) + geom_point(col=rgb(0,0,215,5,maxColorValue=255), pch=16) + geom_smooth(method=glm,se=TRUE,size=0.5,color="gold") + theme(panel.background = element_blank())

## barplot
ggplot(data=data, aes(fill=Class, y=Track_Num, x=reorder(Genres,-Track_Num))) + geom_bar(stat="identity") + theme(panel.background = element_blank(),axis.text.x = element_text(angle = 45, hjust = 1,size=8)) + ylab("Num") + xlab("Genres")

## boxplot matrix example
q16 = ggplot(d, aes(x=factor(year), y=album_popularity)) + geom_boxplot(fill=rgb(0,0,215,100,maxColorValue=255),lwd=0.2,colour="black",outlier.colour="brown", outlier.shape=20, outlier.size=1) + stat_summary(fun.y=mean, geom="line", aes(group=2),colour="gold",size=0.9)  + stat_summary(fun.y=mean, geom="point",size=0.5,colour="black") + theme(panel.background = element_blank(),axis.text.x = element_text(angle = 45, hjust = 1,size=4)) + xlab('year')

## chord diagram
corr <- cor(dat)
chordDiagram(corr)

##
geom_line


valoreX <- 5
alfa <- 0.0081

domanda2_1 <- 9
domanda2_2 <- 5

teta <- 1 - sqrt(alfa)

prX <- function(x){

  if( x >= 1 ){

    return(teta*(1-teta)^(x-1))

  } else{

    return(0)

  }

}

print(teta)

prIntersezione <- 0

for( i in domanda2_2:domanda2_1 ){

  prIntersezione <- prIntersezione + prX(i)

}

prCondizionante <- 1

for( i in 1:(domanda2_2-1) ){

  prCondizionante <- prCondizionante - prX(i)

}

print(prIntersezione/prCondizionante)
print(prIntersezione/alfa)


system.time({
  B = data.frame(x1=runif(100000), x2=runif(100000), x3=runif(100000))
})


# create_data ----
create_data <- function(n = 1000) {
  weights = runif(9, min = -2, max = 2)

  data_value <- data.frame(
    profit = rnorm(n),
    cogs = rnorm(n),
    fixed_cost = rnorm(n),
    rnd = rnorm(n),
    assets = rnorm(n),
    competition = rnorm(n),
    quality = rnorm(n),
    board_size = rnorm(n),
    ceo_age = rnorm(n)
  )
  data_value$firm_value <- rowSums(data_value * weights)

  data_value$female_ceo = as.logical(rbinom(n, 1, 0.5))
  data_value$firm_value <- data_value$firm_value + data_value$female_ceo * runif(1, -0.1, 0.1)

  data_value$industry = sample(c("A", "B", "C", "D"), n, replace = TRUE)
  data_value$firm_value[data_value$industry == "A"] <- data_value$firm_value[data_value$industry == "A"] + runif(1, 0, 0.2)
  data_value$firm_value[data_value$industry == "B"] <- data_value$firm_value[data_value$industry == "B"] + runif(1, -0.1, 0.1)
  data_value$firm_value[data_value$industry == "C"] <- data_value$firm_value[data_value$industry == "C"] - runif(1, -0.1, 0.1)
  data_value$firm_value[data_value$industry == "D"] <- data_value$firm_value[data_value$industry == "D"] - runif(1, 0, 0.2)

  data_value$country = sample(c("A", "B", "C", "D"), n, replace = TRUE)
  data_value$firm_value[data_value$country == "A"] <- data_value$firm_value[data_value$country == "A"] + runif(1, 0, 0.2)
  data_value$firm_value[data_value$country == "B"] <- data_value$firm_value[data_value$country == "B"] + runif(1, -0.1, 0.1)
  data_value$firm_value[data_value$country == "C"] <- data_value$firm_value[data_value$country == "C"] - runif(1, -0.1, 0.1)
  data_value$firm_value[data_value$country == "D"] <- data_value$firm_value[data_value$country == "D"] - runif(1, 0, 0.2)

  data_value$firm_value <- data_value$firm_value + rnorm(n)

  if (requireNamespace("tibble", quietly = TRUE)) {
    data_value <- tibble::as_tibble(data_value)
  }

  return(data_value)
}


# load packages
library(dplyr)
library(igraph)

#setwd('/Users/carolinesklaver/Desktop/Network_DS/ProjectEDA')

# ________________________________________________________________________________________
# FUNCTION FOR METRICS
# function that can take in any df and pump out metrics as df

# read in pipeline data
all_flights_2018 = read.csv('all_flights_2018.csv')

# select origin, dest, flights, make flights = to weight
test = all_flights_2018 %>% select(ORIGIN, DEST, flights) %>% rename(from = ORIGIN, to = DEST, weight = flights)

test <- filter(test, weight>0)
# make into igraph object
test_graph_wgt <- graph.data.frame(test, directed = TRUE)

plot(betweenness(test_graph_wgt))
mean(betweenness(test_graph_wgt))

mean(betweenness(g))

plot(edge_betweenness(test_graph_wgt))
mean(edge_betweenness(test_graph_wgt))

# make into igraph object
test_graph_wgt <- graph.data.frame(test, directed = TRUE)
# check that it is weighted
is_weighted(test_graph_wgt)
print(V(test_graph_wgt))
plot(degree(test_graph_wgt))
print(diameter(test_graph_wgt))
E(test_graph_wgt)

g <- graph_from_edgelist(dataframe %>% select(ORIGIN, DEST) %>% as.matrix())
diameter(g)
farthest_vertices(g)

mean(betweenness(test_graph_wgt))

edge_betweenness(g)

farthest_vertices(g)
farthest_vertices(test_graph_wgt)

dist_mat <- distances(g, v=V(g), to=V(g))
write.csv(dist_mat, 'dist_mat.csv')

dist_mat <- distances(test_graph_wgt, v=V(test_graph_wgt), to=V(test_graph_wgt))
write.csv(dist_mat, 'dist_mat_weighted.csv')

data_98 = read.csv('Air_Data_1998.csv', header = TRUE)
data = read.csv('Air_Data_2018.csv', header = TRUE)
southwest_2018 = data[data$UNIQUE_CARRIER_NAME == 'Southwest Airlines Co.',]
american_2018 = data[data$UNIQUE_CARRIER_NAME == 'American Airlines Inc.',]
delta_2018 = data[data$UNIQUE_CARRIER_NAME == 'Delta Air Lines Inc.',]
united_2018 = data[data$UNIQUE_CARRIER_NAME == 'United Air Lines Inc.',]

get_metrics <- function(dataframe) {

  # Make df into matrix
  # Can change to city instead of city code if we want
  g <- graph_from_edgelist(dataframe %>% select(ORIGIN, DEST) %>% as.matrix())

  # It calculates the shortest paths between all nodes,
  # then assigns each node a score based on its sum of shortest paths
  # and is useful for finding the individuals who are best placed to influence
  # the entire network most quickly.
  Closeness_Centrality <- mean(closeness(g, mode="all"))

  #BETWEENESS
  # vertex betweness
  Betweenness = mean(betweenness(g))

  #DEGREE
  # gives degree of each node, we can do in and out separate if we want
  Degree = mean(degree(g, mode='all'))

  ##DISTANCE
  # The diameter of a graph is the length of the longest geodesic.
  Diameter <- diameter(g, directed = TRUE)

  metrics_df = data.frame(Degree,Degree_Centrality,Betweenness,Closeness_Centrality,Diameter)
  #get number of vertices, edges, and p(edge) for random networks
  numb_edges <- length(E(g))
  numb_vertices <-length(V(g))
  p_edges <- (numb_edges/(numb_vertices*(numb_vertices-1)))

  # generate randmom networks using the parameters from the given network
  # intialize random dataframe
  rand_g_metrics <- data.frame()
  for(i in 1:1000)  {
    g <- sample_gnp(n=numb_vertices, p=p_edges, directed=TRUE)
    degree.cent <- centr_degree(g, mode = "all")
    rand_Degree_Centrality = mean(degree.cent$res)
    rand_Closeness_Centrality <- mean(closeness(g, mode="all"))
    rand_Betweenness = mean(betweenness(g))
    rand_Degree <- mean(degree(g, mode='all'))
    rand_Diameter <- diameter(g, directed = TRUE)
    rand_metric = data.frame(rand_Degree,rand_Degree_Centrality,rand_Betweenness,
                             rand_Closeness_Centrality,rand_Diameter)
    rand_g_metrics <- rbind(rand_g_metrics, rand_metric)

  }
  rand_g_metrics <- colMeans(rand_g_metrics)
  rand_g_metrics_df <- data.frame(rand_g_metrics)
  metrics_df <- merge(metrics_df, t(rand_g_metrics))
  return(metrics_df)

}

metrics_2018 = get_metrics(data)
metrics_1998 = get_metrics(data_98)
metrics_sw_2018 = get_metrics(southwest_2018)
metrics_american_2018 = get_metrics(american_2018)
metrics_delta_2018 = get_metrics(delta_2018)
metrics_united_2018 = get_metrics(united_2018)

#troubleshoot sw
g <- graph_from_edgelist(southwest_2018 %>% select(ORIGIN, DEST) %>% as.matrix())
numb_edges <- length(E(g))
numb_vertices <-length(V(g))
p_edges <- (numb_edges/(numb_vertices*(numb_vertices-1)))

print(p_edges)
print(numb_vertices)

summary_metrics <- data.frame()
metric_dfs <- list(
                metrics_1998,
                metrics_2018,
                metrics_american_2018,
                metrics_delta_2018,
                metrics_united_2018)

row_names <- c(    'metrics_2018',
                   'metrics_1998',

                   'metrics_american_2018',
                   'metrics_delta_2018',
                   'metrics_united_2018')

col_names <- colnames(metrics_2018)

# for averaged metrics output
for (df in metric_dfs) {
  summary_metrics <- rbind(summary_metrics, df)
}
row.names(summary_metrics) <- row_names
colnames(summary_metrics) <- col_names

summary_metrics <- round(summary_metrics, digits=5)
write.csv(summary_metrics, 'summary_metrics.csv')

# for non averaged metrics output
#for (df in metric_dfs) {
#  summary_metrics <- rbind(summary_metrics, colMeans(df))
#  }
#row.names(summary_metrics) <- dfs_names
#colnames(summary_metrics) <- col_names

V(AA_1998)


input <- 312051

print((312051-1)/8)

# start of each ring:
# 1 -> 2
# 2 -> 10 =
# 3 -> 26
# 4 -> 50
# 5 -> 82


library("pracma")

inputs <- c(1, 2, 3, 2.5)

weights <- list( c(0.2, 0.8, -0.5, 1.0),
                 c(0.5, -0.91, 0.26, -0.5),
                 c(-0.26, -0.27, 0.17, 0.87))

biases <- c(2,3,0.5)

weights_matrix <- do.call(cbind, weights)

output <- dot(weights_matrix, inputs) + biases
print(output)


# 4. faza: Analiza podatkov

podatki <- HDI_drzave_leta %>%
  filter(Drzava == "Germany")

# Regresija oz. napoved

quadratic <- lm(data = podatki, Stevilo ~ I(Leto))
leta <- data.frame(Leto=seq(2019, 2025, 1))
prediction <- mutate(leta, Stevilo=predict(quadratic, leta))

regresija <- podatki %>%
  ggplot(aes(x=Leto, y=Stevilo)) +
  geom_smooth(method="lm", fullrange=TRUE, color="red", formula=y ~ x) +
  geom_point(size=2, color="blue") +
  geom_point(data=prediction %>% filter(Leto >= 2019), color="green3", size=3) +
  scale_x_continuous('Leto', breaks = seq(1998, 2025, 1), limits = c(1998,2025)) +
  ylab("HDI") +
  labs(title = "Napoved HDI") +
  theme(axis.text.x=element_text(angle=90, size=10, vjust=0.5))

# Ta graf bom vključila v Shiny aplikacijo.


state <- read.csv(file="~/Downloads/github-sandbox/data-science/estatistica-pratica/homicidios-populacao.csv")
avg <- mean(state[["populacao"]])

avg_trim <- mean(state[["populacao"]], trim=0.1)

med <- median(state[["populacao"]])

weight_avg <- weighted.mean(state[["homicidio"]], w=state[["populacao"]])
#install.packages("matrixStats")

library("matrixStats")
weight_median <- weightedMedian(state[["homicidio"]], w=state[["populacao"]])


circle_of_numbers <- function(n, first_number) {
    (first_number + n %/% 2) %% n
}


#' Wrapper for generating a summary set
#'
#' Allows arbitrary sample overlap
#'
#' @param beta_gx Array of true effects on x
#' @param beta_gy Array of true effects on y
#' @param af Array of effect allele frequencies
#' @param n_gx Sample size of g-x association
#' @param n_gy Sample size of g-y association
#' @param n_overlap Number of overlapping samples
#' @param cor_xy Observational correlation between x and y
#' @param prev_y Disease prevalence of y. Default = NA (in which case treated as continuous)
#' @param sigma_x SD of x. Default=1
#' @param sigma_y SD of y. Default=1
#'
#' @export
#' @return Data frame of summary statistics for x and y
summary_set <- function(beta_gx, beta_gy, af, n_gx, n_gy, n_overlap, cor_xy, prev_y=NA, sigma_x=1, sigma_y=1)
{
  stopifnot(length(beta_gy) == length(beta_gx))
  stopifnot(length(af) == length(beta_gx))
  stopifnot(all(af < 1 & af > 0))
  stopifnot(cor_xy <= 1 & cor_xy >= -1)
  stopifnot(n_overlap <= min(n_gx, n_gy))

  nsnp <- length(beta_gx)

  if(n_overlap == 0)
  {
    bhat_gx <- generate_gwas_ss(params=dplyr::tibble(beta=beta_gx, af=af, snp=1:nsnp), nid=n_gx, vy=sigma_x^2)
    bhat_gy <- generate_gwas_ss(params=dplyr::tibble(beta=beta_gy, af=af, snp=1:nsnp), nid=n_gy, vy=sigma_y^2)
    dat <- merge_exp_out(bhat_gx, bhat_gy)
    return(dat)
  }

  G_prob <- cbind(af^2, 2*af*(1-af), (1-af)^2)

  if(!is.na(prev_y))
  {
    myfunc <- function(af, Gamma0, Gamma1, prev)
    {
      af^2 * stats::plogis(Gamma0 + Gamma1 * 2) + 2 * af * (1 - af) * stats::plogis(Gamma0 + Gamma1) + (1 - af)^2 * stats::plogis(Gamma0) - prev
    }

    Gamma0 <- numeric(nsnp)
    for(i in 1:nsnp)
    {
      Gamma0[i] <- stats::uniroot(myfunc, Gamma1=beta_gy[i], af=af[i], prev=prev_y, lower=-10, upper=10)$root
    }

    var_gy <- asymp_var_logistic(n_gy, G_prob, Gamma0, beta_gy)
    var_gx <- asymp_var_linear(n_gx, G_prob, sigma=sigma_x)
    cov_gx_gy <- asymp_cov_linear_logistic(n_overlap, n_gx, n_gy, G_prob, cor_xy=cor_xy, sigma=sigma_x, Gamma_0=Gamma0, Gamma_1=beta_gy, prev=prev_y)
  }

  var_gy <- asymp_var_linear(n_gy, G_prob, sigma=sigma_y)
  var_gx <- asymp_var_linear(n_gx, G_prob, sigma=sigma_x)
  cov_gx_gy <- asymp_cov_linear_linear(n_overlap, n_gx, n_gy, G_prob, sigma_x=sigma_x, sigma_y=sigma_y,cor_xy=cor_xy)

  cov_array <- array(dim=c(2, 2, nsnp))
  cov_array[1,1,] <- var_gx
  cov_array[2,1,] <- cov_gx_gy
  cov_array[1,2,] <- cov_array[2,1,]
  cov_array[2,2,] <- var_gy

  summary_stats <- apply(cov_array, 3, function(x)
  {
    MASS::mvrnorm(n=1, mu=c(0,0), Sigma=x)
  })

  summary_stats <- t(summary_stats + rbind(beta_gx, beta_gy))

  dat <- dplyr::tibble(
    SNP = 1:nsnp,
    id.exposure="X",
    id.outcome="Y",
    exposure="X",
    outcome="Y",
    beta.exposure = summary_stats[,1],
    beta.outcome = summary_stats[,2],
    se.exposure = sqrt(var_gx),
    se.outcome = sqrt(var_gy),
    fval.exposure = (beta.exposure/se.exposure)^2,
    fval.outcome = (beta.outcome/se.outcome)^2,
    pval.exposure = pf(fval.exposure, df1=1, df2=n_gx-1, lower.tail=FALSE),
    pval.outcome = pf(fval.outcome, df1=1, df2=n_gy-1, lower.tail=FALSE),
    eaf.exposure = af,
    eaf.outcome = af,
    mr_keep=TRUE
  )
  return(dat)
}

## calculate asymptotic version of (X^t W X)
asymp_var_logistic <- function(n,G_prob,Gamma_0,Gamma_1){
  N <- length(Gamma_0)
  disease_probs <- stats::plogis(outer(Gamma_0,c(1,1,1)) +  outer(Gamma_1,c(0,1,2)))
  diag_weights <- disease_probs*(1-disease_probs)

  a <- n*apply(G_prob*diag_weights,1,sum)
  b <- n*apply(G_prob*diag_weights*matrix(rep(c(0,1,2),N),byrow=TRUE,nrow=N),1,sum)
  c <-  b
  d <- n*apply(G_prob*diag_weights*matrix(rep(c(0,1,4),N),byrow=TRUE,nrow=N),1,sum)

  ##  invert matrix and take element for Gamma1
  return(a/(a*d-b*c))

}

asymp_var_linear <- function(n,G_prob,sigma=1){
  N <- nrow(G_prob)

  a <- n*apply(G_prob,1,sum)
  b <- n*apply(G_prob*matrix(rep(c(0,1,2),N),byrow=TRUE,nrow=N),1,sum)
  c <-  b
  d <- n*apply(G_prob*matrix(rep(c(0,1,4),N),byrow=TRUE,nrow=N),1,sum)

  ##  invert matrix and take element for Gamma1
  return(a/(a*d-b*c)*sigma^2)

}

asymp_cov_linear_linear <- function(n_overlap,n_gx,n_gy,G_prob,sigma_x=1,sigma_y=1,cor_xy=.5){
  N <- nrow(G_prob)
    cov_xy <- cor_xy*sigma_x*sigma_y

  a <- apply(G_prob,1,sum)
  b <- apply(G_prob*matrix(rep(c(0,1,2),N),byrow=TRUE,nrow=N),1,sum)
  c <-  b
  d <- apply(G_prob*matrix(rep(c(0,1,4),N),byrow=TRUE,nrow=N),1,sum)

  ##  invert matrix and take element for Gamma1
  return(n_overlap*(a/(a*d-b*c))*cov_xy/(n_gx*n_gy))

}

asymp_cov_linear_logistic <- function(n_overlap,n_gx,n_gy,G_prob,cor_xy=0,sigma=1,Gamma_0,Gamma_1,prev=0.01){
  N <- length(Gamma_0)
  cov_xy <- cor_xy*sigma*sqrt(prev*(1-prev))
  disease_probs <- stats::plogis(outer(Gamma_0,c(1,1,1)) +  outer(Gamma_1,c(0,1,2)))
  diag_weights <- disease_probs*(1-disease_probs)

  a <- apply(G_prob*diag_weights,1,sum)
  b <- apply(G_prob*diag_weights*matrix(rep(c(0,1,2),N),byrow=TRUE,nrow=N),1,sum)
  c <-  b
  d <- apply(G_prob*diag_weights*matrix(rep(c(0,1,4),N),byrow=TRUE,nrow=N),1,sum)

  ##  invert matrix and take element for Gamma1
  return(n_overlap*(a/(a*d-b*c))*cov_xy/(n_gx*n_gy))

}


library(car)

d <- read.csv("~/Documents/io/mirango/mst/max-edge-mst.txt")

ls <- loess(y ~ x, data=d)
pr.loess <- predict(ls)
m <-lm(y ~ x, data=d)
abline(coef(m), col="blue")
pr.abline <- predict(m)

fit1 <- lm(y~poly(x,5,raw=TRUE), data=d)

plot(y ~ x, data=d, xlab="vertices", ylab="largest edge in mst", main="Largest Edge by Number of Vertices")
lines(pr.loess~x, data=d, col="red", lwd=2)
lines(pr.abline~x, data=d, col="blue", lwd=2)

xx <- seq(0,3000, length=100)
lines(xx, predict(fit1, data.frame(x=xx)), col="green", lwd=2)

summary(pr.abline)
summary(pr.loess)
summary(fit1)


J  <- 10
adaptive.ca0.estimates <- read.csv(paste("../data/constant_data/Gaussian_logCA0_adaptive",
                                         "_J=", J, ".csv", sep = ""))

adaptive.ca0.estimates$order <- c(0, 1:(nrow(adaptive.ca0.estimates)-2), 1)

fit.gam.adaptive <- mgcv::gam(lc_a0 ~ s(a0, k = J + 1), data = adaptive.ca0.estimates)

K <- 20000
maxA <- max(adaptive.ca0.estimates$a0)
pred_a0s <- seq(0, maxA, length.out = K)

preds.gam.adaptive  <- get_band(fit.gam.adaptive, xpred = pred_a0s)

adaptive.preds <-  data.frame (a0 = pred_a0s, lca0 = preds.gam.adaptive$mean,
                               lwr = preds.gam.adaptive$lwr,
                        upr = preds.gam.adaptive$upr)

library(ggplot2)

selected <- subset(adaptive.ca0.estimates, a0 > 0 & order < 6) #
selected$point_name <- paste0("j=", selected$order)
selected$lca0 <- selected$lc_a0

p0 <- ggplot(data = adaptive.preds, aes(x = a0, y = lca0)) +
  geom_line() +
  geom_ribbon(aes(min = lwr, max = upr), alpha = .4) +
  geom_point(data = selected ,
             mapping = aes(x = a0, y = lc_a0), alpha = .5, size = 4,
             alpha = .8, inherit.aes = FALSE) +
  geom_text(data = selected, mapping = aes(label = point_name), hjust = 0, vjust = -2) +
  scale_x_continuous(expression(a[0])) +
  scale_y_continuous(expression(log(c(a[0]))), limits = c(-6, 690)) +
  theme_bw(base_size = 16)
p0

ggsave(p0, filename = "../figures/grid_building_schema.pdf", dpi = 500)


library(rpart.plot)

serverData = RxSqlServerData(sqlQuery = "SELECT * FROM RentalFeatures ORDER BY Year, Month, Day", connectionString = "__RSQLCONNECTIONSTRING__")

rentals = rxImport(serverData)

head(rentals)

plot(factor(rentals$Snow), rentals$RentalCount)
plot(factor(rentals$WeekDay), rentals$RentalCount)

rentals$FHoliday = factor(rentals$Holiday)
rentals$FSnow = factor(rentals$Snow)
rentals$FWeekDay = factor(rentals$WeekDay)

plot(ISOdate(rentals$Year, rentals$Month, rentals$Day), rentals$RentalCount)
train_data = rentals[rentals$Year < 2015,]
test_data = rentals[rentals$Year == 2015,]
test_counts = test_data$RentalCount

model = rpart(RentalCount ~ Month + Day + FWeekDay + FSnow + FHoliday, train_data, )

prp(model)

predict(model, data.frame(Month = 1, Day = 1, FWeekDay = factor(7), FHoliday = factor(FALSE), FSnow = factor(TRUE)))
p = predict(model, test_data)
plot(p - test_counts)
mean((p - test_counts) ^ 2)


cat("MCMC functions\n")
#   MCMC;
##  Set up MCMC;
### Parameter bookkeeping;
logit <- function(x){
  exp(x)/(1+exp(x))
}
invlogit <- function(x){
  x[which(x==0)] <- 10^(-16)
  x[which(x==1)] <- 1-10^(-16)
  log(x/(1-x))
}

# this new admlink is much faster.
admlink <- function(i,dat,span){
  link <- as.numeric(dat[i]-dat>=span[1] & dat[i]-dat<span[2] &
                     (1:length(dat))<i)
  return(link)
}

transfpar <- function(par) c(par[1],exp(par[2:3]))
invtransfpar <- function(par) c(par[1],log(par[2:3]))

makelinklist <- function(par,tdata){
  mat <- sapply(1:length(tdata),
         function(x) admlink(x,timedata,
           c(-par[1],length(probtab(transfpar(par)))-1-par[1])))
  return(t(mat))
}

nupdate <- function(ll){
  vec <- apply(ll,1,function(x) length(x[x==1]))
  return(vec)
}

### Distribution;
normpdf <- function(x,m,s){
  dnorm(x,mean=m,sd=s)
}

gammapdf <- function(x,r,l){
  dgamma(x,shape=r,scale=l)
}

dirchpdf <- function(p,u){
  z <- prod(gamma(u))/gamma(sum(u))
  return(prod(p^(u-1))/z)
}

linkdirchpdf <- function(p,u,link){
  prob <- p[link==1]
  value <- u[link==1]
  if (length(prob)==0) {return(1)}
  return(dirchpdf(prob,value))
}

normalize <- function(pvec){
  if (sum(pvec)==0) {return(pvec)}
  return(pvec/sum(pvec))
}

### Random sample generators
gammarnd <- function(theta){
  rgamma(1,shape=theta[1],scale=theta[2])
}

gammamixrnd <- function(theta){
  ifelse(rbinom(1,1,theta[1]),gammarnd(exp(theta[2],exp(theta[3]))),
                              gammarnd(exp(theta[4],exp(theta[5]))))
}

dirchrand <- function(u){
  vec<-sapply(1:length(u),function(x) rgamma(1,shape=u[x],scale=1))
  vec<-normalize(vec)
  return(vec)
}

genuni <- function(lw,up){
  runif(1,min=lw,max=up)
}

### Likelihood functions;
ilik <- function(k,tmdat,theta,pvec){
  sum(probij(k,c(1:length(tmdat)),transfpar(theta),tmdat)*pvec)
}

mlvec <- function(k,tmdat,tpvec,theta){
  tmp <- probij(k,c(1:length(tmdat)),transfpar(theta),tmdat)*tpvec
  Max <- max(tmp)
  posmax <- which(tmp==Max)
  nul <- rep(0,length(tmdat))
  tmp <- nul
  tmp[posmax] <- 1
  if (Max==0) {return(nul)} else {return(normalize(tmp))}
}

initvec <- function(k,tmdat,tpvec,theta){
  tmp <- probij(k,c(1:length(tmdat)),transfpar(theta),tmdat)*tpvec
  Max <- max(tmp)
  posmax <- which(tmp==Max)
  nul <- rep(0,length(tmdat))
  tmp <- nul
  tmp[posmax] <- 1
  if (Max==0) {return(nul)} else {
    return(normalize(tmp+rgamma(1,shape=4,scale=0.004)))}
}

### Priors

thetaprior <- function(transftheta){
  tmp <- sapply(1:length(ltppars[,1]),
    function(x) normpdf(transftheta[x],ltppars[x,1],ltppars[x,2]))
  return(prod(tmp))
}

pmatprior <- function(pmat,link){
  tmp[i] <- sapply(1:length(pmppars),
    function(x) linkdirchpdf(pmat[x],pmppars[x],link[x]))
  return(prod(tmp))
}

typeprior <- function(typepvec){
  dirchpdf(typepvec,tppriorpars)
}

### Posterior
post <- function(dat,transftheta,link,pmat){
  tmp <- sapply(1:length(pmat[,1]),
    function(x) ilik(x,dat,transftheta,link[x,]*pmprior[x,]*pmat[x,]))
  return(thetaprior(transftheta)*prod(tmp[which(tmp!=0)]))
}

logpost <- function(dat,transftheta,link,pmat){
  tmp <- sapply(1:length(pmat[,1]),
    function(x) ilik(x,dat,transftheta,link[x,]*pmprior[x,]*pmat[x,]))
  return(log(thetaprior(transftheta))+sum(log(tmp[which(tmp!=0)])))
}
### Generate candidate parameter values
dthcand <- function(){
  tmp <- sapply(1:length(ltppars[,1]),
    function(x) ifelse(sigth[x]==0,0,rnorm(1,0,sigth[x])))
  return(tmp)
}

candtheta <- function(){
  oldtheta+dthcand()
}

dpcand <- function(){
  matrix(rnorm(length(pmppars[1,])^2,0,sigp),nrow=length(pmppars[1,]))
}

candpmat <- function(){
  t(apply(logit(invlogit(oldpmat)+dpcand())*linklist,1,normalize))
}

typecand <- function(){
  tmp <- sapply(1:length(sigtp),function(x) rnorm(1,0,sigtp[x]))
  return(tmp)
}

candtpmat <- function(){
  normalize(logit(invlogit(oldvec)+typecand()))
}

upd.theta <- function(sigth){
  if (sum(sigth)>0) {
    newtheta <- candtheta()
    linklist <- makelinklist(newtheta,timedata)*typemat
  } else{
    newtheta <- oldtheta
  }
  return(newtheta)
}

upd.typemat <- function(updtype,typemat){
  if (updtype!=0){
    if (tu==0){
      newtypes <- mctype1(oldtypes,freqtype)
      typemat <- mctypemat(newtypes)
      tu <- updtype
    } else{
      tu <- tu-1
    }
  }
  return(typemat)
}

upd.pmat <- function(sigp){
  if(sigp!=0){
    newpmat <- candpmat()
  }else{
    newpmat <- oldpmat
  }
  return(newpmat)
}

### Adaptive rejection sampling (Metropolis-Hastings)
btest <- function(sk){
  newtheta <- upd.theta(sigth)
  typemat <- upd.typemat(updtype,typemat)
  newpmat <- upd.pmat(sigp)
  newlogpost <- logpost(timedata,newtheta,linklist*typemat,newpmat)
  while(!is.finite(newlogpost)){
    newtheta <- upd.theta(sigth)
    typemat <- upd.typemat(updtype,typemat)
    newpmat <- upd.pmat(sigp)
    newlogpost <- logpost(timedata,newtheta,linklist*typemat,newpmat)
  }
  logratio <- newlogpost - oldlogpost
  # cat(" ",logratio," ")
  if (exp(logratio)>=genuni(0,1)){
    oldlogpost <<- newlogpost
    logoldpost <<- -2*oldlogpost
    if (updtype!=0){
      oldtypes <<- newtypes
    }
    oldtheta <<- newtheta
    oldpmat <<- newpmat
    acc <<- acc+1
  } else{rej <<- rej+1}
  if (sk==iterskip){
    inc()
    sk <- 1
  } else{sk <- sk+1}
  return(sk)
}

inc <- function(){
  posttrail[[length(posttrail)+1]] <<- logoldpost
  #pmtrail[[length(pmtrail)+1]] <<- oldpmat
  if (updtype!=0){
    typetrail[[length(typetrail)+1]] <<- oldtypes
  }
  if (sum(sigth)>0){
    thetatrail[[length(thetatrail)+1]] <<- oldtheta
  }
}

gentimes <- function(r){
  oldperc <- 0;
  progbar(0,r);
  for (j in 1:r){
    sk <- btest(sk)
    if (pmpost>logoldpost){
      pmpost <<- logoldpost
      pmth <<- oldtheta
      pmpv <<- oldpmat
      pmtp <<- oldtypes
    }
    newperc <- round(100*j/r);
    if(newperc - oldperc >= 2){
      progbar(j,r);
      oldperc <- newperc;
    }
  }
  cat("\n")
}

burnin <- function(mclist,intro){
  choose <- seq(from=intro,to=length(mclist),by=1)
  return(mclist[choose])
}

thinning <- function(mclist,thinskip){
  choose <- seq(from=1,to=length(mclist),by=thinskip)
  return(mclist[choose])
}

progbar <- function(j,r){
  prgri <- round(100*j/r);
  star <- round(50*j/r); spce <- 50 - star;
  bsp <- ifelse(prgri<10,2,3);
  if(j!=0) cat(rep("\b",52+bsp),sep="");
  cat("|",sep="");
  cat(rep("*",star),sep="");
  cat(rep(" ",spce),sep="");
  cat("|",sep="");
  cat(prgri,"%",sep="");
}


library(shiny)
library(rsconnect)
library(ggplot2)

#############################################################
# Set the baseline parameters
#############################################################
base_lambda <- .8
base_phi <- 0
base_theta <- .1
base_gR <- .02

#############################################################
# Define UI ----
#############################################################
ui <- fluidPage(
  withMathJax(),
  titlePanel("Dynamics of Productivity Growth"),

  mainPanel(

      #hr(),

      h4("Set parameters"),

      fixedRow(
        column(4,
        sliderInput("alt_lambda", h6('Research elasticity \\(\\lambda\\)'),
                    min = 0, max = 1, value = base_lambda, ticks = FALSE, step=.01),
        sliderInput("alt_phi", h6("Productivity effect \\(\\phi\\)"),
                    min = -.35, max = .95, value = base_phi, ticks = FALSE, step=.01),
        sliderInput("alt_theta", h6("Scaling parameter \\(\\theta\\)"),
                    min = .01, max = .3, value = base_theta, ticks = FALSE, step=.01),
        sliderInput("alt_gR", h6("Researcher growth \\(g_R\\)"),
                    min = 0, max = .1, value = base_gR, ticks = FALSE, step=.01),
        br(),
        actionButton("reset", "Reset all to baseline")
        ),
        column(8,
        plotOutput("RAgraph",width = "100%"),
        )
      ) # end FluidRow
      ) # end main panel
  ) # end ui
#############################################################
# Define server logic ----
#############################################################
server <- function(input, output, session) {

  # Reset parameters
  observeEvent(input$reset, {
    updateSliderInput(session,'alt_lambda',value = base_lambda)
    updateSliderInput(session,'alt_phi',value = base_phi)
    updateSliderInput(session,'alt_gR',value = base_gR)
    updateSliderInput(session,'alt_theta',value = base_theta)
  })

  output$RAgraph <- renderPlot(
    {
      RAstar = (input$alt_gR*input$alt_lambda)/(input$alt_theta*(1-input$alt_phi))
      tick <- seq(0,.5,.01) # arbitrary RA values
      df <- data.frame(tick) # create dataframe
      df$gA <- (1-input$alt_phi)*input$alt_theta*df$tick

      ggplot(df, aes(x=tick)) +
        geom_line(aes(y = gA),size=1) +
        geom_hline(yintercept=input$alt_lambda*input$alt_gR, linetype="dashed", color = "black",size=1) +
        geom_vline(xintercept=RAstar, linetype="dotted", color = "black") +
        annotate(geom="text", x=.45, y=input$alt_lambda*input$alt_gR+.002,
                 label=expression(lambda*g[R]),size=4) +
        annotate(geom="text", x=RAstar+.05,y = .07,
                 label=expression(paste(R^{lambda}/A^{1-phi}," Steady State")),size=4) +
        annotate(geom="text", x=.45, y=(1-input$alt_phi)*input$alt_theta*.45+.005,
                 label=expression((1-phi)*g[A]),size=4) +
        xlab(expression(R^{lambda}/A^{1-phi}) ) +
        ylab("Growth rates") +
        theme_light() +
        xlim(0,.5) +
        ylim(0,.075)
    }
  ) # end gky graph

} # end server

# Run the app ----
shinyApp(ui = ui, server = server)


 DSYCON Example Program Results

 Estimate of condition number =  7.57E+01


# Import Data
raw_data <- read.csv(
    "chapter06/data/ml-100k/u.data",
    sep = "\t", header = FALSE
)
colnames(raw_data) = c("UserId", "MovieId", "Rating", "TimeStamp")

movies <- read.csv(
    "chapter06/data/ml-100k/u.item",
    sep = "|", header = FALSE
)
colnames(movies) <- c(
    "MovieId", "MovieTitle", "ReleaseDate", "VideoReleaseDate",
    "IMDbURL", "Unknown", "Action", "Adventure", "Animation",
    "Children", "Comedy", "Crime", "Documentary", "Drama",
    "Fantasy", "FilmNoir", "Horror", "Musical", "Mystery",
    "Romance", "SciFi", "Thriller", "War", "Western"
)
movies <- movies[, -c(2:5)]

ratings_ctx <- merge(
    x = raw_data,
    y = movies,
    by = "MovieId",
    all.x = TRUE
)

# Context Profile
ts <- ratings_ctx$TimeStamp
head(ts)
hours <- as.POSIXlt(ts, origin = "1960-10-01")$hour
head(hours)
ratings_ctx <- data.frame(cbind(ratings_ctx, hours))

# User Context Profile
ucp <- ratings_ctx[(ratings_ctx$UserId == 943), -c(2, 3, 4, 5)]
head(ucp)
ucp_pref <- aggregate(.~hours, ucp[, -1], sum)
head(ucp_pref)
ucp_pref_sc <- cbind(
    context = ucp_pref[, 1],
    t(apply(ucp_pref[, -1], 1, function(x) (x - min(x)) / (max(x) - min(x))))
)
head(ucp_pref_sc)


ifPolindrome <- function(x) {
    x <- toString(x)
    newStr <- strsplit(x, "")[[1]]
    newStr <- rev(newStr)
    newStr <- paste(newStr, collapse="")

    if (newStr == x) {
       return (TRUE)
    }
    return (FALSE)
}

ifSquare <- function(x) {
    cnt <- 999
    while (cnt >= 100) {
        if (x/cnt >= 100 && x/cnt <= 999 && as.integer(x/cnt) == x/cnt) {
           return (TRUE)
        }
        cnt <- cnt-1
    }
    return (FALSE)
}

findBiggest <- function(x) {
    while (x >= 0) {
        if (ifPolindrome(x)) {
           if (ifSquare(x)) {
                return (x)
           }
        }
        x <- (x-1)
    }
}
n<-1000000
findBiggest(n)


### set of simple functions for computing simpler alpha diversity metrics

#' @name alpha_diversity
#' @aliases richness
#' @aliases simpson
#' @aliases shannon
#' @title Compute alpha diversity metrics
#'
#' Note that the Simpson index here is the probability that two individuals randomly drawn will
#' be of the same taxon, and thus gets larger as diveristy *decreases*.
#' @rdname alpha_diversity
#' @param x A matrix with rows as sites and species as columns. Values are abundances or
#' 		presence/absence
#' @return A vector of diversity values
#' @export
richness <- function(x) {
	if(any(x < 0)) stop("Values in x must be positive")
	x[x > 0] <- 1
	x[x != 1] <- 0
	rowSums(x)
}

#' @rdname alpha_diversity
#' @param proportion Logical. If true, abundances in x are considered proportional abundances.
#' 		If false, x will be transformed to proportional abundance
#' @export
simpson <- function(x, proportion=TRUE) {
	if(any(x < 0) | (proportion & any(rowSums(x) > 1))) stop("Abundances must be >= 0 and must be <= 1 if proportion=TRUE")
	if(! proportion) {
		N <- matrix(rowSums(x), nrow=nrow(x), ncol=ncol(x))
		x <- x/N
	}
	apply(x, 1, function(xx) sum(xx^2))
}

#' @rdname alpha_diversity
#' @export
shannon <- function(x) {
	if(!all(.fp_equal(rowSums(x), 1))) {
		warning(paste("Data for shannon diversity are not proportions;",
		              "data will be rescaled to proportional cover"))
		x <- t(apply(x, 1, function(xx) xx/sum(xx)))
	}
	apply(x, 1, function(xx) {
		xx <- xx[xx!= 0]
		-sum(xx * log(xx))
	})
}

.fp_equal <- function(x,y,tol=1e-9) {
	abs(x - y) <= tol
}


#' runif
#'
#' Generate from a uniform distribution using a gpu.
#'
#' @details
#' Uses \code{curand_uniform()} from cuRAND.
#'
#' @param n
#' The number of values to generate
#' @param min,max
#' Parameters for uniform random variables.
#' @param seed
#' Seed for the random number generation.
#' @param type
#' 'double' or 'float'
#'
#' @references CUDA Toolkit Documentation for cuRAND
#' \url{https://docs.nvidia.com/cuda/curand/index.html}
#'
#' @useDynLib curand R_curand_runif
#' @export
runif = function(n, min=0, max=1, seed=getseed(), type="double")
{
  type = match.arg(tolower(type), c("double", "float"))
  type = ifelse(type == "double", TYPE_DOUBLE, TYPE_FLOAT)

  if (n < 0)
    stop("invalid arguments")
  else if (n == 0)
  {
    if (type == TYPE_DOUBLE)
      return(numeric(0))
    else
      return(float(0))
  }

  n1 = floor(sqrt(n))
  n2 = n - n1*n1

  if (min > max || is.badval(min) || is.badval(max))
  {
    warning("NAs produced")
    ret = setnan(n1, n2, type)
  }
  else
    ret = .Call(R_curand_runif, as.integer(n1), as.integer(n2), as.double(min), as.double(max), as.integer(seed), type)

  if (type == TYPE_DOUBLE)
    ret
  else
    float32(ret)
}


 ZTRCON Example Program Results

 Estimate of condition number =  3.74E+01


 DTBCON Example Program Results

 Estimate of condition number =  6.96E+01


library(readr)
library (dplyr)
library (tidyr)
library(caret)

df <- read_csv("~/development/cantcha/data/Cantcha Data Gather (Responses) - Form Responses 1.csv")

colnames(df) <- c("Timestamp", "Photo", "Name", "Colour", "Cartoon", "Fonts", "Informative", "class", "old_class")
#EDA of full dataset

dim (df)
str(df)
summary(df)

#row names
names(df)

#how many classes - and what are they?
num_class <- length(unique(df$class))
uniqueClasses <- as.character(unique(df$class))
cat("There are ", num_class, "unique classes, which are", uniqueClasses)

#class distribution
classDis<- as.data.frame(table(df$class))
names(classDis) <- c("label","count")
classDis

#check that they all add up
sr <- sum(classDis$count)
nr <- nrow(df)
cat("The total of each class add up to the whole number of rows?",sr==nr )

# list all observations for missing values
sapply(df, function(x) sum(is.na(x)))

# drop redundant colums
drop.cols <- c('Timestamp', 'Photo', 'Name', "old_class") # NB we might want to retain and encode "impression"
reduced_df <- df %>% select(-one_of(drop.cols))

dim (reduced_df)
names(reduced_df)

# divide the dataset into train (70%) and test (30%)

set.seed(13579) #to get repeatable data
dt = sort(sample(nrow(reduced_df), nrow(reduced_df)*.7))
trainA<-reduced_df[dt,]
testA<-reduced_df[-dt,]

#class distribution of TEST
classDis<- as.data.frame(table(testA$class))
names(classDis) <- c("label","count")
classDis

#class distribution of TRAIN
classDis<- as.data.frame(table(trainA$class))
names(classDis) <- c("label","count")
classDis