Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/usr/bin/env RScript
- #require(ggplot2)
- require(plotly)
- require(reshape2)
- data <- data.frame(
- y=c(13, 5, 22),
- x1=c(4, 13, 15),
- x2=c(35, 24, 67))
- #general
- a_ <- matrix(c(
- 3,6,8,9,3,0,
- 7,9,3,6,0,1,
- 7,9,6,5,4,7),
- ncol=3)
- #continuous
- a <-matrix(c(
- 5,5,9,9,3,3,
- 9,3,5,3,5,9,
- 3,9,3,5,9,5),
- ncol=3)
- #convex
- aq <- matrix(c(
- 2,2,6,6,7,7,
- 6,7,2,7,2,6,
- 7,6,7,2,6,2),
- ncol=3)
- #one
- az <-matrix(c(
- 1,1,1,1,1,1,
- 1,1,1,1,1,1,
- 1,1,1,1,1,1),
- ncol=3)
- L <- function(beta, data, a) {
- betaperm <- logical(6)
- permutations <- (matrix(c(
- 1, 1, 2, 2, 3, 3,
- 2, 3, 1, 3, 1, 2,
- 3, 2, 3, 1, 2, 1),
- ncol=3))
- for (pi in 1:6) {
- # print((data$y[permutations[pi,1]] - (beta[1]*data$x1[permutations[pi,1]] + beta[2]*data$x2[permutations[pi,1]])))
- # print((data$y[permutations[pi,2]] - (beta[1]*data$x1[permutations[pi,2]] + beta[2]*data$x2[permutations[pi,2]])))
- # print((data$y[permutations[pi,3]] - (beta[1]*data$x1[permutations[pi,3]] + beta[2]*data$x2[permutations[pi,3]])))
- # print("---")
- # print(paste(permutations[pi,1], permutations[pi,2], permutations[pi,3]))
- # print("===")
- #browser()
- betaperm[pi] <-
- ((data$y[permutations[pi,1]] - (beta[1]*data$x1[permutations[pi,1]] + beta[2]*data$x2[permutations[pi,1]])) <=
- (data$y[permutations[pi,2]] - (beta[1]*data$x1[permutations[pi,2]] + beta[2]*data$x2[permutations[pi,2]]))) &&
- ((data$y[permutations[pi,2]] - (beta[1]*data$x1[permutations[pi,2]] + beta[2]*data$x2[permutations[pi,2]])) <=
- (data$y[permutations[pi,3]] - (beta[1]*data$x1[permutations[pi,3]] + beta[2]*data$x2[permutations[pi,3]])))
- }
- aipi <- match(TRUE, betaperm)
- # browser()
- Lres <- a[aipi, 1]*(data$y[1]-(beta[1]*data$x1[1]+beta[2]*data$x2[1])) +
- a[aipi, 2]*(data$y[2]-(beta[1]*data$x1[2]+beta[2]*data$x2[2])) +
- a[aipi, 3]*(data$y[3]-(beta[1]*data$x1[3]+beta[2]*data$x2[3]))
- # print(betaperm)
- # print(aipi)
- # print(paste(a[aipi, 1], (data$y[1]-(beta[1]*data$x1[1]+beta[2]*data$x2[1]))))
- # print(paste(a[aipi, 2], (data$y[2]-(beta[1]*data$x1[2]+beta[2]*data$x2[2]))))
- # print(paste(a[aipi, 3], (data$y[3]-(beta[1]*data$x1[3]+beta[2]*data$x2[3]))))
- # print((data$y[1]-(beta[1]*data$x1[1]+beta[2]*data$x2[1])) +
- # (data$y[2]-(beta[1]*data$x1[2]+beta[2]*data$x2[2])) +
- # (data$y[3]-(beta[1]*data$x1[3]+beta[2]*data$x2[3])))
- return(list(L=Lres, aipi=aipi))
- }
- plotL <- function(beta1, beta2) {
- Lperm <- sapply(beta1, function(x1){
- sapply(beta2, function(x2) {
- L(c(x1, x2), data, a)
- })
- })
- Lbeta <- Lperm[seq(1,nrow(Lperm)-1,2),]
- Cells <- Lperm[seq(2,nrow(Lperm),2),]
- # print(Lbeta)
- colnames(Lbeta) <- as.character(beta1)
- rownames(Lbeta) <- as.character(beta2)
- colnames(Cells) <- as.character(beta1)
- rownames(Cells) <- as.character(beta2)
- # dimnames(Lbeta) <- list(as.character(beta1), as.character(beta2))
- dataWidePlot <- cbind(expand.grid(dimnames(Lbeta)), value = unlist(as.vector(Lbeta)))
- colnames(dataWidePlot) <- c("beta1", "beta2", "L")
- ggData <- ggplot(dataWidePlot, aes(x=beta1, y=beta2)) +
- geom_tile(aes(fill=L))
- cellWidePlot <- cbind(expand.grid(dimnames(Lbeta)), value = unlist(as.vector(Cells)))
- colnames(cellWidePlot) <- c("beta1", "beta2", "C")
- cellWidePlot$C <- as.factor(cellWidePlot$C)
- ggCell <- ggplot(cellWidePlot, aes(x=beta1, y=beta2)) +
- geom_tile(aes(fill=C))
- return(list(ggData, ggCell))
- # return(plot_ly() %>% add_surface(x=~beta1, y=~beta2, z=~Lbeta))
- }
- # plot_ly() %>% add_surface(x=c(1,2), y=c(1,2), z=matrix(c(1,2,3,4), ncol=2))
- # plot_ly(data, x= ~x1, y= ~y)
- # export(plotL(seq(-1, 2, 0.1), seq(-0.5, 1.5, 0.1)), "l.png")
- renPlot <- plotL(seq(-1, 1, 0.03), seq(-1, 1, 0.03))
- L(c(4,6), data, a)
- L(c(4,4.1), data, a)
- L(c(4.1,4), data, a)
Add Comment
Please, Sign In to add comment