mono <- read.csv("monotone.30.csv")

wbar <- mono$data
what <- mono$theory
diff <- what-wbar
ssr <- diff %*% diff
whater <- what - mean(what)
ssr2 <- whater %*% whater
se <- sqrt(ssr/NROW(wbar))
R2 <- 1 - (ssr/ssr2)
se
R2
mean(abs(diff))

what[3] <- (what[3] + 0.10)/2
what[3]
what[8] <- (what[8] + 0.17)/2
what[8] 

diff <- what-wbar
ssr <- diff %*% diff
whater <- what - mean(what)
ssr2 <- whater %*% whater
se <- sqrt(ssr/NROW(wbar))
R2 <- 1 - (ssr/ssr2)
se
R2
mean(abs(diff))

seadj <- sqrt(12/9) * se

seadj

getr2 <- function(regr){
	difr <- mono$data - mean(mono$data)
	ssrbase <- difr %*% difr
	resid <- regr$residuals
	ssrnew <- resid %*% resid
	print(mean(abs(regr$residuals)))
	return(1-(ssrnew/ssrbase))
}
	
	

freg <- lm(mono$data ~ mono$fr)
summary(freg)

getr2(freg)

freg0 <- lm(mono$data ~ mono$fr - 1)
summary(freg0)

getr2(freg0)

ft2 <- mono$fr^2
freg2 <- lm(mono$data ~ mono$fr + ft2)
summary(freg2)

treg <- lm(mono$data ~ mono$theory)
summary(treg)
getr2(treg)

mt2 <- mono$theory^2
treg2 <- lm(mono$data ~ mono$theory + mt2)
summary(treg2)

treg0 <- lm(mono$data ~ mono$theory - 1)
summary(treg0)
getr2(treg0)

g <- mono$DC - 1
l <- -mono$CD
Drd <-(g+l)/(1+g+l)
Drd <- mono$delta - Drd
Dreg <- lm(mono$data ~ Drd)
summary(Dreg)
getr2(Dreg)

pDrd <- Dreg$coefficients[1] + (Dreg$coefficients[2] * Drd)
pDrd

Drd2 <- Drd^2
Dreg2 <- lm(mono$data ~ Drd + Drd2)
summary(Dreg2)



beta_num <- ((1-mono$delta)*g) - mono$delta
beta_den <- ((1-mono$delta)*(g-l)) - mono$delta
beta <- beta_num/beta_den

for(ii in 1:NROW(beta)){
	if(beta[ii] < 0) beta[ii] <- 0
}
breg <- lm(mono$data ~ beta)
summary(breg)
getr2(breg)

pbeta <- breg$coefficients[1] + (breg$coefficients[2] * beta)
pbeta


beta2 <- beta^2
breg2 <- lm(mono$data ~ beta + beta2)
summary(breg2)

wbar <- mono$data
what <- mono$theory
diff <- what-wbar
ssr <- diff %*% diff
whater <- what - mean(what)
ssr2 <- whater %*% whater
se <- sqrt(ssr/NROW(wbar))
R2 <- 1 - (ssr/ssr2)
se
R2
mean(abs(diff))

error <- abs(diff)
jpeg(file = "errorx.jpg")
hist(error, freq = FALSE, xlim = c(0,0.40), ylim = c(0,14))
dev.off()

nash_error <- c(.06, .07, .18, .19)

jpeg(file = "nash.jpg")
hist(nash_error, breaks=c(0,.05,.1,.15,.2,.25,.3, .35, .4), freq = FALSE, ylim = c(0,14))
dev.off()

wbar <- mono$data
what <- 0.9 * mono$theory
diff <- what-wbar
ssr <- diff %*% diff
whater <- what - mean(what)
ssr2 <- whater %*% whater
se <- sqrt(ssr/NROW(wbar))
R2 <- 1 - (ssr/ssr2)
se
R2

wbar <- mono$data
what <- mono$fr
diff <- what-wbar
ssr <- diff %*% diff
whater <- what - mean(what)
ssr2 <- whater %*% whater
se <- sqrt(ssr/NROW(wbar))
R2 <- 1 - (ssr/ssr2)
se
R2
mean(abs(diff))

wbar <- mono$data
what <- mono$mod
diff <- what-wbar
ssr <- diff %*% diff
whater <- what - mean(what)
ssr2 <- whater %*% whater
se <- sqrt(ssr/NROW(wbar))
R2 <- 1 - (ssr/ssr2)
se
R2
mean(abs(diff))

data <- mono$data
theory <- mono$theory

jpeg(file = "plotx.jpg")
plot(theory, data, xlim = c(0,1), ylim = c(0,1))
abline(a = 0, b = 1)
dev.off()	

monoo <- cbind(mono, pDrd, pbeta)
monoo <- monoo[order(monoo$data),]
data <- monoo$data
theory <- monoo$theory

jpeg(file = "monot.jpg")
plot(data, theory, type = "l", ylim = c(0,0.8),col = 2)
lines(data, monoo$fr,col=3)
lines(data, monoo$pDrd, col=4)
lines(data, monoo$pbeta, col=5)
abline(a = 0, b = 1)
legend("bottomright", legend=c("45 deg line", "noise", "learning", expression(Delta), expression(beta)), lty = c(1,1,1,1,1), col=c(1,2,3,4,5))
dev.off()

tneg <- 0
fneg <- 0
dneg <- 0
bneg <- 0
denom <- rep(0, nrow(monoo))

for(ii in 4:(nrow(monoo)-1)){
	denom[ii] <- 0 * -(monoo$data[ii] - monoo$data[ii - 1])
	if((monoo$theory[ii] - monoo$theory[ii - 1]) < denom[ii]) tneg <- tneg + 1
	if((monoo$fr[ii] - monoo$fr[ii - 1]) < denom[ii]) fneg <- fneg + 1
	if((monoo$Drd[ii] - monoo$Drd[ii - 1]) < denom[ii]) dneg <- dneg + 1
	if((monoo$beta[ii] - monoo$beta[ii - 1]) < denom[ii]) bneg <- bneg + 1
}

tneg
fneg
dneg
bneg

stD <- cbind(Drd, mono$low)
stDl <- stD[which(stD[,2] == 1),]
stDh <- stD[which(stD[,2] == 0),]
max(stDl[,1])
min(stDh[,1])

stb <- cbind(beta, mono$low)
stbl <- stb[which(stb[,2] == 1),]
stbh <- stb[which(stb[,2] == 0),]
max(stbl[,1])
min(stbh[,1])

stf <- cbind(mono$fr, mono$low)
stfl <- stf[which(stf[,2] == 1),]
stfh <- stf[which(stf[,2] == 0),]
max(stfl[,1])
min(stfh[,1])


stt <- cbind(mono$theory, mono$low)
sttl <- stt[which(stt[,2] == 1),]
stth <- stt[which(stt[,2] == 0),]
max(sttl[,1])
min(stth[,1])

sdt <- cbind(mono$data, mono$low)
stdl <- sdt[which(sdt[,2] == 1),]
stdh <- sdt[which(sdt[,2] == 0),]
max(stdl[,1])
min(stdh[,1])

xy <- read.csv("coop.03.csv")
rxy <- lm(xy$coop ~ xy$welf)
summary(rxy)

jpeg(file = "welf-hist.jpg")
empirical_welfare <- mono$data
hist(empirical_welfare, main="Histogram of Empirical Welfare", xlab = "Empirical Welfare", freq = FALSE, xlim = c(0,1))
dev.off()

options(width=300)
monoo

