# Databricks notebook source
# MAGIC %md
# MAGIC ##### Copyright (c) Microsoft Corporation.
# MAGIC ##### Licensed under the MIT license.
# MAGIC
# MAGIC ###### File: Step03a_Model_Training_Testing
# MAGIC ###### Date: 06/09/2020

# COMMAND ----------

# MAGIC %md
# MAGIC ####Step03a_Model_Training_Testing R notebook
# MAGIC
# MAGIC This notebook has the following process flow:
# MAGIC   1. Run Step01a_Setup for the Source and sink Configurations and Intialize the spark session.
# MAGIC   2. Load Libraries.
# MAGIC   3. Time series analysis and forecasting for the 311 safety data from 3 cities Chicago, Boston and the city of New York

# COMMAND ----------

# MAGIC  %run "./Step01a_Setup"

# COMMAND ----------

# MAGIC %md
# MAGIC Libraries

# COMMAND ----------

# library(SparkR) #Spark R is already loaded from the Step01a_Setup notebook
library(ggplot2)
library(forecast)
library(ggfortify)
library(fpp2)

# COMMAND ----------

# MAGIC %md
# MAGIC The data from 3 cities Chicago, Boston and the city of New York is enriched in our previous step.

# COMMAND ----------

# MAGIC %md
# MAGIC The 3-1-1 data in these 3 cities are organized in parquet format.
# MAGIC
# MAGIC Apache Parquet is a free and open-source column-oriented data storage format of the Apache Hadoop ecosystem. It is similar to the other columnar-storage file formats available in Hadoop namely RCFile and ORC. It is compatible with most of the data processing frameworks in the Hadoop environment. It provides efficient data compression and encoding schemes with enhanced performance to handle complex data in bulk.

# COMMAND ----------

# MAGIC %md
# MAGIC Let us explore the 3 datasets

# COMMAND ----------

#Constructing the enriched absolute paths
#Notice here we are using all 3 cities
sink_blob_base_path = paste('wasbs://',dbutils.widgets.get("sink_blob_container_name"),'@',dbutils.widgets.get("sink_blob_account_name"),'.blob.core.windows.net',sep="")
#sink_blob_absolute_path_chicago = paste(sink_blob_base_path,"/city311/city=Chicago",sep="")
#sink_blob_absolute_path_boston = paste(sink_blob_base_path,"/city311/city=Boston",sep="")
#sink_blob_absolute_path_newyorkcity = paste(sink_blob_base_path,"/city311/city=NewYorkCity",sep="")
enriched_blob_absolute_path_3cities = paste(sink_blob_base_path,"/city311",sep="")
#print the absolute paths
cat(enriched_blob_absolute_path_3cities)

# COMMAND ----------

#Read the enriched data in a dataframe for 3 cities
enriched_3cities_safety_df <- read.df(enriched_blob_absolute_path_3cities, source = "parquet")

# COMMAND ----------

#Read the enriched data in a dataframe for 3 cities
enriched_chicago_safety_df <- filter(enriched_3cities_safety_df, enriched_3cities_safety_df$city == "Chicago")
enriched_boston_safety_df <- filter(enriched_3cities_safety_df, enriched_3cities_safety_df$city == "Boston")
enriched_newyorkcity_safety_df <- filter(enriched_3cities_safety_df, enriched_3cities_safety_df$city == "NewYorkCity")

# COMMAND ----------

#Lets gauge the scale of the source dataset we are analyzing
cat("","Number of rows for Chicago dataset: ",format(count(enriched_chicago_safety_df),big.mark = ","),"\n", "Number of rows for Boston dataset: ",format(count(enriched_boston_safety_df),big.mark = ",") ,"\n", "Number of rows for New York City dataset: ",format(count(enriched_newyorkcity_safety_df),big.mark = ","))

# COMMAND ----------

printSchema(enriched_3cities_safety_df)

# COMMAND ----------

str(enriched_3cities_safety_df)

# COMMAND ----------

#Register the DataFrame as a SQL temporary view: enriched_3cities_safety_view'
#Registers a DataFrame as a Temporary Table in the SQLContext
registerTempTable(enriched_3cities_safety_df, "enriched_3cities_safety_view")

# COMMAND ----------

#Display top 10 rows
display(sql('SELECT * FROM enriched_3cities_safety_view LIMIT 10'))

# COMMAND ----------

# MAGIC %md
# MAGIC Lets us get the top 30 categories in each city

# COMMAND ----------

allcities_category_grouped_df_top30 = sql('select * from (SELECT city, category, count, ROW_NUMBER() OVER (PARTITION BY city ORDER BY count DESC) as rank
             FROM (
               SELECT city, category, COUNT(*) as count
               FROM enriched_3cities_safety_view
               GROUP BY city, category)) where rank <=30
            ')

# COMMAND ----------

display(allcities_category_grouped_df_top30)

# COMMAND ----------

allcities_subcategory_grouped_df_top30 = sql('select * from (SELECT city, subcategory, count, ROW_NUMBER() OVER (PARTITION BY city ORDER BY count DESC) as rank
             FROM (
               SELECT city, subcategory, COUNT(*) as count
               FROM enriched_3cities_safety_view
               GROUP BY city, subcategory)) where rank <=30
            ')

# COMMAND ----------

display(allcities_subcategory_grouped_df_top30)

# COMMAND ----------

# MAGIC %md
# MAGIC Point to note here is Pothole gets called out in category column of Chicago and Subcategory column of New York City and Boston.
# MAGIC
# MAGIC Pothole facts from wiki (https://en.wikipedia.org/wiki/Pothole#Costs_to_the_public): The American Automobile Association estimated in the five years prior to 2016 that 16 million drivers in the United States have suffered damage from potholes to their vehicle including tire punctures, bent wheels, and damaged suspensions with a cost of $3 billion a year. In India, 3,000 people per year are killed in accidents involving potholes. Britain has estimated that the cost of fixing all roads with potholes in the country would cost £12 billion.
# MAGIC
# MAGIC We will focus on the pothole data from the 3 cities however the techniques can be applied across other categories as well.

# COMMAND ----------

# MAGIC %md
# MAGIC Get all the pothole complaints by city and date

# COMMAND ----------

yearly_count_3cities_pothole = collect(sql('SELECT year,city,count(*) as cnt
               FROM enriched_3cities_safety_view
               WHERE lower(category) like "%pothole%" OR lower(subcategory) like "%pothole%"
               GROUP BY city,year'))

# COMMAND ----------

ggplot(yearly_count_3cities_pothole, aes(x = year, y = cnt, color = city)) + geom_line() + geom_point() +
scale_x_continuous(breaks=seq(2010, 2020, 1)) +
  labs(title = paste0("Yearly count of pothole repair calls"))

# COMMAND ----------

weekly_count_3cities_pothole = collect(sql('select * from (SELECT year,month, weekOfMonth, city,count(*) as cnt
               FROM enriched_3cities_safety_view
               WHERE lower(category) like "%pothole%" OR lower(subcategory) like "%pothole%"
               GROUP BY year,month, weekOfMonth, city) order by year,month,weekOfMonth') )

# COMMAND ----------

head(weekly_count_3cities_pothole)

# COMMAND ----------

ggplot(weekly_count_3cities_pothole, aes(x = year, y = cnt, color = city)) + geom_line() + geom_point() +
scale_x_continuous(breaks=seq(2010, 2020, 1)) +
  labs(title = paste0("Weekly count of pothole repair calls"))

# COMMAND ----------

# MAGIC %md
# MAGIC A time series can be thought of as a vector or matrix of numbers along with some information about what times those numbers were recorded. This information is stored in a ts object in R.
# MAGIC ts(data, start, frequency, ...)

# COMMAND ----------

monthly_count_3cities_pothole = collect(sql('select to_date(concat(year,"-",month,"-","01"),"yyyy-MMM-dd") as startDayOfMonth,year,month, city,cnt  from (SELECT year,month, city,count(*) as cnt
               FROM enriched_3cities_safety_view
               WHERE lower(category) like "%pothole%" OR lower(subcategory) like "%pothole%"
               GROUP BY year,month, city) order by startDayOfMonth') )

# COMMAND ----------

head(monthly_count_3cities_pothole)

# COMMAND ----------

monthly_count_chicago_pothole_2014_2019 = collect(sql('select to_date(concat(year,"-",month,"-","01"),"yyyy-MMM-dd") as startDayOfMonth,cnt  from (SELECT year,month, city,count(*) as cnt
               FROM enriched_3cities_safety_view
               WHERE city="Chicago" and (lower(category) like "%pothole%" OR lower(subcategory) like "%pothole%") and year > 2013 and year < 2020
               GROUP BY year,month, city) order by startDayOfMonth') )

# COMMAND ----------

head(monthly_count_chicago_pothole_2014_2019)

# COMMAND ----------

# MAGIC %md
# MAGIC Convert into ts object

# COMMAND ----------

monthly_count_chicago_pothole_2014_2019_ts = ts(monthly_count_chicago_pothole_2014_2019[, 2], start = c(2014, 1), frequency = 12)

# COMMAND ----------

head(monthly_count_chicago_pothole_2014_2019_ts)

# COMMAND ----------

class(monthly_count_chicago_pothole_2014_2019_ts)

# COMMAND ----------

frequency(monthly_count_chicago_pothole_2014_2019)

# COMMAND ----------

str(monthly_count_chicago_pothole_2014_2019_ts)

# COMMAND ----------

# MAGIC %md
# MAGIC Graphs enable you to visualize many features of the data, including patterns, unusual observations, changes over time, and relationships between variables. Just as the type of data determines which forecasting method to use, it also determines which graphs are appropriate.
# MAGIC You can use the autoplot() function to produce a time plot of the data with or without facets, or panels that display different subsets of data:

# COMMAND ----------

ggplot2::autoplot(monthly_count_chicago_pothole_2014_2019_ts) +
  ggtitle("Monthly Chicago Pothole Incidents") +
  xlab("Year") +
  ylab("Count")

# COMMAND ----------

monthly_count_allcities_pothole_2014_2019 = collect(sql('select to_date(concat(year,"-",month,"-","01"),"yyyy-MMM-dd") as startDayOfMonth,cnt,city  from (SELECT year,month, city,count(*) as cnt
               FROM enriched_3cities_safety_view
               WHERE (lower(category) like "%pothole%" OR lower(subcategory) like "%pothole%") and year > 2013 and year < 2020
               GROUP BY year,month, city) order by startDayOfMonth') )

# COMMAND ----------

class(monthly_count_allcities_pothole_2014_2019)

# COMMAND ----------

monthly_count_allcities_pothole_2014_2019_df = sql('select to_date(concat(year,"-",month,"-","01"),"yyyy-MMM-dd") as startDayOfMonth,cnt,city  from (SELECT year,month, city,count(*) as cnt
               FROM enriched_3cities_safety_view
               WHERE (lower(category) like "%pothole%" OR lower(subcategory) like "%pothole%") and year > 2013 and year < 2020
               GROUP BY year,month, city) order by startDayOfMonth')

# COMMAND ----------

class(monthly_count_allcities_pothole_2014_2019_df)

# COMMAND ----------

monthly_count_allcities_pothole_2014_2019_pivot <- collect(sum(pivot(groupBy(monthly_count_allcities_pothole_2014_2019_df, "startDayOfMonth"), "city"), "cnt"))

# COMMAND ----------

class(monthly_count_allcities_pothole_2014_2019_pivot)

# COMMAND ----------

head(monthly_count_allcities_pothole_2014_2019_pivot)

# COMMAND ----------

monthly_count_allcities_pothole_2014_2019_pivot_ts = ts(monthly_count_allcities_pothole_2014_2019_pivot[, 2:4], start = c(2014, 1), frequency = 12)

# COMMAND ----------

ggplot2::autoplot(monthly_count_allcities_pothole_2014_2019_pivot_ts, facets = TRUE) +
  ggtitle("Monthly 3 cities Pothole Incidents") +
  xlab("Year") +
  ylab("Count") +
 scale_x_continuous(breaks=seq(2014, 2019, 1))

# COMMAND ----------

ggplot2::autoplot(monthly_count_allcities_pothole_2014_2019_pivot_ts, facets = FALSE) +
  ggtitle("Monthly 3 cities Pothole Incidents") +
  xlab("Year") +
  ylab("Count") +
 scale_x_continuous(breaks=seq(2014, 2019, 1))

# COMMAND ----------

frequency(monthly_count_allcities_pothole_2014_2019_pivot_ts)

# COMMAND ----------

# MAGIC %md
# MAGIC Interesting observations:
# MAGIC Can the uptick of pothole repairs in the 3 cities during the first half of the yar be attributed to harsh winters?
# MAGIC Can the budget and contract of workers for pothole repair be alloted and spent following the trend?

# COMMAND ----------

# MAGIC %md
# MAGIC Let us look at Chicago in more details

# COMMAND ----------

monthly_count_Chicago_pothole_2014_2019_df = sql('SELECT year, cnt, month  from (SELECT year,month, city,count(*) as cnt
               FROM enriched_3cities_safety_view
               WHERE city="Chicago" and (lower(category) like "%pothole%" OR lower(subcategory) like "%pothole%") and year > 2013 and year < 2020
               GROUP BY year,month, city) order by year')

# COMMAND ----------

monthly_count_Chicago_2014_2019_pivot <- collect(sum(pivot(groupBy(monthly_count_Chicago_pothole_2014_2019_df, "year"), "month"), "cnt"))

# COMMAND ----------

monthly_count_Chicago_2014_2019_pivot

# COMMAND ----------

monthly_count_Chicago_2014_2019_pivot_ts = ts(monthly_count_Chicago_2014_2019_pivot[, 2:13], start = c(2014, 1), frequency = 1)

# COMMAND ----------

monthly_count_Chicago_2014_2019_pivot_ts

# COMMAND ----------

monthly_count_Chicago_pothole_2014_2019_df_1 = collect(sql('SELECT to_date(concat(year,"-",month,"-","01"),"yyyy-MMM-dd") as startDayOfMonth, cnt  from (SELECT year,month, city,count(*) as cnt
               FROM enriched_3cities_safety_view
               WHERE city="Chicago" and (lower(category) like "%pothole%" OR lower(subcategory) like "%pothole%") and year > 2013 and year < 2020
               GROUP BY year,month, city) order by startDayOfMonth'))

# COMMAND ----------

monthly_count_Chicago_pothole_2014_2019_df_1_ts = ts(monthly_count_Chicago_pothole_2014_2019_df_1[, 2], start = c(2014, 1), frequency = 12)

# COMMAND ----------

ggseasonplot(monthly_count_Chicago_pothole_2014_2019_df_1_ts, main="Seasonal plot broken by year for pothole repairs in Chicago", ylab = "Count")

# COMMAND ----------

# Produce a polar coordinate season plot for the a10 data
ggseasonplot(monthly_count_Chicago_pothole_2014_2019_df_1_ts, main="Polar coordinate season plot broken by year for pothole repairs in Chicago", ylab = "Count", polar = TRUE)

# COMMAND ----------

ggsubseriesplot(monthly_count_Chicago_pothole_2014_2019_df_1_ts, main="Subseries plot broken by month for pothole repairs in Chicago", ylab = "Count")

# COMMAND ----------

# MAGIC %md
# MAGIC It clearly shows that Feb, Mar and Apr have a uptick in pothole repair cases

# COMMAND ----------

# MAGIC %md
# MAGIC The correlations associated with the lag plots form what is called the autocorrelation function (ACF). The ggAcf() function produces ACF plots.

# COMMAND ----------

# Create an ACF plot of the Chicago data
ggAcf(monthly_count_Chicago_pothole_2014_2019_df_1_ts)

# COMMAND ----------

# MAGIC %md
# MAGIC White noise is a term that describes purely random data. We can conduct a Ljung-Box test using the function below to confirm the randomness of a series; a p-value greater than 0.05 suggests that the data are not significantly different from white noise.

# COMMAND ----------

# Plot the original series
autoplot(monthly_count_Chicago_pothole_2014_2019_df_1_ts)

# Plot the differenced series
autoplot(diff(monthly_count_Chicago_pothole_2014_2019_df_1_ts))

# ACF of the differenced series
ggAcf(diff(monthly_count_Chicago_pothole_2014_2019_df_1_ts))

# Ljung-Box test of the differenced series
Box.test(diff(monthly_count_Chicago_pothole_2014_2019_df_1_ts), lag = 10, type = "Ljung")

# COMMAND ----------

monthly_count_Chicago_pothole_2014_2019_df_1_ts

# COMMAND ----------

# MAGIC %md
# MAGIC A forecast is the mean or median of simulated futures of a time series.
# MAGIC
# MAGIC The very simplest forecasting method is to use the most recent observation; this is called a naive forecast and can be implemented in a namesake function. This is the best that can be done for many time series including most stock price data, and even if it is not a good forecasting method, it provides a useful benchmark for other forecasting methods.
# MAGIC
# MAGIC For seasonal data, a related idea is to use the corresponding season from the last year of data. For example, if you want to forecast the sales volume for next March, you would use the sales volume from the previous March. This is implemented in the snaive() function, meaning, seasonal naive.
# MAGIC
# MAGIC For both forecasting methods, you can set the second argument h, which specifies the number of values you want to forecast; as shown in the code below, they have different default values. The resulting output is an object of class forecast. This is the core class of objects in the forecast package, and there are many functions for dealing with them including summary() and autoplot().

# COMMAND ----------

# Use naive() to forecast the Chicago pothole series
fc_monthly_count_Chicago_pothole_2014_2019 <- naive(monthly_count_Chicago_pothole_2014_2019_df_1_ts, h = 12)

# COMMAND ----------

#Plot forecasts
autoplot(fc_monthly_count_Chicago_pothole_2014_2019) +
  ggtitle("Forecast of 2020 Pothole Incidents") +
  xlab("Year") +
  ylab("Count")

# COMMAND ----------

#summarize the forecasts
summary(fc_monthly_count_Chicago_pothole_2014_2019)

# COMMAND ----------

# Use snaive() to forecast the ausbeer series
fcs_monthly_count_Chicago_pothole_2014_2019 <- snaive(monthly_count_Chicago_pothole_2014_2019_df_1_ts, h = 12)

# COMMAND ----------

#Plot forecasts
autoplot(fcs_monthly_count_Chicago_pothole_2014_2019) +
  ggtitle("Seasonal Naive Forecast of 2020 Pothole Incidents in Chicago") +
  xlab("Year") +
  ylab("Count")

# COMMAND ----------

#summarize the forecasts
summary(fcs_monthly_count_Chicago_pothole_2014_2019)

# COMMAND ----------

# MAGIC %md
# MAGIC When applying a forecasting method, it is important to always check that the residuals are well-behaved (i.e., no outliers or patterns) and resemble white noise. The prediction intervals are computed assuming that the residuals are also normally distributed.

# COMMAND ----------

checkresiduals(fcs_monthly_count_Chicago_pothole_2014_2019)

# COMMAND ----------

monthly_count_Chicago_pothole_2014_2019_df_1_ts

# COMMAND ----------

# Create the training data as train
train <- subset(monthly_count_Chicago_pothole_2014_2019_df_1_ts, end = 48)

# COMMAND ----------

train

# COMMAND ----------

# Compute seasonal naive forecasts and save to naive_fc
naive_fc <- snaive(train, h = 108)

# Compute mean forecasts and save to mean_fc
mean_fc <- meanf(train, h = 108)

# Use accuracy() to compute RMSE statistics
print(accuracy(naive_fc, monthly_count_Chicago_pothole_2014_2019_df_1_ts))
print(accuracy(mean_fc, monthly_count_Chicago_pothole_2014_2019_df_1_ts))

# COMMAND ----------

# Create three training series omitting the last 1, 2, and 3 years
train1 <- window(monthly_count_Chicago_pothole_2014_2019_df_1_ts, end = c(2014, 12))
train2 <- window(monthly_count_Chicago_pothole_2014_2019_df_1_ts, end = c(2015, 12))
train3 <- window(monthly_count_Chicago_pothole_2014_2019_df_1_ts, end = c(2016, 12))

# Produce forecasts using snaive()
fc1 <- snaive(train1, h = 4)
fc2 <- snaive(train2, h = 4)
fc3 <- snaive(train3, h = 4)

# Use accuracy() to compare the MAPE of each series
print(accuracy(fc1, monthly_count_Chicago_pothole_2014_2019_df_1_ts)["Test set", "MAPE"])
print(accuracy(fc2, monthly_count_Chicago_pothole_2014_2019_df_1_ts)["Test set", "MAPE"])
print(accuracy(fc3, monthly_count_Chicago_pothole_2014_2019_df_1_ts)["Test set", "MAPE"])

# COMMAND ----------

fcses <- ses(train3, h = 12)
fcnaive <- snaive(train3, h = 12)
fcholt <- holt(train3, h = 12)
fchw <- hw(train3, seasonal = "multiplicative", h = 12)
print(accuracy(fcses, monthly_count_Chicago_pothole_2014_2019_df_1_ts))
print(accuracy(fcnaive, monthly_count_Chicago_pothole_2014_2019_df_1_ts))
print(accuracy(fcholt, monthly_count_Chicago_pothole_2014_2019_df_1_ts))
print(accuracy(fchw, monthly_count_Chicago_pothole_2014_2019_df_1_ts))

# COMMAND ----------

# Plot forecasts
autoplot(fchw)

# COMMAND ----------

fchwa <- hw(train3, seasonal = "additive", h = 12)
autoplot(fchwa)

# COMMAND ----------

# MAGIC %md
# MAGIC Automatic forecasting with exponential smoothing
# MAGIC The namesake function for finding errors, trend, and seasonality (ETS) provides a completely automatic way of producing forecasts for a wide range of time series.

# COMMAND ----------

fiths <- ets(monthly_count_Chicago_pothole_2014_2019_df_1_ts)
autoplot(forecast(fiths))

# COMMAND ----------

checkresiduals(fiths)

# COMMAND ----------

# Fit a seasonal ARIMA model to monthly_count_Chicago_pothole_2014_2019_df_1_ts with lambda = 0
fit <- auto.arima(monthly_count_Chicago_pothole_2014_2019_df_1_ts, lambda = 0)

# COMMAND ----------

# Summarize the fitted model
summary(fit)

# COMMAND ----------

# Plot 2-year forecasts
fit %>% forecast(h = 24) %>% autoplot()

# COMMAND ----------

# Fit a TBATS model to the gas data
fit_tbats <- tbats(monthly_count_Chicago_pothole_2014_2019_df_1_ts)

# COMMAND ----------

# Forecast the series for the next 2 years
fc_tbats <- forecast(fit_tbats, h = 12 * 2)

# COMMAND ----------

# Plot the forecasts
autoplot(fc_tbats)

# COMMAND ----------
#Integrate Azure Machine Learning


library(dplyr)
library(ggplot2)
library(reshape2)
library(tidyverse)
library(readr)

args <- commandArgs(trailingOnly = TRUE)

regrex <- read.csv(args[1])

regrex

x <- regrex[, 2]

y <- regrex[, 1]

png('scatter.png')
qplot(x, y)
dev.off()

png('scatter_line.png')
ggplot(regrex, aes(x, y)) + geom_point() + stat_smooth(method = lm)
dev.off()


#' Complement codes the data for use with an ART network.
#'
#' This function complement codes the given data where the complement of x is 1-x.
#' @title ART_Complement_Code
#' @param data Matrix of size NumFeatures-by-NumSamples that holds the data to be complement coded.
#' @return Data that has been complement coded. It is a matrix of size 2*NumFeatures-by-NumSamples.
#' @export
ART_Complement_Code = function(data)
{
  # Determine the size of the data.
  numFeatures=ncol(data);
  numSamples=nrow(data);

  # Create the return variable.
  complementCodedData = matrix(1,numSamples,2*numFeatures);

  # Do the complement coding for each sample.
  for (j in 1:numSamples)
  {
    count = 1;
    for (i in seq(1,(2*numFeatures),2))
    {
      complementCodedData[j,i] = data[j,count];
      complementCodedData[j,i + 1] = 1 - data[j,count];
      count = count + 1;
    }
  }

  return (complementCodedData);
}


# Data Wrangling in R
# Social Security Disability Case Study

# Load the tidyverse
library(tidyverse)
library(lubridate)
library(stringr)

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

# Take a look at how this was imported
glimpse(ssa)

# Make the dataset long
ssa_long <- gather(ssa, month, applications, -Fiscal_Year)

# And what do we get?
print(ssa_long, n=20)

# Split the month and application type
ssa_long <- separate(ssa_long, month, c("month", "application_method"), sep="_")

# What does that look like?
print(ssa_long, n=20)

# What values do we have for months?
unique(ssa_long$month)

# Convert month to standard abbreviations
ssa_long$month <- substr(ssa_long$month,1,3)

# What values do we now have for months and years?
unique(ssa_long$month)
unique(ssa_long$Fiscal_Year)

# Convert Fiscal_Year from alphanumeric strings to actual years
ssa_long$Fiscal_Year <- str_replace(ssa_long$Fiscal_Year, "FY", "20")

# What values do we now have for months?
unique(ssa_long$Fiscal_Year)

# Build a date string using the first day of the month
paste('01', ssa_long$month, ssa_long$Fiscal_Year)

ssa_long$Date <- dmy(paste("01", ssa_long$month, ssa$Fiscal_Year))

# What do those look like?
unique(ssa_long$Date)


partially.apply <- function(f, ...) {
  capture <- list(...)
  function(...) {
    do.call(f, c(capture, list(...)))
  }
}

fs <- function(f, ...) sapply(list(...), f)
f1 <- function(x) 2*x
f2 <- function(x) x^2

fsf1 <- partially.apply(fs, f1)
fsf2 <- partially.apply(fs, f2)

fsf1(0:3)
fsf2(0:3)
fsf1(seq(2,8,2))
fsf2(seq(2,8,2))


\docType{data}
\name{clima}
\alias{clima}
\title{Datos de clima}
\format{Un data.frame con 3,322 líneas y 9 variables
\describe{
\item{origen}{Estación de clima}
\item{anio}{año de la fecha de registro}
\item{mes}{mes de la fecha de registro}
\item{dia}{día de la fecha de registro}
\item{hora}{hora de la fecha de registro}
\item{temperatura}{temperatura medida en grados Fahrenheit}
\item{punto_rocio}{temperatura medida en grados Fahrenheit en la que, dada la presión atmosférica y humedad, condensa el vapor de agua}
\item{humedad}{humedad relativa}
\item{direccion_viento}{dirección del viento medida en grados}
\item{velocidad_viento}{velocidad del viento medida en millas por hora}
\item{velocidad_rafaga}{velocidad de las ráfagas de viento medida en millas por hora}
\item{precipitacion}{precipitación de lluvia medida en pulgadas}
\item{presion}{presión atmosférica al nivel del mar medida en milibares}
\item{visibilidad}{visibilidad medida en millas}
\item{fecha_hora}{fecha y hora de registro en formato POSIXct}
}}
\usage{clima}
\description{Metadatos del clima y los códigos de cola de los aviones en el registro de aviación de la FAA. American Airways (AA) y Envoy Air (MQ) reportan número de flota en lugar de número de cola, por lo que no es posible trazarlos.}
\keyword{datasets}


# 3. faza: Vizualizacija podatkov

library(ggplot2)
library(ggvis)
library(dplyr)
library(rgdal)
library(mosaic)
library(maptools)
library(ggmap)
library(mapproj)
library(munsell)

#linijski graf POTNIŠKI PREVOZ IN PROMET
graf_promet <- ggplot(data = promet, mapping = aes(x=Leto, y=Stevilo, group=Vrsta_prevoza, color=Vrsta_prevoza)) +
  geom_line(stat = "identity", position = position_dodge(width = NULL)) +
  theme(axis.text.x = element_text(angle = 90, size = 8)) +
  labs(y='Potniki(1000)', color='Vrsta prevoza') +
  theme(legend.text = element_text(size=8)) +
  ggtitle("Potniški prevoz in promet")

# točkasti graf ŠTEVILO UMRLIH V CESTNOPROMETNIH NESREČAH NA 10.000 PREBIVALCEV PO REGIJAH

graf_umrli1 <- ggplot(data = filter(umrli, Regija == 'Pomurska' | Regija == 'Podravska' |
                                     Regija == 'Koroška' | Regija == 'Savinjska' | Regija == 'Zasavska' |
                                     Regija == 'Posavska' | Regija == 'Jugovzhodna' | Regija == 'Osrednjeslovenska' |
                                     Regija == 'Gorenjska' | Regija == 'Primorsko-notranjska' |
                                     Regija == 'Goriška' | Regija == 'Obalno-kraška'),
                     mapping = aes(x=Leto, y=Umrli, color=Regija)) +
                     ggtitle('Število umrlih v cestnoprometnih nesrečah na 10.000 prebivalcev') +
                     geom_point() +
                     facet_wrap(Regija~., ncol=3) +
                     theme(axis.text.x = element_text(angle = 90, size = 6))

# stolpični diagram POVPREČNA STAROST OSEBNEGA AVTOMOBILA PO REGIJAH
graf_starost <- ggplot(data = starost, mapping = aes(x=Regija, y=Starost_avtomobila, fill=factor(Leto))) +
  geom_bar(stat = 'identity', position = 'dodge') +
  labs(y = 'Starost avtomobila') +
  theme(axis.text.x = element_text(angle = 90, size = 8)) +
  ggtitle("Povprečna starost osebnega avtomobila po regijah")

# linijski graf INDEKS ŠTEVILA AVTOMOBILOV GLEDE NA VRSTO POGONA

graf_vrsta_pogona <- ggplot(data=indeksi, mapping = aes(x=Leto, y=Indeks, group=Vrsta_pogona, color=Vrsta_pogona))+
  geom_line(stat = 'identity') +
  theme(axis.text.x = element_text(angle = 90, size = 8)) +
  theme(legend.text = element_text(size=8)) +
  ggtitle("Indeks števila avtomobilov glede na vrsto pogona") +
  labs(color='Vrsta pogona')

#########################################################################################
# Uvozimo zemljevid.

zemljevid <- uvozi.zemljevid("http://biogeo.ucdavis.edu/data/gadm2.8/shp/SVN_adm_shp.zip",
                             "SVN_adm1", mapa = "zemljevid_Slovenije", encoding = "UTF-8")
zemljevid$NAME_1 <- c("Gorenjska", "Goriška","Jugovzhodna", "Koroška", "Primorsko-notranjska", "Obalno-kraška", "Osrednjeslovenska", "Podravska", "Pomurska", "Savinjska", "Posavska", "Zasavska")

zemljevid <- fortify(zemljevid)

# ZEMLJEVID POVPREČNA BRUTO PLAČA V LETU 2015

zemljevid_placa <- ggplot() + geom_polygon(data=left_join(zemljevid, placa2015, by=c("NAME_1"="Regija")),
                                           aes(x=long, y=lat, group=group, fill=Placa)) +
  geom_line() +
  theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.text.y=element_blank(),
        axis.ticks.y=element_blank()) +
  guides(fill=guide_colorbar(title="Plača")) +
  ggtitle("Povprečna bruto plača po regijah leta 2015") +
  labs(x = " ") +
  labs(y = " ") +
  scale_fill_gradient(low = "white", high = "red",
                      space = "Lab", na.value = "#e0e0d1", guide = "black",
                      aesthetics = "fill")

# ZEMLJEVID STAROST OSEBNEGA AVTOMOBILA GLEDE NA REGIJO

zemljevid_starost <- ggplot() + geom_polygon(data=left_join(zemljevid, starost2015, by=c("NAME_1"= "Regija")),
                                             aes(x=long, y=lat, group=group, fill=Starost_avtomobila)) +
  geom_line() +
  theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.text.y=element_blank(),
        axis.ticks.y=element_blank()) +
  guides(fill=guide_colorbar(title="Povprečna starost avtomobila")) +
  ggtitle("Povprečna starost avtomobila po regijah leta 2015") +
  labs(x = " ") +
  labs(y = " ") +
  scale_fill_gradient(low = "white", high = "red",
                      space = "Lab", na.value = "#e0e0d1", guide = "black",
                      aesthetics = "fill")

cor(starost2015$Starost_avtomobila, placa2015$Placa)

avtomobili1 <- filter(avtomobili, Leto=='2015')

zemljevid_avtomobili <- ggplot() + geom_polygon(data=left_join(zemljevid, avtomobili1, by=c("NAME_1"= "Regija")),
                                             aes(x=long, y=lat, group=group, fill=Avtomobili)) +
  geom_line() +
  theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.text.y=element_blank(),
        axis.ticks.y=element_blank()) +
  guides(fill=guide_colorbar(title="Število avtomobilov")) +
  ggtitle("Število avtomobilov na 1000 prebivalcev leta 2015") +
  labs(x = " ") +
  labs(y = " ") +
  scale_fill_gradient(low = "white", high = "red",
                      space = "Lab", na.value = "#e0e0d1", guide = "black",
                      aesthetics = "fill")


library(plyr)
library(ggplot2)

load_exp_data <- function(sources) {
  exp_data <- data.frame(V1=integer(), V2=integer(), medium=character())
  for (s in sources) {
    exp_data_i <- read.table(s[1])
    exp_data_i["medium"] <- s[2]
    exp_data <- rbind(exp_data, exp_data_i)
  }
  data.frame(abscissa=exp_data$V1, ordinata=exp_data$V2, medium=exp_data$medium)
}

plot_exp_data <- function(exp_data, titles) {
  pd <- position_dodge(0.01)
  summary=ddply(exp_data, c("abscissa", "medium"), summarise,
                N=length(ordinata), mean=mean(ordinata), sd=sd(ordinata))
  csummary=ddply(exp_data, c("medium", "abscissa", "ordinata"), nrow)
  ggplot(summary, aes(x=abscissa, y=mean,
                      colour=medium, group=medium)) +
      geom_errorbar(aes(ymin=mean-sd, ymax=mean+sd),
                    width=.03, position=pd, colour="black") +
      geom_line(position=pd) +
      geom_point(position=pd,size=3) +
      scale_x_continuous(trans='log10') +
      labs(title=titles$title) +
      xlab(titles$abscissa) +
      ylab(titles$ordinata) +
      geom_point(data=csummary,
                aes(x=abscissa, y=ordinata, colour=medium,
                    group=medium, size=V1),
                position=pd,
                show.legend=FALSE) +
      scale_size(range=c(0,2),trans="log",labels=NULL)
}


cat("insert number ")
a <- scan(nmax=1, quiet=TRUE)
cat("insert number ")
b <- scan(nmax=1, quiet=TRUE)
print(paste('a+b=', a+b))
print(paste('a-b=', a-b))
print(paste('a*b=', a*b))
print(paste('a%/%b=', a%/%b))
print(paste('a%%b=', a%%b))
print(paste('a^b=', a^b))


library(ggplot2)
# library(tidyverse)
library(plotly)

# Function to make the heatmap
plot_heatmap <- function(xaxis="price"){

  # Selection components for heatmap
  xaxisKey_hm <- tibble(label = c("Price", "Rating"),
                     value = c("price", "points"))

  # gets the label matching the column value
  x_label <- xaxisKey_hm$label[xaxisKey_hm$value==xaxis]

  # make the plot!
  if (xaxis == 'price'){
    p <- ggplot(heatmap_data, aes(price, variety, z = value_scaled)) +
      stat_summary_2d(fun = mean, bins = 10) +
      scale_fill_gradient(low = '#C9DBEB', high = '#740F73') +
      labs(x = 'Price ($)',
           y = 'Grape Variety',
           fill = "Average Value",
           title = "Average Value Scores for Popular Grape Varieties, by Price")
  }

  if (xaxis == 'points'){
    p <- ggplot(heatmap_data, aes(points, variety, z = value_scaled)) +
      stat_summary_2d(fun = mean, bins = 10) +
      scale_fill_gradient(low = '#C9DBEB', high = '#740F73') +
      labs(x = 'Rating', y = 'Grape Variety', fill = "Average Value")
  }

  ggplotly(p) %>% config(displayModeBar = FALSE)
}


#!/usr/bin/env Rscript

# http://www.sthda.com/english/articles/31-principal-component-methods-in-r-practical-guide/118-principal-component-analysis-in-r-prcomp-vs-princomp/

# install.packages('factoextra')
library(factoextra)

htseq_counts_folder <- getwd()

###
# read htseq-counts files
###

read_htseq <- function(main_folder, file_name) {
  read.csv(paste(main_folder, "/", file_name, sep=''),
           header=FALSE,
           row.names=1,
           col.names=c("gene", substring(file_name, 9, 11)),
           sep='\t')
}

htseq_count_list <- list.files(path=htseq_counts_folder, pattern="*.htseq_counts*")
for (i in 1:length(htseq_count_list)) {
  if (!exists("dataset")){
    dataset <- read_htseq(htseq_counts_folder, htseq_count_list[i])
  }
  else {
    temp_dataset <- read_htseq(htseq_counts_folder, htseq_count_list[i])
    dataset <- cbind(dataset, temp_dataset)
    rm(temp_dataset)
  }
}

# remove statistics at the end of each hteq-counts file (last 5 lines)
dataset <- dataset[-seq(nrow(dataset) - 4, nrow(dataset)),]
dataset <- t(dataset)

# change row names
rownames(dataset) <- c("10A", "10B", "10C", "11A", "11B", "11C", "12A", "12B", "12C", "1A", "1B", "1C", "2A", "2B", "2C", "3A", "3B", "3C", "4A", "4B", "4C", "5A", "5B", "5C", "6A", "6B", "6C", "7A", "7B", "7C", "8A", "8B", "8C", "9A", "9B", "9C")

###
# pca
###

png("PCA_htseq_counts.png")
dev.control('enable')
pca <- prcomp(dataset)
colours <- c("#bd0000","#bd0000","#bd0000", "#bd5e00","#bd5e00","#bd5e00", "#bdbd00","#bdbd00","#bdbd00", "#5ebd00","#5ebd00","#5ebd00", "#00bd00","#00bd00","#00bd00", "#00bd5e","#00bd5e","#00bd5e", "#00bdbd","#00bdbd","#00bdbd", "#005ebd","#005ebd","#005ebd", "#0000bd","#0000bd","#0000bd", "#5e00bd","#5e00bd","#5e00bd", "#bd00bd","#bd00bd","#bd00bd", "#bd005e","#bd005e","#bd005e")
pca_graphic <- fviz_pca_ind(pca,
             invisible=c("quali"),
             col.ind=colours,
             repel=TRUE)
pca_graphic + theme(legend.position="none") + geom_point(aes(colour = colours))
dev.copy(postscript, "PCA_htseq_counts.eps", onefile=TRUE, horizontal=FALSE)
dev.off()
dev.off()


max.temp <- c(22, 27, 26, 24, 23, 26, 28)
barplot(max.temp,
main = "Maximum Temperatures in a Week",
xlab = "Degrees Celsius",
ylab = "Day",
names.arg = c("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"),
col = "red",
horiz = TRUE)


library(lars)
library(glmnet)
library(glmpath)
library(covTest)
library(nnlasso)

args <- commandArgs(trailingOnly = TRUE)
regionFreq<-readLines(args[1])
distMat<-readLines(args[2])
totalRegions_freq<-length(regionFreq)/2
totalLines_dist<-length(distMat)
j=1 #distMatCounter

#pdf("test.pdf")
#for(i in 1:100)
for(i in 1:totalRegions_freq)
{
    regionHeader<-as.numeric((strsplit(regionFreq[2*i-1],"\t"))[[1]])
    freq<-as.numeric((strsplit(regionFreq[2*i],"\t"))[[1]])
    print(regionHeader[2])
    freqSize<-length(freq)

    distMatHeader<-as.numeric((strsplit(distMat[j],"\t"))[[1]])
    j=j+1

    dist<-matrix(0.0,0,freqSize)
    if(distMatHeader[3]==regionHeader[2])
    {
	dataFlag<-TRUE
	while(dataFlag)
	{
	    distData<-as.numeric((strsplit(distMat[j],"\t"))[[1]])
	    if(length(distData)==3 || j>totalLines_dist)
	    {
		dataFlag<-FALSE
	    }
	    else
	    {
		dist<-rbind(dist,distData)
		#print(dim(dist))
		j=j+1
	    }
	}
    }
    else
    {
	print("ERROR! Region number not equal to test number.")
    }
    dist<-t(dist)
    #print(dim(dist))
    #print(length(freq))
    #print(freq)
    #print(dist)
    nnlassoobj<-nnlasso(dist, freq, family="normal",intercept=FALSE)
    #print(coef(nnlassoobj))
    #cvobj<-cv.nnlasso(dist,freq,family="normal", k=5,nlambda=50,tau=1,plot=FALSE, errorbars=FALSE)
    cvobj<-tryCatch({
	cvobj<-cv.nnlasso(dist,freq,family="normal", k=5,nlambda=50,tau=1,plot=FALSE, errorbars=FALSE)
	optCoef<-predict(nnlassoobj,mode="lambda",at=cvobj$lambda)
	cat(optCoef[2:length(optCoef)])
	cat("\n")
    }, error=function(err){
	cvobj<-cv.nnlasso(dist,freq,family="normal", k=5,nlambda=50,tau=0.5,plot=FALSE, errorbars=FALSE)
	optCoef<-predict(nnlassoobj,mode="lambda",at=cvobj$lambda)
	cat(optCoef[2:length(optCoef)])
	cat("\n")
	return(cvobj)
    }, finally={})
    #print(cvobj$lambda)
    #optCoef<-predict(nnlassoobj,mode="lambda",at=cvobj$lambda)
    #print(optCoef[2:length(optCoef)],max.levels=(length(optCoef)-1),digits=3)
    #print(optCoef[2:length(optCoef)],digits=3,width=(length(optCoef)-1))
    #cat(optCoef[2:length(optCoef)])
    #cat("\n")
    #cross validation, get nnlassoobj, then predict
    #cv.nnlasso(x,y,family="normal",k=5)
}

#add loop structure to catch error recursively, until no error occur: xxx.recur.r

#dev.off()


#In R the pie chart is created using the pie() function which takes positive numbers as a vector input.
# the syntax of creating pie chart
#pie(x, labels, radius, main, col, clockwise)
if(FALSE){
    "x is a vector containing the numeric values used in the pie chart."
    "labels is used to give description to the slices."
    "radius indicates the radius of the circle of the pie chart.(value between −1 and +1)."
    "main indicates the title of the chart"
    "col indicates the color palette"
    "clockwise is a logical value indicating if the slices are drawn clockwise or anti clockwise."
}

pie_chart <- function(){
# Create data for the graph.
x <- c(21, 62, 10, 53)
labels <- c("London", "New York", "Singapore", "Mumbai")

piepercent<- round(100*x/sum(x), 1)

# Give the chart file a name.
png(file = "city_percentage_legends.jpg") #save the file as jpg

# Plot the chart.
pie(x, labels = piepercent, main = "City pie chart",col = rainbow(length(x)))
legend("topright", c("London","New York","Singapore","Mumbai"), cex = 0.8,
   fill = rainbow(length(x)))

# Save the file.
dev.off()
}

# pie_chart()

pie_chart3d <- function(){
# Get the library.
library(plotrix)

# Create data for the graph.
x <-  c(21, 62, 10,53)
lbl <-  c("London","New York","Singapore","Mumbai")

# Give the chart file a name.
png(file = "3d_pie_chart.jpg")

# Plot the chart.
pie3D(x,labels = lbl,explode = 0.1, main = "Pie Chart of Countries ")

# Save the file.
dev.off()
}

# pie_chart3d()
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#The basic syntax to create a bar-chart in R is:
#barplot(H,xlab,ylab,main, names.arg,col)
if(FALSE){
   "H is a vector or matrix containing numeric values used in bar chart.
    xlab is the label for x axis.
    ylab is the label for y axis.
    main is the title of the bar chart.
    names.arg is a vector of names appearing under each bar.
    col is used to give colors to the bars in the graph."
}

bar_chart <- function(){
# Create the data for the chart
H <- c(7,12,28,3,41)
M <- c("Mar","Apr","May","Jun","Jul")

# Give the chart file a name
png(file = "barchart_months_revenue.png")

# Plot the bar chart
barplot(H,names.arg=M,xlab="Month",ylab="Revenue",col="blue",
main="Revenue chart",border="red")

# Save the file
dev.off()
}

# bar_chart()

group_bar_chart <- function(){
# Create the input vectors.
colors = c("green","orange","brown")
months <- c("Mar","Apr","May","Jun","Jul")
regions <- c("East","West","North")

# Create the matrix of the values.
Values <- matrix(c(2,9,3,11,9,4,8,7,3,12,5,2,8,10,11), nrow = 3, ncol = 5, byrow = TRUE)

# Give the chart file a name
png(file = "barchart_stacked.png")

# Create the bar chart
barplot(Values, main = "total revenue", names.arg = months, xlab = "month", ylab = "revenue", col = colors)

# Add the legend to the chart
legend("topleft", regions, cex = 1.3, fill = colors)

# Save the file
dev.off()
}

# group_bar_chart()
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#BOX PLOTS
#The below script will create a boxplot graph for the relation between
# mpg (miles per gallon) and cyl (number of cylinders).
boxplot1 <- function(){
# Give the chart file a name.
png(file = "boxplot.png")

# Plot the chart.
boxplot(mpg ~ cyl, data = mtcars, xlab = "Number of Cylinders",
   ylab = "Miles Per Gallon", main = "Mileage Data")

# Save the file.
dev.off()
} #this function contains error

# boxplot1()

boxplot2 <- function(){
    # Give the chart file a name.
png(file = "boxplot_with_notch.png")

# Plot the chart.
boxplot(mpg ~ cyl, data = mtcars,
   xlab = "Number of Cylinders",
   ylab = "Miles Per Gallon",
   main = "Mileage Data",
   notch = TRUE,
   varwidth = TRUE,
   col = c("green","yellow","purple"),
   names = c("High","Medium","Low")
)
# Save the file.
dev.off()
}
# boxplot()
# input <- mtcars[,c('mpg','cyl')]
# print(head(input))

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#hist(v,main,xlab,xlim,ylim,breaks,col,border)
if(FALSE){
    "v is a vector containing numeric values used in histogram.
    main indicates title of the chart.
    col is used to set color of the bars.
    border is used to set border color of each bar.
    xlab is used to give description of x-axis.
    xlim is used to specify the range of values on the x-axis.
    ylim is used to specify the range of values on the y-axis.
    breaks is used to mention the width of each bar."
}
histogram1 <- function(){
# Create data for the graph.
v <-  c(9,13,21,8,36,22,12,41,31,33,19)

# Give the chart file a name.
png(file = "histogram.png")

# Create the histogram.
hist(v,xlab = "Weight",col = "yellow",border = "blue")

# Save the file.
dev.off()
}

# histogram1()

histogram2 <- function(){
# Create data for the graph.
v <- c(9,13,21,8,36,22,12,41,31,33,19)

# Give the chart file a name.
png(file = "histogram_lim_breaks.png")

# Create the histogram.
hist(v,xlab = "Weight",col = "green",border = "red", xlim = c(0,40), ylim = c(0,5),
   breaks = 5)

# Save the file.
dev.off()
}

# histogram2()

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#plot(v,type,col,xlab,ylab)
if(FALSE){
    'v is a vector containing the numeric values.
    type takes the value "p" to draw only the points,
    "l" to draw only the lines and "o" to draw both points and lines.
    xlab is the label for x axis.
    ylab is the label for y axis.
    main is the Title of the chart.
    col is used to give colors to both the points and lines.'
}
line_chart1 <- function(){
# Create the data for the chart.
v <- c(7,12,28,3,41)

# Give the chart file a name.
png(file = "line_chart_label_colored.jpg")

# Plot the bar chart.
plot(v,type = "o", col = "red", xlab = "Month", ylab = "Rain fall",
   main = "Rain fall chart")

# Save the file.
dev.off()
}

line_chart1()

line_chart2 <- function(){
# Create the data for the chart.
v <- c(7,12,28,3,41)
t <- c(14,7,6,19,3)

# Give the chart file a name.
png(file = "line_chart_2_lines.jpg")

# Plot the bar chart.
plot(v,type = "o",col = "red", xlab = "Month", ylab = "Rain fall",
   main = "Rain fall chart")

lines(t, type = "o", col = "blue")

# Save the file.
dev.off()
}

line_chart2()
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# plot(x, y, main, xlab, ylab, xlim, ylim, axes)
if(FALSE){
    "x is the data set whose values are the horizontal coordinates.
    y is the data set whose values are the vertical coordinates.
    main is the tile of the graph.
    xlab is the label in the horizontal axis.
    ylab is the label in the vertical axis.
    xlim is the limits of the values of x used for plotting.
    ylim is the limits of the values of y used for plotting.
    axes indicates whether both axes should be drawn on the plot."

    "When we have more than two variables and we want to find the correlation
    between one variable versus the remaining ones we use scatterplot matrix.
    We use pairs() function to create matrices of scatterplots."
    #pairs(formula, data)
    "formula represents the series of variables used in pairs.
    data represents the data set from which the variables will be taken."
}
scatter_plot <- function(){
# Get the input values.
input <- mtcars[,c('wt','mpg')]
print(head(input))
# Give the chart file a name.
png(file = "scatterplot.png")

# Plot the chart for cars with weight between 2.5 to 5 and mileage between 15 and 30.
plot(x = input$wt,y = input$mpg,
   xlab = "Weight",
   ylab = "Milage",
   xlim = c(2.5,5),
   ylim = c(15,30),
   main = "Weight vs Milage"
)

# Save the file.
dev.off()
}
# scatter_plot()

scatter_plot_matrices <- function(){
# Give the chart file a name.
png(file = "scatterplot_matrices.png")

# Plot the matrices between 4 variables giving 12 plots.

# One variable with 3 others and total 4 variables.

pairs(~wt+mpg+disp+cyl,data = mtcars,
   main = "Scatterplot Matrix")

# Save the file.
dev.off()
}
scatter_plot_matrices()


library(VIM)
library(fmsb) ##radarchart
library(stats)
library(data.table)
#setwd('./')

scaleMaxMin1 <- function(x){1*(x - min(x, na.rm=T)) / (max(x, na.rm=T) - min(x, na.rm=T))}

### Get typology factor averages
factor_scores <- scaled.f9scores[,c(1:num_fac)]
colnames(factor_scores) = c("Metro", "BRT", "Bikeshare", "Development", "Sustainability", "Population", "Congestion", "Sprawl", "Network")
#factor_scores <- round(factor_scores,2)
factor_scores$clusterID <- fac9clusters13.ward.scaled$cluster
factor_scores$superclusterID <- factor_scores$clusterID
factor_scores <- data.table(factor_scores)
factor_scores[clusterID==3, superclusterID := 1] # congested
factor_scores[clusterID==4, superclusterID := 2] # brt
factor_scores[clusterID==5, superclusterID := 3] # hyb
factor_scores[clusterID==6, superclusterID := 3] # hyb
factor_scores[clusterID==7, superclusterID := 4] # auto
factor_scores[clusterID==8, superclusterID := 4] # auto
factor_scores[clusterID==9, superclusterID := 5] # mass
factor_scores[clusterID==10, superclusterID := 5] # mass
factor_scores[clusterID==11, superclusterID := 6] # metrobike
factor_scores[clusterID==12, superclusterID := 6] # metrobike

factor_scores <- as.data.frame(factor_scores)
#factor_scores <- as.data.frame(lapply(factor_scores, scaleMaxMin1)) # obtain scaled dataframe

typology_factor_means <- round(aggregate(factor_scores, list(factor_scores$clusterID), mean), 2) #[,c(1:9)]
#typology_factor_means <- as.data.frame(lapply(typology_factor_means, scaleMaxMin1)) # obtain scaled dataframe

super_typology_factor_means <- round(aggregate(factor_scores, list(factor_scores$superclusterID), mean),2)
#super_typology_factor_means <- as.data.frame(lapply(super_typology_factor_means, scaleMaxMin1)) # obtain scaled dataframe

row.names(typology_factor_means) <- c(	"Congested Emerging",
                                        "BusTransit Sprawl",
                                        "Congested Boomer",
                                        "BusTransit Dense",
                                        "Hybrid Moderate",
                                        "Hybrid Giant",
                                        "Auto Sprawl",
                                        "Auto Innovative",
                                        "MassTransit Heavyweight",
                                        "MassTransit Moderate",
                                        "MetroBike Giant",
                                        "MetroBike Emerging"	)

row.names(super_typology_factor_means) <- c( "Congested",
                                       "BusTransit",
                                       "Hybrid",
                                       "Auto",
                                       "MassTransit",
                                       "MetroBike")

### Get top 6 variables and values for each typology
matrixplot(typology_factor_means[,2:10])

#https://www.data-to-viz.com/caveat/spider.html
typology_factor_means$color <- c(
  '#fb9a99', #lightred
  '#fdbf6f', #lightorange
  '#e31a1c', #darkred
  '#ff7f00', #darkorange
  '#ffff99', #yellow '#d2b48c', #lightbrown
  '#b15928', #darkbrown
  '#a6cee3', #lightblue
  '#1f78b4', #darkblue
  '#33a02c',  #darkgreen
  '#b2df8a', #lightgreen
  '#6a3d9a', #darkpurple
  '#cab2d6' #lightpurple
)

super_typology_factor_means$color <- c(
  '#e31a1c', #darkred
  '#ff7f00', #darkorange
  '#b15928', #darkbrown
  '#1f78b4', #darkblue
  '#33a02c', #darkgreen
  '#6a3d9a'  #darkpurple
)

typo_averages <- typology_factor_means[ order(row.names(typology_factor_means)), ]
plot_data <- typo_averages[,2:10]
plot_data <-rbind(rep(1,num_clust) , rep(0,num_clust) , plot_data)

super_typo_averages <- super_typology_factor_means[ order(row.names(super_typology_factor_means)), ]
super_plot_data <- super_typo_averages[,2:10]
super_plot_data <- rbind(rep(1,num_clust) , rep(0,num_clust) , super_plot_data)

# Split the screen in 6 parts
par(mar=rep(1,4)) #c(2.5, .75, 2.5, .75) )#rep(1,4))
par(mfcol=c(4,3))

#par(adj=0)

spider_plot <- function(num_clusters, data, factors_df) {
  for(i in 1:num_clusters){

    # Custom the radarChart !
    radarchart( data[c(1,2,i+2),], axistype=1, centerzero=FALSE,

                #custom polygon #typo_averages$color[i]
                pcol= 'darkgray', pfcol=alpha(factors_df$color[i],.8) , plwd=4, plty=1 ,

                #custom the grid
                cglcol="grey", cglty=1, axislabcol="grey", caxislabels=seq(0,1,.25), cglwd=0.8,

                #custom labels
                vlcex=1.5,

                #title
                title=rownames(factors_df)[i]
    )
  }
}

spider_plot(12, plot_data, typo_averages) # Generate spider plots as seen in paper

par(mfcol=c(2,3))
spider_plot(6,super_plot_data,super_typo_averages) # Spider plots of super-typologies

data_complete <- read.csv('plot-data/urbandata2019-64var-id-sorted-updated-citynames-countries-updated.csv')
typology_var_means <- as.data.frame(aggregate(data_complete[,-c(1:4)], list(data_complete$clusterID), mean,na.rm = TRUE))
row.names(typology_var_means) <- c(	"Congested Emerging",
                                    "BusTransit Sprawl",
                                    "Congested Boomer",
                                    "BusTransit Dense",
                                    "Hybrid Moderate",
                                    "Hybrid Giant",
                                    "Auto Sprawl",
                                    "Auto Innovative",
                                    "MassTransit Heavyweight",
                                    "MassTransit Moderate",
                                    "MetroBike Giant",
                                    "MetroBike Emerging"	)


#devtools::test("asremlPlus")
context("lme4_alldiffs")

cat("#### Test for predictions.frame on Oats with lme4\n")
test_that("PredictionsFrame_lme4", {
  #  skip_on_cran()
  library(asremlPlus)
  library(dae)
  data(Oats.dat)

  ## Use lmerTest and emmmeans to get predictions and associated statistics
  if (requireNamespace("lmerTest", quietly = TRUE) &
      requireNamespace("emmeans", quietly = TRUE))
  {
    m1.lmer <- lmerTest::lmer(Yield ~ Nitrogen*Variety + (1|Blocks/Wplots),
                              data=Oats.dat)
    Var.emm <- emmeans::emmeans(m1.lmer, specs = ~ Nitrogen:Variety)
    Var.preds <- summary(Var.emm)
    Var.preds <- as.predictions.frame(Var.preds, predictions = "emmean",
                                      se = "SE", interval.type = "CI",
                                      interval.names = c("lower.CL", "upper.CL"))

  ## Check the class and validity of the predictions.frame
  testthat::expect_true(is.predictions.frame(Var.preds))
  testthat::expect_true(validPredictionsFrame(Var.preds))
  }

})

cat("#### Test for LSD.frame on Oats with lme4\n")
test_that("PredictionsFrame_lme4", {
  #  skip_on_cran()
  library(asremlPlus)
  library(dae)
  data(Oats.dat)

  ## Use lme4 and emmmeans to get predictions and associated statistics
  if (requireNamespace("lmerTest", quietly = TRUE) &
      requireNamespace("emmeans", quietly = TRUE))
  {
    m1.lmer <- lmerTest::lmer(Yield ~ Nitrogen*Variety + (1|Blocks/Wplots),
                              data=Oats.dat)
    ## Set up a wald.tab
    int <- as.data.frame(rbind(rep(NA,4)))
    rownames(int) <- "(Intercept)"
    wald.tab <- anova(m1.lmer, ddf = "Kenward", type = 1)[,3:6]
    names(wald.tab) <- names(int) <- c("Df", "denDF", "F.inc", "Pr")
    wald.tab <- rbind(int, wald.tab)
    #Get predictions
    Var.emm <- emmeans::emmeans(m1.lmer, specs = ~ Nitrogen:Variety)
    Var.preds <- summary(Var.emm)
    ## Modify Var.preds to be compatible with a predictions.frame
    Var.preds <- as.predictions.frame(Var.preds, predictions = "emmean",
                                      se = "SE", interval.type = "CI",
                                      interval.names = c("lower.CL", "upper.CL"))
    Var.vcov <- vcov(Var.emm)
    Var.sed <- NULL
    den.df <- wald.tab[match("Nitrogen:Variety", rownames(wald.tab)), "denDF"]
    testthat::expect_equal(den.df, 45)

    #Test for LSDs in allDifference
    Var.LSD.diffs <- allDifferences(predictions = Var.preds, classify = "Variety:Nitrogen",
                                     sed = Var.sed, vcov = Var.vcov, tdf = den.df,
                                     sortFactor = "Variety", decreasing = TRUE)
    testthat::expect_true(all(abs(Var.LSD.diffs$LSD -
                                    c(66,15.47425, 18.54065, 19.56706, 18.54065, 0.1653881,2,4)) < 1e-05))
    testthat::expect_true(setequal(names(Var.LSD.diffs$LSD), c("c", "minLSD", "meanLSD", "maxLSD",
                                                              "assignedLSD", "accuracyLSD",
                                                              "falsePos", "falseNeg")))
    testthat::expect_equal(rownames(Var.LSD.diffs$LSD), "overall")

    #Test for LSDby in allDifference
    Var.LSD.diffs <- allDifferences(predictions = Var.preds, classify = "Variety:Nitrogen",
                                    sed = Var.sed, vcov = Var.vcov, tdf = den.df,
                                    LSDtype = "factor.combinations", LSDby = "Variety",
                                    sortFactor = "Variety", decreasing = TRUE)
    testthat::expect_true(all(abs(Var.LSD.diffs$LSD[c("minLSD", "meanLSD", "maxLSD",
                                                      "assignedLSD")] -  15.47425) < 1e-05))
    testthat::expect_true(all(Var.LSD.diffs$LSD["accuracyLSD"] < 1e-15))
    testthat::expect_true(setequal(names(Var.LSD.diffs$LSD), c("c", "minLSD", "meanLSD", "maxLSD",
                                                               "assignedLSD", "accuracyLSD",
                                                               "falsePos", "falseNeg")))
    testthat::expect_true(setequal(rownames(Var.LSD.diffs$LSD), c("Marvellous", "Golden Rain", "Victory")))

    #test for LSDby recalcLSD
    Var.LSD.diffs <- recalcLSD(Var.LSD.diffs, LSDtype = "factor.combinations", LSDby = "Variety")
    testthat::expect_true(is.alldiffs(Var.LSD.diffs))
    testthat::expect_true(validAlldiffs(Var.LSD.diffs))
    testthat::expect_true(all(abs(Var.LSD.diffs$LSD[c("minLSD", "meanLSD", "maxLSD",
                                                      "assignedLSD")] -  15.47425) < 1e-05))
    testthat::expect_true(all(Var.LSD.diffs$LSD["accuracyLSD"] < 1e-15))
    testthat::expect_true(setequal(names(Var.LSD.diffs$LSD), c("c", "minLSD", "meanLSD", "maxLSD",
                                                               "assignedLSD", "accuracyLSD",
                                                               "falsePos", "falseNeg")))
    testthat::expect_true(setequal(rownames(Var.LSD.diffs$LSD), c("Marvellous", "Golden Rain", "Victory")))
  }
})

cat("#### Test for allDifferences.data.frame on Oats with lme4\n")
test_that("alldiffs_lme4", {
  #  skip_on_cran()
  library(asremlPlus)
  library(dae)
  data(Oats.dat)

  ## Use lme4 and emmmeans to get predictions and associated statistics
  if (requireNamespace("lmerTest", quietly = TRUE) &
      requireNamespace("emmeans", quietly = TRUE))
  {
    m1.lmer <- lmerTest::lmer(Yield ~ Nitrogen*Variety + (1|Blocks/Wplots),
                              data=Oats.dat)
    ## Set up a wald.tab
    int <- as.data.frame(rbind(rep(NA,4)))
    rownames(int) <- "(Intercept)"
    wald.tab <- anova(m1.lmer, ddf = "Kenward", type = 1)[,3:6]
    names(wald.tab) <- names(int) <- c("Df", "denDF", "F.inc", "Pr")
    wald.tab <- rbind(int, wald.tab)
    #Get predictions
    Var.emm <- emmeans::emmeans(m1.lmer, specs = ~ Nitrogen:Variety)
    Var.preds <- summary(Var.emm)
    ## Modify Var.preds to be compatible with a predictions.frame
    Var.preds <- as.predictions.frame(Var.preds, predictions = "emmean",
                                      se = "SE", interval.type = "CI",
                                      interval.names = c("lower.CL", "upper.CL"))
    Var.vcov <- vcov(Var.emm)
    Var.sed <- NULL
    den.df <- wald.tab[match("Variety", rownames(wald.tab)), "denDF"]

  #Test for as.alldiffs
  Var.diffs <- as.alldiffs(predictions = Var.preds,
                           sed = Var.sed, vcov = Var.vcov,
                           classify = "Nitrogen:Variety", response = "Yield", tdf = den.df)
  testthat::expect_true(is.alldiffs(Var.diffs))
  testthat::expect_true(validAlldiffs(Var.diffs))
  testthat::expect_equal(nrow(Var.diffs$predictions),12)
  testthat::expect_equal(ncol(Var.diffs$predictions),8)
  testthat::expect_true(is.null(attr(Var.diffs, which = "sortOrder")))
  testthat::expect_true(all(names(Var.diffs$predictions)[1:2] ==  c("Nitrogen","Variety")))
  testthat::expect_true(as.character(Var.diffs$predictions$Variety[1]) == "Victory" &
                          as.character(Var.diffs$predictions$Variety[2]) == "Victory")

  #Test for allDifferences
  Var.sort.diffs <- allDifferences(predictions = Var.preds, classify = "Variety:Nitrogen",
                                   sed = Var.sed, vcov = Var.vcov, tdf = den.df,
                                   sortFactor = "Variety", decreasing = TRUE)
  testthat::expect_true(is.alldiffs(Var.sort.diffs))
  testthat::expect_true(validAlldiffs(Var.sort.diffs))
  testthat::expect_true(as.character(Var.sort.diffs$predictions$Variety[1]) == "Marvellous" &
                          as.character(Var.sort.diffs$predictions$Variety[2]) == "Marvellous")
  testthat::expect_equal(length(attr(Var.sort.diffs, which = "sortOrder")),3)
  testthat::expect_true(all(names(Var.sort.diffs$predictions)[1:2] ==  c("Variety","Nitrogen")))

  ## Change the order of the factors in the alldiffs object and reorder components
  Var.reord.diffs <- allDifferences(predictions = Var.preds,
                                    classify = "Variety:Nitrogen",
                                    sed = Var.sed, vcov = Var.vcov, tdf = den.df)
  testthat::expect_true(is.alldiffs(Var.reord.diffs))
  testthat::expect_true(validAlldiffs(Var.reord.diffs))
  testthat::expect_true(as.character(Var.reord.diffs$predictions$Variety[1]) == "Victory" &
                          as.character(Var.reord.diffs$predictions$Variety[2]) == "Victory")

  #Test for re-order factors with renewClassify
  Var.reord.diffs <- renewClassify(Var.diffs, newclassify = "Variety:Nitrogen")
  testthat::expect_true(as.character(Var.reord.diffs$predictions$Variety[1]) == "Victory" &
                          as.character(Var.reord.diffs$predictions$Variety[2]) == "Victory")

  #Test for re-order factors and sort
  Var.both.diffs <- allDifferences(predictions = Var.preds,
                                   classify = "Variety:Nitrogen",
                                   sed = Var.sed, vcov = Var.vcov, tdf = den.df,
                                   sortFactor = "Variety", decreasing = TRUE)
  testthat::expect_true(as.character(Var.both.diffs$predictions$Variety[1]) == "Marvellous" &
                          as.character(Var.both.diffs$predictions$Variety[2]) == "Marvellous")
  Var.both.diffs <- renewClassify(Var.diffs, newclassify = "Variety:Nitrogen",
                                    sortFactor = "Variety", decreasing = TRUE)
  testthat::expect_true(as.character(Var.both.diffs$predictions$Variety[1]) == "Marvellous" &
                          as.character(Var.both.diffs$predictions$Variety[2]) == "Marvellous")
  }
})

cat("#### Test for alldiffs validity on Oats with lme4\n")
test_that("validity_lme4", {
  #  skip_on_cran()
  library(asremlPlus)
  library(dae)
  data(Oats.dat)

  ## Use lme4 and emmmeans to get predictions and associated statistics
  if (requireNamespace("lmerTest", quietly = TRUE) &
      requireNamespace("emmeans", quietly = TRUE))
  {
    m1.lmer <- lmerTest::lmer(Yield ~ Nitrogen*Variety + (1|Blocks/Wplots),
                              data=Oats.dat)
    ## Set up a wald.tab
    int <- as.data.frame(rbind(rep(NA,4)))
    rownames(int) <- "(Intercept)"
    wald.tab <- anova(m1.lmer, ddf = "Kenward", type = 1)[,3:6]
    names(wald.tab) <- names(int) <- c("Df", "denDF", "F.inc", "Pr")
    wald.tab <- rbind(int, wald.tab)
    #Get predictions
    Var.emm <- emmeans::emmeans(m1.lmer, specs = ~ Nitrogen:Variety)
    Var.preds <- summary(Var.emm)
    ## Modify Var.preds to be compatible with a predictions.frame
    Var.preds <- as.predictions.frame(Var.preds, predictions = "emmean",
                                      se = "SE", interval.type = "CI",
                                      interval.names = c("lower.CL", "upper.CL"))
    Var.vcov <- vcov(Var.emm)
    Var.sed <- NULL
    den.df <- wald.tab[match("Variety", rownames(wald.tab)), "denDF"]

  #Test for as.alldiffs
  Var.diffs <- as.alldiffs(predictions = Var.preds,
                           sed = Var.sed, vcov = Var.vcov,
                           response = "Yield", tdf = den.df)
  Var.diffs$vcov <- NULL
  Var.diffs$predictions <- Var.diffs$predictions[, -match("est.status",
                                                          names(Var.diffs$predictions))]
  testthat::expect_true(is.alldiffs(Var.diffs))
  testthat::expect_warning(msg <- validAlldiffs(Var.diffs))
  testthat::expect_equal(length(msg),5)
  testthat::expect_true(all(unlist(lapply(msg, nchar)) ==  c(41, 63, 118, 62, 119)))
  testthat::expect_true(grepl("Predictions.frame", msg[2], fixed = TRUE))
  testthat::expect_true(grepl("classify", msg[5], fixed = TRUE))

  #Test to show that variables in the classify must be in same order as in the predictions.frame
  Var.diffs <- as.alldiffs(predictions = Var.preds,
                           sed = Var.sed, vcov = Var.vcov,
                           classify = "Variety:Nitrogen", response = "Yield", tdf = den.df)
  testthat::expect_equal(length(attributes(Var.diffs)),6)
  testthat::expect_true(is.null(attr(Var.diffs, which = "sortOrder")))
  testthat::expect_true(is.character(msg <- validAlldiffs(Var.diffs))) #invalid classify
  testthat::expect_true(grepl("classify var", msg[2], fixed = TRUE))
  testthat::expect_false(all(names(Var.diffs$predictions)[1:2] ==  c("Variety","Nitrogen")))
  }
})

cat("#### Test for linTransform on WaterRunoff with lme4\n")
test_that("linTransform_lme4", {
  #  skip_on_cran()
  library(asremlPlus)
  library(dae)
  data("WaterRunoff.dat")

  ## Use lmeTest and emmmeans to get predictions and associated statistics
  if (requireNamespace("lmerTest", quietly = TRUE) &
      requireNamespace("emmeans", quietly = TRUE))
  {
    m1.lmer <- lmerTest::lmer(pH ~ Benches + (Sources * Species) +
                                (1|Benches:MainPlots),
                              data=na.omit(WaterRunoff.dat))
    SS.emm <- emmeans::emmeans(m1.lmer, specs = ~ Sources:Species)
    SS.preds <- summary(SS.emm)
    den.df <- min(SS.preds$df, na.rm = TRUE)
    ## Modify SS.preds to be compatible with a predictions.frame
    SS.preds <- as.predictions.frame(SS.preds, predictions = "emmean",
                                     se = "SE", interval.type = "CI",
                                     interval.names = c("lower.CL", "upper.CL"))

    ## Form an all.diffs object and check its validity
    SS.vcov <- vcov(SS.emm)
    SS.diffs <- allDifferences(predictions = SS.preds, classify = "Sources:Species",
                               vcov = SS.vcov, tdf = den.df)
    testthat::expect_true(validAlldiffs(SS.diffs))

    #Get additive predictions
    diffs.sub <- linTransform(SS.diffs, classify = "Sources:Species",
                              linear.transformation = ~ Sources + Species,
                              Vmatrix = TRUE, tables = "none")
    testthat::expect_true(validAlldiffs(diffs.sub))
    testthat::expect_equal(diffs.sub$predictions$predicted.value[1] -
                             diffs.sub$predictions$predicted.value[6],
                           diffs.sub$predictions$predicted.value[7] -
                             diffs.sub$predictions$predicted.value[12])

    #Contrast matrix for differences between each species and non-planted for the last source
    L <- cbind(matrix(rep(0,7*32), nrow = 7, ncol = 32),
               diag(1, nrow = 7),
               matrix(rep(-1, 7), ncol = 1))
    rownames(L) <- as.character(diffs.sub$predictions$Species[33:39])
    diffs.L <- linTransform(diffs.sub,
                            classify = "Sources:Species",
                            linear.transformation = L,
                            tables = "predictions")
    testthat::expect_true(abs(diffs.L$predictions$predicted.value[1] + 0.04097328) < 1e-04)
    testthat::expect_true(diffs.L$predictions$Combination[1] == "S. iqscjbogxah")
  }
})

cat("#### Test for alldiffs functions on WaterRunoff with lme4\n")
test_that("alldiffs_lme4", {
  #  skip_on_cran()
  library(asremlPlus)
  library(dae)
  data("WaterRunoff.dat")

  ## Use lmeTest and emmmeans to get predictions and associated statistics
  if (requireNamespace("lmerTest", quietly = TRUE) &
      requireNamespace("emmeans", quietly = TRUE))
  {
    m1.lmer <- lmerTest::lmer(pH ~ Benches + (Sources * (Type + Species)) +
                                (1|Benches:MainPlots),
                              data=na.omit(WaterRunoff.dat))
    TS.emm <- emmeans::emmeans(m1.lmer, specs = ~ Sources:Type)
    TS.preds <- summary(TS.emm)
    den.df <- min(TS.preds$df, na.rm = TRUE)
    ## Modify TS.preds to be compatible with a predictions.frame
    TS.preds <- as.predictions.frame(TS.preds, predictions = "emmean",
                                     se = "SE", interval.type = "CI",
                                     interval.names = c("lower.CL", "upper.CL"))

    ## Form an all.diffs object and check its validity
    els <- as.numeric(rownames(TS.preds))
    TS.vcov <- vcov(TS.emm)[els,els]
    TS.diffs <- allDifferences(predictions = TS.preds, classify = "Sources:Type",
                               vcov = TS.vcov, tdf = den.df)
    testthat::expect_true(validAlldiffs(TS.diffs))
  }

  ##Plot p-values for predictions obtained using asreml or lme4
  if (exists("TS.diffs"))
  {
    ##Plot p-values based on diffs obtained from predictions using asreml or lme4
    pdata <- plotPvalues(TS.diffs, gridspacing = rep(c(3,4), c(4,2)), show.sig = TRUE)
    testthat::expect_equal(nrow(pdata), 400)
    testthat::expect_equal(ncol(pdata), 3)
    testthat::expect_true(all(c("X1","X2","p") %in% names(pdata)))
    testthat::expect_equal(sum(!is.na(pdata$p)), 380)

    pdata <- plotPvalues(TS.diffs, sections = "Sources", show.sig = TRUE, axis.labels = TRUE)
    testthat::expect_equal(nrow(pdata), 400)
    testthat::expect_equal(ncol(pdata), 5)
    testthat::expect_true(all(c("X1","X2","p","sections1","sections2") %in% names(pdata)))
    testthat::expect_equal(sum(!is.na(pdata$p)), 380)

    #row and col names cause reshape::melt to throw a warning re type.convert
    testthat::expect_warning(p <- within(reshape::melt(TS.diffs$p.differences),
                                         {
                                           X1 <- factor(X1, levels=dimnames(TS.diffs$p.differences)[[1]])
                                           X2 <- factor(X2, levels=levels(X1))
                                         }))
    names(p)[match("value", names(p))] <- "p"
    testthat::expect_silent(plotPvalues(p, x = "X1", y = "X2",
                                        gridspacing = rep(c(3,4), c(4,2)),
                                        show.sig = TRUE))

    ##Recalculate the LSD values for predictions obtained using asreml or lme4
    TS.diffs <- recalcLSD(TS.diffs, LSDtype = "factor.combinations",
                          LSDby = "Sources")
    testthat::expect_equal(nrow(TS.diffs$LSD), 6)
    testthat::expect_equal(ncol(TS.diffs$LSD), 8)
    testthat::expect_warning(TS.diffs <- redoErrorIntervals(TS.diffs,
                                                            error.intervals = "halfLeast"))
    testthat::expect_false("upper.halfLeastSignificant.limit" %in% names(TS.diffs$predictions))

    ##Use subset.alldiffs to select a subset of the alldiffs object
    TS.diffs.subs <- subset(TS.diffs,
                            subset = grepl("R", Sources, fixed = TRUE) &
                              Type %in% c("Control","Medicinal"))
    testthat::expect_is(TS.diffs.subs, "alldiffs")
    testthat::expect_true(validAlldiffs(TS.diffs.subs))
    testthat::expect_equal(nrow(TS.diffs.subs$predictions),10)
    testthat::expect_equal(ncol(TS.diffs.subs$predictions),8)
    testthat::expect_false(any(TS.diffs.subs$predictions$Sources == "Tap water"))
    testthat::expect_false(any(TS.diffs.subs$predictions$B %in% c("Landscape","Culinary")))
    testthat::expect_equal(length(attributes(TS.diffs.subs)),9)
  }
})

cat("#### Test for exploreLSD on WaterRunoff with lme4\n")
test_that("explore_lme4", {
  #  skip_on_cran()
  library(asremlPlus)
  library(dae)
  data("WaterRunoff.dat")

  ## Use lmeTest and emmmeans to get predictions and associated statistics
  if (requireNamespace("lmerTest", quietly = TRUE) &
      requireNamespace("emmeans", quietly = TRUE))
  {
    m1.lmer <- lmerTest::lmer(pH ~ Benches + (Sources * (Type + Species)) +
                                (1|Benches:MainPlots),
                              data=na.omit(WaterRunoff.dat))
    TS.emm <- emmeans::emmeans(m1.lmer, specs = ~ Sources:Type)
    TS.preds <- summary(TS.emm)
    den.df <- min(TS.preds$df, na.rm = TRUE)
    ## Modify TS.preds to be compatible with a predictions.frame
    TS.preds <- as.predictions.frame(TS.preds, predictions = "emmean",
                                     se = "SE", interval.type = "CI",
                                     interval.names = c("lower.CL", "upper.CL"))

    ## Form an all.diffs object and check its validity
    els <- as.numeric(rownames(TS.preds))
    TS.vcov <- vcov(TS.emm)[els,els]
    TS.diffs <- allDifferences(predictions = TS.preds, classify = "Sources:Type",
                               vcov = TS.vcov, tdf = den.df)
    testthat::expect_true(validAlldiffs(TS.diffs))
  }

  ##Explore the LSDs #the values are not the same as those from asreml
  if (exists("TS.diffs"))
  {
    ##Explore the LSD values for predictions obtained using asreml or lmerTest
    LSDstat <- exploreLSDs(TS.diffs, LSDtype = "factor.combinations",
                           LSDby = "Sources")
    testthat::expect_equal(names(LSDstat), c("frequencies", "distinct.vals", "statistics", "accuracy",
                                             "false.pos", "false.neg", "per.pred.accuracy", "LSD"))
    testthat::expect_true(all(lapply(c("frequencies", "statistics", "accuracy"),
                                     function(k, LSDstat) nrow(LSDstat[[k]]), LSDstat = LSDstat) == 6))
    testthat::expect_true(all(unlist(lapply(c("frequencies", "statistics", "accuracy"), function(k, LSDstat, dat)
      all(rownames(LSDstat[[k]])== levels(WaterRunoff.dat$Sources)), LSDstat = LSDstat, dat = WaterRunoff.dat))))
    testthat::expect_equal(names(LSDstat$frequencies), as.character(seq(0.19, 0.41, 0.02)))
    testthat::expect_equal(LSDstat$distinct.vals$`Rain+Basalt`, c(0.204,0.306,0.319))
    testthat::expect_true(all(abs(LSDstat$statistics[1,] -
                                    c(3, 0.2049027,0.2252329,0.2557283,0.2814212,
                                      0.3065539,0.3126769,0.3163506,0.3187998)) < 1e-05))
    testthat::expect_true(all(abs(LSDstat$accuracy[1,] -
                                    c(3,0.5558598,0.4154228,0.2466349,0.2719005,
                                      0.3315934,0.3446824,0.3522925,0.3572686)) < 1e-05))
    testthat::expect_true(all(lapply(c("per.pred.accuracy", "LSD"),
                                     function(k, LSDstat) nrow(LSDstat[[k]]), LSDstat = LSDstat) == 20))
    testthat::expect_equal(rownames(LSDstat$per.pred.accuracy),
                           as.character(fac.combine(as.list(TS.diffs$predictions[c("Sources","Type")]),
                                                    combine.levels = TRUE)))
    testthat::expect_true(all(abs(LSDstat$per.pred.accuracy[1,] -
                                    c(0.4960954,0.361053,0.1987486,0.2719005,
                                      0.3315934,0.3446824,0.3522925,0.3572686)) < 1e-05))
  }
})

cat("#### Test for sort.alldiffs on Smarthouse with lme4\n")
test_that("sort.alldiffs_lme4", {
  #  skip_on_cran()
  library(asremlPlus)
  library(dae)
  data(Smarthouse.dat)

  if (requireNamespace("lmerTest", quietly = TRUE) &
      requireNamespace("emmeans", quietly = TRUE))
  {
    #Analyse the first response
    m1.lmer <- lmerTest::lmer(y1 ~ Genotype*A*B + (1|Replicate/Mainplot),
                              data=na.omit(Smarthouse.dat))
    GAB.emm <- emmeans::emmeans(m1.lmer, specs = ~ Genotype:A:B)
    GAB.preds <- summary(GAB.emm)
    den.df <- min(GAB.preds$df, na.rm = TRUE)
    ## Modify GAB.preds to be compatible with a predictions.frame
    GAB.preds <- as.predictions.frame(GAB.preds, predictions = "emmean",
                                      se = "SE", interval.type = "CI",
                                      interval.names = c("lower.CL", "upper.CL"))

    ## Form an all.diffs object and check its validity
    GAB.vcov <- vcov(GAB.emm)
    GAB.diffs <- allDifferences(predictions = GAB.preds, classify = "Genotype:A:B",
                                vcov = GAB.vcov, tdf = den.df)
    testthat::expect_true(is.alldiffs(GAB.diffs))
    testthat::expect_true(validAlldiffs(GAB.diffs))
    testthat::expect_equal(nrow(GAB.diffs$predictions),120)
    testthat::expect_equal(ncol(GAB.diffs$predictions),9)
    testthat::expect_equal(as.character(GAB.diffs$predictions$Genotype[1]),"Axe")
    testthat::expect_true(is.null(attr(GAB.diffs, which = "sortOrder")))

    #Test reodering of the classify
    GAB.diffs.reord <- renewClassify(GAB.diffs, newclassify = "A:B:Genotype")
    testthat::expect_equal(as.character(GAB.diffs.reord$predictions$Genotype[1]),"Axe")
    testthat::expect_equal(as.character(GAB.diffs.reord$predictions$Genotype[2]),"Espada")
    testthat::expect_true(abs(GAB.diffs.reord$predictions$predicted.value[2] - -0.2265723017) < 1e-06)

    #Use sort.alldiffs and save order for use with other response variables
    GAB.diffs.sort <- sort(GAB.diffs, sortFactor = "Genotype")
    sort.order <- attr(GAB.diffs.sort, which = "sortOrder")
    testthat::expect_is(GAB.diffs.sort, "alldiffs")
    testthat::expect_true(validAlldiffs(GAB.diffs.sort))
    testthat::expect_equal(nrow(GAB.diffs.sort$predictions),120)
    testthat::expect_equal(ncol(GAB.diffs.sort$predictions),9)
    testthat::expect_equal(as.character(GAB.diffs.sort$predictions$Genotype[1]),"Gladius")
    testthat::expect_equal(length(attributes(GAB.diffs.sort)),9)
    testthat::expect_equal(length(attr(GAB.diffs.sort, which = "sortOrder")),10)

    #Analyse the second response
    m2.lmer <- lmerTest::lmer(y2 ~ Genotype*A*B + (1|Replicate/Mainplot),
                              data=na.omit(Smarthouse.dat))
    GAB.emm <- emmeans::emmeans(m2.lmer, specs = ~ Genotype:A:B)
    GAB.preds <- summary(GAB.emm)
    den.df <- min(GAB.preds$df, na.rm = TRUE)
    ## Modify GAB.preds to be compatible with a predictions.frame
    GAB.preds <- as.predictions.frame(GAB.preds, predictions = "emmean",
                                      se = "SE", interval.type = "CI",
                                      interval.names = c("lower.CL", "upper.CL"))

    ## Form an all.diffs object, sorting it using the y1 sort.order and check its validity
    GAB.vcov <- vcov(GAB.emm)
    GAB.diffs2.sort <- allDifferences(predictions = GAB.preds, classify = "Genotype:A:B",
                                      vcov = GAB.vcov, tdf = den.df,
                                      sortFactor = "Genotype",
                                      sortOrder = sort.order)
    testthat::expect_true(validAlldiffs(GAB.diffs2.sort))
    testthat::expect_equal(as.character(GAB.diffs.sort$predictions$Genotype[1]),
                           as.character(GAB.diffs2.sort$predictions$Genotype[1]))
    testthat::expect_equal(attr(GAB.diffs.sort, which = "sortOrder"),
                           attr(GAB.diffs2.sort, which = "sortOrder"))
  }
})

cat("#### Test for sort.alldiffs on WateRunoff with lme4\n")
test_that("sort.alldiffsWater_lme4", {
  #  skip_on_cran()
  library(asremlPlus)
  library(dae)
  data(WaterRunoff.dat)

  if (requireNamespace("lmerTest", quietly = TRUE) &
      requireNamespace("emmeans", quietly = TRUE))
  {
    #Analyse first response
    m1.lmer <- lmerTest::lmer(pH ~ Benches + (Sources * (Type + Species)) +
                                (1|Benches:MainPlots),
                              data=na.omit(WaterRunoff.dat))
    TS.emm <- emmeans::emmeans(m1.lmer, specs = ~ Sources:Type)
    TS.preds <- summary(TS.emm)
    den.df <- min(TS.preds$df, na.rm = TRUE)
    ## Modify TS.preds to be compatible with a predictions.frame
    TS.preds <- as.predictions.frame(TS.preds, predictions = "emmean",
                                     se = "SE", interval.type = "CI",
                                     interval.names = c("lower.CL", "upper.CL"))

    ## Form an all.diffs object and check its validity
    els <- as.numeric(rownames(TS.preds))
    TS.vcov <- vcov(TS.emm)[els,els]
    TS.diffs <- allDifferences(predictions = TS.preds,
                               classify = "Sources:Type",
                               vcov = TS.vcov, tdf = den.df)

    testthat::expect_true(is.alldiffs(TS.diffs))
    testthat::expect_true(validAlldiffs(TS.diffs))
    testthat::expect_equal(nrow(TS.diffs$predictions),20)
    testthat::expect_equal(ncol(TS.diffs$predictions),8)
    testthat::expect_equal(as.character(TS.diffs$predictions$Type[1]),"Landscape")
    testthat::expect_true(is.null(attr(TS.diffs, which = "sortOrder")))

    #Test reodering of the classify
    TS.diffs.reord <- renewClassify(TS.diffs, newclassify = "Type:Sources")
    testthat::expect_equal(as.character(TS.diffs.reord$predictions$Sources[1]),"Rainwater")
    testthat::expect_equal(as.character(TS.diffs.reord$predictions$Sources[2]),"Recycled water")
    testthat::expect_true(abs(TS.diffs.reord$predictions$predicted.value[2] - 7.646389) < 1e-06)

    #Test sort.alldiffs and save order for use with other response variables
    TS.diffs.sort <- sort(TS.diffs, sortFactor = "Sources",
                          sortParallelToCombo = list(Type = "Control"))
    sort.order <- attr(TS.diffs.sort, which = "sortOrder")
    testthat::expect_is(TS.diffs.sort, "alldiffs")
    testthat::expect_true(validAlldiffs(TS.diffs.sort))
    testthat::expect_equal(nrow(TS.diffs.sort$predictions),20)
    testthat::expect_equal(ncol(TS.diffs.sort$predictions),8)
    testthat::expect_equal(as.character(TS.diffs.sort$predictions$Sources[1]),"Recycled water")
    testthat::expect_equal(length(attributes(TS.diffs.sort)),9)
    testthat::expect_equal(length(attr(TS.diffs.sort, which = "sortOrder")),6)

    #Test sort.alldiffs with supplied sortOrder
    m2.lmer <- lmerTest::lmer(Turbidity ~ Benches + (Sources * (Type + Species)) +
                                (1|Benches:MainPlots),
                              data=na.omit(WaterRunoff.dat))
    TS.emm <- emmeans::emmeans(m2.lmer, specs = ~ Sources:Type)
    TS.preds <- summary(TS.emm)
    den.df <- min(TS.preds$df, na.rm = TRUE)
    ## Modify TS.preds to be compatible with a predictions.frame
    TS.preds <- as.predictions.frame(TS.preds, predictions = "emmean",
                                     se = "SE", interval.type = "CI",
                                     interval.names = c("lower.CL", "upper.CL"))

    ## Form an all.diffs object, sorting it using the pH sort.order and check its validity
    els <- as.numeric(rownames(TS.preds))
    TS.vcov <- vcov(TS.emm)[els,els]
    TS.diffs2.sort <- allDifferences(predictions = TS.preds,
                                     classify = "Sources:Type",
                                     vcov = TS.vcov, tdf = den.df,
                                     sortFactor = "Sources",
                                     sortOrder = sort.order)
    validAlldiffs(TS.diffs2.sort)
    testthat::expect_equal(as.character(TS.diffs.sort$predictions$Sources[1]),
                           as.character(TS.diffs2.sort$predictions$Sources[1]))
    testthat::expect_equal(attr(TS.diffs.sort, which = "sortOrder"),
                           attr(TS.diffs2.sort, which = "sortOrder"))
  }
})

cat("#### Test for facCombine.alldiffs on Ladybird with lme4\n")
test_that("facCombine.alldiffs_lme4", {
  #  skip_on_cran()
  library(asremlPlus)
  library(dae)
  data("Ladybird.dat")

  ## Use lme4 and emmmeans to get predictions and associated statistics
  if (requireNamespace("lmerTest", quietly = TRUE) &
      requireNamespace("emmeans", quietly = TRUE))
  {
    m1.lmer <- lmerTest::lmer(logitP ~ Host*Cadavers*Ladybird + (1|Run),
                              data=Ladybird.dat)
    HCL.emm <- emmeans::emmeans(m1.lmer, specs = ~ Host:Cadavers:Ladybird)
    HCL.preds <- summary(HCL.emm)
    den.df <- min(HCL.preds$df)
    ## Modify HCL.preds to be compatible with a predictions.frame
    names(HCL.preds)[match(c("emmean", "SE", "lower.CL", "upper.CL"),
                           names(HCL.preds))] <- c("predicted.value",
                                                   "standard.error",
                                                   "lower.Confidence.limit",
                                                   "upper.Confidence.limit")
    HCL.preds$est.status <- "Estimable"
    HCL.preds$est.status[is.na(HCL.preds$predicted.value)] <- "Aliased"
    HCL.vcov <- vcov(HCL.emm)
    HCL.sed <- NULL
  }

  if (exists("HCL.preds"))
  {
    ## Form an all.diffs object with predictions obtained with either asreml or lmerTest
    HCL.diffs <- as.alldiffs(predictions = HCL.preds, classify = "Host:Cadavers:Ladybird",
                             sed = HCL.sed, vcov = HCL.vcov, tdf = den.df)

    ## check the class and validity of the alldiffs object
    testthat::expect_true(is.alldiffs(HCL.diffs))
    testthat::expect_true(validAlldiffs(HCL.diffs))
    testthat::expect_equal(nrow(HCL.diffs$predictions),12)
    testthat::expect_equal(ncol(HCL.diffs$predictions),9)

    ## Combine Cadavers and Ladybird
    HCL.Comb.diffs <- facCombine(HCL.diffs, factors = c("Cadavers","Ladybird"))

    ## check the validity of HCL.Comb.diffs
    validAlldiffs(HCL.Comb.diffs)
    testthat::expect_equal(nrow(HCL.Comb.diffs$predictions),12)
    testthat::expect_equal(ncol(HCL.Comb.diffs$predictions),8)
    testthat::expect_true(all(c("Host", "Cadavers_Ladybird", "predicted.value") %in%
                                names(HCL.Comb.diffs$predictions)))
  }

})

cat("#### Test for as.predictions.frame on Ladybird with lme4\n")
test_that("as.predictions.frame_lme4", {
  #  skip_on_cran()
  library(asremlPlus)
  library(dae)
  data("Ladybird.dat")

  ## Use lmerTest and emmmeans to get the predictions and associated statistics
  if (requireNamespace("lmerTest", quietly = TRUE) &
      requireNamespace("emmeans", quietly = TRUE))
  {
    m1.lmer <- lmerTest::lmer(logitP ~ Host*Cadavers*Ladybird + (1|Run),
                              data=Ladybird.dat)
    HCL.emm <- emmeans::emmeans(m1.lmer, specs = ~ Host:Cadavers:Ladybird)
    HCL.preds <- summary(HCL.emm)
    den.df <- min(HCL.preds$df)
    ## Modify HCL.preds to be compatible with a predictions.frame
    HCL.preds <- as.predictions.frame(HCL.preds, predictions = "emmean",
                                     se = "SE", interval.type = "CI",
                                     interval.names = c("lower.CL", "upper.CL"))
    testthat::expect_true(validPredictionsFrame(HCL.preds))
    testthat::expect_silent(plotPredictions(HCL.preds, y = "predicted.value", "Host:Cadavers:Ladybird"))
  }
})

cat("#### Test for addBacktransforms on WaterRunoff with lme4\n")
test_that("addBacktransforms_WaterRunoff_lme4", {
  skip_if_not_installed("asreml")
  skip_on_cran()
  library(asremlPlus)
  library(dae)
  data(WaterRunoff.dat)

  if (requireNamespace("lmerTest", quietly = TRUE) &
      requireNamespace("emmeans", quietly = TRUE))
  {
    m1.lmer <- lmerTest::lmer(log.Turbidity ~ Benches + (Sources * (Type + Species)) +
                                (1|Benches:MainPlots),
                              data=na.omit(WaterRunoff.dat))
    TS.emm <- emmeans::emmeans(m1.lmer, specs = ~ Sources:Species)
    TS.preds <- summary(TS.emm)
    den.df <- min(TS.preds$df, na.rm = TRUE)
    ## Modify TS.preds to be compatible with a predictions.frame
    TS.preds <- as.predictions.frame(TS.preds, predictions = "emmean",
                                     se = "SE", interval.type = "CI",
                                     interval.names = c("lower.CL", "upper.CL"))

    ## Form an all.diffs object and check its validity
    els <- as.numeric(rownames(TS.preds))
    TS.vcov <- vcov(TS.emm)[els,els]
    TS.diffs <- allDifferences(predictions = TS.preds, classify = "Sources:Species",
                               vcov = TS.vcov, tdf = den.df)
    validAlldiffs(TS.diffs)
  }

  ## Plot p-values for predictions obtained using asreml or lmerTest
  if (exists("TS.diffs"))
  {
    ##Add the backtransforms component for predictions obtained using asreml or lmerTest
    TS.diffs <- addBacktransforms.alldiffs(TS.diffs, transform.power = 0)
    testthat::expect_false(is.null(TS.diffs$backtransforms))
    testthat::expect_true(all(abs(exp(TS.diffs$predictions$predicted.value)-
                                    TS.diffs$backtransforms$backtransformed.predictions) < 1e-06))
    testthat::expect_true(all(abs(exp(TS.diffs$predictions$upper.Confidence.limit)-
                                    TS.diffs$backtransforms$upper.Confidence.limit) < 1e-06))
  }
})


library(ggplot2)
library(ggsci)
library(dplyr)
source("~/Box/R/template.r")
readdf <- function(filename){
read.csv(filename, header = F) %>%
    rename(
        size.of.graph = V1,
        size.of.source = V2,
        size.of.sink   = V3,
        density.of.graph = V4,
        size.of.trauma = V5,
        max.flow.before = V6,
        max.flow.after = V7,
        cost.before    = V8,
        cost.after     = V9,
        cost.time = V10
    ) ->df
    return(df)
}

df <- readdf("linear/allComb_out.csv")
df %>%
    summary

# Tue Dec  4 12:24:46 2018 ------------------------------
#' size cost
df %>%
    filter(size.of.source == 16) %>%
    filter(size.of.sink == 16) %>%
    filter(size.of.trauma == 32) %>%
    mutate(
        # x = size.of.trauma,
        # y = (cost.after-cost.before) / (max.flow.before - max.flow.after)
        x = size.of.graph,
        y = cost.time,
        group = naturalsort::naturalfactor(density.of.graph)
    ) %>%
    plot_simple_points2(
        'number of nodes',
        'time cost',
        'density of graph'
    )+
    geom_line(aes(color = group)) +
    scale_color_npg2() +
    theme(legend.position = c(0.2,0.8)) +
    plot_save_pub('costtime-per-numberofnodes')

# Tue Dec  4 12:24:46 2018 ------------------------------
#' size cost
df %>%
    filter(size.of.source == 16) %>%
    filter(size.of.sink == 16) %>%
    filter(size.of.graph == unique(size.of.graph)[3]) %>%
    filter(density.of.graph == 0.8) %>%
    # filter(size.of.trauma == 32) %>%
    group_by(size.of.trauma) %>%
    mutate(sd = 0,
           cost.time = mean(cost.time)) %>%
    ungroup_() %>%
    mutate(
        x = size.of.trauma,
        # y = (cost.after-cost.before) / (max.flow.before - max.flow.after)
        # x = size.of.graph,
        y = cost.time,
        group = '0'
        # group = naturalsort::naturalfactor(density.of.graph)
    ) %>%
    plot_simple_points2(
        'number of trauma',
        'time cost',legend = NULL
    )+
    geom_line(aes(color = group), show.legend = F) +
    # scale_color_npg2() +
    scale_y_continuous(limits=c(0, 10))+
    # theme(legend.position = c(0.8,0.3)) +
    plot_save_pub('costtime-per-numberoftrauma', height = 1.72)

#sizeofgraphset2 Tue Dec  4 13:11:15 2018 ------------------------------
df <- readdf('sizeofgraphset2/allComb_out.csv')

df %>%
    summary

# Tue Dec  4 12:24:46 2018 ------------------------------
#' size cost
df %>%
    filter(size.of.graph < 1000) %>%
    # filter(size.of.source == 16) %>%
    # filter(size.of.sink == 16) %>%
    # filter(size.of.trauma == 32) %>%
    mutate(
        # x = size.of.trauma,
        # y = (cost.after-cost.before) / (max.flow.before - max.flow.after)
        x = size.of.graph,
        y = cost.time,
        group = naturalsort::naturalfactor(density.of.graph)
    ) %>%
    plot_simple_points2(
        'number of nodes',
        'time cost',
        'density of graph'
    )+
    geom_line(aes(color = group)) +
    scale_color_npg2() +
    theme(legend.position = c(0.2,0.8)) +
    plot_save_pub('costtime-per-numberofnodes-2')


testing = FALSE
if ( testing)  {

ca = speciescomposition.db(DS="ca", p=p)
ca$variance

pca =  speciescomposition.db(DS="pca", p=p)

toplot = pca$cscores
spec = as.numeric( as.character( rownames( toplot )))
rownames(toplot) = taxonomy.recode( from="spec", tolookup=spec)

plot.ordination (X=toplot)

# spatial autocorrelation
require(gstat)
drange = 150
nmax = 200
SC = speciescomposition.db( DS="speciescomposition.merged", p=p )
sc = SC[ SC$yr==2011,]
g = gstat(id="sc", formula=pca1~1, loc=~plon+plat, data=sc, maxdist=drange, nmax=nmax )
g.e  = variogram(g, cutoff=drange, cressie=T)
plot(g.v)

# spBayes attempt
require( spBayes)
o = spLM( pca1~1, coords=as.matrix(sc[,c("plon","plat")]), data=sc,
knots=c(6,6,0),
starting=list("phi"=0.6,"sigma.sq"=1, "tau.sq"=1),
sp.tuning=list("phi"=0.01, "sigma.sq"=0.01, "tau.sq"=0.01),
priors=list("phi.Unif"=c(0.3, 3), "sigma.sq.IG"=c(2, 1),
              "tau.sq.IG"=c(2, 1)),
cov.model="exponential",
n.samples=1000, verbose=TRUE)

print(summary(o$p.samples))
plot(o$p.samples)

##Requires MBA package to
##make surfaces
library(MBA)
par(mfrow=c(1,2))
obs.surf <-
 mba.surf(cbind(coords, w), no.X=100, no.Y=100, extend=TRUE)$xyz.est
image(obs.surf, xaxs = "r", yaxs = "r", main="Observed response")
points(coords)
contour(obs.surf, add=T)

w.hat <- rowMeans(o$sp.effects)
w.surf <-
 mba.surf(cbind(coords, w.hat), no.X=100, no.Y=100, extend=TRUE)$xyz.est
image(w.surf, xaxs = "r", yaxs = "r", main="Estimated random effects")
contour(w.surf, add=T)
points(coords, pch=1, cex=1)
points(o$knot.coords, pch=19, cex=1)
legend(1.5,2.5, legend=c("Obs.", "Knots"), pch=c(1,19), bg="white")

# GAM analysis

Family: gaussian
Link function: identity

Formula:
ca1 ~ s(plon, plat, k = 400) + s(z, k = 3) + s(t, k = 3) + s(yr) +
    s(julian, k = 3)

Parametric coefficients:
            Estimate Std. Error t value Pr(>|t|)
(Intercept)  0.04727    0.00344    13.8   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Approximate significance of smooth terms:
                edf Ref.df      F p-value
s(plon,plat) 280.90 344.55   27.4  <2e-16 ***
s(z)           1.00   1.00   89.9  <2e-16 ***
s(t)           1.59   1.83  282.4  <2e-16 ***
s(yr)          8.97   9.00 1611.3  <2e-16 ***
s(julian)      1.99   2.00  382.1  <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

R-sq.(adj) =  0.795   Deviance explained = 79.8%
GCV score = 0.21988  Scale est. = 0.21633   n = 18320
>

Family: gaussian
Link function: identity

Formula:
ca2 ~ s(plon, plat, k = 400) + s(z, k = 3) + s(t, k = 3) + s(yr) +
    s(julian, k = 3)

Parametric coefficients:
            Estimate Std. Error t value Pr(>|t|)
(Intercept)  0.09189    0.00309    29.8   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Approximate significance of smooth terms:
                edf Ref.df      F p-value
s(plon,plat) 342.60 384.87   22.2  <2e-16 ***
s(z)           1.80   1.95 3056.5  <2e-16 ***
s(t)           1.00   1.00  239.2  <2e-16 ***
s(yr)          8.86   8.99  466.4  <2e-16 ***
s(julian)      2.00   2.00  506.5  <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

R-sq.(adj) =  0.824   Deviance explained = 82.8%
GCV score = 0.17794  Scale est. = 0.17447   n = 18320

}


library(shiny)

server <- function(input, output, session)
{
  # Combine the selected variables into a new data frame
  selectedData <- reactive({
    iris[, c(input$xcol, input$ycol)]
  })

  clusters <- reactive({
    kmeans(selectedData(), input$clusters)
  })

  output$plot1 <- renderPlot({
    palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
      "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))

    par(mar = c(5.1, 4.1, 0, 1))
    plot(selectedData(),
         col = clusters()$cluster,
         pch = 20, cex = 3)
    points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
  })
}


require(keras)
require(yaml)

create_dnn <- function(max_sentence_length, unique_vocab) {

  FLAGS <- yaml.load_file('./dnn_model.yml')

  model <-
    keras_model_sequential() %>%
    layer_lstm(
      units = FLAGS$units,
      input_shape = c(max_sentence_length, unique_vocab),
      kernel_initializer = "VarianceScaling",
      kernel_regularizer = regularizer_l1_l2(l1 = FLAGS$reg, l2 = FLAGS$reg)) %>%
    layer_dense(unique_vocab) %>%
    layer_activation("softmax")

  compile(
    model,
    loss = "categorical_crossentropy",
    optimizer = optimizer_nadam(lr = FLAGS$lr))

  model
}


library(utils)
library(gridExtra)
data <- read.csv("https://opendata.ecdc.europa.eu/covid19/casedistribution/csv", na.strings = "", fileEncoding = "UTF-8-BOM")
dsUK <- subset(data, geoId=="UK", select=c(dateRep, cases, Cumulative_number_for_14_days_of_COVID.19_cases_per_100000))
dsLT <- subset(data, geoId=="LT", select=c(dateRep, cases, Cumulative_number_for_14_days_of_COVID.19_cases_per_100000))
colnames(dsUK) <- c("date","cases_UK","index14_UK")
colnames(dsLT) <- c("date","cases_LT","index14_LT")
dsAll <- merge(dsUK, dsLT, by.x="date", all.x=TRUE)
dsAll <- within(dsAll, dates <- strftime(strptime(date,"%d/%m/%Y"),"%Y-%m-%d"))
ds0 <- tail(dsAll[ order(dsAll$dates), ], 20)
ds1 <- ds0[, c(6, 2, 3, 4, 5)]
png('covid_uk_lt.png', width=60, height=30, units="cm", res=100)
par(las=2)
par(mfrow=c(1,2))
plot(factor(ds1$dates), ds1$index14_UK, main="UK", xlab="", ylab="", type="p", col="blue")
plot(factor(ds1$dates), ds1$index14_LT, main="LT", xlab="", ylab="", type="p", col="red")
pdf("covid_uk_lt.pdf", height=11, width=10)
grid.table(ds1, rows=NULL)
dev.off()


#' @export
#'
#'
predict.global_lm <- function(object, ...) {
  args <- list(...)
  if (is.null(args$newdata)) {
    d0 <- cbind(
      object$control$yhat,
      object$control$input$design,
      d = 0
    )

    d1 <- cbind(
      object$treat$yhat,
      object$treat$input$design,
      d = 1
    )

    xlab <- colnames(object$control$input$design)
    d <- data.frame(rbind(d0, d1))
    colnames(d) <- c("outcome", xlab, "d")
    d
  } else {
    newdt <- args$newdata
    design <- as.matrix(newdt)

    b0 <- object$control$estimate[, 1]
    b0 <- matrix(b0[colnames(design)], ncol = 1)
    yhat0 <- design %*% b0

    b1 <- object$treat$estimate[, 1]
    b1 <- matrix(b1[colnames(design)], ncol = 1)
    yhat1 <- design %*% b1
    out <- cbind(yhat1, yhat0, design)
    out <- data.frame(out)
    colnames(out) <- c("yhat1", "yhat0", colnames(design))
    out
  }
}

#'
#' @export
#'
predict.fit_wls <- function(object, ...) {
  args <- list(...)

  # new design matrix
  if (is.null(args$newdata)) {
    point <- object$input$local.wls$data.point
    xmat <- matrix(c(1, point), nrow = 1)
    colnames(xmat) <- c("(Intercept)", "x")

    order <- ncol(object$input$design) - 1
    if (order > 1) {
      for (o in seq(2, order)) {
        xmat <- cbind(xmat, point^o)
        colnames(xmat)[o + 1] <- paste0("x", o)
      }
    }
  } else {
    newdt <- args$newdata
    xmat <- as.matrix(newdt)
  }

  # prediction
  b <- object$estimate[, 1]
  b <- matrix(b[colnames(xmat)], ncol = 1)
  yhat <- xmat %*% b

  # output
  out <- cbind(yhat, xmat)
  out <- data.frame(out)
  colnames(out) <- c("yhat", colnames(xmat))
  out
}

#'
#' @export
#'
predict.local_lm <- function (object, ...) {
  args <- list(...)
  yhat1 <- do.call("predict", append(args, list(object = object$treat)))
  colnames(yhat1)[colnames(yhat1) == "yhat"] <- "yhat1"

  yhat0 <- do.call("predict", append(args, list(object = object$control)))
  colnames(yhat0)[colnames(yhat0) == "yhat"] <- "yhat0"

  out <- cbind(yhat1 = yhat1[, "yhat1"], yhat0)
  out
}