require(raster)
require(sp)
require(maptools)
require(rgdal)
require(akima)

# -------------------------------------------------------------------------------------------------------
# surface_downwelling_shortwave_flux_in_air

# alias: surface_downwelling_shortwave_flux

# The surface called "surface" means the lower boundary of the atmosphere. "shortwave" means shortwave radiation.
# Downwelling radiation is radiation from above. It does not mean "net downward".
# Surface downwelling shortwave is the sum of direct and diffuse solar radiation incident on the surface, and is sometimes called "global radiation".
# When thought of as being incident on a surface, a radiative flux is sometimes called "irradiance".
# In addition, it is identical with the quantity measured by a cosine-collector light-meter and sometimes called "vector irradiance".
# In accordance with common usage in geophysical disciplines, "flux" implies per unit area, called "flux density" in physics.
# -------------------------------------------------------------------------------------------------------

# read in the dat file downloaded from the CRU TS20 website
sunp <- read.table("/workspace/UA/malindgren/projects/iem/PHASE2_DATA/RSDS_working/September2012_finalRuns/10min_sunshine/original_data/TS20/grid_10min_sunp.dat")

# change the colnames to something more useable
colnames(sunp) <- c("lat","lon","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")

# create a shapefile
sunp.pts <- SpatialPoints(coordinates(sunp[,2:1]))

sunp.spdf <- SpatialPointsDataFrame(sunp.pts, as.data.frame(sunp))

colNums <- 3:ncol(sunp)

# PROJ4 Reference projections
akalb <- "+proj=aea +lat_1=55 +lat_2=65 +lat_0=50 +lon_0=-154 +x_0=0 +y_0=0 +datum=NAD83 +units=m +no_defs +ellps=GRS80 +towgs84=0,0,0"

# template map used to create the ts20 cru raster data from the input file format
template <- raster("/Data/Base_Data/Climate/Canada/CRU_Climatology/Temperature/cru_tmean_1/")
values(template) <- NA

# the 1km output template for the final spline interpolation
out_template <- raster("/Data/Base_Data/ALFRESCO_formatted/ALFRESCO_Master_Dataset/ALFRESCO_Model_Input_Datasets/AK_CAN_Inputs/Climate/cru_TS31/historical/pr/pr_total_mm_alf_cru_TS31_01_1901.tif")

# this loop
for(i in colNums){
	print(i)

	if(nchar(i) == 1){ d=paste("0",i-2, sep="")	}else{ d=i-2 }

	rasterize(sunp.spdf, template, field=colnames(sunp)[i] ,filename=paste("/workspace/UA/malindgren/projects/iem/PHASE2_DATA/RSDS_working/September2012_finalRuns/10min_sunshine/output_rasters/sunp_cru_10min_",d,"_1961_1990.tif", sep=""), overwrite=T)

}

####################################################################################################################
# read in the NetCDF as a stack
cld.ts31 <- stack("/workspace/UA/malindgren/projects/iem/PHASE2_DATA/RSDS_working/September2012_finalRuns/10min_sunshine/original_data/TS31/cru_ts_3_10.1901.2009.cld.dat.nc")
cld.ts31.tmp <- brick("/workspace/UA/malindgren/projects/iem/PHASE2_DATA/RSDS_working/September2012_finalRuns/10min_sunshine/original_data/TS31/cru_ts_3_10.1901.2009.cld.dat.nc")

# read in the list of 12 monthly RADIATION (girr) data calculated from Dave McGuires C++ code translated into R by Michael Lindgren
l <- list.files("/workspace/UA/malindgren/projects/iem/PHASE2_DATA/RSDS_working/September2012_finalRuns/outputs/girr_radiation/version2", pattern=".tif", full.names=T)
# now stack that list of files
rad.monthly <- stack(l)

# read in the cru climatology
# this is in SUNP percentage units
sunp.ts20.clim <- stack(list.files("/workspace/UA/malindgren/projects/iem/PHASE2_DATA/RSDS_working/September2012_finalRuns/10min_sunshine/output_rasters", pattern="tif", full.names=TRUE))

# all this does is bring the layernames in as something more descript.  The stack layernames are not as good as the brick
# so I give the stack the brick names
cld.ts31@layernames <- cld.ts31.tmp@layernames
rm(cld.ts31.tmp) # remove the unneeded brick

# AKCanada Extent for spatial subsetting
AKCanada.akalb <- raster("/workspace/Shared/Michael/ArcGIS_Shared/clipper/alaska_west_canada_clipper_forDownscaling.tif")

# project the extent
AKCanada.wgs84 <- projectExtent(AKCanada.akalb, projection(cld.ts31))

# grab the cell ids at the intersection of the new extent and the original data
cld.ts31.desiredCells <- cellsFromExtent(cld.ts31, extent(AKCanada.wgs84), expand=FALSE)

# extract those cells and create a new stack
cld.ts31.desiredCells.e <- cld.ts31[cld.ts31.desiredCells,drop=F]

#####  TS20 climatology data  #########################################################################
# grab the cell ids at the intersection of the new extent and the original data
sunp.ts20.clim.desiredCells <- cellsFromExtent(sunp.ts20.clim, extent(AKCanada.wgs84), expand=FALSE)
# now spatially subset those cells to a new stack
sunp.ts20.clim.desiredCells.e <- sunp.ts20.clim[sunp.ts20.clim.desiredCells,drop=F]

# would be a good idea to do the sunshine percent to cloud percent conversion
# I think this is working correctly now it is units of percent without the percent sign
cld.ts20.clim.desiredCells.e <- 100 - sunp.ts20.clim.desiredCells.e

# temporally subset the stack object to be 1961-1990 for all 12 months
# these numbers were pre-calculated outside of the code
cld.ts31.subset <- subset(cld.ts31.desiredCells.e, 721:1080)

# create an empty brick using the extent from the other stack and no layers in it yet.
cld.ts31.clim <- brick(extent(cld.ts31.subset), nrows=nrow(cld.ts31.subset), ncols=ncol(cld.ts31.subset), crs=projection(cld.ts31.subset), nl=1)

# create climatology
for(j in 1:12){
	#monthLayers<-seq(j, nlayers(cld.subset), by= 12)
	cld.clim.tmp <- mean(subset(cld.ts31.subset, seq(j, nlayers(cld.ts31.subset), by=12)))
	cld.ts31.clim <- addLayer(cld.ts31.clim, cld.clim.tmp)
}

yearList <- 1901:2009

# lets reproject the ts20 Climatology into the final projection system of the output
cld.ts20.clim.extent <- projectExtent(cld.ts20.clim.desiredCells.e, crs=akalb)
cld.ts20.clim.desiredCells.e <- projectRaster(cld.ts20.clim.desiredCells.e, cld.ts20.clim.extent, res=res(rad.monthly), method='ngb')

# create anomalies HISTORICAL
# make an empty brick object
cld.ts31.anom <- brick(extent(cld.ts31.desiredCells.e), nrows=nrow(cld.ts31.desiredCells.e), ncols=ncol(cld.ts31.desiredCells.e), crs=projection(cld.ts31.desiredCells.e), nl=nlayers(cld.ts31.desiredCells.e))
cld.ts31.downscaled.brick <- brick(extent(cld.ts20.clim.desiredCells.e), nrows=nrow(cld.ts20.clim.desiredCells.e), ncols=ncol(cld.ts20.clim.desiredCells.e), crs=projection(cld.ts20.clim.desiredCells.e))

# this is the centroid values of the cru ts20 That is used as the output points to
#  interpolate to from the 0.5 degree to the 10 min spatial resolution of the ts20 climatology
out_xy <- coordinates(cld.ts20.clim.desiredCells.e)
# the output coords for the 1km output
out_1km <- coordinates(out_template)

# calculate and write out the anomalies
for(i in 1:12){ # go through a list of months
	print(paste("	MONTH WORKING = ",i))
	# use the sequence command to create an index of all of the same month during the entire timeseries
	monthList <- seq(i, nlayers(cld.ts31.desiredCells.e), 12)

	# here we select the month we want from the ts20 climatology
	cld.ts20.clim.current <- subset(cld.ts20.clim.desiredCells.e,i,drop=T)

	# this is where we subset the RADIATION montlies to the current month for the final calculation
	rad.monthly.current <- subset(rad.monthly,i,drop=T)
	# rad.monthly.current.v <- getValues(rad.monthly.current)

	# this line will create a 2 character month for filenaming procedures (if needed)
	if(nchar(i)<2){ month=paste("0",i,sep="")}else{month=paste(i,sep="")}

	# here we subset the cld
	cld.ts31.clim.current <- subset(cld.ts31.clim, i, drop=T)

	# here we reproject the data to be in the final output reference system
	cld.ts31.clim.current.extent <- projectExtent(cld.ts31.clim.current, crs=akalb)
	cld.ts31.clim.current <- projectRaster(cld.ts31.clim.current, cld.ts31.clim.current.extent, method='ngb')

	count=0 # a counter to iterate through the years

	for(j in monthList){
		print(paste("anomalies iter ",j))
		count=count+1
		cld.ts31.current <- subset(cld.ts31.desiredCells.e, j, drop=T)

		# here we are going to make the final reprojection into the output reference system
		cld.ts31.current.extent <- projectExtent(cld.ts31.current, crs=akalb)
		cld.ts31.current <- projectRaster(cld.ts31.current, cld.ts31.current.extent, method='ngb')

		# this line generates a proportional anomaly
		anom <- cld.ts31.current/cld.ts31.clim.current

		# write out the 0.5 resolution anomalies (temporary file)
		writeRaster(anom, filename=paste("/workspace/UA/malindgren/projects/iem/PHASE2_DATA/RSDS_working/September2012_finalRuns/outputs/anomalies/anomalies_original_resolution/","cld_pct_proportionalAnom_cru_ts31_", month,"_",yearList[count],".tif",sep=""), overwrite=T)

		# # # # # # INTERPOLATION SECTION # # # # # #
		in_xy <- coordinates(anom)
		z_in <- getValues(anom)

		xyz <- cbind(in_xy,z_in)
		xyz.na <- na.omit(xyz)

		in_xy <- xyz.na[,1:2]
		z_in <- xyz.na[,3]

		anom.spline	<- interp(x=in_xy[,1],y=in_xy[,2],z=z_in,xo=seq(min(out_xy[,1]),max(out_xy[,1]),l=ncol(cld.ts20.clim.desiredCells.e)), yo=seq(min(out_xy[,2]),max(out_xy[,2]),l=nrow(cld.ts20.clim.desiredCells.e),linear=F))

		# transpose the data here
		anom.interp <- t(anom.spline$z)[,nrow(anom.spline$z):1]

		# turn that into a new raster object
		anom.interp.r <- raster(anom.interp, xmn=xmin(cld.ts20.clim.desiredCells.e), xmx=xmax(cld.ts20.clim.desiredCells.e), ymn=ymin(cld.ts20.clim.desiredCells.e), ymx=ymax(cld.ts20.clim.desiredCells.e), crs=projection(cld.ts20.clim.desiredCells.e))

		# write out the interpolated to 10min resolution anomalies (temporary file)
		writeRaster(anom.interp.r, filename=paste("/workspace/UA/malindgren/projects/iem/PHASE2_DATA/RSDS_working/September2012_finalRuns/outputs/anomalies/interpolated_10min/","cld_pct_proportionalAnom_cru_ts31_10min_", month,"_",yearList[count],".tif",sep=""), overwrite=T)

		# this is where we put downscale the interpolated proportional anomalies
		cld.ts31.downscaled <- cld.ts20.clim.current*anom.interp.r

		# write out the downscaled cloud raster
		writeRaster(cld.ts31.downscaled, filename=paste("/workspace/UA/malindgren/projects/iem/PHASE2_DATA/RSDS_working/September2012_finalRuns/outputs/downscaled_10min/cld/","cld_pct_cru_ts31_10min_", month,"_",yearList[count],".tif",sep=""), overwrite=T)

		######  INTERPOLATION TO 1km Section #######

		# here we want to interpolate the new downscaled raster to 1km resolution used by TEM
		xyz <- cbind(coordinates(cld.ts31.downscaled), getValues(cld.ts31.downscaled))
		# get rid of the NA's
		xyz.na <- na.omit(xyz)
		xyz=xyz.na

		# here we interpolate to a 1km data set
		downscaled.spline	<- interp(x=xyz[,1],y=xyz[,2],z=xyz[,3],xo=seq(min(out_1km[,1]),max(out_1km[,1]),l=ncol(out_template)), yo=seq(min(out_1km[,2]),max(out_1km[,2]),l=nrow(out_template),linear=F))

		# transpose the data here
		downscaled.interp <- t(downscaled.spline$z)[,nrow(downscaled.spline$z):1]

		# turn that into a new raster object
		downscaled.interp.r <- raster(downscaled.interp, xmn=xmin(out_template), xmx=xmax(out_template), ymn=ymin(out_template), ymx=ymax(out_template), crs=projection(out_template))

		# these lines take the values that exceed 100% and truncate them back to 100
		ind <- which(values(downscaled.interp.r) > 100)
		values(downscaled.interp.r)[ind] <- 100

		# write out the downscaled cloud raster
		writeRaster(downscaled.interp.r, filename=paste("/workspace/UA/malindgren/projects/iem/PHASE2_DATA/RSDS_working/September2012_finalRuns/outputs/downscaled_1km/cld/","cld_pct_cru_ts31_1km_", month,"_",yearList[count],".tif",sep=""), overwrite=T)

		# now we calculate the nirr from the girr and the cloudcover percent using the code from Dave McGuire
		##############################################################################################################
		#		** this is the c++ version given by Dave.  I am using R to calculate it here
		#		if (clds > -0.1) {
		#			nirr = cld.subset.v * (0.251 + (0.509*(1.0 - clds/100.0))) # basically percent cloudcover
		#			}else {
		#				nirr = -999.9; }
		##############################################################################################################

		output.v <- getValues(downscaled.interp.r)

		#ind <- which(values(downscaled.interp.r) > -0.1)
		oob <- which(values(downscaled.interp.r) <= -0.1)

		if(length(oob)>0){
			nirr = rad.monthly.current * (0.251 + (0.509 * (1.0 - downscaled.interp.r/100)))
			values(nirr)[oob] <- -9999
		}else{
			nirr = rad.monthly.current * (0.251 + (0.509 * (1.0 - downscaled.interp.r/100)))
		}

		writeRaster(nirr, filename=paste("/workspace/UA/malindgren/projects/iem/PHASE2_DATA/RSDS_working/September2012_finalRuns/outputs/downscaled_1km/nirr/","nirr_pct_cru_ts31_1km_", month,"_",yearList[count],".tif",sep=""), overwrite=T)
	}
}


#Function to plot catch residuals

# use over.all.max to set the maximum size of the reference buble. A value of 0 scales bubles individually

plot.catch.residuals<-function(dev,nox=1,noy=1,Portrait=TRUE,use.ref.dot=TRUE,add.title=TRUE,over.all.max=1.5)
{

file<-file.path(data.path,"catch_residuals.out")
res<-scan(file,sep=',',comment.char = "#")
res[res==-99.9]<-NA

a<-res
a[a>99]<-NA
max.buble<-max(abs(a),na.rm=TRUE)

Init.function() # get SMS.contol object  including sp.names

nyr<-SMS.control@last.year.model-SMS.control@first.year+1

ir<-1    #counter in residuals file
nox.noy<-nox*noy
plot.no<-nox.noy-1

for (sp in first.VPA:nsp) {
  #ages<-SP.settings[sp,1:4]
  ages<-SMS.control@species.info[sp,"last-age-likelihood"]
    ages<-SMS.control@species.info[sp,"last-age"]

  nag<-ages[1]-SMS.control@first.age+1
  sp.name<-SMS.control@species.names[sp]

  if (SMS.control@combined.catches==1) lastSeason<-1  else  lastSeason<-SMS.control@last.season

 for (season in 1:lastSeason) {

    plot.no<-plot.no+1

    if (plot.no%%nox.noy==0){
      newplot(dev,nox,noy,Portrait=Portrait,filename=paste(sp.name,plot.no))
      par(mar=c(3,4,3,2))
      if (dev=="wmf") par(mar=c(2,4,2,2))
    }

    tmp<-matrix(res[ir:(ir+(nag+3)*nyr-1)],ncol=nyr,nrow=nag+3)
    la.like<-SMS.control@species.info[sp,"last-age-likelihood"]
    nag.like<-la.like-SMS.control@first.age+1
    tmp<-tmp[4:(nag.like+3),]
    #print(tmp)
    if (!all(is.na(tmp))) {
      max.buble<-max(abs(tmp),na.rm=TRUE)

      xpos <- SMS.control@first.year:SMS.control@last.year.model
      ypos <- fa:la.like
      if (SMS.control@last.season>1 & SMS.control@combined.catches==0) title<- paste(sp.name,", Season ",season,sep="") else  title<- sp.name
     # if (over.all.max>0) maxsize<-0.25/over.all.max*max.buble else maxsize<-0.25

      if (!add.title) title<-''
      if (over.all.max>0) residplot(tmp,xpos,ypos,main=title,refdot=use.ref.dot,maxn=over.all.max)
      else  residplot(tmp,xpos,ypos,main=title,refdot=use.ref.dot)
    }
    ir<-ir+nyr*(nag+3)
  }
 }
}

plot.catch.residuals2<-function(dev,nox=1,noy=1,Portrait=TRUE,use.ref.dot=TRUE,add.title=TRUE,over.all.max=1.5)
{
a<-Read.catch.survey.residuals()
res<-subset(a,data=='catch',select=c(Species,Species.n,Year,Quarter,Age,residual))
res[res$residual==-99.9,'residual']<-NA

max.buble<-max(abs(res$residual),na.rm=TRUE)

Init.function() # get SMS.contol object  including sp.names

nox.noy<-nox*noy
plot.no<-nox.noy-1

for (sp in first.VPA:nsp) {
   sp.name<-SMS.control@species.names[sp]
  plot.no<-nox.noy-1
  if (SMS.control@combined.catches==1) lastSeason<-1  else  lastSeason<-SMS.control@last.season

   aa<-subset(res,Species.n==sp)

  over.all.max<-max(aa$residual,na.rm=T)
 for (season in 1:lastSeason) {
    a<-subset(aa,Quarter==season)
    tmp<-tapply(a$residual,list(a$Year,a$Age),sum,na.rm=T)
     print(tmp)
    if (!all(is.na(tmp))) {
    plot.no<-plot.no+1

    if (plot.no%%nox.noy==0){
      newplot(dev,nox,noy,Portrait=Portrait,filename=paste(sp.name,plot.no))
      par(mar=c(3,4,3,2))
      if (dev=="wmf") par(mar=c(2,4,2,2))
    }

      max.buble<-max(abs(tmp),na.rm=TRUE)

      xpos <- sort(unique(a$Year))
      ypos <- sort(unique(a$Age))
      if (SMS.control@last.season>1 & SMS.control@combined.catches==0) title<- paste(sp.name,", Season ",season,sep="") else  title<- sp.name
     # if (over.all.max>0) maxsize<-0.25/over.all.max*max.buble else maxsize<-0.25

      if (!add.title) title<-''
      if (over.all.max>0) residplot(tmp,xpos,ypos,main=title,refdot=use.ref.dot,maxn=over.all.max)
      else  residplot(tmp,xpos,ypos,main=title,refdot=use.ref.dot)
    }
  }
 }
}

#clear graphical windows
# cleanup()

# use over.all.max to set the maximum size of the reference buble. A value of 0 scales bubles individually between plots (e.g by quarter)

#plot.catch.residuals2(dev='screen',nox=1,noy=2,Portrait=F, use.ref.dot=TRUE,add.title=T,over.all.max=6.0)


library(testthat)
library(digest)

test_1 <- function() {
  test_that("Solution is incorrect", {
    expect_equal(digest(answer1), "0acb97bbfd2fa2133d6057dbdcab2910")
  })
  print("Success!")
}

test_2 <- function() {
  test_that("Solution is incorrect", {
    expect_equal(digest(answer2), "046b366d6fdb4a722fb0e30c00e2910e")
  })
  print("Success!")
}

test_3 <- function() {
  test_that("Solution is incorrect", {
    expect_equal(digest(round(reg_LESS$coefficients[2], 2)), "285b74f54658c34c1084a513375afc29")
  })
  print("Success!")
}

test_4 <- function() {
  test_that("Solution is incorrect", {
    expect_equal(digest(round(reg_HS$coefficients[2], 2)), "6daf2ec473e5b3262d4f13aa1efa6faf")
  })
  print("Success!")
}

test_5 <- function() {
  test_that("Solution is incorrect", {
    expect_equal(digest(round(reg_SC$coefficients[2], 2)), "f84d62f49df429fab57e40f81fee0393")
  })
  print("Success!")
}

test_6 <- function() {
  test_that("Solution is incorrect", {
    expect_equal(digest(round(reg_BACH$coefficients[2], 2)), "df57fae07fdacdfb8f055e9eed7e6fef")
  })
  print("Success!")
}

test_7 <- function() {
  test_that("Solution is incorrect", {
    expect_equal(digest(round(reg_GRAD$coefficients[2], 2)), "854270bbc3cf342a422f29a6edecc493")
  })
  print("Success!")
}

test_8 <- function() {
  test_that("Solution is incorrect", {
    expect_equal(digest(round(reg2$coefficients[2], 2)), "b561beb775d931d6917773e2becdc20e")
  })
  print("Success!")
}

test_9 <- function() {
  test_that("Solution is incorrect", {
    expect_equal(digest(round(reg3$coefficients[2], 2)), "4cebe999d1ac30bf82c8a70c2a225d49")
  })
  print("Success!")
}

test_10 <- function() {
  test_that("Solution is incorrect", {
    expect_equal(digest(round(reg5$coefficients[2], 2)), "bb26a49ddc5b8a6b8396b14cbba81a75")
  })
  print("Success!")
}

test_11 <- function() {
  test_that("Solution is incorrect", {
    expect_equal(digest(round(reg6$coefficients[2], 2)), "14b4e5c6d8fe58b02104569b5940b378")
  })
  print("Success!")
}


library(ggplot2)
library(Matrix)
library(methods)
library(scales)

#args=commandArgs(T);
#sample=as.character(args[1]);

color_list<-hue_pal()(27)

setwd("./")
path_out="result/"

ident_list=as.matrix(read.table("data_skeleton/ident_list_coords.txt",sep="\t"))
ident=as.matrix(read.table("data_skeleton/ident.txt"))
coords=as.matrix(read.table("data_skeleton/coords.txt"))

df1<-data.frame(coordx=coords[,1],coordy=coords[,2],group=ident[,1])
df1$group<-factor(df1$group,levels=c(unique(ident_list[,1])), ordered=TRUE)
df2<-data.frame(coordx=as.numeric(ident_list[,2]),coordy=as.numeric(ident_list[,3]),label=ident_list[,1])
#df2$group<-factor(df2$group,levels=c(unique(ident_list[,1])), ordered=TRUE)

pdf(paste(path_out,"lineage_skeleton_ref.pdf",sep=""),width=6,height=6)
par(mai=c(0,0,0,0));
pl<-ggplot()+
geom_point(data=df1,aes(x=coordx,y=coordy,colour=group),size=0.5,alpha=1)+
geom_text(data=df2,aes(x=coordx,y=coordy,label=label),size=4,colour="black")+
    labs(x="tSNE1",y="tSNE2")+theme_bw()+
theme(
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        legend.text=element_text(size=16),
        axis.text.x = element_text(size=13),
        axis.text.y = element_text(size=13),
        axis.title=element_text(size=16),
        legend.position = "none",
        panel.background = element_blank()
)
pl<-pl+scale_colour_manual(values=color_list)
pl
dev.off()


rm(list = ls())

wd.main <- 'C:/Users/gbal/Desktop/r.training'
setwd(wd.main)

salmon <- read.table('2.data/2.salmon/salmon.data.raw.2.txt',
                     header = TRUE,
                     sep = ';',
                     dec = ',')

head(salmon)

salmon$weight[which(salmon$weight > 50)] <-
  salmon$weight[which(salmon$weight > 50)] / 1000

salmon$length[which(salmon$length < 44)] <-
  salmon$length[which(salmon$length < 44)] * 2.54

#============================================================================

for(c in 1:dim(salmon)[2]){

  if(is.numeric(salmon[ , c])){
    boxplot(salmon[ , c],
            main = colnames(salmon)[c])
  }else{
    barplot(table(salmon[ , c]),
            main = colnames(salmon)[c])
  }

}


# hutchinsons index as a functon set for 1890-2003 data with placename, year, month, rain
#M:\Environmental_Health\DroughtAndDrying\2Work
#requires a database with gridded rain data
library(RODBC)
ch<-odbcConnect("weather")

# need to calculate 6 month totals BY GRID CELL
sqlQuery(ch,"drop TABLE bom_grids.time;
CREATE TABLE bom_grids.time
( timeid serial,
year integer NOT NULL,
month integer NOT NULL,
   CONSTRAINT time_pkey PRIMARY KEY (timeid)
 );

insert into bom_grids.time (year, month)
select distinct year, month from bom_grids.rain_act_1890_2008;
")

sqlQuery(ch,"select * from bom_grids.rain_act_1890_2008 limit 1;")

##########################################################################################################################
#
#
#
#d=sqlQuery(ch,"select * from bom_grids.rain_act_1890_2008_2 order by gid,timeid;")
months=1:12
states=c('act','nsw','vic','qld','sa','tas','wa','nt')

st=Sys.time()

for(ste in states[8]){
ste=states[1]
        gids=sqlQuery(ch,paste("select distinct gid from bom_grids.rain_",ste,"_1890_2008;",sep=""))
        #calc 6mo

        sqlQuery(ch,
				# cat(
				paste("CREATE TABLE bom_grids.rain_",ste,"_1890_2008_1
          (gid integer,
          admin_name character varying(255),
          long double precision,
          lat double precision,
          year integer NOT NULL,
          month integer NOT NULL,
          timeid integer,
          rain double precision,
          CONSTRAINT rain",ste,"1_pkey PRIMARY KEY (gid,timeid)
           );

        insert into bom_grids.rain_",ste,"_1890_2008_1 (gid, admin_name, long, lat, year, month,timeid, rain)
            select gid, admin_name, long, lat, bom_grids.rain_",ste,"_1890_2008.year, bom_grids.rain_",ste,"_1890_2008.month,timeid, rain
            from bom_grids.rain_",ste,"_1890_2008 join bom_grids.time on (bom_grids.rain_",ste,"_1890_2008.year= bom_grids.time.year)
            and (bom_grids.rain_",ste,"_1890_2008.month= bom_grids.time.month);",sep="")
          )

        sqlQuery(ch,paste("
          CREATE TABLE bom_grids.rain_",ste,"_1890_2008_2
            (gid integer,
             timeid integer,
             year integer NOT NULL,
             month integer NOT NULL,
                  rain double precision,
                  rain6mo double precision,
                   CONSTRAINT rain",ste,"2_pkey PRIMARY KEY (gid,timeid)
                 );

                insert into bom_grids.rain_",ste,"_1890_2008_2 (gid, timeid, year, month,rain,rain6mo)
                select t1.gid, t1.timeid, t1.year, t1.month,t1.rain,sum(t2.rain)
                from bom_grids.rain_",ste,"_1890_2008_1 as t1 join bom_grids.rain_",ste,"_1890_2008_1 as t2
                on (t1.gid=t2.gid)
                where t1.timeid between t2.timeid and t2.timeid+5
                group by t1.gid, t1.timeid, t1.year, t1.month,t1.rain
                having count(t2.rain)=6
                order by t1.timeid;",sep="")
                )

                sqlQuery(ch,paste("create table bom_grids.rain_",ste,"_1890_2008_3 (
                    gid int4,
                    timeid int4,
                    year int4,
                    month int4,
                    rain double precision,
                    rain6mo double precision,
                    pctile double precision,
                    rescaledPctile double precision,
                    droughtIndex double precision,
                    indexBelowThreshold double precision,
                    CONSTRAINT r_",ste,"_pk PRIMARY KEY (gid, timeid))",sep="")
                    )

                    #st=Sys.time()

                      for(g in gids[,1]){

                        #g=gids[1,1]

                        # calc %iles

# rank in percentage terms with respect to the rainfall totals for the same sequence of 6-months over all years of record
                                for(month in months){
                                #month=1
                                    sqlQuery(ch,"create table bom_grids.temporary (
                                      rank serial,
                                      gid int4,
                                      timeid int4,
                                      year int4,
                                      month int4,
                                      rain double precision,
                                      rain6mo double precision,
                                      pctile double precision,
                                      rescaledPctile double precision,
                                      droughtIndex double precision,
                                      indexBelowThreshold double precision
                                      )")

                                sqlQuery(ch,paste("insert into bom_grids.temporary (gid ,timeid, year, month, rain,rain6mo)
                                      select t1.gid ,t1.timeid, t1.year, t1.month, t1.rain,t1.rain6mo
                                      from bom_grids.rain_",ste,"_1890_2008_2 as t1
                                      where month = ",month," and gid ='",g,"'
                                      order by rain6mo",sep="")
                                      )

                                    n=sqlQuery(ch,"select count(*) from bom_grids.temporary")
                                    sqlQuery(ch,paste("update bom_grids.temporary set pctile = (cast(rank as numeric)-1)/(",n,"-1);
                                   		  update bom_grids.temporary set rescaledPctile = 8*(pctile-0.5);
                                   		  update bom_grids.temporary  set droughtIndex= 1 where rescaledPctile < -1 ;
                               		      update bom_grids.temporary set indexbelowthreshold  = droughtIndex * rescaledPctile;

                                        insert into bom_grids.rain_",ste,"_1890_2008_3 (gid ,timeid, year, month, rain,
                                          rain6mo,pctile,rescaledPctile,droughtIndex,indexBelowThreshold)
                                        select t1.gid ,t1.timeid, t1.year, t1.month, t1.rain,t1.rain6mo,t1.pctile,t1.rescaledPctile,t1.droughtIndex,
                                          t1.indexBelowThreshold from bom_grids.temporary as t1
                                        order by t1.gid, t1.timeid;",sep="")
                                        )

                                    sqlQuery(ch,"drop table bom_grids.temporary;")

                                    }

                            }
 }

                              en=Sys.time()

                              print(en-st)

########################
#-- are any first months a index month?
#
sqlQuery(ch,paste("select * from bom_grids.rain_",ste,"_1890_2008_3 where year = 1890 and month = 6
and indexbelowthreshold is not null;",sep=""))

#sqlQuery(ch,
cat(paste("update bom_grids.rain_",ste,"_1890_2008_3
set indexbelowthreshold = null
where year = 1890 and month = 6
and indexbelowthreshold is not null;",sep=""))

#Hutchinson says "As the percentile value of zero rainfalls is not well defined, if the total rainfall for a six-month period was zero then the percentile value is set to the mid-point of the relative frequency that the six-month sequence is dry"
# I used the (rank-1)/(length-1)

# I will do NT first and then re-do all the other states, only gids that have zero 6mos.

d=sqlQuery(ch,"select *
 from bom_grids.rain_nt_1890_2008_3
 where month = 9 and gid ='21082'
 order by rain6mo")
head(d)
plot(d$rain6mo,d$pctile)
segments(0,(nrow(d[d$rain6mo==0,])-1)/(nrow(d)-1),20,(nrow(d[d$rain6mo==0,])-1)/(nrow(d)-1))

cat(paste("update bom_grids.rain_",ste,"_1890_2008_3 as t1
set pctile = foo.max
from (
select t1.gid, t1.year, t1.month, case when rain6mo = 0 then t2.max else pctile end as max
	from bom_grids.rain_",ste,"_1890_2008_3 as t1 left join
		(
		select gid,month, max(pctile)
		from bom_grids.rain_",ste,"_1890_2008_3
		where rain6mo =0
		group by gid,month
		) t2
	on t1.gid=t2.gid
	and t1.month=t2.month
) as foo
where t1.gid=foo.gid
and t1.month=foo.month
and t1.year=foo.year",sep="")
)

#re-do the rescaling of the pctiles work from above
# insert calcs into bom_grids.rain_",ste,"_1890_2008_5
# delete old ~3 and then rename ~5 to bom_grids.rain_",ste,"_1890_2008_3 and then create bom_grids.rain_",ste,"_1890_2008_4

gids=sqlQuery(ch,paste("select distinct gid from bom_grids.rain_",ste,"_1890_2008;",sep=""))

strt=Sys.time()
 sqlQuery(ch,paste("create table bom_grids.rain_",ste,"_1890_2008_5 (
                    gid int4,
                    timeid int4,
                    year int4,
                    month int4,
                    rain double precision,
                    rain6mo double precision,
                    pctile double precision,
                    rescaledPctile double precision,
                    droughtIndex double precision,
                    indexBelowThreshold double precision,
                    CONSTRAINT r5_",ste,"_pk PRIMARY KEY (gid, timeid))",sep="")
                    )

for(g in gids[,1]){

		for(month in months){
		#month=1
		sqlQuery(ch,"create table bom_grids.temporary (
		  rank serial,
		  gid int4,
		  timeid int4,
		  year int4,
		  month int4,
		  rain double precision,
		  rain6mo double precision,
		  pctile double precision,
		  rescaledPctile double precision,
		  droughtIndex double precision,
		  indexBelowThreshold double precision
		  )")

		sqlQuery(ch,paste("insert into bom_grids.temporary (gid ,timeid, year, month, rain,rain6mo,pctile)
		  select t1.gid ,t1.timeid, t1.year, t1.month, t1.rain,t1.rain6mo,t1.pctile
		  from bom_grids.rain_",ste,"_1890_2008_3 as t1
		  where month = ",month," and gid ='",g,"'
		  order by rain6mo",sep="")
		  )

		n=sqlQuery(ch,"select count(*) from bom_grids.temporary")
		sqlQuery(ch,paste("
			  update bom_grids.temporary set rescaledPctile = 8*(pctile-0.5);
			  update bom_grids.temporary  set droughtIndex= 1 where rescaledPctile < -1 ;
		    update bom_grids.temporary set indexbelowthreshold  = droughtIndex * rescaledPctile;

		    insert into bom_grids.rain_",ste,"_1890_2008_5 (gid ,timeid, year, month, rain,
		      rain6mo,pctile,rescaledPctile,droughtIndex,indexBelowThreshold)
		    select t1.gid ,t1.timeid, t1.year, t1.month, t1.rain,t1.rain6mo,t1.pctile,t1.rescaledPctile,t1.droughtIndex,
		      t1.indexBelowThreshold from bom_grids.temporary as t1
		    order by t1.gid, t1.timeid;",sep="")
		    )

		sqlQuery(ch,"drop table bom_grids.temporary;")

		}
}
endd=Sys.time()
print(endd-strt)

d=sqlQuery(ch,"select *
 from bom_grids.rain_nt_1890_2008_5
 where month = 9 and gid ='21082'
 order by rain6mo")
head(d)

sqlQuery(ch,"drop table bom_grids.rain_nt_1890_2008_3;
alter table bom_grids.rain_nt_1890_2008_5 rename to rain_nt_1890_2008_3;")

d=sqlQuery(ch,"select *
 from bom_grids.rain_nt_1890_2008_3
 where month = 9 and gid ='21082'
 order by rain6mo")
head(d)

###############################################################################
#calc sums
                             sqlQuery(ch,
														 # cat(
														 paste("
                             begin;
                             drop table  bom_grids.rain_",ste,"_1890_2008_4;
                             end;
                              create table bom_grids.rain_",ste,"_1890_2008_4 (
                              gid int4,
                              timeid int4,
                              year int4,
                              month int4,
                              rain double precision,
                              rain6mo double precision,
                              pctile double precision,
                              rescaledPctile double precision,
                              indexBelowThreshold double precision,
                              sum double precision,
                              count int4,
                              CONSTRAINT r4_",ste,"_pk PRIMARY KEY (gid, timeid))",sep="")
                              )

#close(ch)
library(RODBC)
ch=odbcConnect('weather')
ste=states[8]
ste
        gids=sqlQuery(ch,paste("select distinct gid from bom_grids.rain_",ste,"_1890_2008;",sep=""))

                    nrow(gids)
                    doneGids=sqlQuery(ch,paste("select distinct gid from bom_grids.rain_",ste,"_1890_2008_4",sep=""))
                    nrow(doneGids)
                    tail(doneGids)
                    summary(gids)
hist(gids[,1])

								    st=Sys.time()

                    for(i in seq(6300,6700,10)){

                           li=i
                           print(li)
                           ui=i+10

                            sqlQuery(ch,
                            paste("insert into bom_grids.rain_",ste,"_1890_2008_4 (
                                      gid, timeid, \"year\", \"month\", rain, rain6mo, pctile, rescaledpctile,
                                      indexbelowthreshold, sum, count)
                                select t3.gid,t3.timeid,t3.year,t3.month,t3.rain,t3.rain6mo,t3.pctile,t3.rescaledpctile,t3.indexbelowthreshold,
                                    sum(t4.indexbelowthreshold),count(t4.indexbelowthreshold)
                                from (select t1.gid, t1.timeid,t1.indexbelowthreshold
                                from bom_grids.rain_",ste,"_1890_2008_3 as t1
                                where t1.gid>=",li," and t1.gid<",ui,"
                                order by t1.gid, t1.timeid) as t4,
                                   (select t1.gid, t1.timeid,t1.year,t1.month,t1.rain,t1.rain6mo,t1.pctile,t1.rescaledpctile,t1.indexbelowthreshold,max(t2.timeid)
                                      from
                                      (select t1.gid, t1.timeid,t1.year,t1.month,t1.rain,t1.rain6mo,t1.pctile,t1.rescaledpctile,t1.indexbelowthreshold
                                      from bom_grids.rain_",ste,"_1890_2008_3 as t1
                                      where t1.gid>=",li," and t1.gid<",ui,"
                                      order by t1.gid, t1.timeid) as t1,
                                      (select t1.gid, t1.timeid,t1.indexbelowthreshold
                                      from bom_grids.rain_",ste,"_1890_2008_3 as t1
                                      where t1.gid>=",li," and t1.gid<",ui,"
                                      order by t1.gid, t1.timeid) as t2
                                      where t1.gid = t2.gid
                                      and t1.timeid >= t2.timeid
                                      and t2.indexbelowthreshold is null
                                      group by t1.gid, t1.timeid,t1.year,t1.month,t1.rain,t1.rain6mo,t1.pctile,t1.rescaledpctile,t1.indexbelowthreshold
                                      order by t1.timeid)
                                    as t3
                                where t3.gid=t4.gid
                                and t3.timeid >= t4.timeid
                                and t3.max <= t4.timeid
                                group by t3.gid, t3.timeid,t3.year,t3.month,t3.rain,t3.rain6mo,t3.pctile,t3.rescaledpctile,t3.indexbelowthreshold
                                order by t3.gid,t3.timeid",sep="")
                                )

                    }

en=Sys.time()

print(en-st)

############################
# for some reason got to XXXX and then just took forever to do the rest etc
# workaround by make new table with

#sqlQuery(ch,"delete from bom_grids.rain_qld_1890_2008_4
# where gid>=22130;")

setgo=22772
#drop table bom_grids.rain_",ste,"_1890_2008_3test;

library(RODBC)
ch=odbcConnect('weather')
ste=states[8]

sqlQuery(ch,
paste("
create table bom_grids.rain_",ste,"_1890_2008_3test (
                              gid int4,
                              timeid int4,
                              year int4,
                              month int4,
                              rain double precision,
                              rain6mo double precision,
                              pctile double precision,
                              rescaledPctile double precision,
                              droughtIndex double precision,
                              indexBelowThreshold double precision,
                              CONSTRAINT r3tst_",ste,"_pk PRIMARY KEY (gid, timeid)
                              );

insert into bom_grids.rain_",ste,"_1890_2008_3test (gid, timeid, \"year\", \"month\", rain, rain6mo, pctile, rescaledpctile,
       droughtindex, indexbelowthreshold)

SELECT t1.gid, t1.timeid, t1.\"year\", t1.\"month\", t1.rain, t1.rain6mo, t1.pctile, t1.rescaledpctile,
       t1.droughtindex, t1.indexbelowthreshold
  FROM bom_grids.rain_",ste,"_1890_2008_3 as t1
  where gid>=",setgo,";
",sep=""))

summary(gids)

st=Sys.time()

                    for(i in seq(setgo,23942,10)){

                           li=i
                           print(li)
                           ui=i+10

                            sqlQuery(ch,
                            paste("insert into bom_grids.rain_",ste,"_1890_2008_4 (
                                      gid, timeid, \"year\", \"month\", rain, rain6mo, pctile, rescaledpctile,
                                      indexbelowthreshold, sum, count)
                                select t3.gid,t3.timeid,t3.year,t3.month,t3.rain,t3.rain6mo,t3.pctile,t3.rescaledpctile,t3.indexbelowthreshold,
                                    sum(t4.indexbelowthreshold),count(t4.indexbelowthreshold)
                                from (select t1.gid, t1.timeid,t1.indexbelowthreshold
                                from bom_grids.rain_",ste,"_1890_2008_3test as t1
                                where t1.gid>=",li," and t1.gid<",ui,"
                                order by t1.gid, t1.timeid) as t4,
                                   (select t1.gid, t1.timeid,t1.year,t1.month,t1.rain,t1.rain6mo,t1.pctile,t1.rescaledpctile,t1.indexbelowthreshold,max(t2.timeid)
                                      from
                                      (select t1.gid, t1.timeid,t1.year,t1.month,t1.rain,t1.rain6mo,t1.pctile,t1.rescaledpctile,t1.indexbelowthreshold
                                      from bom_grids.rain_",ste,"_1890_2008_3test as t1
                                      where t1.gid>=",li," and t1.gid<",ui,"
                                      order by t1.gid, t1.timeid) as t1,
                                      (select t1.gid, t1.timeid,t1.indexbelowthreshold
                                      from bom_grids.rain_",ste,"_1890_2008_3test as t1
                                      where t1.gid>=",li," and t1.gid<",ui,"
                                      order by t1.gid, t1.timeid) as t2
                                      where t1.gid = t2.gid
                                      and t1.timeid >= t2.timeid
                                      and t2.indexbelowthreshold is null
                                      group by t1.gid, t1.timeid,t1.year,t1.month,t1.rain,t1.rain6mo,t1.pctile,t1.rescaledpctile,t1.indexbelowthreshold
                                      order by t1.timeid)
                                    as t3
                                where t3.gid=t4.gid
                                and t3.timeid >= t4.timeid
                                and t3.max <= t4.timeid
                                group by t3.gid, t3.timeid,t3.year,t3.month,t3.rain,t3.rain6mo,t3.pctile,t3.rescaledpctile,t3.indexbelowthreshold
                                order by t3.gid,t3.timeid",sep="")
                                )

                    }

en=Sys.time()

print(en-st)

#all done?

sqlQuery(ch,paste("select t1.gid, t2.gid from (
SELECT distinct gid
  FROM bom_grids.rain_",ste,"_1890_2008_3) as t1 left join (
SELECT distinct gid
  FROM bom_grids.rain_",ste,"_1890_2008_4) as t2 on t1.gid=t2.gid
  where t2.gid is null ",sep=""))

sqlQuery(ch,paste("select gid, year, count(month) from bom_grids.rain_",ste,"_1890_2008_4
where gid = ",setgo,"
group by gid, year
order by year",sep=""))

sqlQuery(ch,paste("drop table bom_grids.rain_",ste,"_1890_2008_3test",sep=""))
#

#qc
sqlQuery(ch,paste("begin;
drop table test82;
    commit;")
sqlQuery(ch,paste("    begin;
  select t1.gid, year, max(sum) as mxsum, max(count) as mxcount, t2.the_geom into test82
    from bom_grids.rain_",ste,"_1890_2008_4 as t1 join bom_grids.grid_aus as t2 on (t1.gid=t2.gid)
    group by t1.gid, year, t2.the_geom
    having year = 1982;
    create unique index tst82pk on test82 (gid);
    commit;
    ",sep="")
    )

#  now re-do the other months with zero 6month rains set to the pctile of the relfreq of the month being dry
# find the gids with zeros in the rain6mo using a master table

#drop table bom_grids.rain_aus_1890_2008_4;
#CREATE TABLE bom_grids.rain_aus_1890_2008_4 (
#	gid integer NOT NULL,
#  timeid integer NOT NULL,
#  "year" integer,
#  "month" integer,
#  rain double precision,
#  rain6mo double precision,
#  pctile double precision,
#  rescaledpctile double precision,
#  indexbelowthreshold double precision,
#  sum double precision,
#  count integer,
#  CONSTRAINT r_aus_pk PRIMARY KEY (gid, timeid)
#);
#
#CREATE TABLE bom_grids.rain_nt_1890_2008_4 (
#  gid integer NOT NULL,
#  timeid integer NOT NULL,
#  "year" integer,
#  "month" integer,
#  rain double precision,
#  rain6mo double precision,
#  pctile double precision,
#  rescaledpctile double precision,
#  droughtindex double precision,
#  indexbelowthreshold double precision,
#  sum double precision,
#  count integer,
#  CONSTRAINT r4_nt_pk PRIMARY KEY (gid, timeid)
#);
#
#INSERT INTO bom_grids.rain_nt_1890_2008_4(
#            gid, timeid, "year", "month", rain, rain6mo, pctile, rescaledpctile,
#            droughtindex, indexbelowthreshold)
#    select * from bom_grids.rain_nt_1890_2008_3;
#
#
#ALTER TABLE bom_grids.rain_qld_1890_2008_4 inherit bom_grids.rain_aus_1890_2008_4;
#ALTER TABLE bom_grids.rain_nt_1890_2008_4  inherit bom_grids.rain_aus_1890_2008_4;
#ALTER TABLE bom_grids.rain_wa_1890_2008_4 inherit bom_grids.rain_aus_1890_2008_4;
#ALTER TABLE bom_grids.rain_sa_1890_2008_4 inherit bom_grids.rain_aus_1890_2008_4;
#ALTER TABLE bom_grids.rain_nsw_1890_2008_4  inherit bom_grids.rain_aus_1890_2008_4;
#ALTER TABLE bom_grids.rain_vic_1890_2008_4 inherit bom_grids.rain_aus_1890_2008_4;
#ALTER TABLE bom_grids.rain_act_1890_2008_4 inherit bom_grids.rain_aus_1890_2008_4;
#ALTER TABLE bom_grids.rain_tas_1890_2008_4 inherit bom_grids.rain_aus_1890_2008_4;
#
#
#
#
sqlQuery(ch,"
ALTER TABLE bom_grids.rain_nt_1890_2008_4  inherit bom_grids.rain_aus_1890_2008_4;
ALTER TABLE bom_grids.rain_nsw_1890_2008_4  inherit bom_grids.rain_aus_1890_2008_4;
drop table bom_grids.zero_rain6mo;
select bom_grids.grid_aus.gid, cast(count(*) as numeric) as countsofzero, the_geom
into bom_grids.zero_rain6mo
from bom_grids.rain_aus_1890_2008_4 join bom_grids.grid_aus on bom_grids.rain_aus_1890_2008_4.gid=bom_grids.grid_aus.gid
group by rain6mo, bom_grids.grid_aus.gid, the_geom
having rain6mo = 0;
create unique index \"bom_grids.zero_rain6mo_pk\" on bom_grids.zero_rain6mo (gid);")

#
#

# first qld
ste=states[4]
ste

select t1.*
from bom_grids.rain_",ste,"_1890_2008_4 t1 join bom_grids.zero_rain6mo t2 on t1.gid=t2.gid

# finally add indexes and do partitioned table stuff
for(ste in states){
 cat(paste("ALTER TABLE bom_grids.grid_",ste," ALTER COLUMN the_geom SET NOT NULL;
 CREATE INDEX grid",ste,"_gist on bom_grids.grid_",ste," using GIST(the_geom);
 ALTER TABLE bom_grids.grid_",ste," CLUSTER ON grid",ste,"_gist;",sep="")
)
}

library(RODBC)
ch=odbcConnect("weather")
for(ste in states){
upperi=sqlQuery(ch,paste("select max(gid) from bom_grids.grid_",ste,";",sep=""))
loweri=sqlQuery(ch,paste("select min(gid) from bom_grids.grid_",ste,";",sep=""))
 cat(paste("ALTER TABLE bom_grids.grid_",ste," ADD CHECK (gid <=",upperi,"
  and gid >=",loweri,");",sep=""))
}

for(ste in states){
 cat(paste("ALTER TABLE bom_grids.rain_",ste,"_1890_2008_4 CLUSTER ON r4_",ste,"_pk;\n",sep="")
)
}

library(RODBC)
ch=odbcConnect("weather")
for(ste in states){
upperi=sqlQuery(ch,paste("select max(gid) from bom_grids.grid_",ste,";",sep=""))
loweri=sqlQuery(ch,paste("select min(gid) from bom_grids.grid_",ste,";",sep=""))
cat(paste("ALTER TABLE bom_grids.grid_",ste," ADD CHECK (gid <=",upperi,"
  and gid >=",loweri,");",sep=""))
}

for(ste in states){
 cat(paste("create index r4_",ste,"_mnth on bom_grids.rain_",ste,"_1890_2008_4 (month);
 	create index r4_",ste,"_yy on bom_grids.rain_",ste,"_1890_2008_4 (year);\n",sep="")
)
}

ls()
###############################################################################
## old work
## calculate the indices  in R
#		data$count<-as.numeric(0)
#
#		for(j in 2:nrow(data)){
#		  data$count[j]<-ifelse(is.na(data$indexbelowthreshold[j]),0,
#                     ifelse(!is.na(data$indexbelowthreshold[j-1]),1+data$count[j-1],
#                     1))
#		}
#
#		data$sums<-as.numeric(0)
#
#		for(j in 2:nrow(data)){
#		  data$sums[j]<-ifelse(is.na(data$indexbelowthreshold[j]),0,
#                    ifelse(!is.na(data$indexbelowthreshold[j-1]),data$indexbelowthreshold[j]+data$sums[j-1],
#                    data$indexbelowthreshold[j]))
#		}
#
#data[1:100,]
#
## or in SQL
#sqlQuery(ch,paste("select gid,                 ,timeid,              ,year,                ,month,               ,rain,                ,rain6mo,             ,pctile      ,rescaledpctile,      ,droughtindex,        ,indexbelowthreshold
#into bom_grids.rain_",ste,"_1890_2008_droughtIndexesTest
#from bom_grids.rain_",ste,"_1890_2008_3 as t1,  bom_grids.rain_",ste,"_1890_2008_3 as t2
#where gid = ",gids[1,1],"
#order by timeid",sep=""))
#
#
#################################################################################
##checks
#qc=sqlQuery(ch,paste("SELECT gid, timeid, year, month, rain, rain6mo, pctile, rescaledpctile,
#       droughtindex, indexbelowthreshold
#  FROM bom_grids.rain_",ste,"_1890_2008_3
#  where gid=6682
#  order by gid, timeid;",sep=""))
#
#head(qc)
#qc[order(qc$pctile),]
#
#plot(qc$timeid,qc$rain6mo)
#lines(qc$timeid,qc$rain6mo)
#lines(lowess(qc$rain6mo~qc$timeid,f=0.2))
#
## will create a table called droughtIndices
#
## and rain extracted for a single place like
##  CD_CODE year month      rain
##1 1140101 1890     1  26.86461
##2 1140101 1890     2 167.12060
#
## and called data
#
##set drought threshold
## Hutchinson rescaled percentiles to fall between -4 and +4 to replicate palmer index
## then set the threshold at -1 which is upper limit of mild drought in palmer index
## this is 3/8ths, or the 37.5th percentile
#
#
#droughtIndex<-function(data,droughtThreshold=.375){
#		#calculate 6 month totals
#		x<-ts(data[,4],start=1,end=c(114,12),frequency=12)
#		x<-c(rep(NA,5),x+lag(x,1)+lag(x,2)+lag(x,3)+lag(x,4)+lag(x,5))
#		data$sixmnthtot<-x
#		data<-na.omit(data)
#		# rank in percentage terms with respect to the rainfall totals for the same sequence of 6-months over all years of record
#		for(i in 1:12){
#		  x<-data[data$month==i,5]
#		  x<-na.omit(x)
#		  y<-(rank(x)-1)/(length(x)-1)
#		  # rescale between -4 and +4 to replicate palmer index
#		  z<-8*(y-.5)
#		  # defualts set the threshold at -1 which is upper limit of mild drought in palmer index (3/8ths, or the 37.5th percentile)
#		  drought<-x<=quantile(x,droughtThreshold)
#		  # calculate the drought index for any months that fall below the threshold
#		  zd<-z*drought
#		  # save out to the data
#		  dataout<-data[data$month==i,]
#		  dataout$index<-z
#		  dataout$indexBelowThreshold<-zd
#		  sqlSave(ch,dataout,rownames=F,append=T)
#		  }
#
#		data<-sqlQuery(ch,"select * from dataout order by year, month")
#		sqlDrop(ch,"dataout")
#
#		# now calculate the indices
#		data$count<-as.numeric(0)
#
#		for(j in 2:nrow(data)){
#		  data$count[j]<-ifelse(data$indexBelowThreshold[j]==0,0,
#        ifelse(data$indexBelowThreshold[j-1]!=0,1+data$count[j-1],1))
#		}
#
#		data$sums<-as.numeric(0)
#
#		for(j in 2:nrow(data)){
#		  data$sums[j]<-ifelse(data$indexBelowThreshold[j]==0,0,
#                      ifelse(data$indexBelowThreshold[j-1]!=0,data$indexBelowThreshold[j]+data$sums[j-1],data$indexBelowThreshold[j]))
#		}
#		droughtIndices<-data
#		#sqlDrop(ch,"droughtIndices")
#		sqlSave(ch,droughtIndices,rownames=F,append=T)
#		}
#


#!/usr/bin/env Rscript

#Andrew Burt - a.burt@ucl.ac.uk

args <- commandArgs(trailingOnly=TRUE)
path_to_src <- args[1]
source(paste(path_to_src,"olsBIOMASS.r",sep=""))
source(paste(path_to_src,"nls.r",sep=""))
source(paste(path_to_src,"quantileregression.r",sep=""))
source(paste(path_to_src,"bootstrap.r",sep=""))
source(paste(path_to_src,"measuncert.r",sep=""))
source(paste(path_to_src,"fieldresults.r",sep=""))

cdata <- read.table(args[2],col.names=c("country","d","h","agb","rho"))
caldata <- data.frame(cdata$d*cdata$d*cdata$h*cdata$rho,cdata$agb)
colnames(caldata) <- c("X","y")

alpha <- as.numeric(args[3])
runs <- as.numeric(args[4])
nn <- as.integer(length(caldata$X) * as.numeric(args[5]))

model <- fitNLS(caldata)
nlqrmodels <- nlQuantileRegression(model,caldata,alpha)
bootmodels <- bootstrap(model,caldata,runs)

results <- list()
n <- 1
for(i in 6:length(args))
{
	fielddata <- read.table(args[i],col.names=c("id","x","y","d","h","rho"))
	tmp1 <- strsplit(args[i],'/')
	tmp2 <- tmp1[[1]][length(tmp1[[1]])]
	tmp3 <- strsplit(tmp2,'\\.')
	pname <- tmp3[[1]][1]
	#
	fdata <- data.frame(fielddata$d*fielddata$d*fielddata$h*fielddata$rho)
	colnames(fdata) <- c("X")
	stem_count <- nrow(fielddata)
	basal_area <- sum((fielddata$d / 2) ^ 2 * pi)
	lorey_height <- sum(((fielddata$d / 2) ^ 2 * pi) * fielddata$h ) / sum((fielddata$d / 2) ^ 2 * pi)
	wd_baw <- sum((fielddata$d / 2) ^ 2 * pi * fielddata$rho ) / sum((fielddata$d / 2) ^ 2 * pi)
	###ols
	ols_t_agb <- yhatBIOMASS(fielddata) * 1000
	ols_t_agb_li <- treeIntervalsBIOMASS(fielddata,alpha)[,1] * 1000
	ols_t_agb_ui <- treeIntervalsBIOMASS(fielddata,alpha)[,2] * 1000
	ols_t_u <- 0.5 * (ols_t_agb_ui - ols_t_agb_li) / ols_t_agb
	ols_p_agb <- sum(ols_t_agb)
	ols_p_agb_li <- plotIntervalBIOMASS(fielddata)[[1]] * 1000
	ols_p_agb_ui <- plotIntervalBIOMASS(fielddata)[[2]] * 1000
	ols_p_u <- 0.5 * (ols_p_agb_ui - ols_p_agb_li) / ols_p_agb
	#
	nls1_sigma_meas <- measSigma(model,fielddata)
	nls1_t_agb <- yhat(model,fdata)
	nls1_t_agb_ali <- getPredictionIntervals(nlqrmodels,fdata)[,1]
	nls1_t_agb_aui <- getPredictionIntervals(nlqrmodels,fdata)[,2]
	nls1_t_agb_mli <- nls1_t_agb - nls1_sigma_meas * qnorm(alpha/2,lower.tail=FALSE)
	nls1_t_agb_mui <- nls1_t_agb + nls1_sigma_meas * qnorm(alpha/2,lower.tail=FALSE)
	nls1_t_agb_li <- nls1_t_agb_ali - nls1_sigma_meas * qnorm(alpha/2,lower.tail=FALSE)
	nls1_t_agb_ui <- nls1_t_agb_aui + nls1_sigma_meas * qnorm(alpha/2,lower.tail=FALSE)
	nls1_t_u_a <- 0.5 * (nls1_t_agb_aui - nls1_t_agb_ali) / nls1_t_agb
	nls1_t_u_m <- 0.5 * (nls1_t_agb_mui - nls1_t_agb_mli) / nls1_t_agb
	nls1_t_u <- 0.5 * (nls1_t_agb_ui - nls1_t_agb_li) / nls1_t_agb
	#
	nls1_p_agb <- sum(nls1_t_agb)
	nls1_p_agb_ali <- sum(getConfidenceIntervals(bootmodels,fdata,alpha)[,1])
	nls1_p_agb_aui <- sum(getConfidenceIntervals(bootmodels,fdata,alpha)[,2])
	nls1_p_agb_mli <- nls1_p_agb - (1/sqrt(nrow(fdata)) * sum(nls1_sigma_meas*qnorm(alpha/2,lower.tail=FALSE)))
	nls1_p_agb_mui <- nls1_p_agb + (1/sqrt(nrow(fdata)) * sum(nls1_sigma_meas*qnorm(alpha/2,lower.tail=FALSE)))
	nls1_p_agb_li <- nls1_p_agb_ali - (1/sqrt(nrow(fdata)) * sum(nls1_sigma_meas*qnorm(alpha/2,lower.tail=FALSE)))
	nls1_p_agb_ui <- nls1_p_agb_aui + (1/sqrt(nrow(fdata)) * sum(nls1_sigma_meas*qnorm(alpha/2,lower.tail=FALSE)))
	nls1_p_u_a <- 0.5 * (nls1_p_agb_aui - nls1_p_agb_ali) / nls1_p_agb
	nls1_p_u_m <- 0.5 * (nls1_p_agb_mui - nls1_p_agb_mli) / nls1_p_agb
	nls1_p_u <- 0.5 * (nls1_p_agb_ui - nls1_p_agb_li) / nls1_p_agb
	#
	nls2_t_agb <- numeric(nrow(fdata))
	nls2_t_agb_ali <- numeric(nrow(fdata))
	nls2_t_agb_aui <- numeric(nrow(fdata))
	nls2_t_agb_mli <- numeric(nrow(fdata))
	nls2_t_agb_mui <- numeric(nrow(fdata))
	nls2_t_agb_li <- numeric(nrow(fdata))
	nls2_t_agb_ui <- numeric(nrow(fdata))
	nls2_t_u_a <- numeric(nrow(fdata))
	nls2_t_u_m <- numeric(nrow(fdata))
	nls2_t_u <- numeric(nrow(fdata))
	#
	nls2_p_agb <- 0
	nls2_p_agb_ali <- 0
	nls2_p_agb_aui <- 0
	nls2_p_agb_mli <- 0
	nls2_p_agb_mui <- 0
	nls2_p_agb_li <- 0
	nls2_p_agb_ui <- 0
	#
	for(j in 1:nrow(fdata))
	{
		segcaldata <- head(caldata[order(abs(caldata$X-fdata$X[j])),],nn)
		data <- data.frame(fdata$X[j])
		colnames(data) <- c("X")
		meas <- data.frame(fielddata[j,])
		colnames(meas) <- c("id","x","y","d","h","rho")
		#
		segmodel <- fitNLS(segcaldata)
		segnlqrmodels <- nlQuantileRegression(segmodel,segcaldata,alpha)
		segbootmodels <- bootstrap(model,segcaldata,runs)
		#
		nls2_sigma_meas <- measSigma(segmodel,meas)
		nls2_t_agb[j] <- yhat(segmodel,data)
		nls2_t_agb_ali[j] <- getPredictionIntervals(segnlqrmodels,data)[,1]
		nls2_t_agb_aui[j] <- getPredictionIntervals(segnlqrmodels,data)[,2]
		nls2_t_agb_mli[j] <- nls2_t_agb[j] - nls2_sigma_meas[[1]] * qnorm(alpha/2,lower.tail=FALSE)
		nls2_t_agb_mui[j] <- nls2_t_agb[j] + nls2_sigma_meas[[1]] * qnorm(alpha/2,lower.tail=FALSE)
		nls2_t_agb_li[j] <- nls2_t_agb_ali[j] - nls2_sigma_meas[[1]] * qnorm(alpha/2,lower.tail=FALSE)
		nls2_t_agb_ui[j] <- nls2_t_agb_aui[j] + nls2_sigma_meas[[1]] * qnorm(alpha/2,lower.tail=FALSE)
		nls2_t_u_a[j] <- 0.5 * (nls2_t_agb_aui[j] - nls2_t_agb_ali[j]) / nls2_t_agb[j]
		nls2_t_u_m[j] <- 0.5 * (nls2_t_agb_mui[j] - nls2_t_agb_mli[j]) / nls2_t_agb[j]
		nls2_t_u[j] <- 0.5 * (nls2_t_agb_ui[j] - nls2_t_agb_li[j]) / nls2_t_agb[j]
		#
		nls2_p_agb <- nls2_p_agb + nls2_t_agb[j]
		nls2_p_agb_ali <- nls2_p_agb_ali + getConfidenceIntervals(segbootmodels,data,alpha)[,1]
		nls2_p_agb_aui <- nls2_p_agb_aui + getConfidenceIntervals(segbootmodels,data,alpha)[,2]
		nls2_p_agb_mli <- nls2_p_agb_mli + nls2_t_agb[j] - (1/sqrt(nrow(fdata)) * nls2_sigma_meas[[1]] * qnorm(alpha/2,lower.tail=FALSE))
		nls2_p_agb_mui <- nls2_p_agb_mui + nls2_t_agb[j] + (1/sqrt(nrow(fdata)) * nls2_sigma_meas[[1]] * qnorm(alpha/2,lower.tail=FALSE))
		nls2_p_agb_li <- nls2_p_agb_li + getConfidenceIntervals(segbootmodels,data,alpha)[,1] - (1/sqrt(nrow(fdata)) * nls2_sigma_meas[[1]] * qnorm(alpha/2,lower.tail=FALSE))
		nls2_p_agb_ui <- nls2_p_agb_ui + getConfidenceIntervals(segbootmodels,data,alpha)[,2] + (1/sqrt(nrow(fdata)) * nls2_sigma_meas[[1]] * qnorm(alpha/2,lower.tail=FALSE))
	}
	nls2_p_u_a <- 0.5 * (nls2_p_agb_aui - nls2_p_agb_ali) / nls2_p_agb
	nls2_p_u_m <- 0.5 * (nls2_p_agb_mui - nls2_p_agb_mli) / nls2_p_agb
	nls2_p_u <- 0.5 * (nls2_p_agb_ui - nls2_p_agb_li) / nls2_p_agb
	#
	###sort tree results
	tr <- data.frame(pname,fielddata$id,fielddata$x,fielddata$y,round(fielddata$d,3),round(fielddata$h,3),round(fielddata$rho,3),
	round(ols_t_agb,3),round(ols_t_agb_li,3),round(ols_t_agb_ui,3),round(ols_t_u,3),
	round(nls1_t_agb,3),round(nls1_t_agb_ali,3),round(nls1_t_agb_aui,3),round(nls1_t_agb_mli,3),round(nls1_t_agb_mui,3),round(nls1_t_agb_li,3),round(nls1_t_agb_ui,3),round(nls1_t_u_a,3),round(nls1_t_u_m,3),round(nls1_t_u,3),
	round(nls2_t_agb,3),round(nls2_t_agb_ali,3),round(nls2_t_agb_aui,3),round(nls2_t_agb_mli,3),round(nls2_t_agb_mui,3),round(nls2_t_agb_li,3),round(nls2_t_agb_ui,3),round(nls2_t_u_a,3),round(nls2_t_u_m,3),round(nls2_t_u,3))
	colnames(tr) <- c("pid","tid","x","y","d","h","rho",
	"ols_t_agb","ols_t_agb_li","ols_t_agb_ui","ols_t_u",
	"nls1_t_agb","nls1_t_agb_ali","nls1_t_agb_aui","nls1_t_agb_mli","nls1_t_agb_mui","nls1_t_agb_li","nls1_t_agb_ui","nls1_t_u_a","nls1_t_u_m","nls1_t_u",
	"nls2_t_agb","nls2_t_agb_ali","nls2_t_agb_aui","nls2_t_agb_mli","nls2_t_agb_mui","nls2_t_agb_li","nls2_t_agb_ui","nls2_t_u_a","nls2_t_u_m","nls2_t_u")
	###sort plot results
	pr <- data.frame(pname,round(stem_count,0),round(basal_area,3),round(lorey_height,3),round(wd_baw,3),
	round(ols_p_agb,3),round(ols_p_agb_li,3),round(ols_p_agb_ui,3),round(ols_p_u,3),
	round(nls1_p_agb,3),round(nls1_p_agb_ali,3),round(nls1_p_agb_aui,3),round(nls1_p_agb_mli,3),round(nls1_p_agb_mui,3),round(nls1_p_agb_li,3),round(nls1_p_agb_ui,3),round(nls1_p_u_a,3),round(nls1_p_u_m,3),round(nls1_p_u,3),
	round(nls2_p_agb,3),round(nls2_p_agb_ali,3),round(nls2_p_agb_aui,3),round(nls2_p_agb_mli,3),round(nls2_p_agb_mui,3),round(nls2_p_agb_li,3),round(nls2_p_agb_ui,3),round(nls2_p_u_a,3),round(nls2_p_u_m,3),round(nls2_p_u,3))
	colnames(pr) <- c("pid","sc","ba","lh","wd_baw",
	"ols_p_agb","ols_p_agb_li","ols_p_agb_ui","ols_p_u",
	"nls1_p_agb","nls1_p_agb_ali","nls1_p_agb_aui","nls1_p_agb_mli","nls1_p_agb_mui","nls1_p_agb_li","nls1_p_agb_ui","nls1_p_u_a","nls1_p_u_m","nls1_p_u",
	"nls2_p_agb","nls2_p_agb_ali","nls2_p_agb_aui","nls2_p_agb_mli","nls2_p_agb_mui","nls2_p_agb_li","nls2_p_agb_ui","nls2_p_u_a","nls2_p_u_m","nls2_p_u")
	###
	results[[n]] <- tr
	n <- n+1
	results[[n]] <- pr
	n <- n+1
}
writeResults(results)


m <- apply(energy_stats_2008, 1, function(x) x[1:2])
pdf("slike/Natutral_gas_imprts_exports_2008.pdf")
barplot(m, beside=TRUE, main ='Natural gas import & export in 2008', xlab ='Country', ylab = 'Natural gas in BCF',col = c('darkblue','red'), legend =c('Natural Gas Exports','Natural Gas Imports'),xlim = c(0, 15))
dev.off()

n <- apply(energy_stats_2008, 1, function(x) x[3:4])
pdf('slike/Electricity_imports_exports_2008.pdf')
barplot(n, beside=T, main = 'Electricity imports & exports in 2008', xlab = 'Country', ylab = "Electricity in Billion Kilowatthours", col = c('green','yellow'), legend=c('Electricity Exports','Electricity Imports'),xlim = c(0, 15), args.legend = c(x="top"))
dev.off()

o <- apply(energy_stats_2008, 1, function(x) x[5:6])
pdf('slike/Refined_Petrolium_imports_exports_2008.pdf')
barplot(o, beside=T, main='Refined Petroleum imprts & exports in 2008', xlab ='Country', ylab ='Refined_Petroleum_export_Thousand_Barrels_Per_Day', col =c('purple','deeppink'), legend=c('Refined Petroleum Exports','Refined Petroleum Imports'), xlim = c(0, 15), args.legend = c(x="top"))
dev.off()

k <- apply(energy_stats_2009,1,function(x) x[1:2])
pdf("slike/Natutral_gas_imprts_exports_2009.pdf")
barplot(k, beside=TRUE, main ='Natural gas import & export in 2009', xlab ='Country', ylab = 'Natural gas in BCF',col = c('darkblue','red'), legend =c('Natural Gas Exports','Natural Gas Imports'),xlim = c(0, 15))
dev.off()

l <- apply(energy_stats_2009, 1, function(x) x[3:4])
pdf('slike/Electricity_imports_exports_2009.pdf')
barplot(l, beside=T, main = 'Electricity imports & exports in 2009', xlab = 'Country', ylab = "Electricity in Billion Kilowatthours", col = c('green','yellow'), legend=c('Electricity Exports','Electricity Imports'),xlim = c(0, 15), args.legend = c(x="top"))
dev.off()

j <- apply(energy_stats_2009, 1, function(x) x[5:6])
pdf('slike/Refined_Petrolium_imports_exports_2009.pdf')
barplot(j, beside=T, main='Refined Petroleum imprts & exports in 2009', xlab ='Country', ylab ='Refined_Petroleum_export_Thousand_Barrels_Per_Day', col =c('purple','deeppink'), legend=c('Refined Petroleum Exports','Refined Petroleum Imports'), xlim = c(0, 15), args.legend = c(x="top"))
dev.off()

r <- apply(energy_stats_2010,1,function(x) x[1:2])
pdf("slike/Natutral_gas_imprts_exports_2010.pdf")
barplot(r, beside=TRUE, main ='Natural gas import & export in 2010', xlab ='Country', ylab = 'Natural gas in BCF',col = c('darkblue','red'), legend =c('Natural Gas Exports','Natural Gas Imports'),xlim = c(0, 15))
dev.off()

t <- apply(energy_stats_2010, 1, function(x) x[3:4])
pdf('slike/Electricity_imports_exports_2010.pdf')
barplot(t, beside=T, main = 'Electricity imports & exports in 2010', xlab = 'Country', ylab = "Electricity in Billion Kilowatthours", col = c('green','yellow'), legend=c('Electricity Exports','Electricity Imports'),xlim = c(0, 15), args.legend = c(x="top"))
dev.off()

e <- apply(energy_stats_2010, 1, function(x) x[5:6])
pdf('slike/Refined_Petrolium_imports_exports_2010.pdf')
barplot(e, beside=T, main='Refined Petroleum imprts & exports in 2010', xlab ='Country', ylab ='Refined_Petroleum_export_Thousand_Barrels_Per_Day', col =c('purple','deeppink'), legend=c('Refined Petroleum Exports','Refined Petroleum Imports'), xlim = c(0, 15), args.legend = c(x="top"))
dev.off()

u <- apply(energy_stats_2011,1,function(x) x[1:2])
pdf("slike/Natutral_gas_imprts_exports_2011.pdf")
barplot(u, beside=TRUE, main ='Natural gas import & export in 2011', xlab ='Country', ylab = 'Natural gas in BCF',col = c('darkblue','red'), legend =c('Natural Gas Exports','Natural Gas Imports'),xlim = c(0, 15))
dev.off()

s <- apply(energy_stats_2011, 1, function(x) x[3:4])
pdf('slike/Electricity_imports_exports_2011.pdf')
barplot(s, beside=T, main = 'Electricity imports & exports in 2011', xlab = 'Country', ylab = "Electricity in Billion Kilowatthours", col = c('green','yellow'), legend=c('Electricity Exports','Electricity Imports'),xlim = c(0, 15), args.legend = c(x="top"))
dev.off()

d <- apply(energy_stats_2011, 1, function(x) x[5:6])
pdf('slike/Refined_Petrolium_imports_exports_2011.pdf')
barplot(d, beside=T, main='Refined Petroleum imprts & exports in 2011', xlab ='Country', ylab ='Refined_Petroleum_export_Thousand_Barrels_Per_Day', col =c('purple','deeppink'), legend=c('Refined Petroleum Exports','Refined Petroleum Imports'), xlim = c(0, 15), args.legend = c(x="topleft"))
dev.off()

v <- apply(energy_stats_2012,1,function(x) x[1:2])
pdf("slike/Natutral_gas_imprts_exports_2012.pdf")
barplot(v, beside=TRUE, main ='Natural gas import & export in 2012', xlab ='Country', ylab = 'Natural gas in BCF',col = c('darkblue','red'), legend =c('Natural Gas Exports','Natural Gas Imports'),xlim = c(0, 15))
dev.off()

a <- apply(energy_stats_2012, 1, function(x) x[3:4])
pdf('slike/Electricity_imports_exports_2012.pdf')
barplot(a, beside=T, main = 'Electricity imports & exports in 2012', xlab = 'Country', ylab = "Electricity in Billion Kilowatthours", col = c('green','yellow'), legend=c('Electricity Exports','Electricity Imports'),xlim = c(0, 15), args.legend = c(x="top"))
dev.off()

b <- apply(energy_stats_2012, 1, function(x) x[5:6])
pdf('slike/Refined_Petrolium_imports_exports_2012.pdf')
barplot(b, beside=T, main='Refined Petroleum imprts & exports in 2012', xlab ='Country', ylab ='Refined_Petroleum_export_Thousand_Barrels_Per_Day', col =c('purple','deeppink'), legend=c('Refined Petroleum Exports','Refined Petroleum Imports'), xlim = c(0, 15), args.legend = c(x="topleft"))
dev.off()

pdf('slike/Total_Primary_Energy_Production_Quadrillion_Btu_2008.pdf')
pie(energy_stats_2008$Total_Primary_Energy_Production_Quadrillion_Btu, labels = c('Germany','Russia','UK','US'), col=c('gold1','royalblue','violetred','chartreuse'), main ='Total Primary Energy Production Quadrillion Btu 2008')
dev.off()

pdf('slike/Total_Primary_Energy_Production_Quadrillion_Btu_2009.pdf')
pie(energy_stats_2009$Total_Primary_Energy_Production_Quadrillion_Btu, labels = c('Germany','Russia','UK','US'), col=c('gold1','royalblue','violetred','chartreuse'), main ='Total Primary Energy Production Quadrillion Btu 2009')
dev.off()

pdf('slike/Total_Primary_Energy_Production_Quadrillion_Btu_2010.pdf')
pie(energy_stats_2010$Total_Primary_Energy_Production_Quadrillion_Btu, labels = c('Germany','Russia','UK','US'), col=c('gold1','royalblue','violetred','chartreuse'), main ='Total Primary Energy Production Quadrillion Btu 2010')
dev.off()

pdf('slike/Total_Primary_Energy_Production_Quadrillion_Btu_2011.pdf')
pie(energy_stats_2011$Total_Primary_Energy_Production_Quadrillion_Btu, labels = c('Germany','Russia','UK','US'), col=c('gold1','royalblue','violetred','chartreuse'), main ='Total Primary Energy Production Quadrillion Btu 2011')
dev.off()

pdf('slike/Total_Primary_Energy_Production_Quadrillion_Btu_2012.pdf')
pie(energy_stats_2012$Total_Primary_Energy_Production_Quadrillion_Btu, labels = c('Germany','Russia','UK','US'), col=c('gold1','royalblue','violetred','chartreuse'), main ='Total Primary Energy Production Quadrillion Btu 2012')
dev.off()

pdf('slike/Total_Primary_Energy_Consumption_Quadrillion_Btu_2008.pdf')
pie(energy_stats_2008$Total_Primary_Energy_Consumption_Quadrillion_Btu, labels = c('Germany','Russia','UK','US'), col=c('magenta4','lawngreen','red3','deepskyblue2'), main ='Total Primary Energy Consumption Quadrillion Btu 2008')
dev.off()

pdf('slike/Total_Primary_Energy_Consumption_Quadrillion_Btu_2009.pdf')
pie(energy_stats_2009$Total_Primary_Energy_Consumption_Quadrillion_Btu, labels = c('Germany','Russia','UK','US'), col=c('magenta4','lawngreen','red3','deepskyblue2'), main ='Total Primary Energy Consumption Quadrillion Btu 2009')
dev.off()

pdf('slike/Total_Primary_Energy_Consumption_Quadrillion_Btu_2010.pdf')
pie(energy_stats_2010$Total_Primary_Energy_Consumption_Quadrillion_Btu, labels = c('Germany','Russia','UK','US'), col=c('magenta4','lawngreen','red3','deepskyblue2'), main ='Total Primary Energy Consumption Quadrillion Btu 2010')
dev.off()

pdf('slike/Total_Primary_Energy_Consumption_Quadrillion_Btu_2011.pdf')
pie(energy_stats_2011$Total_Primary_Energy_Consumption_Quadrillion_Btu, labels = c('Germany','Russia','UK','US'), col=c('magenta4','lawngreen','red3','deepskyblue2'), main ='Total Primary Energy Consumption Quadrillion Btu 2011')
dev.off()

pdf('slike/Total_Primary_Energy_Consumption_Quadrillion_Btu_2012.pdf')
pie(energy_stats_2012$Total_Primary_Energy_Consumption_Quadrillion_Btu, labels = c('Germany','Russia','UK','US'), col=c('magenta4','lawngreen','red3','deepskyblue2'), main ='Total Primary Energy Consumption Quadrillion Btu 2012')
dev.off()


#Combine vectors by rows and columns

v1 = c(1,3,5,7,9)
v2 = c(2,4,6,8,10)
print("Original vectors:")
print(v1)
print(v2)
print("Combines the said two vectors by columns:")
result = cbind(v1,v2)
print(result)
print("Combines the said two vectors by rows:")
result = rbind(v1,v2)
print(result)


#' Toy data that makes no sense
#'
#' @description Data arbitrarily created using:
#' \preformatted{
#'  set.seed(333)
#'  lm_data = setNames(as.data.frame(runif(50, min = 0, max = 50)), 'y')
#'  lm_data$x = lm_data$y + 1
#' }
#' @docType data
#' @usage data(lm_data)
#' @keywords datasets
#' @examples
#' data(lm_data)
#' df_train = lm_data[1:25, ]
#' df_test = lm_data[26:50, ]
#'
#' lm_int = lm(y ~ x, data = df_train)
#' lm_noint = lm(y ~ 0 + x, data = df_train)
#' list_lm = c('lm_int', 'lm_noint')
#'
#' predicted = predict2(
#'   model = list_lm,
#'   newdata = df_test,
#'   actual = df_test$y,
#'   pred_type = 'response',
#'   write_model = FALSE,
#'   write_pred = FALSE,
#'   csv_name = 'none'
#' )
#' head(predicted)
"lm_data"


setwd("./")

if(!("tidyverse" %in% installed.packages())){
  install.packages("tidyr", dependencies = TRUE)
}

if(!("ggplot2" %in% installed.packages())){
  install.packages("ggplot2", dependencies = TRUE)
}

if(!("summarytools" %in% installed.packages())){
  install.packages("summarytools", dependencies = TRUE)
}

library(tidyverse)
library(ggplot2)
library(summarytools)
library(lubridate)

options(scipen = 100)

dane <- read_csv("Walmart.csv",show_col_types = FALSE)

dane <- dane %>%
  mutate(Date = dmy(Date))

descr(dane)
view(dfSummary(dane))

options(repr.plot.width = 15, repr.plot.height = 5)
ggplot(dane, aes(x=Weekly_Sales, color='Weekly Sales')) +
  geom_histogram(bins=50)+
  xlab("Sprzedaż tygodniowa [USD]")+
  ylab("Ilość wystąpień")+
  ggtitle("Sprzedaż tygodniowa")+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5),plot.title = element_text(hjust = 0.5))

Maximum_Sales <- dane %>%
  group_by(Store) %>%
  summarize(Total_Sales=sum(Weekly_Sales))

head(arrange(Maximum_Sales,desc(Total_Sales)))

options(repr.plot.width = 15, repr.plot.height = 5)
ggplot(Maximum_Sales,aes(x=factor(Store),y=Total_Sales,fill=Total_Sales)) +
  geom_col()+
  xlab("Sklep")+
  ylab("Sprzedaż [USD]")+
  ggtitle("Sprzedaż tygodniowa")+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5),plot.title = element_text(hjust = 0.5))+
  scale_fill_gradient(low="orange", high="blue")

Diff <- dane %>%
  group_by(Store) %>%
  summarize(sd= sd(Weekly_Sales),mean= mean(Weekly_Sales),CV= sd/mean) %>%
  arrange(desc(sd))
head(Diff)

options(repr.plot.width = 15, repr.plot.height = 5)
dane %>%
  filter(Store == 14) %>%
  ggplot(aes(y=Weekly_Sales)) +
  geom_boxplot(colour="black",fill="orchid")+
  ylab("Sprzedaż [USD]")+
  ggtitle("Odchylenie standardowe dla sklepu 14") +
  theme(plot.title = element_text(hjust = 0.5))

Super_Bowl <- c('2010-02-12', '2011-02-11', '2012-02-10')
Super_Bowl <- ymd(Super_Bowl)

Labour_Day <- c('2010-08-10', '2011-09-09', '2012-09-07')
Labour_Day <- ymd(Labour_Day)

Thanksgiving <- c('2010-11-26', '2011-11-25', '2012-11-23')
Thanksgiving <- ymd(Thanksgiving)

Christmas <- c('2010-12-31', '2011-12-30', '2012-12-28')
Christmas <- ymd(Christmas)

holiday_sales <- dane %>%
  mutate(Holiday = case_when(Date %in% Super_Bowl ~ "Super Bowl",
                             Date %in% Labour_Day ~ "Święto pracy",
                             Date %in% Thanksgiving ~ "Święto dziękczynienia",
                             Date %in% Christmas ~ "Boże Narodzenie",
                             TRUE ~ "Zwykły dzień"))

holiday_sales %>%
  select(Weekly_Sales,Holiday) %>%
  group_by(Holiday) %>%
  summarise(average_sales = mean(Weekly_Sales)) %>%
  arrange(desc(average_sales))

options(repr.plot.width = 15, repr.plot.height = 5)
holiday_sales %>%
  select(Weekly_Sales,Holiday) %>%
  group_by(Holiday) %>%
  summarise(average_sales = mean(Weekly_Sales)) %>%
  ggplot(aes(x=Holiday,y=average_sales,fill=Holiday)) +
  geom_col() +
  ggtitle("Sprzedaż według świąt") +
  theme(plot.title = element_text(hjust = 0.5))

y2010_sales <- dane %>%
  group_by(Store) %>%
  filter(Date >= "2010-01-01", Date <= "2010-12-31") %>%
  summarise(y2010_sales = sum(Weekly_Sales))

y2011_sales <- dane %>%
  group_by(Store) %>%
  filter(Date >= "2011-01-01", Date <= "2011-12-31") %>%
  summarise(y2011_sales = sum(Weekly_Sales))

y2012_sales <- dane %>%
  group_by(Store) %>%
  filter(Date >= "2012-01-01", Date <= "2012-12-31") %>%
  summarise(y2012_sales = sum(Weekly_Sales))

year_sales <- left_join(y2010_sales, y2011_sales, by="Store") %>%
  left_join(., y2012_sales, by="Store")

options(repr.plot.width = 15, repr.plot.height = 7.5)
year_sales %>%
  gather("Id","Sales",2:4) %>%
  ggplot(aes(fill=Id,x=factor(Store),y=Sales)) +
  geom_col(position="dodge") + xlab("Store") +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5),plot.title = element_text(hjust = 0.5))+
  xlab("Sklep")+
  ylab("Sprzedaż [USD]")+
  ggtitle("Sprzedaż roczna sklepów")

monthly_data <- dane %>%
  mutate(Month = month(Date,label = TRUE),Year = year(Date),Quarter = as.character(quarter(Date,with_year = TRUE)))

options(repr.plot.width = 15, repr.plot.height = 7.5)
monthly_data %>%
  filter(Year == 2010) %>%
  group_by(Month) %>%
  summarise(Monthly_sale = sum(Weekly_Sales)) %>%
    ggplot(aes(x=Month,y=Monthly_sale,fill=Month)) +
    geom_col() +
    xlab("Mesiąc")+
    ylab("Sprzedaż miesięczna [USD]")+
    ggtitle("Sprzedaż miesięczna w 2010 roku") +
    theme(plot.title = element_text(hjust = 0.5))

options(repr.plot.width = 15, repr.plot.height = 7.5)
monthly_data %>%
  filter(Year == 2011) %>%
  group_by(Month) %>%
  summarise(Monthly_sale = sum(Weekly_Sales)) %>%
    ggplot(aes(x=Month,y=Monthly_sale,fill=Month)) +
    geom_col() +
    xlab("Mesiąc")+
    ylab("Sprzedaż miesięczna [USD]")+
    ggtitle("Sprzedaż miesięczna w 2011 roku") +
    theme(plot.title = element_text(hjust = 0.5))

options(repr.plot.width = 15, repr.plot.height = 7.5)
monthly_data %>%
  filter(Year == 2012) %>%
  group_by(Month) %>%
  summarise(Monthly_sale = sum(Weekly_Sales)) %>%
    ggplot(aes(x=Month,y=Monthly_sale,fill=Month)) +
    geom_col() +
    xlab("Mesiąc")+
    ylab("Sprzedaż miesięczna [USD]")+
    ggtitle("Sprzedaż miesięczna w 2012 roku") +
    theme(plot.title = element_text(hjust = 0.5))

options(repr.plot.width = 15, repr.plot.height = 7.5)
monthly_data %>%
  group_by(Quarter) %>%
  summarise(Quarter_sales = sum(Weekly_Sales)) %>%
  ggplot(aes(x=Quarter,y=Quarter_sales,fill=Quarter)) +
  geom_col() +
  xlab("Kwartał")+
  ylab("Sprzedaż kwartalna [USD]")+
  ggtitle("Sprzedaż kwartalna") +
  theme(plot.title = element_text(hjust = 0.5))

y2010_fuel <- dane %>%
  filter(Date >= "2010-01-01", Date <= "2010-12-31") %>%
  select(Fuel_Price, Store)

y2011_fuel <- dane %>%
  filter(Date >= "2011-01-01", Date <= "2011-12-31") %>%
  select(Fuel_Price, Store)

y2012_fuel <- dane %>%
  filter(Date >= "2012-01-01", Date <= "2012-12-31") %>%
  select(Fuel_Price, Store)

total_fuel <- left_join(y2010_fuel, y2011_fuel, by="Store") %>%
  left_join(., y2012_fuel, by="Store") %>%
  select(Fuel_Price.x, Fuel_Price.y, Fuel_Price)

names(total_fuel)[1] <- 'Fuel_2010'
names(total_fuel)[2] <- 'Fuel_2011'
names(total_fuel)[3] <- 'Fuel_2012'

descr(total_fuel)

year_fuel <- dane %>%
  select(Fuel_Price, Date)

options(repr.plot.width = 15, repr.plot.height = 7.5)
ggplot(year_fuel, aes(x=Date, y=Fuel_Price)) +
  geom_point() +
  geom_smooth(se=F, color="red") +
  geom_smooth(method='lm', color='blue') +
  xlab("Czas")+
  ylab("Cena paliwa [USD]") +
  ggtitle("Cena paliwa 2010 - 2012 ") +
  theme(plot.title = element_text(hjust = 0.5))

y2010_unemployment <- dane %>%
  filter(Date >= "2010-01-01", Date <= "2010-12-31") %>%
  select(Unemployment, Store)

y2011_unemployment <- dane %>%
  filter(Date >= "2011-01-01", Date <= "2011-12-31") %>%
  select(Unemployment, Store)

y2012_unemployment <- dane %>%
  filter(Date >= "2012-01-01", Date <= "2012-12-31") %>%
  select(Unemployment, Store)

total_unemployment <- left_join(y2010_unemployment, y2011_unemployment, by="Store") %>%
  left_join(., y2012_unemployment, by="Store") %>%
  select(Unemployment.x, Unemployment.y, Unemployment)

names(total_unemployment)[1] <- 'Unemployment_2010'
names(total_unemployment)[2] <- 'Unemployment_2011'
names(total_unemployment)[3] <- 'Unemployment_2012'

descr(total_unemployment)

year_unemployment <- dane %>%
  select(Unemployment, Date)

options(repr.plot.width = 15, repr.plot.height = 7.5)
ggplot(year_unemployment, aes(x=Date, y=Unemployment)) +
  geom_point() +
  geom_smooth(se=F, color='red') +
  geom_smooth(method='lm', color='blue') +
  xlab("Czas")+
  ylab("Wskaźnik bezrobocia") +
  ggtitle("Bezrobocie 2010 - 2012 ") +
  theme(plot.title = element_text(hjust = 0.5))

y2010_df <- dane %>%
  filter(Date >= "2010-01-01", Date <= "2010-12-31")

y2011_df <- dane %>%
  filter(Date >= "2011-01-01", Date <= "2011-12-31")

y2012_df <- dane %>%
  filter(Date >= "2012-01-01", Date <= "2012-12-31")

options(repr.plot.width = 15, repr.plot.height = 5)
ggplot(y2010_df,aes(x=Temperature,y=Weekly_Sales)) +
geom_point() +
geom_smooth(color="orange") +
ggtitle("Sprzedaż vs. Temperatura w 2010 roku") +
xlab("Temperatura") +
ylab("Sprzedaż [USD]") +
theme(plot.title = element_text(hjust = 0.5))
cat("Korelacja sprzedaży do temperatury w 2010 roku wyniosła:", cor(y2010_df$Weekly_Sales,y2010_df$Temperature))

options(repr.plot.width = 15, repr.plot.height = 5)
ggplot(y2011_df,aes(x=Temperature,y=Weekly_Sales)) +
geom_point() +
geom_smooth(color="blue") +
ggtitle("Sprzedaż vs. Temperatura w 2011 roku") +
xlab("Temperatura") +
ylab("Sprzedaż [USD]") +
theme(plot.title = element_text(hjust = 0.5))
cat("Korelacja sprzedaży do temperatury w 2011 roku wyniosła:", cor(y2011_df$Weekly_Sales,y2011_df$Temperature))

options(repr.plot.width = 15, repr.plot.height = 5)
ggplot(y2012_df,aes(x=Temperature,y=Weekly_Sales)) +
geom_point() +
geom_smooth(color="green") +
ggtitle("Sprzedaż vs. Temperatura w 2012 roku") +
xlab("Temperatura") +
ylab("Sprzedaż [USD]") +
theme(plot.title = element_text(hjust = 0.5))
cat("Korelacja sprzedaży do temperatury w 2012 roku wyniosła:", cor(y2012_df$Weekly_Sales,y2012_df$Temperature))

y2010_df <- dane %>%
  filter(Date >= "2010-01-01", Date <= "2010-12-31")

y2011_df <- dane %>%
  filter(Date >= "2011-01-01", Date <= "2011-12-31")

y2012_df <- dane %>%
  filter(Date >= "2012-01-01", Date <= "2012-12-31")

options(repr.plot.width = 15, repr.plot.height = 5)
ggplot(y2010_df,aes(x=Unemployment,y=Weekly_Sales)) +
geom_point() +
geom_smooth(color="orange") +
ggtitle("Sprzedaż vs. bezrobocie w 2010 roku") +
xlab("Bezrobocie") +
ylab("Sprzedaż [USD]") +
theme(plot.title = element_text(hjust = 0.5))
cat("Korelacja sprzedaży do bezrobocia w 2010 roku wyniosła:", cor(y2010_df$Weekly_Sales,y2010_df$Unemployment))

options(repr.plot.width = 15, repr.plot.height = 5)
ggplot(y2011_df,aes(x=Unemployment,y=Weekly_Sales)) +
geom_point() +
geom_smooth(color="blue") +
ggtitle("Sprzedaż vs. bezrobocie w 2011 roku") +
xlab("Bezrobocie") +
ylab("Sprzedaż [USD]") +
theme(plot.title = element_text(hjust = 0.5))
cat("Korelacja sprzedaży do bezrobocia w 2011 roku wyniosła:", cor(y2011_df$Weekly_Sales,y2011_df$Unemployment))

options(repr.plot.width = 15, repr.plot.height = 5)
ggplot(y2012_df,aes(x=Unemployment,y=Weekly_Sales)) +
geom_point() +
geom_smooth(color="green") +
ggtitle("Sprzedaż vs. bezrobocie w 2012 roku") +
xlab("Bezrobocie") +
ylab("Sprzedaż [USD]") +
theme(plot.title = element_text(hjust = 0.5))
cat("Korelacja sprzedaży do bezrobocia w 2012 roku wyniosła:", cor(y2012_df$Weekly_Sales,y2012_df$Unemployment))

y2010_df <- dane %>%
  filter(Date >= "2010-01-01", Date <= "2010-12-31")

y2011_df <- dane %>%
  filter(Date >= "2011-01-01", Date <= "2011-12-31")

y2012_df <- dane %>%
  filter(Date >= "2012-01-01", Date <= "2012-12-31")

options(repr.plot.width = 15, repr.plot.height = 5)
ggplot(y2010_df,aes(x=CPI,y=Weekly_Sales)) +
geom_point() +
geom_smooth(color="orange") +
ggtitle("Sprzedaż vs. CPI w 2010 roku") +
xlab("CPI - Index cen konsumpcyjnych") +
ylab("Sprzedaż [USD]") +
theme(plot.title = element_text(hjust = 0.5))
cat("Korelacja sprzedaży do CPI w 2010 roku wyniosła:", cor(y2010_df$Weekly_Sales,y2010_df$CPI))

options(repr.plot.width = 15, repr.plot.height = 5)
ggplot(y2011_df,aes(x=CPI,y=Weekly_Sales)) +
geom_point() +
geom_smooth(color="blue") +
ggtitle("Sprzedaż vs. CPI w 2011 roku") +
xlab("CPI - Index cen konsumpcyjnych") +
ylab("Sprzedaż [USD]") +
theme(plot.title = element_text(hjust = 0.5))
cat("Korelacja sprzedaży do CPI w 2011 roku wyniosła:", cor(y2011_df$Weekly_Sales,y2011_df$CPI))

options(repr.plot.width = 15, repr.plot.height = 5)
ggplot(y2012_df,aes(x=CPI,y=Weekly_Sales)) +
geom_point() +
geom_smooth(color="orange") +
ggtitle("Sprzedaż vs. CPI w 2012 roku") +
xlab("CPI - Index cen konsumpcyjnych") +
ylab("Sprzedaż [USD]") +
theme(plot.title = element_text(hjust = 0.5))
cat("Korelacja sprzedaży do CPI w 2012 roku wyniosła:", cor(y2012_df$Weekly_Sales,y2012_df$CPI))

y2010_df <- dane %>%
  filter(Date >= "2010-01-01", Date <= "2010-12-31")

y2011_df <- dane %>%
  filter(Date >= "2011-01-01", Date <= "2011-12-31")

y2012_df <- dane %>%
  filter(Date >= "2012-01-01", Date <= "2012-12-31")

options(repr.plot.width = 15, repr.plot.height = 5)
ggplot(y2010_df,aes(x=Fuel_Price,y=Weekly_Sales)) +
geom_point() +
geom_smooth(color="orange") +
ggtitle("Sprzedaż vs. cena paliwa w 2010 roku") +
xlab("Cena paliwa [USD]") +
ylab("Sprzedaż [USD]") +
theme(plot.title = element_text(hjust = 0.5))
cat("Korelacja sprzedaży do kosztów paliwa w 2010 roku wyniosła:", cor(y2010_df$Weekly_Sales,y2010_df$Fuel_Price))

options(repr.plot.width = 15, repr.plot.height = 5)
ggplot(y2011_df,aes(x=Fuel_Price,y=Weekly_Sales)) +
geom_point() +
geom_smooth(color="blue") +
ggtitle("Sprzedaż vs. cena paliwa w 2011 roku") +
xlab("Cena paliwa [USD]") +
ylab("Sprzedaż [USD]") +
theme(plot.title = element_text(hjust = 0.5))
cat("Korelacja sprzedaży do kosztów paliwa w 2011 roku wyniosła:", cor(y2011_df$Weekly_Sales,y2011_df$Fuel_Price))

options(repr.plot.width = 15, repr.plot.height = 5)
ggplot(y2012_df,aes(x=Fuel_Price,y=Weekly_Sales)) +
geom_point() +
geom_smooth(color="green") +
ggtitle("Sprzedaż vs. cena paliwa w 2012 roku") +
xlab("Cena paliwa [USD]") +
ylab("Sprzedaż [USD]") +
theme(plot.title = element_text(hjust = 0.5))
cat("Korelacja sprzedaży do kosztów paliwa w 2012 roku wyniosła:", cor(y2012_df$Weekly_Sales,y2012_df$Fuel_Price))

sklep22 <- dane %>%
  filter(Store==22)

cor.test(sklep22$Weekly_Sales,sklep22$Temperature)

cor(dane$Weekly_Sales,dane$Temperature)

cor.test(sklep22$Weekly_Sales,sklep22$Unemployment)

cor(dane$Weekly_Sales,dane$Unemployment)

cor.test(sklep22$Weekly_Sales,sklep22$CPI)

cor(dane$Weekly_Sales,dane$CPI)

cor.test(sklep22$Weekly_Sales,sklep22$Fuel_Price)

cor(dane$Weekly_Sales,dane$Fuel_Price)

cor.test(sklep22$Fuel_Price,sklep22$Temperature)

cor(dane$Fuel_Price,dane$Temperature)

cor.test(sklep22$Fuel_Price,sklep22$Unemployment)

cor(dane$Fuel_Price,dane$Unemployment)

t.test(sklep22$Weekly_Sales, mu=1000000)

mean(dane$Weekly_Sales)

t.test(sklep22$Unemployment, mu=8)

mean(dane$Unemployment)

t.test(sklep22$Fuel_Price, mu=3.5)

mean(dane$Fuel_Price)

t.test(sklep22$Weekly_Sales ~ sklep22$Holiday_Flag)

dane %>%
  filter(Holiday_Flag == 0) %>%
  summarise(srednia_zwykly_dzien=mean(Weekly_Sales))

dane %>%
  filter(Holiday_Flag == 1) %>%
  summarise(srednia_swieto=mean(Weekly_Sales))

shapiro.test(sklep22$Weekly_Sales)

ks.test(dane$Weekly_Sales, "pnorm", mean=mean(dane$Weekly_Sales), sd=sd(dane$Weekly_Sales))

options(repr.plot.width = 15, repr.plot.height = 7.5)
ggplot(dane,aes(sample=Weekly_Sales))+
  stat_qq(color="red") +
  stat_qq_line(color="green")+
  xlab("Wartość rozkładu")+
  ylab("Tygodniowa wielkość sprzedaży [USD]") +
  ggtitle("Rozkład emipiryczny tygodniowej sprzedaży dla całej populacji") +
  theme(plot.title = element_text(hjust = 0.5))

print("Rozkład poniższej cechy dla całej badanej populacji nie jest normalny")

options(repr.plot.width = 15, repr.plot.height = 7.5)
ggplot(sklep22,aes(sample=Weekly_Sales))+
  stat_qq(color="red") +
  stat_qq_line(color="green")+
  xlab("Wartość rozkładu")+
  ylab("Tygodniowa wielkość sprzedaży [USD]") +
  ggtitle("Rozkład emipiryczny tygodniowej sprzedaży dla próby") +
  theme(plot.title = element_text(hjust = 0.5))

print("Rozkład poniższej cechy dla całej badanej populacji nie jest normalny")

options(repr.plot.width = 15, repr.plot.height = 7.5)
ggplot(dane,aes(sample=CPI))+
  stat_qq(color="red") +
  stat_qq_line(color="green")+
  xlab("Wartość rozkładu")+
  ylab("Index CPI") +
  ggtitle("Rozkład emipiryczny wskaźnika cen konsumpcyjnych dla całej populacji") +
  theme(plot.title = element_text(hjust = 0.5))

print("Rozkład poniższej cechy dla całej badanej populacji nie jest normalny")

options(repr.plot.width = 15, repr.plot.height = 7.5)
ggplot(sklep22,aes(sample=CPI))+
  stat_qq(color="red") +
  stat_qq_line(color="green")+
  xlab("Wartość rozkładu ")+
  ylab("Index CPI") +
  ggtitle("Rozkład emipiryczny cen konsumpcyjnych dla próby") +
  theme(plot.title = element_text(hjust = 0.5))

print("Rozkład poniższej cechy dla całej badanej populacji nie jest normalny")

options(repr.plot.width = 15, repr.plot.height = 7.5)
ggplot(dane,aes(sample=Fuel_Price))+
  stat_qq(color="red") +
  stat_qq_line(color="green")+
  xlab("Wartość rozkładu")+
  ylab("Cena paliwa [USD]") +
  ggtitle("Rozkład emipiryczny cen paliwa dla całej populacji") +
  theme(plot.title = element_text(hjust = 0.5))

print("Rozkład poniższej cechy dla całej badanej populacji nie jest normalny")

options(repr.plot.width = 15, repr.plot.height = 7.5)
ggplot(sklep22,aes(sample=Fuel_Price))+
  stat_qq(color="red") +
  stat_qq_line(color="green")+
  xlab("Wartość rozkładu")+
  ylab("Cena paliwa [USD]") +
  ggtitle("Rozkład emipiryczny cenp aliwa dla próby") +
  theme(plot.title = element_text(hjust = 0.5))

print("Rozkład poniższej cechy dla całej badanej populacji nie jest normalny")

wilcox.test(sklep22$Weekly_Sales ~sklep22$Holiday_Flag)


library(reshape2)
library(plyr)
library(stringr)
source("tidy-data/data/xtable.r")
options(stringsAsFactors = FALSE)

# Load -----------------------------------------------------------------------
raw <- read.csv("tidy-data/data/tb.csv", na.strings = "")
raw$new_sp <- NULL
raw <- subset(raw, year == 2000)
names(raw)[1] <- "country"

names(raw) <- str_replace(names(raw), "new_sp_", "")
raw$m04 <- NULL
raw$m514 <- NULL
raw$f04 <- NULL
raw$f514 <- NULL

xtable(raw[1:10, 1:11], file = "tidy-data/data/tb-raw.tex")

# Melt -----------------------------------------------------------------------

clean <- melt(raw, id = c("country", "year"), na.rm = TRUE)
names(clean)[3] <- "column"
names(clean)[4] <- "cases"

clean <- arrange(clean, country, column, year)

clean1 <- clean

xtable(clean[1:15, ], file = "tidy-data/data/tb-clean-1.tex")

# Break up variable in to sex and age ----------------------------------------

clean$sex <- str_sub(clean$column, 1, 1)

ages <- c("04" = "0-4", "514" = "5-14", "014" = "0-14", "1524" = "15-24", "2534" = "25-34", "3544" = "35-44", "4554" = "45-54", "5564" = "55-64", "65"= "65+", "u" = NA)

clean$age <- factor(ages[str_sub(clean$column, 2)], levels = ages)

clean <- clean[c("country", "year", "sex", "age", "cases")]

xtable(clean[1:15, ], file = "tidy-data/data/tb-clean-2.tex")


 S30ACJ Example Program Results

      SIGMA    IVALID

    7.834E-01    0
    7.386E-01    0
    4.096E-01    0
    4.085E-01    0
    4.179E-01    0


#Probam narediti nekaj grafov:
graf.meddrzavne.selitve <- ggplot(data=meddrzavne.selitve.drzavljanstvo %>% group_by(vrsta, drzava)
                           %>% summarise(Stevilo=sum(stevilo)),
                           mapping = aes(x=reorder(drzava, Stevilo), y=Stevilo, fill=vrsta)) +
  geom_bar(stat = 'identity', position = 'dodge') + xlab("Država") + ylab("Število") +
  ggtitle("Graf števila odseljenih in priseljenih po državah") + coord_flip()

graf.meddrzavne.selitve.odseljeni <- ggplot(data=meddrzavne.selitve.osnovni %>%
                                              filter(vrsta=="Odseljeni v tujino") %>%
                                       group_by(spol, starost, spol) %>%
                                       summarise(Stevilo=sum(stevilo)),
                                     mapping = aes(x=starost, y=Stevilo, fill=spol)) +
                                       geom_bar(stat = 'identity', position = 'dodge') +
  xlab("Starost") + ylab("Število")+ ggtitle("Graf odseljenih Slovencev po letih") + coord_flip()

graf.meddrzavne.selitve.priseljeni <- ggplot(data=meddrzavne.selitve.osnovni %>%
                                               filter(vrsta=="Priseljeni iz tujine") %>%
                                                 group_by(spol, starost) %>%
                                                 summarise(Stevilo=sum(stevilo)),
                                               mapping = aes(x=starost, y=Stevilo, fill=spol)) +
  geom_bar(stat = 'identity', position = 'dodge') +
  xlab("Starost") + ylab("Število")+ ggtitle("Graf priseljenih Slovencev po letih") + coord_flip()

funkcija.bdp <- function() {
  podatki <- bdp %>% drop_na(3)
  podatki$BDP <- parse_number(podatki$BDP)
  povprecje <- podatki %>% group_by(Drzava) %>% summarise(Povprecje.bdp = mean(BDP)) %>% arrange(desc(Povprecje.bdp))
  return(povprecje)
}
graf_bdp <- ggplot(data = funkcija.bdp(), mapping = aes(x=reorder(Drzava, Povprecje.bdp) ,y=Povprecje.bdp,
                                                            fill=Drzava)) +
  geom_bar(stat = 'identity', position = 'dodge', show.legend = FALSE) +
  xlab("Država") + ylab("BDP") + ggtitle("Povprečni BDP po Evropskih državah") + coord_flip()

graf.odseljeni.prebivalci <- ggplot(data=odseljeni.prebivalci %>% group_by(drzava, drzavljanstvo) %>% summarise(Stevilo=sum(stevilo)),
       aes(x = drzava, y = Stevilo, fill = drzavljanstvo)) +
  geom_bar(stat = 'identity', position = 'dodge') +
  xlab("Država") + ylab("Število") + ggtitle("Odseljeni prebivalci glede na državljanstvo") +
  coord_flip()

#naredil graf v katerem se vidi iz katerih držav je prišlo največ ljudi z določeno izobrazbo.
#npr. iz Bosne in Hercegovine je prišlo največ ljudi - tako s srednešolsko kot tudi z osnovnošolsko izobrazbo.

graf.priseljeni.prebivalci.izo <- ggplot(data=priseljeni.prebivalci %>% group_by(drzava, izobrazba) %>% summarise(Stevilo=sum(stevilo)),
       aes(x = drzava, y = Stevilo, fill = izobrazba)) +
  geom_bar(stat = 'identity', position = 'dodge') +
  xlab("Država") + ylab("Število") +
  ggtitle("Priseljeni prebivalci glede na izobrazbo") +
  coord_flip()

graf.odseljeni.prebivalci.izo <- ggplot(data=odseljeni.prebivalci %>% group_by(drzava, izobrazba) %>% summarise(Stevilo=sum(stevilo)),
                                     aes(x = drzava, y = Stevilo, fill = izobrazba)) +
  geom_bar(stat = 'identity', position = 'dodge') +
  xlab("Država") + ylab("Število") +
  ggtitle("Odseljeni prebivalci glede na izobrazbo") +
  coord_flip()

#probal bom narisati zemljevid iz kje  kerih občin se je največ Slovencev izselilo,
#in v katere občine se je največ Slovencev priselilo.

odseljeni.obcine <- selitveno.gibanje %>% filter(vrsta == "Odseljeni v tujino") %>%
                              group_by(obcina) %>% summarise(vsota=sum(stevilo))

odseljeni.obcine[["obcina"]] <- factor(odseljeni.obcine[["obcina"]])

priseljeni.obcine <- selitveno.gibanje %>% filter(vrsta == "Priseljeni iz tujine") %>%
                              group_by(obcina) %>% summarise(vsota=sum(stevilo))
priseljeni.obcine[["obcina"]] <- factor(priseljeni.obcine[["obcina"]])

razlika.obcine <- prebivalstvo %>%
  inner_join(priseljeni.obcine) %>% rename(priseljeni=vsota) %>%
  inner_join(odseljeni.obcine) %>% rename(odseljeni=vsota) %>%
  mutate(priseljeni=priseljeni/stevilo, odseljeni=odseljeni/stevilo) %>%
  mutate(razlika=priseljeni-odseljeni)

razlika.obcine[["obcina"]] <- factor(razlika.obcine[["obcina"]])

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