Guest User

Untitled

a guest
May 23rd, 2018
72
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.56 KB | None | 0 0
  1. #!/usr/bin/env RScript
  2.  
  3. #require(ggplot2)
  4. require(plotly)
  5. require(reshape2)
  6.  
  7. data <- data.frame(
  8. y=c(13, 5, 22),
  9. x1=c(4, 13, 15),
  10. x2=c(35, 24, 67))
  11. #general
  12. a_ <- matrix(c(
  13. 3,6,8,9,3,0,
  14. 7,9,3,6,0,1,
  15. 7,9,6,5,4,7),
  16. ncol=3)
  17. #continuous
  18. a <-matrix(c(
  19. 5,5,9,9,3,3,
  20. 9,3,5,3,5,9,
  21. 3,9,3,5,9,5),
  22. ncol=3)
  23. #convex
  24. aq <- matrix(c(
  25. 2,2,6,6,7,7,
  26. 6,7,2,7,2,6,
  27. 7,6,7,2,6,2),
  28. ncol=3)
  29. #one
  30. az <-matrix(c(
  31. 1,1,1,1,1,1,
  32. 1,1,1,1,1,1,
  33. 1,1,1,1,1,1),
  34. ncol=3)
  35.  
  36. L <- function(beta, data, a) {
  37. betaperm <- logical(6)
  38. permutations <- (matrix(c(
  39. 1, 1, 2, 2, 3, 3,
  40. 2, 3, 1, 3, 1, 2,
  41. 3, 2, 3, 1, 2, 1),
  42. ncol=3))
  43. for (pi in 1:6) {
  44. # print((data$y[permutations[pi,1]] - (beta[1]*data$x1[permutations[pi,1]] + beta[2]*data$x2[permutations[pi,1]])))
  45. # print((data$y[permutations[pi,2]] - (beta[1]*data$x1[permutations[pi,2]] + beta[2]*data$x2[permutations[pi,2]])))
  46. # print((data$y[permutations[pi,3]] - (beta[1]*data$x1[permutations[pi,3]] + beta[2]*data$x2[permutations[pi,3]])))
  47. # print("---")
  48. # print(paste(permutations[pi,1], permutations[pi,2], permutations[pi,3]))
  49. # print("===")
  50. #browser()
  51. betaperm[pi] <-
  52. ((data$y[permutations[pi,1]] - (beta[1]*data$x1[permutations[pi,1]] + beta[2]*data$x2[permutations[pi,1]])) <=
  53. (data$y[permutations[pi,2]] - (beta[1]*data$x1[permutations[pi,2]] + beta[2]*data$x2[permutations[pi,2]]))) &&
  54. ((data$y[permutations[pi,2]] - (beta[1]*data$x1[permutations[pi,2]] + beta[2]*data$x2[permutations[pi,2]])) <=
  55. (data$y[permutations[pi,3]] - (beta[1]*data$x1[permutations[pi,3]] + beta[2]*data$x2[permutations[pi,3]])))
  56. }
  57. aipi <- match(TRUE, betaperm)
  58. # browser()
  59. Lres <- a[aipi, 1]*(data$y[1]-(beta[1]*data$x1[1]+beta[2]*data$x2[1])) +
  60. a[aipi, 2]*(data$y[2]-(beta[1]*data$x1[2]+beta[2]*data$x2[2])) +
  61. a[aipi, 3]*(data$y[3]-(beta[1]*data$x1[3]+beta[2]*data$x2[3]))
  62. # print(betaperm)
  63. # print(aipi)
  64. # print(paste(a[aipi, 1], (data$y[1]-(beta[1]*data$x1[1]+beta[2]*data$x2[1]))))
  65. # print(paste(a[aipi, 2], (data$y[2]-(beta[1]*data$x1[2]+beta[2]*data$x2[2]))))
  66. # print(paste(a[aipi, 3], (data$y[3]-(beta[1]*data$x1[3]+beta[2]*data$x2[3]))))
  67. # print((data$y[1]-(beta[1]*data$x1[1]+beta[2]*data$x2[1])) +
  68. # (data$y[2]-(beta[1]*data$x1[2]+beta[2]*data$x2[2])) +
  69. # (data$y[3]-(beta[1]*data$x1[3]+beta[2]*data$x2[3])))
  70. return(list(L=Lres, aipi=aipi))
  71. }
  72.  
  73. plotL <- function(beta1, beta2) {
  74. Lperm <- sapply(beta1, function(x1){
  75. sapply(beta2, function(x2) {
  76. L(c(x1, x2), data, a)
  77. })
  78. })
  79. Lbeta <- Lperm[seq(1,nrow(Lperm)-1,2),]
  80. Cells <- Lperm[seq(2,nrow(Lperm),2),]
  81. # print(Lbeta)
  82. colnames(Lbeta) <- as.character(beta1)
  83. rownames(Lbeta) <- as.character(beta2)
  84. colnames(Cells) <- as.character(beta1)
  85. rownames(Cells) <- as.character(beta2)
  86. # dimnames(Lbeta) <- list(as.character(beta1), as.character(beta2))
  87. dataWidePlot <- cbind(expand.grid(dimnames(Lbeta)), value = unlist(as.vector(Lbeta)))
  88. colnames(dataWidePlot) <- c("beta1", "beta2", "L")
  89. ggData <- ggplot(dataWidePlot, aes(x=beta1, y=beta2)) +
  90. geom_tile(aes(fill=L))
  91.  
  92. cellWidePlot <- cbind(expand.grid(dimnames(Lbeta)), value = unlist(as.vector(Cells)))
  93. colnames(cellWidePlot) <- c("beta1", "beta2", "C")
  94. cellWidePlot$C <- as.factor(cellWidePlot$C)
  95. ggCell <- ggplot(cellWidePlot, aes(x=beta1, y=beta2)) +
  96. geom_tile(aes(fill=C))
  97.  
  98. return(list(ggData, ggCell))
  99. # return(plot_ly() %>% add_surface(x=~beta1, y=~beta2, z=~Lbeta))
  100. }
  101.  
  102. # plot_ly() %>% add_surface(x=c(1,2), y=c(1,2), z=matrix(c(1,2,3,4), ncol=2))
  103. # plot_ly(data, x= ~x1, y= ~y)
  104. # export(plotL(seq(-1, 2, 0.1), seq(-0.5, 1.5, 0.1)), "l.png")
  105. renPlot <- plotL(seq(-1, 1, 0.03), seq(-1, 1, 0.03))
  106. L(c(4,6), data, a)
  107. L(c(4,4.1), data, a)
  108. L(c(4.1,4), data, a)
Add Comment
Please, Sign In to add comment