########
## Utilities for fft fringe analysis
########

.up2 <- function(nr, nc=nr) 2^(ceiling(log2(max(nr,nc))))

## FFT fit routine
#
## parameters:
## FFT fit routine
#
## parameters:
#
#	imagedata: matrix containing greyscale values of interferogram image
#	cp: a list with components (xc, yc, rx, ry, obstruct) describing pupil parameters
#	fringescale: scale factor for fringes: 1 for single pass, .5 for double
#	sl: approximate location of desired sidelobe in the form c(x,y)
#	filter: size of filter around DC
#	taper: amount to taper edge of half plane cut
#	zlist: Zernikes to fit. Defaults to order 14
#	zc0: Zernikes we want zeroed. Defaults to tilts, defocus, and coma
#	satarget: SA term for desired asphere, if appropriate
#	astig.bath: astigmatism due to Bath geometry
#	puw.alg: phase unwrapping algorithm

fftfit <- function(imagedata, cp=NULL,
                   sl=c(1,1), filter=NULL, taper=2, options = psfit_options()) {

  nr <- nrow(imagedata)
  nc <- ncol(imagedata)
  npad <- nextn(max(nr,nc))
  if (!is.null(cp)) {
    prt <- pupil.rhotheta(nr, nc, cp)
    imagedata[is.na(prt$rho)] <- mean(imagedata)
  }
  imagedata <- imagedata-mean(imagedata)
  im <- padmatrix(imagedata, npad=npad, fill=0)
  im.fft <- fftshift(fft(im))
  if (is.null(filter)) {
    sldata <- pick.sidelobe(imagedata)
    sl <- sldata$sl
    filter <- sldata$filter
  }
  if (filter > 0) {
    xs <- 2*(-(npad/2):(npad/2-1))/filter
    rho2 <- outer(xs, xs, function(x,y) x^2+y^2)
    im.fft <- im.fft*(1-exp(-rho2/2))
  }
  sl <- round(sl) #round sidelobe position to integer values
  ## decide which half plane to 0
  sfilter <- matrix(1,npad,npad)
  if (sl[1] == 0) {
    if (sl[2] > 0) {
      sfilter[, 1:(npad/2+1)] <- 0
    } else {
      sfilter[, (npad/2+1):npad] <- 0
    }
  } else if (sl[2] == 0) {
    if (sl[1] > 0) {
      sfilter[1:(npad/2+1),] <- 0
    } else {
      sfilter[(npad/2+1):npad,] <- 0
    }
  } else {
    dydx <- -sl[1]/sl[2]
    xcut <- (1:npad)-(npad/2+1)
    ycut <- (npad/2+1) + round(dydx*xcut)
    ycut[ycut<1] <- 1
    ycut[ycut>npad] <- npad
    if (sl[2] > 0) {
      for (i in 1:npad) sfilter[i, 1:ycut[i]] <- 0
    } else {
      for (i in 1:npad) sfilter[i, ycut[i]:npad] <- 0
    }
  }
  im.fft <- im.fft*gblur(sfilter, fw=taper)
  sl.fft <- matrix(0, npad, npad)
  xmin <- max(1-sl[1], 1)
  xmax <- min(npad-sl[1], npad)
  ymin <- max(1-sl[2], 1)
  ymax <- min(npad-sl[2], npad)
  sl.fft[xmin:xmax, ymin:ymax] <- im.fft[(sl[1]+(xmin:xmax)),(sl[2]+(ymin:ymax))]
  if (options$plots) {
    plot.cmat(submatrix(sl.fft, size=npad/2))
  }
  cphase <- fft(fftshift(sl.fft), inv=TRUE)[1:nr, 1:nc]
  phase <- Arg(cphase)
  mod <- Mod(cphase)
  mod <- mod/max(mod)
  if (is.null(cp)) {
    cp <- circle.pars(mod, plot=options$plots)
  }
  cp.orig <- cp
  if (options$crop) {
    mod <- crop(mod, cp)$im
    phase <- crop(phase, cp)
    cp <- phase$cp
    phase <- phase$im
  }
  nr <- nrow(phase)
  nc <- ncol(phase)
  prt <- pupil.rhotheta(nr, nc, cp)
  phase[is.na(prt$rho)] <- NA
  class(phase) <- "pupil"
  wf.raw <- switch(options$puw_alg,
                   qual = qpuw(phase, mod),
                   brcut = brcutpuw(phase),
                   qpuw(phase, mod)
  )
  wf.raw <- options$fringescale*wf.raw
  class(wf.raw) <- "pupil"
  wf.nets <- wf_net(wf.raw, cp, options)
  outs <- list(phi=phase, mod=mod, cp=cp,cp.orig=cp.orig,
       wf.net=wf.nets$wf.net, wf.smooth=wf.nets$wf.smooth,
       wf.residual=wf.nets$wf.residual, fit=wf.nets$fit, zcoef.net=wf.nets$zcoef.net)
  class(outs) <- append(class(outs), "wf_fitted")
  outs
}


DL = function(y,sW){
k          = length(y)
w = sW^2
sum.w      = sum(w)
mu.hat     = sum(y*w)/sum.w
W          = sum.w - (sum(w^2)/sum.w)
Q          = sum(w*(y-mu.hat)^2)
typS       = sum(w*(k-1))/(sum.w^2 - sum(w^2))
Qp         = 1-pchisq(Q,k-1)

tausq.hat  = max(0,(Q-(k-1))/W)
w.tauhat   = 1/((1/w)+tausq.hat)

return(tausq.hat)

}

eff <- c(0.1, 0.2, 0.21, 0.5, 0.3)
se <- c(0.02, 0.3, 0.03, 0.07, 0.1)

a <- rma(yi=eff, sei=se, method="FE")
b <- rma(yi=eff, sei=se, method="DL")

DL = function(y=logHR, s = se.logHR)
{
	k            = length(y)
	w            = 1/s^2
	sum.w        = sum(w)
	mu.hat       = sum(y*w)/sum.w
	W            = sum.w - (sum(w^2)/sum.w)
	Q            = sum(w*(y-mu.hat)^2)
	typS         = sum(w*(k-1))/(sum.w^2 - sum(w^2))
	Qp           = 1-pchisq(Q,k-1)

	# fixed effects estimate

	Var.muhat    = 1/sum(w)
	muFE.CI      = mu.hat + c(-1.96,1.96)*sqrt(Var.muhat)
	Zfe          = (mu.hat)/sqrt(Var.muhat)
	FEp          = 2*(1 - pnorm(abs(Zfe)))

	# DL random effects estimate

	tausq.hat    = max(0,(Q-(k-1))/W)
	w.tauhat     = 1/(s^2+tausq.hat)
	mu.tau.hat   = sum(w.tauhat*y)/sum(w.tauhat)
	Var.mutauhat = 1/sum(w.tauhat)
	muRE.CI      = mu.tau.hat + c(-1.96,1.96)*sqrt(Var.mutauhat)
	Isq          = tausq.hat/(tausq.hat+typS)
	Zre          = (mu.tau.hat)/sqrt(Var.mutauhat)
	REp          = 2*(1 - pnorm(abs(Zre)))

	sum.wre      = sum(w.tauhat)

	summary      = c(k,Q,Qp,(100*Isq),mu.hat,muFE.CI,
	                 FEp,mu.tau.hat,muRE.CI,REp)

	out = list(
		fe=mu.hat,
		fe_se = sqrt(Var.muhat),
		re=mu.tau.hat,
		re_se = sqrt(Var.mutauhat)
	)

	return(out)
}

DL(eff, se)

rs1100405       t       c       -0.0178 0.0132  0.177   +--     0.0     0.388   2       0.8237  0.01514304      0.02311397      0.9879

CHR	POS	SNP	N	EFFECT_ALLELE	NON_EFFECT_ALLELE	EFFECT_ALLELE_FREQ	BETA	SE	r2	r2hat	P_VAL
7	43517495	rs1100405	1467	4	2	0.342195	0.00101	0.03945	4.47e-07	0.996	0.9798

CHR POS SNP STRAND EFFECT_ALLELE NON_EFFECT_ALLELE FREQ_EFFECT N BETA SE r2 PVALUE r2hat
7 43517495 rs1100405 + C T 0.665 1233 0.023 0.016 0.00152 0.1674 0.9958

SNP	CHR	POS	Rsq	AL1	AL2	FREQ1	TRAIT	EFFECT	SE	H2	LOD	PVALUE
rs1100405	7	43517495	0.9986	C	T	0.666	glucose_ND	0.011	0.029	0.008	0.032	0.7029

library(metafor)

rma(y=c(-0.00101, 0.023, 0.011), sei=c(0.03945, 0.016, 0.029), method="FE")
rma(y=c(-0.00101, 0.023, 0.011), sei=c(0.03945, 0.016, 0.029), method="DL")

DL(c(-0.00101, 0.023, 0.011), c(0.03945, 0.016, 0.029))

rs2433681       a       g       -0.0149 0.0225  0.5072  -+-     68.2    6.297   2       0.04292 -0.03706755     0.04442108      0.9704

CHR	POS	SNP	N	EFFECT_ALLELE	NON_EFFECT_ALLELE	EFFECT_ALLELE_FREQ	BETA	SE	r2	r2hat	P_VAL
2	169498916	rs2433681	1467	1	3	0.0978187	-0.1559	0.06133	0.004391	0.946	0.0118

CHR POS SNP STRAND EFFECT_ALLELE NON_EFFECT_ALLELE FREQ_EFFECT N BETA SE r2 PVALUE r2hat
2 169498916 rs2433681 + G A 0.926 1233 -0.014 0.029 0.00018 0.6296 0.9918

SNP	CHR	POS	Rsq	AL1	AL2	FREQ1	TRAIT	EFFECT	SE	H2	LOD	PVALUE
rs2433681	2	169498916	0.967	G	A	0.894	glucose_ND	0.009	0.044	0.002	0.008	0.8466

rma(y=c(-0.1559, 0.014, -0.009), sei=c(0.06133, 0.029, 0.044), method="FE")
rma(y=c(-0.1559, 0.014, -0.009), sei=c(0.06133, 0.029, 0.044), method="DL")


library(Seurat)
library(cowplot)
library(data.table)
library(future)
library(magrittr) # needs to be run every time you start R and want to use %>%
library(dplyr)

seurat_recipet = function(expr){
expr_obj = CreateSeuratObject(expr)
expr_obj = NormalizeData(expr_obj, normalization.method = "LogNormalize", scale.factor = 10000)
expr_obj = ScaleData(expr_obj)
expr_obj = FindVariableFeatures(expr_obj, selection.method = "vst", nfeatures = 2000)
expr_obj = RunPCA(expr_obj, features = VariableFeatures(object = expr_obj), npcs = 100)
expr_obj
}

write_csv = function(vec, fn){write.table(vec, file = fn, append = FALSE, quote = FALSE, sep = ",",
                eol = "\n", na = "NA", dec = ".", row.names = TRUE,
                col.names = TRUE, qmethod = c("escape", "double"),
                fileEncoding = "")}

exprs=read.table('GSE150903_sub.csv', row.names=1, header=T , check.names = F)
exprs=t(exprs)

meta=read.csv('GSE150903/meta.tsv', sep = '\t')

abrain = seurat_recipet(exprs)
Idents(abrain) = meta$Cluster
abrain.markers=FindAllMarkers(object = abrain)

saveRDS(abrain.markers, file = "seurat.marker.list.rds")
topgene=abrain.markers %>% group_by(cluster) %>% top_n(n = 10, wt = avg_logFC)
write_csv(topgene, 'seurat_topgene.csv')
write_csv(as.data.frame(abrain.markers), 'seurat_markers.csv' )


#===============================================================
# Estimate ideologies by projecting the users (rows) onto the
# ideological subspace created from the previous script.
# Normalize the ideological values to facilitate analysis.
#
# This script assumes:
#  - adjacency matrix stored in adj_matrix.Rdata
#  - correspondence analysis result stored in correspondence.Rdata
#===============================================================

library(Matrix)
load("adj_matrix.Rdata")  # matrix y
load("correspondence.Rdata")  # matrix res

#===============================================================
# COLUMN PROJECTIONS
# This is mostly unnecessary, because we did not do a second
# stage census to gather additional political accounts. Due
# to this, there are no additional columns to project onto the
# original subspace.
#
# We keep this section to remain consistent with the original
# authors' work.
#===============================================================

col.df <- data.frame(
    colname = res$colnames,
    coord1 = res$colcoord[,1],
    coord2 = res$colcoord[,2],
    coord3 = res$colcoord[,3],
    stringsAsFactors = FALSE)

save(col.df, file = "col_coord.Rdata")

#===============================================================
# ROW PROJECTIONS
# This part is actually necessary. Because we identified the
# ideological subspace as those users who follow at least 5
# political accounts, we now need to account for those who
# follow fewer than 5 (but still at least 1).
#
# To do this, we project all of the rows into the subspace
# created by the correspondence analysis. Some rows already
# exist in the subspace (those users who follow 5 or more
# politicians), but the projection for them is simply the
# identity.
#===============================================================

load("adj_matrix.Rdata")  # reloads entire y
load("col_coord.Rdata")

# We can only project users who follow at least one of our politicians.
y <- y[rowSums(y)>0,]  # (472,985 x 443)

# Load column coordinates, but remove labels (443 x 3)
colcoords <- matrix(as.matrix(col.df[,2:4]), ncol=3)
gam.00 <- colcoords  # (443 x 3)

# Compute column masses
colmasses <- colSums(y) / sum(y)
cs <- colmasses  # length 443

# Matrix of singular values (472985, 3)
# [[sigma1, sigma2, sigma3],
#  [sigma1, sigma2, sigma3],
#             ...          ]
svphi <- matrix(res$sv[1:3], nrow = nrow(y), ncol = 3, byrow = TRUE)

points <- as.matrix(y) * 1  # (472985 x 443), and the *1 coerces to numeric
rs.sum <- rowSums(points)  # length 472985

# Normalize points so that rows sum to 1, then transpose (so columns sum to 1)
base2 <- points / matrix(rs.sum, nrow = nrow(points), ncol = ncol(points))
base2 <- t(base2)

# Prepare to project
cs.0 <- matrix(cs, nrow = nrow(base2), ncol = ncol(base2))  # (443 x 472985)
base2 <- base2 - cs.0  # (443 x 472985)

# Do the projection
# t(as.matrix(base2)) has dim (472985 x 443); gam.00 has dim (443 x 3)
# multiplying gives (472985 x 3); then divide by singular values svphi
phi <- t(as.matrix(base2)) %*% gam.00 / svphi
row.df <- phi

# Save projection matrix
row.df <- data.frame(
    rowname = rownames(y)[1:nrow(row.df)],
    coord1 = row.df[,1],
    coord2 = row.df[,2],
    coord3 = row.df[,3],
    sum = rowSums(y),
    stringsAsFactors = FALSE)

save(row.df, file = "row_coord.Rdata")

#===============================================================
# NORMALIZATION
# Combine estimates of ideology for both rows (users) and
# columns (politicians). This takes advantage of the structure
# of the analysis, allowing us to use the same correspondence
# analysis for two groups of people.
#
# Normalize both sets of estimates; users should be normally
# distributed on N(0, 1), while politicians should have sd = 1.
#
# Combine them, then save the output.
#===============================================================

# First, normalize the row estimates
load("row_coord.Rdata")  # reload row.df

# First singular value represents ideology
users <- row.df
names(users)[c(1, 2)] <- c("id", "ideology")

# Keep relevant values
users <- users[, c("id", "ideology", "sum")]
users$type <- "users"
users$party <- ""

# Rescale to N(0, 1). Sort the users by their ideology first, then generate
# values from N(0, 1), sort those, and assign them in turn to each user.
users2 <- users[order(users$ideology + rnorm(length(users$ideology), 0, 0.05)),]

p <- rnorm(nrow(users), 0, 1)
p <- sort(p)
users2$ideology <- p

users <- users[,c("id", "ideology", "type", "party", "sum")]

# Next, normalize column estimates
load("col_coord.Rdata")  # reload col.df

# Set up columns
col.df$id <- col.df$colname
col.df$ideology <- col.df$coord1
col.df$sum <- 0
col.df$party <- ""
col.df$type <- "politicians"

# Keep columns of interest
politicians <- col.df[,c("id", "ideology", "type", "party", "sum")]

# Rescale column ideologies to have standard deviation 1.
# (Note res$rowcoord[,1] used to have user ideologies, since those were the
# first singular values.)
ratio <- sd(politicians$ideology) / sd(res$rowcoord[,1])
politicians$ideology <- politicians$ideology / ratio

# Combine datasets
estimates <- rbind(politicians, users)
estimates <- estimates[!duplicated(estimates$id),]

# Ideologies are backwards, due to the reflectional invariance of the
# method we used. Multiply by -1 to make liberals have negative values (more
# "left") and Republicans positive ones.
estimates$ideology <- estimates$ideology * -1

save(estimates, file = "estimates.Rdata")


#Functions deep learning (Statistics Model)
library(caTools)
library(tidyverse)
library(dslabs)
library(ggplot2)
library(stringr)
library(lubridate)

options(digits = 10)
options(scipen=999)

FileAddress<-"C:/Users/ajzan/Documents/GitHub/Tesouro-Direto/DataBase/"
setwd(FileAddress)

DataBase<-read.table(paste(getwd(),"CompletedDataBase.txt", sep="/"),header = TRUE, sep="\t", dec=",")
#convert factor to date
DataBase[,2]<-as.Date(DataBase[,2])

head(DataBase)

TitulosNames<-unique(DataBase[,1])
length(TitulosNames)
DataBase <- mutate(DataBase, ClassTitulos = substring(Titulos.e.Vencimento, 1,str_locate(pattern=" ", Titulos.e.Vencimento)[,1]-1))
DataBase <- mutate(DataBase, Vencimento = dmy(substring(Titulos.e.Vencimento, str_locate(pattern=" ", Titulos.e.Vencimento)[,1]+1,nchar(as.character(Titulos.e.Vencimento)))))

#function for LFT
LFT_Interest<- function(DataBase, DataVencimento){
DataVencimento = ymd(as.character("2021-03-01"))
DataBase<-DataBase %>% filter (ClassTitulos=="LFT", Vencimento == DataVencimento) %>% mutate(PU.Venda.Ant = lag(PU.Venda,1), TaxaAnual=((PU.Venda/PU.Venda.Ant)^252-1)*100) %>% select (ClassTitulos, Vencimento, Data, PU.Venda, TaxaAnual) %>% filter(!is.na(TaxaAnual)) %>% distinct(Data, .keep_all = TRUE)
#head(DataBase)

#DataBase %>%
#  ggplot(aes(x = Data, y = TaxaAnual)) +
#  geom_line() +
#  geom_smooth(method = "loess")

}

Analise Base de Dados dos Titulos Serie Temporal.r


#' GCx of a list of genes
#'
#' Calculates the GC1,2,3 and GC12 contents of a list of genes
#'
#' @param x a list of KZsqns objects.
#' @param pos the position of the codon for which GCx is calculated. 1: GC1; 2:GC2; 3: GC3; 4:GC12
#' @return a matrix of the GCx of the list of genes
#' @examples
#'
#' @export

gcx <- function(x, pos=1){
  if(!is.list(x)){
    cat("Just one perhap very long sequence?\n")
    x = list(x)
  }
  ans = matrix(0, length(x), 1)
  rownames(ans) <- paste0('s_', 1:length(x))
  indx = c(T,T,T)
  adj = 1
  switch(as.character(pos),
         '1' = {
           indx[2:3] = F
           colnames(ans) <- 'GC1'
         },
         '2' = {
           indx[c(1,3)] = F
           colnames(ans) <- 'GC2'
         },
         '3' = {
           indx[1:2] = F
           colnames(ans) <- 'GC3'
         },
         '4' = {
           indx[3] = F
           colnames(ans) <- 'GC12'
           adj = 2
         },
         {
           stop("Not a valid pos value")
         })
  for(i in 1:length(x)){
    temp = table(strsplit(paste0(paste(x[[i]],collapse = ''), 'GGGCCC', sep=''), split = '')[[1]][indx])
    ans[i,1] = (temp["G"] + temp["C"] - 2*adj)/length(x[[i]])/adj
  }
  return(ans)
}


#' Banded Matrices
#'
#' @description
#' Storage and methods for banded matrices.
#'
#' @import methods
#'
#' @useDynLib band,
#' R_tobanded, R_tomatrix_fromband, R_tomatrix_fromsym, R_tosymmetric,
#' R_symmetrize,
#' R_matprinter,
#' R_xpose_band, R_xpose_full,
#' R_isSym_band, R_isSym_full,
#' R_eig_sympacked, R_eig_full
#'
#' @docType package
#' @name band-package
#' @author Drew Schmidt
#' @keywords package
NULL


# 4. faza: Analiza podatkov

zemljevid.slovenije <- function(n) {
  podatki.zemljevid <- razlika.obcine %>% mutate(obcina=parse_factor(obcina, levels(zemljevid$OB_UIME)))
  podatki.zemljevid.norm <- podatki.zemljevid %>% select(priseljeni, odseljeni)%>% scale()
  rownames(podatki.zemljevid.norm) <- podatki.zemljevid$obcina
  k <- kmeans(podatki.zemljevid.norm, n, nstart=1000)
  skupina <- data.frame(obcina=podatki.zemljevid$obcina, skupina=factor(k$cluster))
  print(ggplot() + geom_polygon(data=left_join(zemljevid,skupina,
                                            by=c("OB_UIME"="obcina")),
                                aes(x=long, y=lat, group=group,
                                    fill=skupina)) + xlab("") + ylab(""))
}

meddrzavne.priseljeni <- meddrzavne.selitve.vsi %>%
  filter(starost=="Starostne skupine - SKUPAJ") %>%
  filter(spol=="Spol - SKUPAJ") %>%
  filter(vrsta=="Priseljeni iz tujine")

meddrzavni.priseljeni <- function() {
  don<-xts(x = meddrzavne.priseljeni$stevilo, order.by=as.yearqtr.default(meddrzavne.priseljeni$leto))
  dygraph(don) %>%
    dyOptions(labelsUTC = TRUE, fillGraph=TRUE, fillAlpha=0.1, drawGrid = FALSE, colors="#D8AE5A") %>%
    dyRangeSelector() %>%
    dyCrosshair(direction = "vertical") %>%
    dyShading(from = "2007-1-1", to = "2009-1-1", color = "#CCEBD6") %>%
    dyHighlight(highlightCircleSize = 5, highlightSeriesBackgroundAlpha = 0.2, hideOnMouseOut = FALSE)  %>%
    dyRoller(rollPeriod = 1) %>%
    dySeries("V1", label = "Število priseljenih")
}

graf.obcin <- function(ime, naloga){
  if(naloga=="Priseljeni"){
    zenske <- selitveno.gibanje %>% filter(vrsta=="Priseljeni iz tujine" &
                                           obcina==ime & spol=="Ženske")
    moski <- selitveno.gibanje %>% filter(vrsta=="Priseljeni iz tujine" &
                                          obcina==ime & spol=="Moški")
  }
  if(naloga=="Izseljeni"){
    zenske <- selitveno.gibanje %>% filter(vrsta=="Odseljeni v tujino" &
                                             obcina==ime & spol=="Ženske")
    moski <- selitveno.gibanje %>% filter(vrsta=="Odseljeni v tujino" &
                                            obcina==ime & spol=="Moški")
  }
  moski$stevilo <- moski$stevilo + zenske$stevilo
  don<-xts(x = moski$stevilo, order.by=as.yearqtr.default(moski$leto))
  dygraph(don) %>%
    dyOptions(labelsUTC = TRUE, fillGraph=TRUE, fillAlpha=0.1,
              drawGrid = FALSE, colors="#D8AE5A") %>%
    dyCrosshair(direction = "vertical") %>%
    dyHighlight(highlightCircleSize = 5, highlightSeriesBackgroundAlpha = 0.2,
                hideOnMouseOut = FALSE)  %>%
    dyRoller(rollPeriod = 1) %>%
    dySeries("V1", label = "Število")
}

#Brez veze... nič se ne vidi.
#library(ggplot2)
#library(plotly)
#library(gapminder)

#p <- meddrzavne.selitve.vsi %>%
#   filter(starost != "Starostne skupine - SKUPAJ" & starost != "Povprečna starost") %>%
#   filter(spol=="Spol - SKUPAJ") %>%
#   ggplot( aes(stevilo, leto, size = stevilo, color=starost)) +
#   geom_point() +
#   theme_bw()
#
# ggplotly(p)


# Dexter Barrows
#
# IF2 parametric bootstrapping function

library(foreach)
library(parallel)
library(doParallel)
library(Rcpp)

if2_spa_paraboot <- function(if2data_parent, T, Tlim, steps, N, nTrials, if2file, stoc_sir_file, NP, nPasses, coolrate, neinum, neibmat) {

	nloc <- length(neinum)

	source(stoc_sir_file)
	#print(stoc_sir_file)

	if(nTrials < 2) {
		nTrials <- 2
	}

	# unpack if2 first fit data

	# ...parameters
	paramdata_parent <- data.frame( if2data_parent$paramdata )
	names(paramdata_parent) <- c("R0", "r", "sigma", "eta", "berr", "phi")
	parmeans_parent <- colMeans(paramdata_parent)
	names(parmeans_parent) <- names(paramdata_parent)

	# ...intital infected
	Iinitdata_parent <- data.frame( if2data$initInfec )
	Iinitmeans_parent <- rowMeans(Iinitdata_parent)

	# ...states
	statedata_parent <- data.frame( if2data_parent$finalstate )
	names(statedata_parent) <- c("S","I","R","B")
	#statemeans_parent <- colMeans(statedata_parent)
	#names(statemeans_parent) <- names(statedata_parent)

	## use parametric bootstrapping to generate forcasts
	##
	trajectories <- foreach( i = 1:nTrials, .combine = list, .packages = "Rcpp") %dopar% {

		source(stoc_sir_file)

		## draw new data
		##

		pars <- with( as.list(parmeans_parent),
		              c(R0 = R0,
	          			r = r,
	          			N = N,
	          			eta = eta,
	          			berr = berr,
	          			phi = phi) )

		init_cond <- with( as.list(parmeans_parent),
		                   matrix(c(500 - Iinitmeans_parent, Iinitmeans_parent, rep(0, nloc)), nloc, 3) )
		colnames(init_cond) <- c("S", "I", "R")

		# generate trajectory
		ssdeout <- StocSSIR(init_cond, pars, Tlim, steps, neinum, neibmat)
		colnames(ssdeout) <- c('S','I','R','B')

		# add noise
	    counts_raw 	<- ssdeout[,'I',] + matrix( rnorm(nloc*(Tlim+1), 0, parmeans_parent[['sigma']]), nloc, Tlim+1)
		counts 		<- ifelse(counts_raw < 0, 0, counts_raw)

	    ## refit using new data
	    ##

	    rm(if2_spa) # because stupid things get done in packages
	    sourceCpp(if2file)
	    if2time <- system.time( if2data <- if2_spa(counts, Tlim+1, N, NP, nPasses, coolrate, neinum, neibmat, nloc) )

	    paramdata <- data.frame( if2data$paramdata )
		names(paramdata) <- c("R0", "r", "sigma", "eta", "berr", "phi")
		parmeans <- colMeans(paramdata)
		names(parmeans) <- names(paramdata)

		## generate the rest of the trajectory
		##

		# pack new parameter estimates
		pars <- with( 	as.list(parmeans),
		              c(R0 = R0,
	          			r = r,
	          			N = N,
	          			eta = eta,
	          			berr = berr,
	          			phi = phi) )

		init_cond <- as.matrix(statedata_parent[,c("S", "I", "R")])

		# generate remaining trajectory part
		ssdeout_future <- StocSSIR(init_cond, pars, T-Tlim, steps, neinum, neibmat)
		colnames(ssdeout_future) <- c('S','I','R','B')

		return ( list(  counts = unname(ssdeout_future[,'I',]),
		       	    	parmeans = parmeans,
		       	    	time = if2time[['user.self']]) )

	}

	return(trajectories)

}


#' @title nodeSize
#' @description Computes size of vertices
#' @details Computes size of vertices based on some importance algorithm such as \code{\link[igraph]{page.rank}}
#' @aliases nodeSize
#' @export nodeSize
#' @author Jared P. Lander
#' @importFrom igraph page.rank "V<-" V
#' @param graph An igraph object
#' @param func A function that returns a cluster membership for each node
#' @param \dots Further arguments for \code{func}
#' @return A graph with a new Vertex slot 'axis' that stores the cluster membership
#' @examples
#' data(flights)
#' library(igraph)
#' g <- graph.data.frame(flights, directed=TRUE)
#' g2 <- nodeSize(g)
#' V(g2)$nodeSize
#'
nodeSize <- function(graph, func=page.rank, ...)
{
    size <- func(graph, ...)

    if(class(size) == 'list')
    {
        size <- size$vector
    }

    V(graph)$nodeSize <- size

    return(graph)
}


# R, Yelp and the Search for Good Indian Food

# Explore the `reviews` data eset with `summary()`
summary(reviews)

# Explore the `users` data set with `summary()`
summary(users)

# Explore the `businesses` data set with `summary()`
summary(businesses)

# Make dplry package avaiable to use
library(dplyr)

# Combine the reviews and users data sets
ru  <- inner_join(reviews, users)

# combine the newly created data set with the businesses data set
rub <- inner_join(ru, businesses)

# Take a look at the combined data frame
summary(rub)

# Create indian review column
rub$is_indian <- grepl("Indian", rub$categories) == TRUE

# Select only reviews for Indian restaurants
indian <- subset(rub, is_indian == TRUE)

# The package dplyr is available ot use
# Generate a new data frame with the number of reviews by each reviewer
number_reviews_indian <- indian %>%
  select(user_id,user_name) %>%
  group_by(user_id) %>%
  summarise(total_reviews = n())

# Print the table of total_reviews
table(number_reviews_indian$total_reviews)

# Pring the average number of reviews per users
mean(number_reviews_indian$total_reviews)

# The package dplyr is available to use
# Combine number of Indian reviews with original data frame of Indian restaurant reviews
indian_plus_number <- inner_join(indian,number_reviews_indian)

# Display column names for the new data frame
names(indian_plus_number)

# Generate weighted_stars variable
indian_plus_number$weighted_stars <- indian_plus_number$stars * indian_plus_number$total_reviews

# Create a new weighted review for each restaurant (Note: package dplyr is available to use)
new_review_indian <- indian_plus_number %>%
  select(city, business_name, avg_stars, stars, total_reviews, weighted_stars) %>%
  group_by(city, business_name, avg_stars) %>%
  summarize(cnt = n(),
            avg = sum(stars) / cnt,
            new = sum(weighted_stars) / sum(total_reviews),
            diff = new - avg)

# Load the ggplot2 package into the environment
library(ggplot2)

# Plot the distribution of changes to reviews
hist(new_review_indian$diff, main = "Changes in Star Reviews", xlab = "Change")

# Plot the changes in review per restaurant
ggplot(new_review_indian, aes(x=1:nrow(new_review_indian), y=diff, fill=city)) +
    geom_bar(stat="identity", position=position_dodge()) +
    theme_classic() + scale_fill_grey() + xlab("Businesses ID") + ylab("Change in Star Review")

# Display a summary of the
summary(new_review_indian)

# Section 2 - Authenticity Ratings

R Yelp and the Search for Good Indian Food.r


source("./utils.r")
comm.set.seed(1234, diff=TRUE)
if (storage == "float")
  comm.stop("float not supported for k-means")

centers = c(0, 2, 10)
k.true = length(centers)

generator = function(m, n, centers)
{
  data = matrix(0.0, m, n)
  for (i in 1:m)
    data[i, ] = rnorm(n, mean=sample(centers, size=1))

  data
}

generator = compiler::cmpfun(generator)
data = generator(m.local, n, centers)
m = m.local * comm.size()
x = shaq(data, m, n, checks=FALSE)

time = comm.timer(lapply(2:4, function(k) km(x, k=k, seed=1234, maxiter=2)))

comm.print(time)

finalize()


# standardize_data generic function ----
standardize_data <- function(data, center = TRUE, scale = TRUE, ...) UseMethod("standardize_data", data)

# standardize_data data.frame method ----
standardize_data.data.frame <- function(data, center = TRUE, scale = TRUE, ...) {

  # run checks ----
  if (!is.logical(center)) {
    center <- TRUE
    warning("center must be a logical value! Default for center is TRUE.")
  }
  if (!is.logical(scale)) {
	scale <- TRUE
	warning("scale must be a logical value! Default for scale is TRUE.")
  }

  # run standardization ----
  numeric_vars <- unlist(lapply(data, is.numeric))
  scaled_data <- scale(data[,numeric_vars], center = center, scale = scale)
  out <- cbind.data.frame(scaled_data, data[,!numeric_vars])

  # return output ----
  if (requireNamespace("tibble", quietly = TRUE)) {
	out <- tibble::as_tibble(out)
  }

  return(out)
}


library(matrixStats)
library(lubridate,warn.conflicts = FALSE)

make_country_csvs <- function() {
  args <- commandArgs(trailingOnly = TRUE)
  filename <- args[1]

  load(paste0("results/", filename))

  forecast_days = 7

  for(i in 1:length(countries)){
    N <- length(dates[[i]])
    N2 <- N + forecast_days
    country <- countries[[i]]

    raw_pred <- prediction[,1:N2,i]

    predicted_cases <- colMeans(raw_pred)
    predicted_cases_li = colQuantiles(raw_pred, probs=.025)
    predicted_cases_ui = colQuantiles(raw_pred, probs=.975)

    raw_deaths <- estimated.deaths[,1:N2,i]

    estimated_deaths <- colMeans(raw_deaths)
    estimated_deaths_li <- colQuantiles(raw_deaths, probs=.025)
    estimated_deaths_ui <- colQuantiles(raw_deaths, probs=.975)

    ddates <- as_date(as.character(dates[[i]]))
    ddates <- c(ddates, ddates[length(ddates)] + 1:forecast_days)

    raw_rt <- out$Rt_adj[,1:N2,i]

    rt <- colMeans(raw_rt)
    rt_li <- colQuantiles(raw_rt, probs=.025)
    rt_ui <- colQuantiles(raw_rt, probs=.975)

    raw_reported = reported_cases[[i]][1:N2]
    raw_deaths = deaths_by_country[[i]][1:N2]

    df <- data.frame(
      "time" = ddates,
      "country" = rep(country, N2),
      "reported_cases" = cumsum(raw_reported),
      "reported_deaths" = cumsum(raw_deaths),
      "predicted_cases" = cumsum(predicted_cases),
      "predicted_cases_min" = cumsum(predicted_cases_li),
      "predicted_cases_max" = cumsum(predicted_cases_ui),
      "estimated_deaths" = format(cumsum(estimated_deaths), scientific=FALSE),
      "estimated_deaths_min" = format(cumsum(estimated_deaths_li), scientific=FALSE),
      "estimated_deaths_max" = format(cumsum(estimated_deaths_ui), scientific=FALSE),
      "rt" = rt,
      "rt_min" = rt_li,
      "rt_max" = rt_ui
    )

    write.csv(
      df,
      paste0('results/country-', country, '.csv'),
      row.names=FALSE,
      na=""
    )
  }

}

make_country_csvs()


library(readr)
library(dplyr)
library("ROCR")

Total <- read_csv('Total_data.csv')
Expert <- read_csv('Expert_data.csv')

print('Total');glimpse(Total)
print('Expert');glimpse(Expert)

table(Total$`Offering Course Code`)
table(Expert$`Offering Course Code`)

################################################ Result evaluation function ################################################
results <- function(Mean_expert,Bias_Users,w=3){
# print('Cor')
x1=round(cor(Mean_expert,Bias_Users,method = "pearson"),2);
#     print(x1)

# print('RMSE')
x2=round(sqrt(mean((Mean_expert - Bias_Users)^2)),2);
#     print(x2)
Experts=ifelse(Mean_expert>=3,1,0)
Users=ifelse(Bias_Users>=w,1,0)
# print('AUC')
x3=round(as.double(performance(prediction(Users,Experts), 'auc')@y.values),2);
#     print(x3)
t=table(Users,Experts)
TN=t[1]
FP=t[2]
FN=t[3]
TP=t[4]

ACC=  round((TP+TN)/(TP + TN + FP + FN),2)
# print('sensitivity') ;
    tpr=round(TP/(TP + FN),2);
#     print(tpr)
# print('specificity') ;
    tnr=round(TN/(TN + FP),2);
#     print(tnr)

x=c(tpr,tnr,x3,ACC);
#     print(x)
write.table(t(c(x)), "clipboard", sep=" & ", row.names=FALSE, col.names=FALSE)
    return(c(x,x1,x2))
    }
################################################ reliability score function ################################################

scoreG <- function(x,a){    # reliability score function
     out <-  (2/(1+exp(-a*(x))))-1
    return(out)
    }
################################################ reward score function################################################
reward <- function(x,sigma,top){    # reward score function
     mu=0
    normal <- 1/(sqrt(2 * pi) * sigma) * exp(-((x - mu)^2/(2* sigma^2)))
    normal0 <- 1/(sqrt(2 * pi) * sigma) * exp(-(( - mu)^2/(2* sigma^2)))
    out <- top*(normal)
    return(out)
    }
################################################ punish score function################################################
punish <- function(x,sigma,top){    # punish score function
     mu=0
#     sigma= 0.5    #var(Total$Diff)/2=0.7502/2
    normal <- 1/(sqrt(2 * pi) * sigma) * exp(-((x - mu)^2/(2* sigma^2)))
    normal0 <- 1/(sqrt(2 * pi) * sigma) * exp(-(( - mu)^2/(2* sigma^2)))
    out <- top*(-normal0+normal)
    return(out)
    }
################################################ Resource Discrimination score function################################################
rdis <- function(x,eps,sigma){    # Resource Discrimination
     mu=0
    normal <- 1/(sqrt(2 * pi) * sigma) * exp(-((x - 3 - mu)^2/(2* sigma^2)))
    normal0 <- 1/(sqrt(2 * pi) * sigma) * exp(-(( - mu)^2/(2* sigma^2)))
    out <- (normal0-normal+eps)
    return(out)
    }
################################################ Trust score function ################################################

pntrust <- function(x,a){    # aprroved/reject score function
    out <-  (1/(.1+exp(-a*(x))))

    return(out)
    }
trust <- function(x,a){    # reliability score function
    out <-  (2/(1+exp(-a*(x))))-1
    return(out)
    }

c(
length(unique(Total$Resource_ID)),
length(unique(Total$User_ID)),
dim(Total)[1]
)

c(
length(unique(Expert$Resource_ID)),
length(unique(Total$User_ID[Total$Resource_ID %in% Expert$Resource_ID])),
length((Total$User_ID[Total$Resource_ID %in% Expert$Resource_ID]))
)

Mean_Users=vector()
k=1
for (i in Expert$Resource_ID)
    {
    Mean_Users[k]=mean(Total$Decision[Total$Resource_ID==i])
    k=k+1
    }
results(Expert$Decision,Mean_Users,3)

mean=Mean_Users
expert=Expert$Decision
models=data.frame(expert,mean)

Mean_Users=vector()
k=1
for (i in Expert$Resource_ID)
    {
    Mean_Users[k]=median(Total$Decision[Total$Resource_ID==i])
    k=k+1
    }
results(Expert$Decision,Mean_Users,3)

initial=1000
score <- function(x){    # reliability score function
     mu=0
    sigma= .75     #var(Total$Diff)/2=0.7502/2
    normal <- 1/(sqrt(2 * pi) * sigma) * exp(-((x - mu)^2/(2* sigma^2)))
    normal0 <- 1/(sqrt(2 * pi) * sigma) * exp(-(( - mu)^2/(2* sigma^2)))
    out <- 100*(normal-normal0/2) #
    return(out)
    }
Total_User_ID=unique(Total$User_ID)
Total_Resource_ID=unique(Total$Resource_ID)
############## Reliabity calculation
Moderating_Score=matrix(initial, nrow = length(Total_User_ID), ncol = 1)#initial
Resource_Quality=matrix(nrow = length(Total_Resource_ID), ncol = 1)
kr=1
moderation_NEUR_current=matrix(nrow = dim(Total)[1], ncol = 3)
for(i in Total_Resource_ID)
    {

        wsum=0;
        rsum=0

            for (j in Total$User_ID[Total$Resource_ID==i] )
            {
                kk=match(j,Total_User_ID)
                if(Moderating_Score[kk]>0)
                    {
                    rsum= rsum+ (Total$Decision[Total$User_ID==j &
                                         Total$Resource_ID==i])*
                                            Moderating_Score[kk]
                    wsum=wsum+Moderating_Score[kk]
                    }
            }
        rhat= rsum/wsum
        for (j in Total$User_ID[Total$Resource_ID==i] )
            {
                kk=match(j,Total_User_ID)
                Dr= rhat
                        ################ expert
                if(i %in% Expert$Resource_ID) {Dr=Expert$Decision[Expert$Resource_ID==i]}
                        ########################

                Moderating_Score[kk]=Moderating_Score[kk]+
                    score((Total$Decision[Total$User_ID==j &
                                     Total$Resource_ID==i]-Dr))
             if(Moderating_Score[kk]<=0) Moderating_Score[kk]=1

        }
        Resource_Quality[kr]=rhat
kr=kr+1
    }
####################################
RQ=data.frame(Resource_Quality)
RQ$Resource_ID =Total_Resource_ID

############################################ Evaluation

Test_Data_Resource_ID=unique(Expert$Resource_ID)
Test_Data_Users_Decision=matrix(0, nrow = length(Test_Data_Resource_ID), ncol = 3)
k=1
for (i in Test_Data_Resource_ID)
    {
    Test_Data_Users_Decision[k,1]=i
    Test_Data_Users_Decision[k,2]=Expert$Decision[Expert$Resource_ID==i]
    Test_Data_Users_Decision[k,3]=RQ$Resource_Quality[RQ$Resource_ID==i]
   k=k+1
    }
########################################################################
Expert_Decision=Test_Data_Users_Decision[,2]
Users_Decision=Test_Data_Users_Decision[,3]
results(Expert_Decision,Users_Decision)

write_csv(data.frame(Test_Data_Resource_ID,Users_Decision,Expert_Decision),'EM_out.csv')

results(Expert_Decision,Users_Decision)

Decision=Users_Decision
expert=Expert_Decision
Test=data.frame(Decision,expert)
Test$Colour="darkgreen"
Test$Colour[Test$Decision<3]="blue"

Test$shape=3
Test$shape[Test$Decision<3]=4
Test$shape[Test$Decision<3 & Test$expert>=3]=6
Test$shape[Test$Decision>=3 & Test$expert<3]=2
Test$class="tp"
Test$class[Test$expert<3 & Test$Decision<3]="tn"

Test$Colour[Test$expert>=3 & Test$Decision<3]="darkviolet"
Test$class[Test$expert>=3 & Test$Decision<3]="fn"

Test$Colour[Test$expert<3 & Test$Decision>=3]="red"
Test$class[Test$expert<3 & Test$Decision>=3]="fp"

y_p=5.5
library(ggplot2)
box_plot2 <- ggplot(Test, aes(x=as.factor(expert), y = Decision))
bx2=box_plot2 +
    geom_boxplot(outlier.colour = "white") +
    ylim(.5,y_p)+ ylab('Students\' Ratings')+ xlab('Instructors\' Ratings')+ ggtitle('(b) Current Model ')+
    geom_jitter(shape = Test$shape,
        color = Test$Colour,
        position = position_jitter(width = 0.31)) +
    theme_classic()

bx2

q_id=unique(Total$Resource_ID)#[1:16]
glimpse(q_id)
print('expert')
# Expert=subset(Expert,Expert$Resource_ID %in% q_id)
expert1=Expert[,c('Resource_ID','Decision')]
glimpse(expert1)

moderations=subset(Total,Resource_ID %in% q_id)[,c('Resource_ID','User_ID','Decision')]
glimpse(moderations)

u_id=unique(moderations$User_ID)
glimpse(u_id)

##################################### Initializing #####################################
reward0=500 # Initial reward point
rel_teta=.001 # Relibility function coef
maxrew=100
tp=vector()
tn=vector()
auc=vector()
cor=vector()
rmse=vector()

    N=length(u_id)+1
    ##################################### Variables #####################################
    Pos=matrix(0,nrow=N ,ncol= 1 ) # Users' Positive Ratings
    Neg=matrix(0,nrow=N ,ncol= 1 ) # Users' Negative Ratings
    Rew=matrix(reward0,nrow=N ,ncol= 1 ) # Users' Rewards
    W=matrix(scoreG(reward0,rel_teta),nrow=N ,ncol= 1 ) # Users' Reliability
    W[N]=1
    Trust= diag(N) #matrix(0,nrow=N ,ncol= N )
    A=matrix(0,nrow=N ,ncol= N ) # agreements btw users
    D=matrix(0,nrow=N ,ncol= N ) # disagreements btw users
    WT = (Trust %*% W) # Weight based on reliability and others Trust
    RA=matrix(0,nrow=length(q_id) ,ncol= 1 ) # number of agreements on Rj
    RD=matrix(0,nrow=length(q_id) ,ncol= 1 ) # number of disagreements on Rj
    Rhat=matrix(0,nrow=length(q_id) ,ncol= 1 ) # Inferred Decision on Rj
    RhatT=matrix(0,nrow=length(q_id) ,ncol= 1 ) # Inferred Decision on Rj
    RhatN=matrix(0,nrow=length(q_id) ,ncol= 1 ) # Number of Decision on Rj
    RhatW=matrix(0,nrow=length(q_id) ,ncol= 1 ) # Number of Decision on Rj

    kq=1
    for(i in q_id)
        {
        B= Trust %*% Trust
        tau=quantile(B[1:N-1,N],names = FALSE)[1]
        tauWT=quantile(WT,names = FALSE)[1]
        tauW=quantile(W,names = FALSE)[1]
        users=moderations$User_ID[moderations$Resource_ID==i]
        n=length(users)
        si=0
        wi=0
        Win= matrix(1,nrow= n,ncol=1) # collecting user reliability
        exclude= matrix(1,nrow= N,ncol=1) # removing those moderated this resource for trust propagation and keeping others
        exclude[N]=0
        for(j in 1:(n-1))
            {
            kj=match(users[j],u_id)
            exclude[kj]=0
            Win[j]=W[kj]
            Dj=moderations$Decision[moderations$User_ID==users[j] & moderations$Resource_ID==i]
            if (W[kj]>tauW & WT[kj]>tauWT &  B[kj,N]>=tau)
            {
#                 neg=sum(moderations$Decision[moderations$User_ID==users[j] & moderations$Resource_ID %in% q_id [1:kq]]<3)
#                 pos=sum(moderations$Decision[moderations$User_ID==users[j] & moderations$Resource_ID %in% q_id [1:kq]]>=3)
                if (Dj<3) {Neg[kj]= Neg[kj]+1; PN=(Pos[kj]+Neg[kj])/Neg[kj]}
                if (Dj>=3) {Pos[kj]= Pos[kj]+1;PN=(Pos[kj]+Neg[kj])/Pos[kj]}

                PNj=pntrust(PN,.5)
                si=si+Dj*(PNj*W[kj]); wi=wi+(PNj*W[kj])
                                RhatN[kq]= RhatN[kq]+1 # number of decisions
                                RhatW[kq]= wi # number of decisions

            }                                                                               ########################## DECISION
            for(l in users[(j+1):n])
                {
                kl=match(l,u_id)
                Dl=moderations$Decision[moderations$User_ID==l & moderations$Resource_ID==i]
                if ((Dl>= 3 &  Dj>=3) | (Dl< 3 &  Dj<3))
                {
                    A[kj,kl]= A[kj,kl]+1;A[kl,kj]= A[kl,kj]+1;
                    RA[kq]=RA[kq]+1
                }
                else
                {
                    D[kj,kl]= D[kj,kl]+1;D[kl,kj]= D[kl,kj]+1;
                    RD[kq]=RD[kq]+1
                }
            }
            if (i %in% Expert$Resource_ID)
                {
                Ej=Expert$Decision[Expert$Resource_ID==i]
                if ((Ej>= 3 &  Dj>=3) )
                    {
                    A[kj,N]= A[kj,N]+1;A[N,kj]= A[N,kj]+1;
                }
                if ( (Ej< 3 &  Dj<3))
                    {
                    A[kj,N]= A[kj,N]+1;A[N,kj]= A[N,kj]+1;
                }

                if ((Ej>= 3 &  Dj<3) )
                    {
                    D[kj,N]= D[kj,N]+1;D[N,kj]= D[N,kj]+1;
                }
                if ((Ej< 3 &  Dj>=3) )
                    {
                    D[kj,N]= D[kj,N]+1;D[N,kj]= D[N,kj]+1;
                }
            }
        }
        ########################### inferred decision on R
        kj=match(users[n],u_id)
        exclude[kj]=0
        Dj=moderations$Decision[moderations$User_ID==users[n] & moderations$Resource_ID==i]
        Win[n]=W[kj]
        if (W[kj]>tauW & WT[kj]>tauWT & B[kj,N]>=tau)
            {
#                 neg=sum(moderations$Decision[moderations$User_ID==users[n] & moderations$Resource_ID %in% q_id [1:kq]]<3)
#                 pos=sum(moderations$Decision[moderations$User_ID==users[n] & moderations$Resource_ID %in% q_id [1:kq]]>=3)
                 if (Dj<3) {Neg[kj]= Neg[kj]+1; PN=(Pos[kj]+Neg[kj])/Neg[kj]}
                if (Dj>=3) {Pos[kj]= Pos[kj]+1;PN=(Pos[kj]+Neg[kj])/Pos[kj]}

                PNj=pntrust(PN,.5)
                si=si+Dj*(PNj*W[kj]); wi=wi+(PNj*W[kj])
                            RhatN[kq]= RhatN[kq]+1 # number of decisions
                            RhatW[kq]= wi # weight of decisions

            }  # If Reliability User >0 AND sum trust*Relibility other users >0 ########################## DECISION

        Rhat[kq] = si/wi # inferred decision on R
        RhatT[kq] = si/wi # inferred decision on R based on Users
        if(wi==0)
            {
            Rhat[kq] = 0
        RhatT[kq] = 0
        }
        Eimpact = max(Win) # no expert
        if (i %in% Expert$Resource_ID)
                {
                Ej=Expert$Decision[Expert$Resource_ID==i]
                if ((Ej>= 3 &  Dj>=3) )
                    {
                    A[kj,N]= A[kj,N]+1;A[N,kj]= A[N,kj]+1;
                }
                if ( (Ej< 3 &  Dj<3))
                    {
                    A[kj,N]= A[kj,N]+1;A[N,kj]= A[N,kj]+1;
                }

                if ((Ej>= 3 &  Dj<3) )
                    {
                    D[kj,N]= D[kj,N]+1;D[N,kj]= D[N,kj]+1;
                }
                if ((Ej< 3 &  Dj>=3) )
                    {
                    D[kj,N]= D[kj,N]+1;D[N,kj]= D[N,kj]+1;
                }
            Rhat[kq] = Ej
#             Eimpact = 1 # expert
            }
        Trust=trust((A-D),1) # Update trusts btw users
        ########################### update user reliability
        GRew=matrix(0,nrow=N ,ncol= 1 ) # Users' Gained Rewards
        TC=matrix(0,nrow=N ,ncol= 1 ) # Connected Users
        for(j in 1:n)
            {

            kj = match(users[j],u_id)
            TC=TC+abs(Trust[,kj])
            Dj = moderations$Decision[moderations$User_ID==users[j] & moderations$Resource_ID==i]
            Dl = Rhat[kq]
            if ((Dl>= 3 &  Dj>=3) )
                {

                point=
                reward(Dl-Dj,1,Eimpact*maxrew) * rdis(Dl,.1,.445) # Gain rewards * Resoource Discrimination

                }
            if ( (Dl< 3 &  Dj<3))
                {

                point=
                 reward(Dl-Dj,1,Eimpact*maxrew) * rdis(Dl,.1,.445) # Gain rewards * Resoource Discrimination

                }

            if ((Dl>= 3 &  Dj<3) )
                {
                point=
                punish(Dl-Dj,1,Eimpact*maxrew) * rdis(Dl,.1,.445) # Recieve Punishment * Resource Discrimination
                }
            if ((Dl< 3 &  Dj>=3) )
                {
                point=
                 punish(Dl-Dj,1,Eimpact*maxrew) * rdis(Dl,.1,.445) # Recieve Punishment * Resource Discrimination
                }
            GRew[kj] =  point
        }
        ########################### Propagation
        others=exclude*c(u_id,1) # Remove current moderators
        others[TC==0]=0 # Remove unconnected users
        for (uc in others[others!=0]) # only connected users outside the supernode
            {
            kuc=match(uc,u_id)
            relmax=W[kuc]
            Tmax=0
            for (um in users)
                {
                kum=match(um,u_id)
                if (Trust[kuc,kum]!=0)
                    {
                    if (W[kum]>relmax)
                        {
                        relmax=W[kum]
                        beta=.5
                        if (i %in% Expert$Resource_ID)
                        {
                            beta=1
                        }
                        GRew[kuc] =  GRew[kum] * Trust[kuc,kum] *beta
                        Tmax = abs(GRew[kuc])
                    }
                    if (W[kum]==relmax)
                        {
                        if (abs(GRew[kum] * Trust[kuc,kum])> Tmax)
                            {
                            relmax=W[kum]
                             beta=.5
                            if (i %in% Expert$Resource_ID)
                            {
                                beta=1
                            }
                            GRew[kuc] =  GRew[kum] * Trust[kuc,kum]* beta
                            Tmax = abs(GRew[kuc])
                        }
                    }
                }
            }

        }
        if (i %in% Expert$Resource_ID)
            {
            others=exclude*c(u_id,1) # Remove current moderators
            GRew[N]=reward(Dl-Dj,1,Eimpact*maxrew) * rdis(Dl,.1,.445)
            beta=1
            for (uc in others[others!=0]) # only connected users outside the supernode
                {
                kuc=match(uc,u_id)
                if (Trust[kuc,N]!=0)
                    {
                    GRew[kuc] =  GRew[N] * Trust[kuc,N]* beta
                    }

            }
        }

        Rew = Rew + GRew
        W = scoreG(Rew,rel_teta) # update user reliability
        W[N]=1 # Expert
        WT =  (Trust %*% W)
        kq=kq+1
    }
    ##################################### Evaluation #####################################

RQ=data.frame(q_id,RhatT)
    inferred=vector()
    k=1
    for (i in Expert$Resource_ID)
        {
        inferred[k]=RQ$RhatT[RQ$q_id==i]
        k=k+1
    }
results(Expert$Decision,inferred,3)

write_csv(data.frame(Expert$Resource_ID,inferred,Expert$Decision),'Graph_moderation_out.csv')

results(Expert$Decision,inferred,3)

NEUR2$graph=inferred

Total_User_ID=unique(Total$User_ID)
Total_Resource_ID=unique(Total$Resource_ID)
############## Reliabity calculation
Resource_Quality=matrix(nrow = length(Total_Resource_ID), ncol = 1)
kr=1
for(i in Total_Resource_ID)
    {

        wsum=0;
        rsum=0

            for (j in Total$User_ID[Total$Resource_ID==i] )
            {

                    rsum= rsum+ (Total$Decision[Total$User_ID==j & Total$Resource_ID==i])*
                                            (Total$`Comment Length`[Total$User_ID==j &Total$Resource_ID==i])
                    wsum=wsum+(Total$`Comment Length`[Total$User_ID==j &Total$Resource_ID==i])

            }
        rhat= rsum/wsum

        Resource_Quality[kr]=rhat
kr=kr+1
    }
####################################
RQ=data.frame(Resource_Quality)
RQ$Resource_ID =Total_Resource_ID

############################################ Evaluation

Test_Data_Resource_ID=unique(Expert$Resource_ID)
Test_Data_Users_Decision=matrix(0, nrow = length(Test_Data_Resource_ID), ncol = 3)
k=1
for (i in Test_Data_Resource_ID)
    {
    Test_Data_Users_Decision[k,1]=i
    Test_Data_Users_Decision[k,2]=Expert$Decision[Expert$Resource_ID==i]
    Test_Data_Users_Decision[k,3]=RQ$Resource_Quality[RQ$Resource_ID==i]
   k=k+1
    }
########################################################################
Expert_Decision=Test_Data_Users_Decision[,2]
Users_Decision=Test_Data_Users_Decision[,3]
results(Expert_Decision,Users_Decision)

results(Expert_Decision,Users_Decision)#100

models$length=Users_Decision

glimpse(Total)

Total_User_ID=unique(Total$User_ID)
Total_Resource_ID=unique(Total$Resource_ID)
############## Reliabity calculation
Resource_Quality=matrix(nrow = length(Total_Resource_ID), ncol = 1)
kr=1
for(i in Total_Resource_ID)
    {

        wsum=0;
        rsum=0

            for (j in Total$User_ID[Total$Resource_ID==i] )
            {

                    rsum= rsum+ (Total$Decision[Total$User_ID==j & Total$Resource_ID==i])*
                                            (1+100*abs(Total$`Relatedness Score`[Total$User_ID==j &Total$Resource_ID==i]))
                    wsum=wsum+(1+100*abs(Total$`Relatedness Score`[Total$User_ID==j &Total$Resource_ID==i]))

            }
        rhat= rsum/wsum

        Resource_Quality[kr]=rhat
kr=kr+1
    }
####################################
RQ=data.frame(Resource_Quality)
RQ$Resource_ID =Total_Resource_ID

############################################ Evaluation

Test_Data_Resource_ID=unique(Expert$Resource_ID)
Test_Data_Users_Decision=matrix(0, nrow = length(Test_Data_Resource_ID), ncol = 3)
k=1
for (i in Test_Data_Resource_ID)
    {
    Test_Data_Users_Decision[k,1]=i
    Test_Data_Users_Decision[k,2]=Expert$Decision[Expert$Resource_ID==i]
    Test_Data_Users_Decision[k,3]=RQ$Resource_Quality[RQ$Resource_ID==i]
   k=k+1
    }
########################################################################
Expert_Decision=Test_Data_Users_Decision[,2]
Users_Decision=Test_Data_Users_Decision[,3]
results(Expert_Decision,Users_Decision)

Total_User_ID=unique(Total$User_ID)
Total_Resource_ID=unique(Total$Resource_ID)
############## Reliabity calculation
Resource_Quality=matrix(nrow = length(Total_Resource_ID), ncol = 1)
kr=1
for(i in Total_Resource_ID)
    {

        wsum=0;
        rsum=0

            for (j in Total$User_ID[Total$Resource_ID==i] )
            {

                    rsum= rsum+ (Total$Decision[Total$User_ID==j & Total$Resource_ID==i])*
                                            (Total$`Comment Length`[Total$User_ID==j &Total$Resource_ID==i])*
                                            (1+100*abs(Total$`Relatedness Score`[Total$User_ID==j &Total$Resource_ID==i]))
                    wsum=wsum+(Total$`Comment Length`[Total$User_ID==j &Total$Resource_ID==i])*
                                            (1+100*abs(Total$`Relatedness Score`[Total$User_ID==j &Total$Resource_ID==i]))

            }
        rhat= rsum/wsum

        Resource_Quality[kr]=rhat
kr=kr+1
    }
####################################
RQ=data.frame(Resource_Quality)
RQ$Resource_ID =Total_Resource_ID

############################################ Evaluation

Test_Data_Resource_ID=unique(Expert$Resource_ID)
Test_Data_Users_Decision=matrix(0, nrow = length(Test_Data_Resource_ID), ncol = 3)
k=1
for (i in Test_Data_Resource_ID)
    {
    Test_Data_Users_Decision[k,1]=i
    Test_Data_Users_Decision[k,2]=Expert$Decision[Expert$Resource_ID==i]
    Test_Data_Users_Decision[k,3]=RQ$Resource_Quality[RQ$Resource_ID==i]
   k=k+1
    }
########################################################################
Expert_Decision=Test_Data_Users_Decision[,2]
Users_Decision=Test_Data_Users_Decision[,3]
results(Expert_Decision,Users_Decision)

models$Lbert=Users_Decision

moderations=Total
##################################### Initializing #####################################
reward0=500 # Initial reward point
rel_teta=.001 # Relibility function coef
maxrew=100
tp=vector()
tn=vector()
auc=vector()
cor=vector()
rmse=vector()

    N=length(u_id)+1
    ##################################### Variables #####################################
    Pos=matrix(0,nrow=N ,ncol= 1 ) # Users' Positive Ratings
    Neg=matrix(0,nrow=N ,ncol= 1 ) # Users' Negative Ratings
    Rew=matrix(reward0,nrow=N ,ncol= 1 ) # Users' Rewards
    W=matrix(scoreG(reward0,rel_teta),nrow=N ,ncol= 1 ) # Users' Reliability
    W[N]=1
    Trust= diag(N) #matrix(0,nrow=N ,ncol= N )
    A=matrix(0,nrow=N ,ncol= N ) # agreements btw users
    D=matrix(0,nrow=N ,ncol= N ) # disagreements btw users
    WT = (Trust %*% W) # Weight based on reliability and others Trust
    RA=matrix(0,nrow=length(q_id) ,ncol= 1 ) # number of agreements on Rj
    RD=matrix(0,nrow=length(q_id) ,ncol= 1 ) # number of disagreements on Rj
    Rhat=matrix(0,nrow=length(q_id) ,ncol= 1 ) # Inferred Decision on Rj
    RhatT=matrix(0,nrow=length(q_id) ,ncol= 1 ) # Inferred Decision on Rj
    RhatN=matrix(0,nrow=length(q_id) ,ncol= 1 ) # Number of Decision on Rj
    RhatW=matrix(0,nrow=length(q_id) ,ncol= 1 ) # Number of Decision on Rj

    kq=1
    for(i in q_id)
        {
        B= Trust %*% Trust
        tau=quantile(B[1:N-1,N],names = FALSE)[1]
        tauWT=quantile(WT,names = FALSE)[1]
        tauW=quantile(W,names = FALSE)[1]
        users=moderations$User_ID[moderations$Resource_ID==i]
        n=length(users)
        si=0
        wi=0
        Win= matrix(1,nrow= n,ncol=1) # collecting user reliability
        exclude= matrix(1,nrow= N,ncol=1) # removing those moderated this resource for trust propagation and keeping others
        exclude[N]=0
        for(j in 1:(n-1))
            {
            kj=match(users[j],u_id)
            exclude[kj]=0
            Win[j]=W[kj]
            Dj=moderations$Decision[moderations$User_ID==users[j] & moderations$Resource_ID==i]
            if (W[kj]>tauW & WT[kj]>tauWT &  B[kj,N]>=tau)
            {
#                 neg=sum(moderations$Decision[moderations$User_ID==users[j] & moderations$Resource_ID %in% q_id [1:kq]]<3)
#                 pos=sum(moderations$Decision[moderations$User_ID==users[j] & moderations$Resource_ID %in% q_id [1:kq]]>=3)
                if (Dj<3) {Neg[kj]= Neg[kj]+1; PN=(Pos[kj]+Neg[kj])/Neg[kj]}
                if (Dj>=3) {Pos[kj]= Pos[kj]+1;PN=(Pos[kj]+Neg[kj])/Pos[kj]}

                PNj=pntrust(PN,.5)
                si=si+Dj*(PNj*W[kj])*
                (moderations$`Comment Length`[moderations$User_ID==users[j] & moderations$Resource_ID==i])*
                    (1+100*abs(moderations$`Relatedness Score`[moderations$User_ID==users[j] &moderations$Resource_ID==i]))
                wi=wi+(PNj*W[kj])*
                (moderations$`Comment Length`[moderations$User_ID==users[j] & moderations$Resource_ID==i])*
                    (1+100*abs(moderations$`Relatedness Score`[moderations$User_ID==users[j] &moderations$Resource_ID==i]))
                                RhatN[kq]= RhatN[kq]+1 # number of decisions
                                RhatW[kq]= wi # number of decisions

            }                                                                               ########################## DECISION
            for(l in users[(j+1):n])
                {
                kl=match(l,u_id)
                Dl=moderations$Decision[moderations$User_ID==l & moderations$Resource_ID==i]
                if ((Dl>= 3 &  Dj>=3) | (Dl< 3 &  Dj<3))
                {
                    A[kj,kl]= A[kj,kl]+1;A[kl,kj]= A[kl,kj]+1;
                    RA[kq]=RA[kq]+1
                }
                else
                {
                    D[kj,kl]= D[kj,kl]+1;D[kl,kj]= D[kl,kj]+1;
                    RD[kq]=RD[kq]+1
                }
            }
            if (i %in% Expert$Resource_ID)
                {
                Ej=Expert$Decision[Expert$Resource_ID==i]
                if ((Ej>= 3 &  Dj>=3) )
                    {
                    A[kj,N]= A[kj,N]+1;A[N,kj]= A[N,kj]+1;
                }
                if ( (Ej< 3 &  Dj<3))
                    {
                    A[kj,N]= A[kj,N]+1;A[N,kj]= A[N,kj]+1;
                }

                if ((Ej>= 3 &  Dj<3) )
                    {
                    D[kj,N]= D[kj,N]+1;D[N,kj]= D[N,kj]+1;
                }
                if ((Ej< 3 &  Dj>=3) )
                    {
                    D[kj,N]= D[kj,N]+1;D[N,kj]= D[N,kj]+1;
                }
            }
        }
        ########################### inferred decision on R
        kj=match(users[n],u_id)
        exclude[kj]=0
        Dj=moderations$Decision[moderations$User_ID==users[n] & moderations$Resource_ID==i]
        Win[n]=W[kj]
        if (W[kj]>tauW & WT[kj]>tauWT & B[kj,N]>=tau)
            {
#                 neg=sum(moderations$Decision[moderations$User_ID==users[n] & moderations$Resource_ID %in% q_id [1:kq]]<3)
#                 pos=sum(moderations$Decision[moderations$User_ID==users[n] & moderations$Resource_ID %in% q_id [1:kq]]>=3)
                 if (Dj<3) {Neg[kj]= Neg[kj]+1; PN=(Pos[kj]+Neg[kj])/Neg[kj]}
                if (Dj>=3) {Pos[kj]= Pos[kj]+1;PN=(Pos[kj]+Neg[kj])/Pos[kj]}

                PNj=pntrust(PN,.5)
                si=si+Dj*(PNj*W[kj])*
                (moderations$`Comment Length`[moderations$User_ID==users[n] & moderations$Resource_ID==i])*
                    (1+100*abs(moderations$`Relatedness Score`[moderations$User_ID==users[n] & moderations$Resource_ID==i]))
                wi=wi+(PNj*W[kj])*
                (moderations$`Comment Length`[moderations$User_ID==users[n] & moderations$Resource_ID==i])*
                    (1+100*abs(moderations$`Relatedness Score`[moderations$User_ID==users[n] & moderations$Resource_ID==i]))
                            RhatN[kq]= RhatN[kq]+1 # number of decisions
                            RhatW[kq]= wi # weight of decisions

            }  # If Reliability User >0 AND sum trust*Relibility other users >0 ########################## DECISION

        Rhat[kq] = si/wi # inferred decision on R
        RhatT[kq] = si/wi # inferred decision on R based on Users
        if(wi==0)
            {
            Rhat[kq] = 0
        RhatT[kq] = 0
        }
        Eimpact = max(Win) # no expert
        if (i %in% Expert$Resource_ID)
                {
                Ej=Expert$Decision[Expert$Resource_ID==i]
                if ((Ej>= 3 &  Dj>=3) )
                    {
                    A[kj,N]= A[kj,N]+1;A[N,kj]= A[N,kj]+1;
                }
                if ( (Ej< 3 &  Dj<3))
                    {
                    A[kj,N]= A[kj,N]+1;A[N,kj]= A[N,kj]+1;
                }

                if ((Ej>= 3 &  Dj<3) )
                    {
                    D[kj,N]= D[kj,N]+1;D[N,kj]= D[N,kj]+1;
                }
                if ((Ej< 3 &  Dj>=3) )
                    {
                    D[kj,N]= D[kj,N]+1;D[N,kj]= D[N,kj]+1;
                }
            Rhat[kq] = Ej
#             Eimpact = 1 # expert
            }
        Trust=trust((A-D),1) # Update trusts btw users
        ########################### update user reliability
        GRew=matrix(0,nrow=N ,ncol= 1 ) # Users' Gained Rewards
        TC=matrix(0,nrow=N ,ncol= 1 ) # Connected Users
        for(j in 1:n)
            {

            kj = match(users[j],u_id)
            TC=TC+abs(Trust[,kj])
            Dj = moderations$Decision[moderations$User_ID==users[j] & moderations$Resource_ID==i]
            Dl = Rhat[kq]
            if ((Dl>= 3 &  Dj>=3) )
                {

                point=
                reward(Dl-Dj,1,Eimpact*maxrew) * rdis(Dl,.1,.445) # Gain rewards * Resoource Discrimination

                }
            if ( (Dl< 3 &  Dj<3))
                {

                point=
                 reward(Dl-Dj,1,Eimpact*maxrew) * rdis(Dl,.1,.445) # Gain rewards * Resoource Discrimination

                }

            if ((Dl>= 3 &  Dj<3) )
                {
                point=
                punish(Dl-Dj,1,Eimpact*maxrew) * rdis(Dl,.1,.445) # Recieve Punishment * Resource Discrimination
                }
            if ((Dl< 3 &  Dj>=3) )
                {
                point=
                 punish(Dl-Dj,1,Eimpact*maxrew) * rdis(Dl,.1,.445) # Recieve Punishment * Resource Discrimination
                }
            GRew[kj] =  point
        }
        ########################### Propagation
        others=exclude*c(u_id,1) # Remove current moderators
        others[TC==0]=0 # Remove unconnected users
        for (uc in others[others!=0]) # only connected users outside the supernode
            {
            kuc=match(uc,u_id)
            relmax=W[kuc]
            Tmax=0
            for (um in users)
                {
                kum=match(um,u_id)
                if (Trust[kuc,kum]!=0)
                    {
                    if (W[kum]>relmax)
                        {
                        relmax=W[kum]
                        beta=.5
                        if (i %in% Expert$Resource_ID)
                        {
                            beta=1
                        }
                        GRew[kuc] =  GRew[kum] * Trust[kuc,kum] *beta
                        Tmax = abs(GRew[kuc])
                    }
                    if (W[kum]==relmax)
                        {
                        if (abs(GRew[kum] * Trust[kuc,kum])> Tmax)
                            {
                            relmax=W[kum]
                             beta=.5
                            if (i %in% Expert$Resource_ID)
                            {
                                beta=1
                            }
                            GRew[kuc] =  GRew[kum] * Trust[kuc,kum]* beta
                            Tmax = abs(GRew[kuc])
                        }
                    }
                }
            }

        }
        if (i %in% Expert$Resource_ID)
            {
            others=exclude*c(u_id,1) # Remove current moderators
            GRew[N]=reward(Dl-Dj,1,Eimpact*maxrew) * rdis(Dl,.1,.445)
            beta=1
            for (uc in others[others!=0]) # only connected users outside the supernode
                {
                kuc=match(uc,u_id)
                if (Trust[kuc,N]!=0)
                    {
                    GRew[kuc] =  GRew[N] * Trust[kuc,N]* beta
                    }

            }
        }

        Rew = Rew + GRew
        W = scoreG(Rew,rel_teta) # update user reliability
        W[N]=1 # Expert
        WT =  (Trust %*% W)
        kq=kq+1
    }
    ##################################### Evaluation #####################################

RQ=data.frame(q_id,RhatT)
    inferred=vector()
    k=1
    for (i in Expert$Resource_ID)
        {
        inferred[k]=RQ$RhatT[RQ$q_id==i]
        k=k+1
    }
results(Expert$Decision,inferred,3)

write_csv(data.frame(Expert$Resource_ID,inferred,Expert$Decision),'GraphLbert_out_moderation.csv')

models$Gbert=inferred

write.csv(models,'models_outcomes.csv', row.names=FALSE)

models=read.csv('models_outcomes.csv')
em=read.csv('EM_out.csv')
models$em=em$ Users_Decision
glimpse(models)
glimpse(em)

results(models$expert ,models$Gbert  ,3)

Decision=models$mean
expert=models$expert
Test=data.frame(Decision,expert)
Test$Colour="darkgreen"
Test$Colour[Test$Decision<3]="blue"

Test$shape=3
Test$shape[Test$Decision<3]=4
Test$shape[Test$Decision<3 & Test$expert>=3]=6
Test$shape[Test$Decision>=3 & Test$expert<3]=2
Test$class="tp"
Test$class[Test$expert<3 & Test$Decision<3]="tn"

Test$Colour[Test$expert>=3 & Test$Decision<3]="darkviolet"
Test$class[Test$expert>=3 & Test$Decision<3]="fn"

Test$Colour[Test$expert<3 & Test$Decision>=3]="red"
Test$class[Test$expert<3 & Test$Decision>=3]="fp"

y_p=5.5
library(ggplot2)
box_plot2 <- ggplot(Test, aes(x=as.factor(expert), y = Decision))
bx1=box_plot2 +
    geom_boxplot(outlier.colour = "white") +
    ylim(.5,y_p)+ ylab('Inferred Decision from Students\'Ratings')+ xlab('Instructors\' Decision')+ ggtitle('(a) Mean ')+
#     geom_jitter(shape = Test$shape,
#         color = Test$Colour,
#         position = position_jitter(width = 0.31)) +
    theme_classic() +
geom_vline(xintercept = 2.5, linetype="dashed",
                color = "darkgrey",size=1)+
geom_hline(yintercept = 3, linetype="dashed",
                color = "darkgrey",size=1)
################################
Decision=models$em
expert=models$expert
Test=data.frame(Decision,expert)
Test$Colour="darkgreen"
Test$Colour[Test$Decision<3]="blue"

Test$shape=3
Test$shape[Test$Decision<3]=4
Test$shape[Test$Decision<3 & Test$expert>=3]=6
Test$shape[Test$Decision>=3 & Test$expert<3]=2
Test$class="tp"
Test$class[Test$expert<3 & Test$Decision<3]="tn"

Test$Colour[Test$expert>=3 & Test$Decision<3]="darkviolet"
Test$class[Test$expert>=3 & Test$Decision<3]="fn"

Test$Colour[Test$expert<3 & Test$Decision>=3]="red"
Test$class[Test$expert<3 & Test$Decision>=3]="fp"

y_p=5.5
library(ggplot2)
box_plot2 <- ggplot(Test, aes(x=as.factor(expert), y = Decision))
bx2=box_plot2 +
    geom_boxplot(outlier.colour = "white") +
    ylim(.5,y_p)+ ylab('')+ xlab('Instructors\' Decision')+ ggtitle('(b) Expectation-Maximisation ')+
#     geom_jitter(shape = Test$shape,
#         color = Test$Colour,
#         position = position_jitter(width = 0.31)) +
    theme_classic() +
geom_vline(xintercept = 2.5, linetype="dashed",
                color = "darkgrey",size=1)+
geom_hline(yintercept = 3, linetype="dashed",
                color = "darkgrey",size=1)
################################
Decision=models$length
expert=models$expert
Test=data.frame(Decision,expert)
Test$Colour="darkgreen"
Test$Colour[Test$Decision<3]="blue"

Test$shape=3
Test$shape[Test$Decision<3]=4
Test$shape[Test$Decision<3 & Test$expert>=3]=6
Test$shape[Test$Decision>=3 & Test$expert<3]=2
Test$class="tp"
Test$class[Test$expert<3 & Test$Decision<3]="tn"

Test$Colour[Test$expert>=3 & Test$Decision<3]="darkviolet"
Test$class[Test$expert>=3 & Test$Decision<3]="fn"

Test$Colour[Test$expert<3 & Test$Decision>=3]="red"
Test$class[Test$expert<3 & Test$Decision>=3]="fp"

y_p=5.5
library(ggplot2)
box_plot2 <- ggplot(Test, aes(x=as.factor(expert), y = Decision))
bx3=box_plot2 +
    geom_boxplot(outlier.colour = "white") +
    ylim(.5,y_p)+ ylab(' ')+ xlab('Instructors\' Decision')+ ggtitle('(c) Text Analysis (Length) ')+
#     geom_jitter(shape = Test$shape,
#         color = Test$Colour,
#         position = position_jitter(width = 0.31)) +
    theme_classic() +
geom_vline(xintercept = 2.5, linetype="dashed",
                color = "darkgrey",size=1)+
geom_hline(yintercept = 3, linetype="dashed",
                color = "darkgrey",size=1)
#################################
Decision=models$Gbert
expert=models$expert
Test=data.frame(Decision,expert)
Test$Colour="darkgreen"
Test$Colour[Test$Decision<3]="blue"

Test$shape=3
Test$shape[Test$Decision<3]=4
Test$shape[Test$Decision<3 & Test$expert>=3]=6
Test$shape[Test$Decision>=3 & Test$expert<3]=2
Test$class="tp"
Test$class[Test$expert<3 & Test$Decision<3]="tn"

Test$Colour[Test$expert>=3 & Test$Decision<3]="darkviolet"
Test$class[Test$expert>=3 & Test$Decision<3]="fn"

Test$Colour[Test$expert<3 & Test$Decision>=3]="red"
Test$class[Test$expert<3 & Test$Decision>=3]="fp"

y_p=5.5
library(ggplot2)
box_plot2 <- ggplot(Test, aes(x=as.factor(expert), y = Decision))
bx4=box_plot2 +
    geom_boxplot(outlier.colour = "white") +
    ylim(.5,y_p)+ ylab('')+ xlab('Instructors\' Decision')+ ggtitle('(d) Graph (LengthxBERT)')+
#     geom_jitter(shape = Test$shape,
#         color = Test$Colour,
#         position = position_jitter(width = 0.31)) +
    theme_classic()+
geom_vline(xintercept = 2.5, linetype="dashed",
                color = "darkgrey",size=1)+
geom_hline(yintercept = 3, linetype="dashed",
                color = "darkgrey",size=1)+
annotate("rect", xmin = 0.482, xmax = 2.48, ymin = 0.48, ymax = 2.98,
  alpha = .2,fill='blue')+
annotate("rect", xmin = 2.52, xmax = 5.52, ymin = 3.02, ymax = 5.5,
  alpha = .2,fill='darkolivegreen')+
annotate("rect", xmin = 2.52, xmax = 5.52, ymin = 3.02, ymax = 5.5,
  alpha = .2,fill='darkolivegreen')+
annotate("rect", xmin = 2.52, xmax = 5.52, ymin = 3.02, ymax = 5.5,
  alpha = .2,fill='darkolivegreen')

library("cowplot")
plot_grid(bx1,bx2,bx3,bx4,
          ncol = 4, nrow = 2)
pdf("models comparison.pdf", width=16, height=4)
plot_grid(bx1,bx2,bx3,bx4,
          ncol = 4, nrow = 1)
dev.off()


#!/usr/bin/Rscript

# Bhishan Poudel
# Jan 12, 2016
# clear; Rscript autosPlot.r  ; rm *~

# inputs: data/autos.dat
# outputs: figures/autos.png

# set the working directory
setwd("~/Copy/Programming/R/rprograms/plotting/2dplots/")

# Start device driver to save output to figure
#png(filename="figures/autosPlot.png", height=295, width=300,  bg="white")

# Read car and truck values from tab-delimited autos.dat
autos_data <- read.table("data/autos.dat", header=T, sep="\t")

# Compute the largest y value used in the data (or we could
# just use range again)
max_y <- max(autos_data)

# Define colors to be used for cars, trucks, suvs
plot_colors <- c("blue","red","forestgreen")

# Graph autos using y axis that ranges from 0 to max_y.
# Turn off axes and annotations (axis labels) so we can
# specify them ourself
plot(autos_data$cars, type="o", col=plot_colors[1],
   ylim=c(0,max_y), axes=FALSE, ann=FALSE)

# Make x axis using Mon-Fri labels
axis(1, at=1:5, lab=c("Mon", "Tue", "Wed", "Thu", "Fri"))

# Make y axis with horizontal labels that display ticks at
# every 4 marks. 4*0:max_y is equivalent to c(0,4,8,12).
axis(2, las=1, at=4*0:max_y)

# Create box around plot
box()

# Graph trucks with red dashed line and square points
lines(autos_data$trucks, type="o", pch=22, lty=2,
   col=plot_colors[2])

# Graph suvs with green dotted line and diamond points
lines(autos_data$suvs, type="o", pch=23, lty=3,
   col=plot_colors[3])

# Create a title with a red, bold/italic font
title(main="Autos", col.main="red", font.main=4)

# Label the x and y axes with dark green text
title(xlab= "Days", col.lab=rgb(0,0.5,0))
title(ylab= "Total", col.lab=rgb(0,0.5,0))

# Create a legend at (1, max_y) that is slightly smaller
# (cex) and uses the same line colors and points used by
# the actual plots
legend(1, max_y, names(autos_data), cex=0.8, col=plot_colors,
   pch=21:23, lty=1:3);

# Turn off device driver (to flush output to png)
#dev.off()


weights <- function(portfolio, portfolioname=NULL) {
    ## input:  portfolio = dataframe with columns labeled "Holding" and "Quantity"
    ## output: portfolio with added columns for "Market_Value" and "Weight"

    ##-------------------------------------------------------------------------
    ## COLLAPSE IDENTICAL HOLDINGS (ESPECIALLY FOR COMBINED ACCOUNTS)

    ## combine duplicate holdings
    portfolio <- aggregate(portfolio$Quantity, by=list(portfolio$Holding), FUN=sum)
    names(portfolio) <- c('Holding', 'Quantity')

    ##-------------------------------------------------------------------------
    ## DETERMINE WEIGHT OF EACH HOLDING

    ## obtain closing price data and merge with portfolio
    closeall   <- equity.price(portfolio$Holding)
    closeall$Holding <- rownames(closeall)
    portfolio <- merge(portfolio, closeall, by='Holding')
    portfolio <- select(portfolio, c('Holding', 'Name', 'Quantity', 'Close'))

    ## determine weight
    portfolio$Market_Value <- portfolio$Quantity * portfolio$Close
    totalvalue             <- sum(portfolio$Market_Value)
    portfolio$Weight       <- portfolio$Market_Value / totalvalue

    ## print(portfolio)

    return(portfolio)
}


# BoxPlot (or WhiskerPlot) using ggboxplot // используем не обычную встроенную в R Basic Graphics функцию boxplot, а ggboxplot (более функциональную, advanced). Тут можно менять палитру, настраивать оси и наводить красоту. В обычном boxplot функции красоты очень ограниченны.

# ЧАСТЬ 1: делаем data.frame
	# шаг-1. вчитываем таблицу. делаем из нее датафрейм.
MDepths <- read.csv("Depths.csv", header=TRUE, sep = ",")
	# шаг-2. чистим датафрейм от NA значений
df <- na.omit(MDepths)
row.has.na <- apply(MDF, 1, function(x){any(is.na(x))}) # проверяем, удалил ли все NA
sum(row.has.na) # суммируем все NA, должно получиться: [1] 0
head(df) # смотрим очищенный датафрейм. теперь с ним работаем.
	# шаг-3. из большого датафрейма выбираем только те значения X и Y, которые нужны для данного боксплота, здесь: profiles и depths)
MDepths_df <- data.frame(profiles = 1:25, depths = c(df$profile1, df$profile2, df$profile3, df$profile4, df$profile5, df$profile6, df$profile7, df$profile8, df$profile9, df$profile10, df$profile11, df$profile12, df$profile13, df$profile14, df$profile15, df$profile16, df$profile17, df$profile18, df$profile19, df$profile20, df$profile21, df$profile22, df$profile23, df$profile24, df$profile25))

# ЧАСТЬ 2: делаем боксплот (диаграмму распределения данных "whisker boxplot")
	# шаг-4. чертим боксплот по датафрейму MDepths_df. добавляем палитру, тип линий.
p<- ggboxplot(
	MDepths_df,
	title="马里亚纳海沟。剖面11。Mariana Trench, Profiles 1-25.",
	subtitle = "统计图表。箱形图。Notched Boxplot for Data Groups by 25 Profiles with Outliers)",
	caption = "Statistics Processing and Graphs: \nR Programming. Data Source: QGIS",
	x = "profiles",
	y = "depths",
	width = 0.8,
	notch = TRUE,
	fill = "profiles",
	linetype = 1, size = .1,
	outlier.colour = "grey44",
	palette = c("magma"),
	orientation = "horizontal"
	)
p
   	# шаг-5 добавляем обертку темы (легенда, оси, подписи и пр.)
boxplot_Mariana<- p +
	theme(
#   plot.title = element_text(family = "Times New Roman", face = 2, size = 12),
    plot.title = element_text(family = "Kai", face = "bold", size = 12),
	plot.subtitle = element_text(family = "Hei", face = "bold", size = 8),
	plot.caption = element_text(face = 2, size = 6),
    panel.background=ggplot2::element_rect(fill = "white"),
    legend.justification = c(.85, .1),
    legend.position = c(.85, .1),
    legend.box.just = "right",
    legend.margin = margin(6, 6, 6, 6),
    legend.direction = "vertical",
    legend.background = element_rect(fill = "white"),
    legend.key.width = unit(.3,"cm"),
    legend.key.height = unit(.3,"cm"),
    legend.spacing = unit(.3,"cm"),
    legend.box.background = element_rect(colour = "honeydew4",size=0.2),
    legend.text = element_text(family = "Arial", colour="black", size=6, face=1),
    legend.title = element_text(family = "Arial", colour="black", size=6, face=1),
    strip.text.x = element_text(colour = "white"),
    panel.grid.major = element_line("gray24", size = 0.1, linetype = "dotted"),
    panel.grid.minor = element_line("gray24", size = 0.1, linetype = "dotted"),
    axis.text.x = element_text(family = "Arial", face = 3, color = "gray24",size = 6, angle = 15),
    axis.text.y = element_text(family = "Arial", face = 3, color = "gray24",size = 6, angle = 90),
    axis.ticks.length=unit(.1,"cm"),
    axis.line = element_line(size = .3, colour = "grey80"),
    axis.title.y = element_text(margin = margin(t = 20, r = .3), family = "Times New Roman", face = 2, size = 8),
    axis.title.x = element_text(family = "Times New Roman", face = 2, size = 8,margin = margin(t = .2)))
boxplot_Mariana


halfsum_contrasts = function(...){
	contr.sum(...)*.5
}