API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jun 25th, 2016
146
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 12.77 KB | None | 0 0
raw download clone embed print report
  1.  
  2. ################################################################################
  3.  
  4. ### Experiment 4: Patch the bins function
  5. library("ggplot2")
  6. bins <- function (breaks, closed = c("right", "left"), fuzz = 1e-08 *
  7. stats::median(diff(breaks)))
  8. {
  9. stopifnot(is.numeric(breaks))
  10. closed <- match.arg(closed)
  11. breaks <- sort(breaks)
  12. if (closed == "right") {
  13. fuzzes <- c(-fuzz, rep.int(fuzz, length(breaks) - 1))
  14. }
  15. else {
  16. fuzzes <- c(rep.int(-fuzz, length(breaks) - 1), fuzz)
  17. }
  18.  
  19. ## PATCH
  20. print(breaks)
  21. ## [1] -1.00 -0.95 -0.90 -0.85 -0.80 -0.75 -0.70 -0.65
  22. ## [9] -0.60 -0.55 -0.50 -0.45 -0.40 -0.35 -0.30 -0.25
  23. ## [17] -0.20 -0.15 -0.10 -0.05 0.00 0.05 0.10 0.15
  24. ## [25] 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55
  25. ## [33] 0.60 0.65 0.70 0.75 0.80 0.85 0.90 0.95
  26. ## [41] 1.00
  27.  
  28. fuzzy = breaks + fuzzes
  29. print(fuzzy)
  30. ## [1] -1.0e+00 -9.5e-01 -9.0e-01 -8.5e-01 -8.0e-01
  31. ## [6] -7.5e-01 -7.0e-01 -6.5e-01 -6.0e-01 -5.5e-01
  32. ## [11] -5.0e-01 -4.5e-01 -4.0e-01 -3.5e-01 -3.0e-01
  33. ## [16] -2.5e-01 -2.0e-01 -1.5e-01 -1.0e-01 -5.0e-02
  34. ## [21] -5.0e-10 5.0e-02 1.0e-01 1.5e-01 2.0e-01
  35. ## [26] 2.5e-01 3.0e-01 3.5e-01 4.0e-01 4.5e-01
  36. ## [31] 5.0e-01 5.5e-01 6.0e-01 6.5e-01 7.0e-01
  37. ## [36] 7.5e-01 8.0e-01 8.5e-01 9.0e-01 9.5e-01
  38. ## [41] 1.0e+00
  39.  
  40. structure(list(breaks = breaks, fuzzy = breaks + fuzzes,
  41. right_closed = closed == "right"), class = "ggplot2_bins")
  42. ## THIS IS THE PATCHED FUNCTION
  43. }
  44. assignInNamespace("bins", bins, ns = "ggplot2")
  45.  
  46. # ggplot2:::bins # check
  47. df <- data.frame(var = seq(-100,100,10)/100)
  48. p <- ggplot(data = df, aes(x = var)) + geom_histogram(aes(y = ..count..), binwidth = 0.05, boundary = 1, closed = "left")
  49. p
  50.  
  51.  
  52. ################################################################################
  53.  
  54. ### Experiment 5: Patch the bin_vector function
  55. library("ggplot2")
  56. bin_vector <- function(x, bins, weight = NULL, pad = FALSE) {
  57. stopifnot(ggplot2:::is_bins(bins))
  58.  
  59. if (all(is.na(x))) {
  60. return(ggplot2:::bin_out(length(x), NA, NA, xmin = NA, xmax = NA))
  61. }
  62.  
  63. if (is.null(weight)) {
  64. weight <- rep(1, length(x))
  65. } else {
  66. weight[is.na(weight)] <- 0
  67. }
  68.  
  69. ## PATCH
  70. print("weight")
  71. print(weight)
  72. ## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
  73.  
  74. ## PATCH
  75. print("str(bins)")
  76. print(str(bins))
  77. ## List of 3
  78. ## $ breaks : num [1:41] -1 -0.95 -0.9 -0.85 -0.8 -0.75 -0.7 -0.65 -0.6 -0.55 ...
  79. ## $ fuzzy : num [1:41] -1 -0.95 -0.9 -0.85 -0.8 ...
  80. ## $ right_closed: logi FALSE
  81. ## - attr(*, "class")= chr "ggplot2_bins"
  82. ## NULL
  83.  
  84. ## PATCH
  85. print("bins$fuzzy")
  86. print(bins$fuzzy)
  87. ## [1] "bins$fuzzy"
  88. ## [1] -1.0e+00 -9.5e-01 -9.0e-01 -8.5e-01 -8.0e-01
  89. ## [6] -7.5e-01 -7.0e-01 -6.5e-01 -6.0e-01 -5.5e-01
  90. ## [11] -5.0e-01 -4.5e-01 -4.0e-01 -3.5e-01 -3.0e-01
  91. ## [16] -2.5e-01 -2.0e-01 -1.5e-01 -1.0e-01 -5.0e-02
  92. ## [21] -5.0e-10 5.0e-02 1.0e-01 1.5e-01 2.0e-01
  93. ## [26] 2.5e-01 3.0e-01 3.5e-01 4.0e-01 4.5e-01
  94. ## [31] 5.0e-01 5.5e-01 6.0e-01 6.5e-01 7.0e-01
  95. ## [36] 7.5e-01 8.0e-01 8.5e-01 9.0e-01 9.5e-01
  96. ## [41] 1.0e+00
  97.  
  98. ## PATCH
  99. print("bins$breaks")
  100. print(bins$breaks)
  101. ## [1] -1.00 -0.95 -0.90 -0.85 -0.80 -0.75 -0.70 -0.65
  102. ## [9] -0.60 -0.55 -0.50 -0.45 -0.40 -0.35 -0.30 -0.25
  103. ## [17] -0.20 -0.15 -0.10 -0.05 0.00 0.05 0.10 0.15
  104. ## [25] 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55
  105. ## [33] 0.60 0.65 0.70 0.75 0.80 0.85 0.90 0.95
  106. ## [41] 1.00
  107.  
  108. ## PATCH
  109. print("bins$right_closed")
  110. print(bins$right_closed)
  111. ## [1] FALSE
  112.  
  113. # bin_idx <- cut(x, bins$breaks, right = bins$right_closed,
  114. # include.lowest = TRUE)
  115.  
  116. ## PATCH
  117. ## Replace bins$breaks with bins$fuzzy
  118. bin_idx <- cut(x, bins$fuzzy, right = bins$right_closed,
  119. include.lowest = TRUE)
  120.  
  121.  
  122. ## PATCH
  123. print("dput(bin_idx)")
  124. print(dput(bin_idx)) ## should I see fuzz here?
  125. ## bin_idx <- structure(c(1L, 3L, 5L, 7L, 9L, 11L, 12L, 14L, 16L, 18L, 21L,
  126. ## 22L, 24L, 26L, 28L, 31L, 32L, 34L, 37L, 38L, 40L), .Label = c("[-1,-0.95)",
  127. ## "[-0.95,-0.9)", "[-0.9,-0.85)", "[-0.85,-0.8)", "[-0.8,-0.75)",
  128. ## "[-0.75,-0.7)", "[-0.7,-0.65)", "[-0.65,-0.6)", "[-0.6,-0.55)",
  129. ## "[-0.55,-0.5)", "[-0.5,-0.45)", "[-0.45,-0.4)", "[-0.4,-0.35)",
  130. ## "[-0.35,-0.3)", "[-0.3,-0.25)", "[-0.25,-0.2)", "[-0.2,-0.15)",
  131. ## "[-0.15,-0.1)", "[-0.1,-0.05)", "[-0.05,0)", "[0,0.05)", "[0.05,0.1)",
  132. ## "[0.1,0.15)", "[0.15,0.2)", "[0.2,0.25)", "[0.25,0.3)", "[0.3,0.35)",
  133. ## "[0.35,0.4)", "[0.4,0.45)", "[0.45,0.5)", "[0.5,0.55)", "[0.55,0.6)",
  134. ## "[0.6,0.65)", "[0.65,0.7)", "[0.7,0.75)", "[0.75,0.8)", "[0.8,0.85)",
  135. ## "[0.85,0.9)", "[0.9,0.95)", "[0.95,1]"), class = "factor")
  136.  
  137. bin_count <- as.numeric(tapply(weight, bin_idx, sum, na.rm = TRUE))
  138. bin_count[is.na(bin_count)] <- 0
  139.  
  140. ## PATCH
  141. print("bin_count")
  142. print(bin_count) ## The bin_count is incorrect
  143. ## [1] 1 0 1 0 1 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 1 1 0 1
  144. ## [25] 0 1 0 1 0 0 1 1 0 1 0 0 1 1 0 1
  145.  
  146. bin_x <- (bins$breaks[-length(bins$breaks)] + bins$breaks[-1]) / 2
  147. bin_widths <- diff(bins$breaks)
  148.  
  149. # Pad row of 0s at start and end
  150. if (pad) {
  151. bin_count <- c(0, bin_count, 0)
  152.  
  153. width1 <- bin_widths[1]
  154. widthn <- bin_widths[length(bin_widths)]
  155.  
  156. bin_widths <- c(width1, bin_widths, widthn)
  157. bin_x <- c(bin_x[1] - width1, bin_x, bin_x[length(bin_x)] + widthn)
  158. }
  159.  
  160. # Add row for missings
  161. if (any(is.na(bins))) {
  162. bin_count <- c(bin_count, sum(is.na(bins)))
  163. bin_widths <- c(bin_widths, NA)
  164. bin_x <- c(bin_x, NA)
  165. }
  166.  
  167. ggplot2:::bin_out(bin_count, bin_x, bin_widths)
  168. ## THIS IS THE PATCHED FUNCTION
  169. }
  170. assignInNamespace("bin_vector", bin_vector, ns = "ggplot2")
  171. df <- data.frame(var = seq(-100,100,10)/100)
  172. p <- ggplot(data = df, aes(x = var)) + geom_histogram(aes(y = ..count..), binwidth = 0.05, boundary = 1, closed = "left")
  173. p
  174.  
  175.  
  176.  
  177. ################################################################################
  178.  
  179. ### Experiment 6: Patch the bin_breaks function
  180. library("ggplot2")
  181. bin_breaks <- function(breaks, closed = c("right", "left")) {
  182. ## PATCH
  183. print(breaks)
  184. ## [1] -1.00 -0.95 -0.90 -0.85 -0.80 -0.75 -0.70 -0.65
  185. ## [9] -0.60 -0.55 -0.50 -0.45 -0.40 -0.35 -0.30 -0.25
  186. ## [17] -0.20 -0.15 -0.10 -0.05 0.00 0.05 0.10 0.15
  187. ## [25] 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55
  188. ## [33] 0.60 0.65 0.70 0.75 0.80 0.85 0.90 0.95
  189. ## [41] 1.00
  190. ggplot2:::bins(breaks, closed)
  191. ## THIS IS THE PATCHED FUNCTION
  192. }
  193. assignInNamespace("bin_breaks", bin_breaks, ns = "ggplot2")
  194. df <- data.frame(var = seq(-100,100,10)/100)
  195. p <- ggplot(data = df, aes(x = var)) + geom_histogram(aes(y = ..count..), binwidth = 0.05, boundary = 1, closed = "left")
  196. p
  197.  
  198.  
  199.  
  200. ################################################################################
  201.  
  202. ### Experiment 7: Patch the StatBin ggproto object
  203. library("ggplot2")
  204. StatBin <- ggproto("StatBin", Stat,
  205. setup_params = function(data, params) {
  206. if (!is.null(data$y) || !is.null(params$y)) {
  207. stop("stat_bin() must not be used with a y aesthetic.", call. = FALSE)
  208. }
  209. if (is.integer(data$x)) {
  210. stop('StatBin requires a continuous x variable the x variable is discrete. Perhaps you want stat="count"?',
  211. call. = FALSE)
  212. }
  213.  
  214. if (!is.null(params$drop)) {
  215. warning("`drop` is deprecated. Please use `pad` instead.", call. = FALSE)
  216. params$drop <- NULL
  217. }
  218. if (!is.null(params$origin)) {
  219. warning("`origin` is deprecated. Please use `boundary` instead.", call. = FALSE)
  220. params$boundary <- params$origin
  221. params$origin <- NULL
  222. }
  223. if (!is.null(params$right)) {
  224. warning("`right` is deprecated. Please use `closed` instead.", call. = FALSE)
  225. params$closed <- if (params$right) "right" else "left"
  226. params$right <- NULL
  227. }
  228. if (!is.null(params$width)) {
  229. stop("`width` is deprecated. Do you want `geom_bar()`?", call. = FALSE)
  230. }
  231. if (!is.null(params$boundary) && !is.null(params$center)) {
  232. stop("Only one of `boundary` and `center` may be specified.", call. = FALSE)
  233. }
  234.  
  235. if (is.null(params$breaks) && is.null(params$binwidth) && is.null(params$bins)) {
  236. message_wrap("`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.")
  237. params$bins <- 30
  238. }
  239.  
  240. params
  241. },
  242.  
  243. compute_group = function(data, scales, binwidth = NULL, bins = NULL,
  244. center = NULL, boundary = NULL,
  245. closed = c("right", "left"), pad = FALSE,
  246. # The following arguments are not used, but must
  247. # be listed so parameters are computed correctly
  248. breaks = NULL, origin = NULL, right = NULL,
  249. drop = NULL, width = NULL) {
  250. ## PATCH
  251. print(str(bins))
  252. ## NULL
  253.  
  254. if (!is.null(breaks)) {
  255. bins <- ggplot2:::bin_breaks(breaks, closed)
  256. ## PATCH
  257. print("loop level 1")
  258. print(str(bins))
  259. } else if (!is.null(binwidth)) {
  260. bins <- ggplot2:::bin_breaks_width(scales$x$dimension(), binwidth, center = center,
  261. boundary = boundary, closed = closed)
  262. ## PATCH
  263. print("loop level 2")
  264. print(str(bins))
  265. ## [1] "loop level 2"
  266. ## List of 3
  267. ## $ breaks : num [1:41] -1 -0.95 -0.9 -0.85 -0.8 -0.75 -0.7 -0.65 -0.6 -0.55 ...
  268. ## $ fuzzy : num [1:41] -1 -0.95 -0.9 -0.85 -0.8 ...
  269. ## $ right_closed: logi FALSE
  270. ## - attr(*, "class")= chr "ggplot2_bins"
  271. print("bins$fuzzy")
  272. print(bins$fuzzy)
  273. ## [1] -1.0e+00 -9.5e-01 -9.0e-01 -8.5e-01 -8.0e-01
  274. ## [6] -7.5e-01 -7.0e-01 -6.5e-01 -6.0e-01 -5.5e-01
  275. ## [11] -5.0e-01 -4.5e-01 -4.0e-01 -3.5e-01 -3.0e-01
  276. ## [16] -2.5e-01 -2.0e-01 -1.5e-01 -1.0e-01 -5.0e-02
  277. ## [21] -5.0e-10 5.0e-02 1.0e-01 1.5e-01 2.0e-01
  278. ## [26] 2.5e-01 3.0e-01 3.5e-01 4.0e-01 4.5e-01
  279. ## [31] 5.0e-01 5.5e-01 6.0e-01 6.5e-01 7.0e-01
  280. ## [36] 7.5e-01 8.0e-01 8.5e-01 9.0e-01 9.5e-01
  281. ## [41] 1.0e+00
  282.  
  283. } else {
  284. bins <- ggplot2:::bin_breaks_bins(scales$x$dimension(), bins, center = center,
  285. boundary = boundary, closed = closed)
  286. ## PATCH
  287. print("loop level 3")
  288. print(str(bins))
  289. }
  290.  
  291. ggplot2:::bin_vector(data$x, bins, weight = data$weight, pad = pad)
  292. },
  293.  
  294. default_aes = ggplot2:::aes(y = ..count..),
  295. required_aes = c("x")
  296. )
  297.  
  298. assignInNamespace("StatBin", StatBin, ns = "ggplot2")
  299. df <- data.frame(var = seq(-100,100,10)/100)
  300. p <- ggplot(data = df, aes(x = var)) + geom_histogram(aes(y = ..count..), binwidth = 0.05, boundary = 1, closed = "left")
  301. p
  302.  
  303.  
  304.  
  305.  
  306. ################################################################################
  307.  
  308. ### Experiment 8: Patch the bin_breaks_width function
  309. library("ggplot2")
  310. bin_breaks_width <- function(x_range, width = NULL, center = NULL,
  311. boundary = NULL, closed = c("right", "left")) {
  312. stopifnot(length(x_range) == 2)
  313.  
  314. # if (length(x_range) == 0) {
  315. # return(bin_params(numeric()))
  316. # }
  317. stopifnot(is.numeric(width), length(width) == 1)
  318. if (width <= 0) {
  319. stop("`binwidth` must be positive", call. = FALSE)
  320. }
  321.  
  322. if (!is.null(boundary) && !is.null(center)) {
  323. stop("Only one of 'boundary' and 'center' may be specified.")
  324. } else if (is.null(boundary)) {
  325. if (is.null(center)) {
  326. # If neither edge nor center given, compute both using tile layer's
  327. # algorithm. This puts min and max of data in outer half of their bins.
  328. boundary <- width / 2
  329.  
  330. } else {
  331. # If center given but not boundary, compute boundary.
  332. boundary <- center - width / 2
  333. }
  334. }
  335.  
  336. # Find the left side of left-most bin: inputs could be Dates or POSIXct, so
  337. # coerce to numeric first.
  338. x_range <- as.numeric(x_range)
  339. width <- as.numeric(width)
  340. boundary <- as.numeric(boundary)
  341. shift <- floor((x_range[1] - boundary) / width)
  342. origin <- boundary + shift * width
  343.  
  344. # Small correction factor so that we don't get an extra bin when, for
  345. # example, origin = 0, max(x) = 20, width = 10.
  346. max_x <- x_range[2] + (1 - 1e-08) * width
  347. breaks <- seq(origin, max_x, width)
  348.  
  349. ## PATCH
  350. print(max_x)
  351. ## [1] 1.05
  352.  
  353. ## PATCH
  354. print(breaks)
  355. ## [1] -1.00 -0.95 -0.90 -0.85 -0.80 -0.75 -0.70 -0.65
  356. ## [9] -0.60 -0.55 -0.50 -0.45 -0.40 -0.35 -0.30 -0.25
  357. ## [17] -0.20 -0.15 -0.10 -0.05 0.00 0.05 0.10 0.15
  358. ## [25] 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55
  359. ## [33] 0.60 0.65 0.70 0.75 0.80 0.85 0.90 0.95
  360. ## [41] 1.00
  361.  
  362. ggplot2:::bin_breaks(breaks, closed = closed)
  363. ## THIS IS THE PATCHED FUNCTION
  364. }
  365. assignInNamespace("bin_breaks_width", bin_breaks_width, ns = "ggplot2")
  366. df <- data.frame(var = seq(-100,100,10)/100)
  367. p <- ggplot(data = df, aes(x = var)) + geom_histogram(aes(y = ..count..), binwidth = 0.05, boundary = 1, closed = "left")
  368. p
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!