├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── R ├── demand.R ├── econocharts-package.R ├── globals.R ├── indiference.R ├── intersect.R ├── laffer.R ├── neolabsup.R ├── ppf.R ├── ptvalue.R ├── sdcurve.R ├── supply.R ├── tax.R └── zzz.R ├── README.md ├── econocharts.Rproj └── man ├── curve_intersect.Rd ├── demand.Rd ├── econocharts-package.Rd ├── indifference.Rd ├── laffer.Rd ├── neolabsup.Rd ├── ppf.Rd ├── ptvalue.Rd ├── sdcurve.Rd ├── supply.Rd └── tax_graph.Rd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: econocharts 2 | Title: Microeconomics and Macroeconomics Charts Made with 'ggplot2' 3 | Version: 1.0 4 | Authors@R: c( 5 | person("José Carlos", "Soage González", email = "jsoage@uvigo.es", role = c("aut", "cre")), 6 | person("Andrew", "Heiss", email = "andrewheiss@gmail.com", role = "aut")) 7 | Description: Contains several functions for creating fully-customizable microeconomics or macroeconomics charts, such as supply and demand curves, indifference curves, production-possibility frontiers or Laffer curves. 8 | Imports: ggplot2, dplyr, Hmisc, scales, glue 9 | License: MIT + file LICENSE 10 | Encoding: UTF-8 11 | URL: https://r-coder.com/, https://r-coder.com/economics-charts-r/ 12 | LazyData: true 13 | Roxygen: list(markdown = TRUE) 14 | RoxygenNote: 7.1.1 15 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2020 2 | COPYRIGHT HOLDER: José Carlos Soage González 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2020 José Carlos Soage González 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | 23 | 24 | 25 | # MIT License 26 | 27 | Copyright (c) 2017 Andrew Heiss 28 | 29 | Permission is hereby granted, free of charge, to any person obtaining a copy 30 | of this software and associated documentation files (the "Software"), to deal 31 | in the Software without restriction, including without limitation the rights 32 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 33 | copies of the Software, and to permit persons to whom the Software is 34 | furnished to do so, subject to the following conditions: 35 | 36 | The above copyright notice and this permission notice shall be included in all 37 | copies or substantial portions of the Software. 38 | 39 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 40 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 41 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 42 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 43 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 44 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 45 | SOFTWARE. 46 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(curve_intersect) 4 | export(demand) 5 | export(indifference) 6 | export(laffer) 7 | export(neolabsup) 8 | export(ppf) 9 | export(ptvalue) 10 | export(sdcurve) 11 | export(supply) 12 | export(tax_graph) 13 | import(dplyr) 14 | import(ggplot2) 15 | importFrom(stats,approxfun) 16 | importFrom(stats,uniroot) 17 | -------------------------------------------------------------------------------- /R/demand.R: -------------------------------------------------------------------------------- 1 | #' @title demand curves 2 | #' 3 | #' @description TODO 4 | #' 5 | #' @param ... Specify the demand curve or curves separated by commas (as `data.frame`) you want to display in the graph. This will override the sample curve. 6 | #' @param ncurves Number of demand curves to be generated based on the sample data. 7 | #' @param xmax Numeric. Allows modifying the maximum X value for the default demand function. 8 | #' @param ymax Numeric. Allows modifying the maximum Y value for the default demand function. 9 | #' @param type Possible values are `"convex"` (default) and `"line"` to plot a convex or a linear demand function by default, respectively. 10 | #' @param x Y-axis values where to create intersections with the demand curves. 11 | #' @param curve_names Boolean. If `TRUE`, the function adds default names to each. 12 | #' @param names If `curve_names = TRUE` are custom names for the curves. 13 | #' @param linecol Line color of the curves. 14 | #' @param labels If `x` is specified, are the labels for the intersection points. 15 | #' @param generic Boolean. If `TRUE` and `x` is specified, the axis labels shows generic names. If `FALSE`, the axis labels are the actual data of the axis that corresponds to the intersection points. 16 | #' @param geom Possible values are `"text"` to display the labels of the intersection points with text and `"label"` to show them with labels. 17 | #' @param geomcol Color of the labels of the intersection points. 18 | #' @param geomfill If `geom = "label"` is the background color of the label. 19 | #' @param main Main title of the plot. 20 | #' @param sub Subtitle of the plot. 21 | #' @param xlab Name of the X-axis. 22 | #' @param ylab Name of the Y-axis. 23 | #' @param bg.col Background color of the plot. 24 | #' @import ggplot2 dplyr 25 | #' @export 26 | demand <- function(..., 27 | ncurves = 1, 28 | # distance = 1, 29 | xmax, 30 | ymax, 31 | type = "convex", 32 | x, 33 | curve_names = TRUE, 34 | names, # Names of the demand curves 35 | linecol, 36 | labels, # Label points 37 | generic = TRUE, 38 | geom = "text", 39 | geomcol = 1, 40 | geomfill = "white", 41 | main = NULL, 42 | sub = NULL, 43 | xlab = NULL, 44 | ylab = NULL, 45 | bg.col = "white") { 46 | 47 | if(!missing(labels)){ 48 | 49 | if(length(labels) == 1) { 50 | if(labels == "") { 51 | labels <- rep("", length(x)) 52 | } 53 | } 54 | 55 | if(length(labels) != length(x)) { 56 | warning(paste("The number of labels provided must be equal to the intersections, so length(labels) must be:", length(x) * ncurves)) 57 | } 58 | 59 | } 60 | 61 | m <- FALSE 62 | 63 | if(missing(...)){ 64 | ncurve <- ncurves 65 | 66 | if(missing(xmax)){ 67 | xmax <- 9 68 | } 69 | 70 | if(missing(ymax)){ 71 | ymax <- 9 72 | } 73 | 74 | if(type == "convex") { 75 | # Sample indifference curve 76 | curve <- data.frame(Hmisc::bezier(c(1, 3, xmax), 77 | c(ymax, 3, 1))) 78 | 79 | m <- TRUE 80 | } 81 | 82 | if(type == "line") { 83 | curve <- data.frame(x = c(0.9, xmax), 84 | y = c(ymax, 0.9)) 85 | m <- TRUE 86 | } 87 | } else{ 88 | curve <- list(...) 89 | ncurve <- length(curve) 90 | 91 | class <- vector("character", ncurve) 92 | 93 | for(i in 1:ncurve) { 94 | 95 | class[i] <- class(curve[[i]]) 96 | 97 | } 98 | 99 | if(any(class != "data.frame")) { 100 | stop("You can only pass data frames to the '...' argument") 101 | } 102 | 103 | if(ncurve == 1){ 104 | m <- TRUE 105 | } 106 | } 107 | 108 | if(missing(linecol)){ 109 | 110 | if(missing(...)){ 111 | linecol <- 1 112 | } 113 | 114 | if(!missing(...) & ncurve == 1){ 115 | linecol <- 1 116 | } 117 | 118 | if(!missing(...) & ncurve > 1){ 119 | linecol <- rep(1, ncurve) 120 | } 121 | } else { 122 | 123 | if(!missing(...) & length(linecol) == 1){ 124 | linecol <- rep(linecol, ncurve) 125 | } 126 | } 127 | 128 | if(!missing(x)){ 129 | 130 | if(any(x < 0) | any(x > max(data.frame(curve)$y))) { 131 | warning("There are values on the 'x' argument lower than 0 or greater than the maximun value of the curve") 132 | x <- x[x <= max(data.frame(curve)$y)] 133 | } 134 | 135 | # Calculate the intersections of the curves 136 | intersections <- tibble() 137 | 138 | if((missing(...) | length(curve) == 1) & ncurves == 1) { 139 | 140 | for(i in 1:length(x)) { 141 | intersections <- intersections %>% 142 | bind_rows(curve_intersect(data.frame(x = c(0, 10000), y = rep(x[i], 2)), data.frame(curve))) 143 | 144 | } 145 | } else { 146 | 147 | intersections <- vector("list", ncurve) 148 | 149 | if(ncurves > 1) { 150 | 151 | if(length(x) == 1) { 152 | w <- 0 153 | for(i in 1:ncurve){ 154 | 155 | for(j in 1:length(x)) { 156 | 157 | intersections[[i]][[j]] <- bind_rows(curve_intersect(data.frame(x = 1:1000, y = rep(x[j], nrow(curve))), data.frame(x = curve$x + w, y = curve$y))) 158 | w <- w + 1 159 | } 160 | } 161 | 162 | intersections <- bind_rows(intersections) 163 | } else { 164 | stop("Multiple intersections with ncurves > 1 is not implemented yet") 165 | } 166 | 167 | } else { 168 | 169 | for(i in 1:ncurve){ 170 | 171 | for(j in 1:length(x)) { 172 | 173 | intersections[[i]][[j]] <- bind_rows(curve_intersect(data.frame(x = 1:1000, y = rep(x[j], nrow(curve[[1]]))), curve[[i]])) 174 | } 175 | } 176 | 177 | intersections <- bind_rows(intersections) 178 | 179 | } 180 | } 181 | # print(intersections) 182 | } 183 | 184 | if(missing(labels) & !missing(x)){ 185 | labels <- LETTERS[1:nrow(intersections)] 186 | } 187 | 188 | p <- ggplot(mapping = aes(x = x, y = y)) 189 | 190 | 191 | if(missing(...) | m){ 192 | 193 | for(i in 0:(ncurves - 1)) { 194 | p <- p + geom_line(data = data.frame(x = curve$x + i, y = curve$y), color = linecol, size = 1, linetype = 1) 195 | } 196 | 197 | } else { 198 | 199 | for(i in 1:length(curve)) { 200 | p <- p + geom_line(data = data.frame(curve[[i]]), color = linecol[i], size = 1, linetype = 1) 201 | } 202 | } 203 | 204 | if(curve_names == TRUE) { 205 | 206 | if(ncurves == 1) { 207 | 208 | if(missing(names)) { 209 | names <- "D" 210 | } 211 | 212 | p <- p + annotate(geom = "text", x = max(as.data.frame(curve)$x) + 0.5, y = min(as.data.frame(curve)$y), label = names, parse = TRUE, 213 | size = 4, color = geomcol) 214 | } else { 215 | 216 | if(missing(names)) { 217 | names <- sapply(1:ncurves, function(i) paste0("D[", i, "]")) 218 | } 219 | 220 | j <- 0 221 | for(i in 1:ncurves){ 222 | p <- p + annotate(geom = "text", x = max(as.data.frame(curve)$x) + j + 0.35, y = min(as.data.frame(curve)$xy), label = names[i], parse = TRUE, 223 | size = 4, color = geomcol) 224 | j <- j + 1 225 | } 226 | } 227 | 228 | } 229 | 230 | if(!missing(x)) { 231 | p <- p + geom_segment(data = intersections, 232 | aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") + 233 | 234 | geom_segment(data = intersections, 235 | aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") + 236 | geom_point(data = intersections, size = 3) 237 | 238 | 239 | if(geom == "label") { 240 | for(i in 1:nrow(intersections)){ 241 | 242 | p <- p + annotate(geom = "label", x = unlist(intersections[1][i, ]) + 0.35, y = unlist(intersections[2][i, ]), label = labels[i], 243 | size = 4, fill = geomfill, color = geomcol) 244 | } 245 | } 246 | 247 | if(geom == "text") { 248 | 249 | for(i in 1:nrow(intersections)){ 250 | 251 | p <- p + annotate(geom = "text", x = unlist(intersections[1][i, ]) + 0.35, y = unlist(intersections[2][i, ]), label = labels[i], 252 | size = 4, color = geomcol) 253 | } 254 | } 255 | 256 | if(generic == FALSE) { 257 | 258 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 259 | breaks = intersections$x, labels = round(intersections$x, 2)) + 260 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + 1), 261 | breaks = unique(round(intersections$y, 2)), labels = unique(round(intersections$y, 2))) 262 | 263 | } else { 264 | 265 | if(ncurve == 1 & missing(...)){ 266 | 267 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 268 | breaks = intersections$x, labels = sapply(length(x):1, function(i) as.expression(bquote(X[.(LETTERS[i])])))) + 269 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 270 | breaks = round(intersections$y, 2), labels = sapply(length(x):1, function(i) as.expression(bquote(Y[.(LETTERS[i])])))) 271 | } else { 272 | 273 | labels <- rev(sapply(length(intersections$x):1, function(i) as.expression(bquote(P[.(LETTERS[i])])))) 274 | 275 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 276 | breaks = intersections$x, labels = labels) + 277 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 278 | breaks = x, labels = sapply(length(x):1, function(i) as.expression(bquote(Q[.(LETTERS[i])])))) 279 | } 280 | 281 | } 282 | } else { 283 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves)) + 284 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves)) 285 | } 286 | 287 | p <- p + labs(x = xlab, y = ylab, title = main, subtitle = sub) 288 | 289 | p <- p + 290 | # coord_equal() + 291 | theme_classic() + 292 | theme(plot.title = element_text(size = rel(1.3)), 293 | # axis.text.x = element_text(colour = linecol), 294 | axis.title.y = element_text(margin = margin(t = 0, r = 10, b = 0, l = 0), angle = 0, vjust = 1), 295 | axis.title.x = element_text(margin = margin(t = 0, r = 25, b = 0, l = 0), angle = 0, hjust = 1), 296 | plot.background = element_rect(fill = bg.col), 297 | plot.margin = margin(0.5, 1, 0.5, 0.5, "cm")) 298 | 299 | if(!missing(x)){ 300 | return(list(p = p, intersections = intersections, curve = curve)) 301 | } else { 302 | return(list(p = p, curve = curve)) 303 | } 304 | } 305 | 306 | -------------------------------------------------------------------------------- /R/econocharts-package.R: -------------------------------------------------------------------------------- 1 | #' @title econocharts: Microeconomics and Macroeconomics charts Made with 'ggplot2' 2 | #' 3 | #' @description This package allows creating microeconomics and macroeconomics charts, like supply and demand curves, production-possibility frontiers, indifference curves, Laffer curves or customized charts with very simple functions. 4 | #' 5 | #' @details 6 | #' \itemize{ 7 | #' \item{Package: econocharts} 8 | #' \item{Version: 1.0} 9 | #' \item{Maintainer: José Carlos Soage González \email{jsoage@@uvigo.es}} 10 | #' } 11 | #' 12 | #' @author 13 | #' \itemize{ 14 | #' \item{Soage González, José Carlos.} 15 | #' \item{Weiss, Andrew.} 16 | #' } 17 | #' 18 | #' @seealso 19 | #' \itemize{ 20 | #' \item{\href{https://r-coder.com/}{R tutorials}} 21 | #' } 22 | #' 23 | #' @docType package 24 | #' @name econocharts-package 25 | NULL 26 | -------------------------------------------------------------------------------- /R/globals.R: -------------------------------------------------------------------------------- 1 | utils::globalVariables(c("x", "y", "text", "fill", "lab", "ticks", "zero")) 2 | -------------------------------------------------------------------------------- /R/indiference.R: -------------------------------------------------------------------------------- 1 | #' @title Indifference curves 2 | #' 3 | #' @description TODO 4 | #' 5 | #' @param ... Specify the curve or curves separated by commas (as `data.frame`) you want to display in the graph. This will override the sample curve. 6 | #' @param ncurves If `...` is not specified, is the number of indifference curves to be generated based on the sample data. 7 | #' @param xmax Numeric. Allows modifying the maximum X value for the default indifference function. 8 | #' @param ymax Numeric. Allows modifying the maximum Y value for the default indifference function. 9 | #' @param type Possible values are `"normal`, for a normal indifference function, `"psubs"` for perfect substitute and `"pcom"` for perfect complements. 10 | #' @param x Y-axis values where to create intersections with the indifference curves. 11 | #' @param pointcol If `x` is specified, is the color of the points that represents the intersections. 12 | #' @param curve_names Boolean. If `TRUE`, the function adds default names to each. 13 | #' @param names If `curve_names = TRUE` are custom names for the curves. 14 | #' @param linecol Line color of the curves. 15 | #' @param labels If `x` is specified are the labels for the intersection points. 16 | #' @param generic Boolean. If `TRUE` and `x` is specified, the axis labels shows generic names. If `FALSE`, the axis labels are the actual data of the axis that corresponds to the intersection points. 17 | #' @param geom Possible values are `"text"` to display the labels of the intersection points with text and `"label"` to show them with labels. 18 | #' @param geomcol Color of the labels of the intersection points. 19 | #' @param geomfill If `geom = "label"` is the background color of the label. 20 | #' @param main Main title of the plot. 21 | #' @param sub Subtitle of the plot. 22 | #' @param xlab Name of the X-axis. 23 | #' @param ylab Name of the Y-axis. 24 | #' @param bg.col Background color of the plot. 25 | #' @import ggplot2 dplyr 26 | #' @export 27 | indifference <- function(..., 28 | ncurves = 1, 29 | xmax, 30 | ymax, 31 | type = "normal", 32 | x, 33 | pointcol = 1, 34 | curve_names = TRUE, 35 | names, 36 | linecol, 37 | labels, 38 | generic = TRUE, 39 | geom = "text", 40 | geomcol = 1, 41 | geomfill = "white", 42 | main = NULL, 43 | sub = NULL, 44 | xlab = NULL, 45 | ylab = NULL, 46 | bg.col = "white"){ 47 | 48 | m <- FALSE 49 | 50 | match.arg(type, choices = c("normal", "psubs", "pcom")) 51 | 52 | if(missing(...)){ 53 | ncurve <- ncurves 54 | 55 | if(missing(xmax)){ 56 | xmax <- 9 57 | } 58 | 59 | if(missing(ymax)){ 60 | ymax <- 9 61 | } 62 | 63 | if(type == "normal") { 64 | # Example indifference curve 65 | curve <- data.frame(Hmisc::bezier(c(0.9, xmax - 6, xmax), 66 | c(ymax, ymax - 6, 0.9))) 67 | 68 | m <- TRUE 69 | } 70 | 71 | if(type == "psubs") { 72 | curve <- data.frame(x = c(0.9, xmax), 73 | y = c(ymax, 0.9)) 74 | m <- TRUE 75 | } 76 | 77 | if(type == "pcom") { 78 | curve <- data.frame(x = c(rep(0.9, 10), seq(0.9, 9, length.out = 10)), 79 | y = c(seq(0.9, 9, length.out = 10), rep(0.9, 10))) 80 | m <- TRUE 81 | } 82 | 83 | } else{ 84 | 85 | curve <- list(...) 86 | 87 | class <- vector("character", length(curve)) 88 | 89 | for(i in 1:length(curve)) { 90 | 91 | class[i] <- class(curve[[i]]) 92 | 93 | } 94 | 95 | if(any(class != "data.frame")) { 96 | stop("You can only pass data frames to the '...' argument") 97 | } 98 | 99 | 100 | ncurve <- length(curve) 101 | if(ncurve == 1){ 102 | m <- TRUE 103 | } 104 | } 105 | 106 | if(missing(names)) { 107 | names <- sapply(1:ncurves, function(i) paste0("I[", i, "]")) 108 | } 109 | 110 | if(missing(linecol)){ 111 | 112 | if(missing(...)){ 113 | linecol <- 1 114 | } 115 | 116 | if(!missing(...) & ncurve == 1){ 117 | linecol <- 1 118 | } 119 | 120 | if(!missing(...) & ncurve > 1){ 121 | linecol <- rep(1, ncurve) 122 | } 123 | } else { 124 | 125 | if(!missing(...) & length(linecol) == 1){ 126 | linecol <- rep(linecol, ncurve) 127 | } else { 128 | 129 | # linecols <- vector("list", length = ncurves) 130 | # 131 | # for(i in 1:ncurves){ 132 | # linecols[[i]] <- rep(linecol[i], nrow(curve)/ ncurves) 133 | # } 134 | # 135 | # linecol <- unlist(linecols) 136 | 137 | } 138 | } 139 | 140 | if(missing(labels) & !missing(x)){ 141 | labels <- LETTERS[1:length(x)] 142 | } 143 | 144 | if(!missing(x)){ 145 | 146 | if(any(x < 0) | any(x > max(data.frame(curve)$y))) { 147 | warning("There are values on the 'x' argument lower than 0 or greater than the maximun value of the curve") 148 | x <- x[x <= max(data.frame(curve)$y)] 149 | } 150 | 151 | 152 | if(type == "pcom") { 153 | warning("Intersections not available for perfect complements. Please add the points manually") 154 | } else { 155 | # Calculate the intersections of the curves 156 | intersections <- tibble() 157 | 158 | if(missing(...) | length(curve) == 1) { 159 | 160 | for(i in 1:length(x)) { 161 | intersections <- intersections %>% 162 | bind_rows(curve_intersect(data.frame(x = c(0, 10000), y = rep(x[i], 2)), data.frame(curve))) 163 | 164 | } 165 | } else { 166 | 167 | intersections <- vector("list", ncurve) 168 | for(i in 1:ncurve){ 169 | 170 | for(j in 1:length(x)) { 171 | 172 | intersections[[i]][[j]] <- bind_rows(curve_intersect(data.frame(x = 1:1000, y = rep(x[j], nrow(curve[[1]]))), curve[[i]])) 173 | } 174 | 175 | } 176 | intersections <- bind_rows(intersections) 177 | } 178 | # print(intersections) 179 | } 180 | } 181 | 182 | p <- ggplot(mapping = aes(x = x, y = y)) 183 | 184 | 185 | if(missing(...) | m){ 186 | 187 | for(i in 0:(ncurves - 1)) { 188 | p <- p + geom_line(data = data.frame(curve) + i, color = linecol, size = 1, linetype = 1) 189 | } 190 | 191 | } else { 192 | 193 | for(i in 1:length(curve)) { 194 | p <- p + geom_line(data = data.frame(curve[[i]]), color = linecol[i], size = 1, linetype = 1) 195 | } 196 | } 197 | 198 | if(curve_names == TRUE) { 199 | 200 | if(ncurves == 1) { 201 | p <- p + annotate(geom = "text", x = max(as.data.frame(curve)$x) + 0.5, y = min(as.data.frame(curve)$y), label = "I", 202 | size = 4, color = geomcol) 203 | } else { 204 | 205 | j <- 0 206 | for(i in 1:ncurves){ 207 | p <- p + annotate(geom = "text", x = max(as.data.frame(curve)$x) + j + 0.5, y = min(as.data.frame(curve)$y) + j, label = names[i], parse = TRUE, 208 | size = 4, color = geomcol) 209 | j <- j + 1 210 | } 211 | } 212 | 213 | } 214 | 215 | if(!missing(x) & type != "pcom"){ 216 | 217 | p <- p + geom_segment(data = intersections, 218 | aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") + 219 | 220 | geom_segment(data = intersections, 221 | aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") + 222 | geom_point(data = intersections, size = 3, color = pointcol) 223 | 224 | 225 | if(geom == "label") { 226 | for(i in 1:length(x)){ 227 | 228 | p <- p + annotate(geom = "label", x = unlist(intersections[1][i, ]) + 0.25, y = unlist(intersections[2][i, ]) + 0.25, label = rev(labels)[i], 229 | size = 4, fill = "white", color = geomcol) 230 | } 231 | } 232 | 233 | if(geom == "text") { 234 | for(i in 1:length(x)){ 235 | 236 | p <- p + annotate(geom = "text", x = unlist(intersections[1][i, ]) + 0.25, y = unlist(intersections[2][i, ]) + 0.25, label = rev(labels)[i], 237 | size = 4, color = geomcol) 238 | } 239 | } 240 | 241 | if(generic == FALSE) { 242 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + 1), breaks = intersections$x, labels = round(intersections$x, 2)) + 243 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + 1), breaks = intersections$y, labels = round(intersections$y, 2)) 244 | } else { 245 | 246 | if(ncurve == 1 | missing(...)){ 247 | 248 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 249 | breaks = intersections$x, labels = sapply(length(x):1, function(i) as.expression(bquote(X[.(LETTERS[i])])))) + 250 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 251 | breaks = intersections$y, labels = sapply(length(x):1, function(i) as.expression(bquote(Y[.(LETTERS[i])])))) 252 | } else { 253 | 254 | labels <- sapply(length(intersections$x):1, function(i) as.expression(bquote(X[.(LETTERS[i])]))) 255 | 256 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 257 | breaks = intersections$x, labels = labels) + 258 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 259 | breaks = x, labels = sapply(length(x):1, function(i) as.expression(bquote(Y[.(LETTERS[i])])))) 260 | } 261 | 262 | } 263 | } else { 264 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves)) + 265 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves)) 266 | } 267 | 268 | p <- p + labs(x = xlab, y = ylab, title = main, subtitle = sub) 269 | 270 | p <- p + 271 | # coord_equal() + 272 | theme_classic() + 273 | theme(plot.title = element_text(size = rel(1.3)), 274 | # axis.text.x = element_text(colour = linecol), 275 | axis.title.y = element_text(margin = margin(t = 0, r = 10, b = 0, l = 0), angle = 0, vjust = 1), 276 | axis.title.x = element_text(margin = margin(t = 0, r = 25, b = 0, l = 0), angle = 0, hjust = 1), 277 | plot.background = element_rect(fill = bg.col), 278 | plot.margin = margin(0.5, 1, 0.5, 0.5, "cm")) 279 | 280 | if(!missing(x)){ 281 | return(list(p = p, intersections = intersections, curve = curve)) 282 | } else { 283 | return(list(p = p, curve = curve)) 284 | } 285 | } 286 | -------------------------------------------------------------------------------- /R/intersect.R: -------------------------------------------------------------------------------- 1 | #' @title Intersection of two curves 2 | #' 3 | #' @description Calculate where two lines or curves intersect. Curves are defined as data 4 | #' frames with x and y columns providing cartesian coordinates for the lines. 5 | #' This function works on both linear and nonlinear curves. 6 | #' 7 | #' @param curve1 Either a \code{data.frame} with columns named \code{x} and \code{y} or a function. 8 | #' @param curve2 Either \code{data.frame} with columns named \code{x} and \code{y} or a function. 9 | #' @param empirical If true (default) indicates that the curves are data frames of empirical data. If false, indicates that the curves are actual functions. 10 | #' @param domain Two-value numeric vector indicating the bounds along the x-axis where the intersection should be found when \code{empirical} is false 11 | #' 12 | #' @details For now, \code{curve_intersect} will only find one intersection. 13 | #' 14 | #' If you define curves with empirical data frames (i.e. provide actual values 15 | #' for x and y), ensure that \code{empirical = TRUE}. 16 | #' 17 | #' If you define curves with functions (i.e. \code{curve1 <- x^2}), ensure that 18 | #' \code{empirical = FALSE} and provide a range of x-axis values to search for 19 | #' an intersection using \code{domain}. 20 | #' 21 | #' @return A list with \code{x} and \code{y} values. 22 | #' 23 | #' @author 24 | #' \itemize{ 25 | #' \item{Weiss, Andrew.} 26 | #' } 27 | #' 28 | #' @importFrom stats approxfun uniroot 29 | #' 30 | #' @examples 31 | #' # Straight lines (empirical) 32 | #' line1 <- data.frame(x = c(1, 9), y = c(1, 9)) 33 | #' line2 <- data.frame(x = c(9, 1), y = c(1, 9)) 34 | #' 35 | #' curve_intersect(line1, line2) 36 | #' 37 | #' # Curved lines (empirical) 38 | #' curve1 <- data.frame(Hmisc::bezier(c(1, 8, 9), c(1, 5, 9))) 39 | #' curve2 <- data.frame(Hmisc::bezier(c(1, 3, 9), c(9, 3, 1))) 40 | #' 41 | #' curve_intersect(curve1, curve2) 42 | #' 43 | #' # Curved lines (functional) 44 | #' curve1 <- function(q) (q - 10)^2 45 | #' curve2 <- function(q) q^2 + 2*q + 8 46 | #' 47 | #' curve_intersect(curve1, curve2, empirical = FALSE, domain = c(0, 5)) 48 | #' @export 49 | curve_intersect <- function(curve1, curve2, empirical = TRUE, domain = NULL) { 50 | if (!empirical & missing(domain)) { 51 | stop("'domain' must be provided with non-empirical curves") 52 | } 53 | 54 | if (!empirical & (length(domain) != 2 | !is.numeric(domain))) { 55 | stop("'domain' must be a two-value numeric vector, like c(0, 10)") 56 | } 57 | 58 | if (empirical) { 59 | 60 | # Approximate the functional form of both curves 61 | curve1_f <- approxfun(curve1$x, curve1$y, rule = 2) 62 | curve2_f <- approxfun(curve2$x, curve2$y, rule = 2) 63 | 64 | # Calculate the intersection of curve 1 and curve 2 along the x-axis 65 | point_x <- uniroot(function(x) curve1_f(x) - curve2_f(x), 66 | c(min(curve1$x), max(curve1$x)))$root 67 | 68 | # Find where point_x is in curve 2 69 | point_y <- curve2_f(point_x) 70 | } else { 71 | # Calculate the intersection of curve 1 and curve 2 along the x-axis 72 | # within the given domain 73 | point_x <- uniroot(function(x) curve1(x) - curve2(x), domain)$root 74 | 75 | # Find where point_x is in curve 2 76 | point_y <- curve2(point_x) 77 | } 78 | # } 79 | 80 | return(list(x = point_x, y = point_y)) 81 | } 82 | 83 | 84 | # APROXIMAR CUANDO LA LINEA ES VERTICAL 85 | 86 | 87 | # linerect <- data.frame(x = c(5,5), y = c(0, 9)) 88 | # 89 | # line3 <- data.frame(x = c(2, 10), y = c(1, 9)) 90 | # 91 | # 92 | # curve_intersect(linerect, line3) # No va 93 | # 94 | # plot(linerect, type = "l") 95 | # lines(line3, type = "l", col = 2) 96 | # 97 | # AF2 = approxfun(line3$x, line3$y) 98 | # AF2(5) 99 | 100 | 101 | # line <- data.frame(x = 0:10, y = rep(3, 11)) 102 | # lines(line) 103 | # curve_intersect(line, curve) 104 | # 105 | # 106 | # 107 | # curve <- data.frame(Hmisc::bezier(c(1, 9, 2), 108 | # c(1, 5, 9))) 109 | # line <- data.frame(x = 0:10, y = rep(3, 11)) 110 | # 111 | # plot(curve$x, curve$y, type = "l") 112 | # lines(line) 113 | # 114 | # 115 | # int <- curve_intersect(curve, line) 116 | # abline(v = int$x) 117 | # 118 | # ggplot(curve, aes(x = x, y = y)) + 119 | # geom_line() + 120 | # geom_path() 121 | -------------------------------------------------------------------------------- /R/laffer.R: -------------------------------------------------------------------------------- 1 | #' @title Laffer curve 2 | #' 3 | #' @description Creates Laffer curves. The function allows specifying a custom Laffer curve, modifying the maximum X and Y axis values, creating intersections along the values of the Y-axis and the curve and customizing the final output with other arguments. 4 | #' 5 | #' @param curve Specify a custom curve (as `data.frame`). This will override the sample curve. 6 | #' @param t Y-axis values where to create intersections with the Laffer curve. 7 | #' @param xmax Numeric. Allows modifying the maximum X value for the default Laffer curve. 8 | #' @param ymax Numeric. Allows modifying the maximum Y value for the default Laffer curve. 9 | #' @param pointcol Color of the point that represents the optimum point. 10 | #' @param generic Boolean. If `TRUE` and `x` is specified, the axis labels shows generic names. If `FALSE`, the axis labels are the actual data of the axis that corresponds to the intersection points and the optimal point. 11 | #' @param showmax If `TRUE`, shows the optimal point. 12 | #' @param main Main title of the plot. 13 | #' @param sub Subtitle of the plot. 14 | #' @param xlab Name of the X-axis. 15 | #' @param ylab Name of the Y-axis. 16 | #' @param acol Color of the area of the curve. 17 | #' @param alpha Transparency of the colored area. 18 | #' @param bg.col Background color of the plot. 19 | #' @import ggplot2 dplyr 20 | #' @export 21 | laffer <- function(curve, t, xmax, ymax, pointcol = 1, generic = TRUE, showmax = TRUE, 22 | main = NULL, sub = NULL, xlab = NULL, ylab = NULL, acol, alpha = 0.3, bg.col = "white"){ 23 | 24 | if(missing(ymax)) { 25 | ymax <- 5 26 | } 27 | 28 | if(missing(xmax)) { 29 | xmax <- 10 30 | } 31 | 32 | if(ymax > xmax) { 33 | stop("'ymax' must be lower or equal to 'xmax'") 34 | } 35 | 36 | if(missing(curve)){ 37 | 38 | # Example laffer curve 39 | curve <- data.frame(Hmisc::bezier(c(0, ymax, xmax), 40 | c(0, xmax + 0.1, 0))) 41 | } 42 | 43 | if(!missing(t)){ 44 | 45 | if(any(t < 0) | any(t > max(data.frame(curve)$y))) { 46 | warning("There are values on the 't' argument lower than 0 or greater than the maximun value of the curve") 47 | t <- t[t <= max(data.frame(curve)$y)] 48 | } 49 | 50 | # Calculate the intersections of the curves 51 | intersections <- tibble() 52 | 53 | for(i in 1:length(t)) { 54 | intersections <- intersections %>% 55 | bind_rows(curve_intersect(data.frame(curve[curve$x < max(curve$y),]), data.frame(x = c(0, 10000), y = rep(t[i], 2)))) 56 | } 57 | 58 | for(i in 1:length(t)) { 59 | intersections <- intersections %>% 60 | bind_rows(curve_intersect(data.frame(curve[curve$x > max(curve$y),]), data.frame(x = c(0, 10000), y = rep(t[i], 2)))) 61 | } 62 | # print(intersections) 63 | } 64 | 65 | p <- ggplot(mapping = aes(x = x, y = y)) 66 | 67 | if(!missing(acol)){ 68 | 69 | p <- p + geom_ribbon(data = data.frame(curve), 70 | aes(x = x, 71 | ymax = y), ymin = 0, 72 | alpha = alpha, fill = acol) 73 | } 74 | 75 | p <- p + geom_line(data = data.frame(curve), color = 1, size = 1, linetype = 1) 76 | 77 | if(showmax == TRUE) { 78 | p <- p + 79 | geom_segment(data = data.frame(curve[which.max(curve$y), ]), 80 | aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") + 81 | geom_segment(data = data.frame(curve[which.max(curve$y), ]), 82 | aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") + 83 | geom_point(data = curve[which.max(curve$y), ], size = 3, color = pointcol) 84 | } 85 | 86 | 87 | if(!missing(t)){ 88 | 89 | p <- p + geom_segment(data = intersections, 90 | aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") + 91 | geom_segment(data = intersections, 92 | aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") + 93 | geom_point(data = intersections, size = 3) 94 | 95 | 96 | if(generic == FALSE){ 97 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve$x)) + 1), 98 | breaks = intersections$x, labels = round(intersections$x, 2)) + 99 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve$y)) + 1), 100 | breaks = c(intersections$y, max(curve$y)), labels = round(c(intersections$y, max(curve$y)), 2)) 101 | } else { 102 | 103 | labels <- rev(sapply(length(intersections$x):1, function(i) as.expression(bquote(t[.(i)])))) 104 | 105 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve$x)) + 1), 106 | breaks = c(intersections$x, curve[which.max(curve$y), ]$x), labels = c(labels, "t*")) + 107 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve$y)) + 1), 108 | breaks = c(unique(intersections$y), curve[which.max(curve$y), ]$y), labels = c(rev(sapply(length(unique(intersections$y)):1, function(i) as.expression(bquote("T"[.(i)])))), "T*") ) 109 | } 110 | 111 | } else { 112 | 113 | if(generic == FALSE) { 114 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(curve$x) + 1), breaks = round(curve[which.max(curve$y), ]$x, 2), labels = round(curve[which.max(curve$y), ]$x, 2)) + 115 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(curve$y) + 1), breaks = round(max(curve$y), 2), labels = round(max(curve$y), 2)) 116 | } else { 117 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(curve$x) + 1), breaks = curve[which.max(curve$y), ]$x, labels = "t*") + 118 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(curve$y) + 1), breaks = max(curve$y), labels = "T*") 119 | 120 | } 121 | } 122 | 123 | p <- p + labs(x = xlab, y = ylab, title = main, subtitle = sub) + 124 | # coord_equal() + 125 | theme_classic() + 126 | theme(plot.title = element_text(size = rel(1.3)), 127 | axis.title.y = element_text(margin = margin(t = 0, r = 10, b = 0, l = 0), angle = 0, vjust = 1), 128 | axis.title.x = element_text(margin = margin(t = 0, r = 25, b = 0, l = 0), angle = 0, hjust = 1), 129 | plot.background = element_rect(fill = bg.col), 130 | plot.margin = margin(0.5, 1, 0.5, 0.5, "cm")) 131 | 132 | if(missing(t)){ 133 | return(list(p = p, curve = curve)) 134 | } else { 135 | return(list(p = p, intersections = intersections, curve = curve)) 136 | } 137 | 138 | } 139 | 140 | -------------------------------------------------------------------------------- /R/neolabsup.R: -------------------------------------------------------------------------------- 1 | #' @title Neoclassical labor supply 2 | #' 3 | #' @description Function to create a charts for neoclassical labor supply curves 4 | #' 5 | #' @param ... Custom curve. 6 | #' @param ncurves Number of curves to be created. 7 | #' @param x Y-axis values where to create intersections with the demand curves. 8 | #' @param curve_names Boolean. If `TRUE`, the function adds default names to each. 9 | #' @param names If `curve_names = TRUE` are custom names for the curves. 10 | #' @param linecol Line color of the curves. 11 | #' @param labels If `x` is specified are the labels for the intersection points. 12 | #' @param generic Boolean. If `TRUE` and `x` is specified, the axis labels shows generic names. If `FALSE`, the axis labels are the actual data of the axis that corresponds to the intersection points. 13 | #' @param geom Possible values are `"text"` to display the labels of the intersection points with text and `"label"` to show them with labels. 14 | #' @param geomcol Color of the labels of the intersection points. 15 | #' @param geomfill If `geom = "label"` is the background color of the label. 16 | #' @param main Main title of the plot. 17 | #' @param sub Subtitle of the plot. 18 | #' @param xlab Name of the X-axis. 19 | #' @param ylab Name of the Y-axis. 20 | #' @param bg.col Background color of the plot. 21 | #' @import ggplot2 dplyr 22 | #' 23 | #' 24 | #' 25 | #' 26 | #' 27 | #' @export 28 | neolabsup <- function(..., 29 | ncurves = 1, 30 | x, 31 | curve_names = TRUE, 32 | names, # Names of the supply curves 33 | linecol, 34 | labels, # Label points 35 | generic = TRUE, 36 | geom = "text", 37 | geomcol = 1, 38 | geomfill = "white", 39 | main = NULL, 40 | sub = NULL, 41 | xlab = NULL, 42 | ylab = NULL, 43 | bg.col = "white") { 44 | 45 | if(!missing(labels)){ 46 | 47 | if(length(labels) == 1) { 48 | if(labels == "") { 49 | labels <- rep("", length(x)) 50 | } 51 | } 52 | 53 | if(length(labels) != length(x)) { 54 | warning(paste("The number of labels provided must be equal to the intersections, so length(labels) must be:", length(x) * ncurves)) 55 | } 56 | 57 | } 58 | 59 | m <- FALSE 60 | 61 | if(missing(...)){ 62 | ncurve <- ncurves 63 | 64 | # Example indifference curve 65 | curve <- data.frame(Hmisc::bezier(c(1, 9, 2), 66 | c(1, 5, 9))) 67 | 68 | m <- TRUE 69 | 70 | } else { 71 | curve <- list(...) 72 | ncurve <- length(curve) 73 | 74 | class <- vector("character", ncurve) 75 | 76 | for(i in 1:ncurve) { 77 | 78 | class[i] <- class(curve[[i]]) 79 | 80 | } 81 | 82 | if(any(class != "data.frame")) { 83 | stop("You can only pass data frames to the '...' argument") 84 | } 85 | 86 | if(ncurve == 1){ 87 | m <- TRUE 88 | } 89 | } 90 | 91 | 92 | if(missing(linecol)){ 93 | 94 | if(missing(...)){ 95 | linecol <- 1 96 | } 97 | 98 | if(!missing(...) & ncurve == 1){ 99 | linecol <- 1 100 | } 101 | 102 | if(!missing(...) & ncurve > 1){ 103 | linecol <- rep(1, ncurve) 104 | } 105 | } else { 106 | 107 | if(!missing(...) & length(linecol) == 1){ 108 | linecol <- rep(linecol, ncurve) 109 | } 110 | } 111 | 112 | if(!missing(x)){ 113 | 114 | if(any(x < 0) | any(x > max(data.frame(curve)$y))) { 115 | warning("There are values on the 'x' argument lower than 0 or greater than the maximun value of the curve") 116 | x <- x[x <= max(data.frame(curve)$y)] 117 | } 118 | 119 | # Calculate the intersections of the curves 120 | intersections <- tibble() 121 | 122 | 123 | for(i in 1:length(x)) { 124 | if(x[i] < max(data.frame(curve[curve$y < max(curve$x),])$y)) { 125 | intersections <- intersections %>% 126 | bind_rows(curve_intersect(data.frame(curve[curve$y < max(curve$x),]), data.frame(x = c(0, 10000), y = rep(x[i], 2)))) 127 | } else { 128 | intersections <- intersections %>% 129 | bind_rows(curve_intersect(data.frame(curve[curve$y > max(curve$x),]), data.frame(x = c(0, 10000), y = rep(x[i], 2)))) 130 | 131 | } 132 | } 133 | 134 | 135 | 136 | } 137 | 138 | if(missing(labels) & !missing(x)){ 139 | labels <- LETTERS[1:nrow(intersections)] 140 | } 141 | 142 | p <- ggplot(mapping = aes(x = x, y = y)) 143 | 144 | 145 | if(missing(...) | m){ 146 | 147 | for(i in 0:(ncurves - 1)) { 148 | p <- p + geom_path(data = data.frame(x = curve$x + i, y = curve$y), color = linecol, size = 1, linetype = 1) 149 | } 150 | 151 | } else { 152 | 153 | for(i in 1:length(curve)) { 154 | p <- p + geom_path(data = data.frame(curve[[i]]), color = linecol[i], size = 1, linetype = 1) 155 | } 156 | } 157 | 158 | if(curve_names == TRUE) { 159 | 160 | if(ncurves == 1) { 161 | 162 | if(missing(names)) { 163 | names <- "S" 164 | } 165 | 166 | p <- p + annotate(geom = "text", x = curve[nrow(curve),]$x - 0.2, y = max(as.data.frame(curve)$y), label = names, parse = TRUE, 167 | size = 4, color = geomcol) 168 | } else { 169 | 170 | if(missing(names)) { 171 | names <- sapply(1:ncurves, function(i) paste0("S[", i, "]")) 172 | } 173 | 174 | j <- 0 175 | for(i in 1:ncurves){ 176 | p <- p + annotate(geom = "text", x = curve[nrow(curve),]$x + j - 0.2, y = max(as.data.frame(curve)$y), label = names[i], parse = TRUE, 177 | size = 4, color = geomcol) 178 | j <- j + 1 179 | } 180 | } 181 | 182 | } 183 | 184 | if(!missing(x)) { 185 | p <- p + geom_segment(data = intersections, 186 | aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") + 187 | 188 | geom_segment(data = intersections, 189 | aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") + 190 | geom_point(data = intersections, size = 3) 191 | 192 | 193 | if(geom == "label") { 194 | for(i in 1:nrow(intersections)){ 195 | 196 | p <- p + annotate(geom = "label", x = unlist(intersections[1][i, ]) + 0.35, y = unlist(intersections[2][i, ]), label = labels[i], 197 | size = 4, fill = geomfill, color = geomcol) 198 | } 199 | } 200 | 201 | if(geom == "text") { 202 | 203 | for(i in 1:nrow(intersections)){ 204 | 205 | p <- p + annotate(geom = "text", x = unlist(intersections[1][i, ]) + 0.35, y = unlist(intersections[2][i, ]), label = labels[i], 206 | size = 4, color = geomcol) 207 | } 208 | } 209 | 210 | if(generic == FALSE) { 211 | 212 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve$x)) + ncurves), 213 | breaks = intersections$x, labels = round(intersections$x, 2)) + 214 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + 1), 215 | breaks = unique(round(intersections$y, 2)), labels = unique(round(intersections$y, 2))) 216 | 217 | } else { 218 | 219 | if(ncurve == 1 & missing(...)){ 220 | 221 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve$x)) + ncurves), 222 | breaks = intersections$x, labels = sapply(1:length(x), function(i) as.expression(bquote(L[.(LETTERS[i])])))) + 223 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 224 | breaks = round(intersections$y, 2), labels = sapply(1:length(x), function(i) as.expression(bquote(W[.(LETTERS[i])])))) 225 | } else { 226 | 227 | labels <- rev(sapply(length(intersections$x):1, function(i) as.expression(bquote(P[.(LETTERS[i])])))) 228 | 229 | 230 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve$x)) + ncurves), 231 | breaks = intersections$x, labels = labels) + 232 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 233 | breaks = x, labels = sapply(length(x):1, function(i) as.expression(bquote(Q[.(LETTERS[i])])))) 234 | } 235 | 236 | } 237 | } else { 238 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve$x)) + ncurves)) + 239 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves)) 240 | } 241 | 242 | p <- p + labs(x = xlab, y = ylab, title = main, subtitle = sub) 243 | 244 | p <- p + 245 | # coord_equal() + 246 | theme_classic() + 247 | theme(plot.title = element_text(size = rel(1.3)), 248 | # axis.text.x = element_text(colour = linecol), 249 | axis.title.y = element_text(margin = margin(t = 0, r = 10, b = 0, l = 0), angle = 0, vjust = 1), 250 | axis.title.x = element_text(margin = margin(t = 0, r = 25, b = 0, l = 0), angle = 0, hjust = 1), 251 | plot.background = element_rect(fill = bg.col), 252 | plot.margin = margin(0.5, 1, 0.5, 0.5, "cm")) 253 | 254 | if(!missing(x)){ 255 | return(list(p = p, intersections = intersections, curve = curve)) 256 | } else { 257 | return(list(p = p, curve = curve)) 258 | } 259 | } 260 | 261 | 262 | -------------------------------------------------------------------------------- /R/ppf.R: -------------------------------------------------------------------------------- 1 | #' @title Production–possibility frontier 2 | #' 3 | #' @description Creates production–possibility frontiers. The function allows specifying custom frontiers, modifying the type of the curves (concave or linear), creating intersections along the values of the Y-axis and the curve and customizing the final output with further arguments. 4 | #' 5 | #' @param ... Specify the production–possibility frontiers separated by comma (as `data.frame`) you want to display in the graph. This will override the sample curve. 6 | #' @param xmax Numeric. Allows modifying the maximum X value for the default production–possibility frontier. 7 | #' @param ymax Numeric. Allows modifying the maximum Y value for the default production–possibility frontier. 8 | #' @param type Possible values are `"concave"` (default) and `"line"` to plot a concave or a linear production–possibility frontier function by default, respectively. 9 | #' @param x Y-axis values where to create intersections with the production–possibility frontier 10 | #' @param linecol Line color of the curves. 11 | #' @param labels If `x` is specified are the labels for the intersection points. 12 | #' @param generic Boolean. If `TRUE` and `x` is specified, the axis labels shows generic names. If `FALSE`, the axis labels are the actual data of the axis that corresponds to the intersection points. 13 | #' @param geom Possible values are `"text"` to display the labels of the intersection points with text and `"label"` to show them with labels. 14 | #' @param geomcol Color of the labels of the intersection points. 15 | #' @param geomfill If `geom = "label"` is the background color of the label. 16 | #' @param main Main title of the plot. 17 | #' @param sub Subtitle of the plot. 18 | #' @param xlab Name of the X-axis. 19 | #' @param ylab Name of the Y-axis. 20 | #' @param acol Color of the area of the below the production–possibility frontier 21 | #' @param alpha Transparency of the colored area 22 | #' @param bg.col Background color of the plot 23 | #' @import ggplot2 dplyr 24 | #' @export 25 | ppf <- function(..., 26 | xmax, 27 | ymax, 28 | type = "concave", 29 | x, 30 | linecol, 31 | labels, 32 | generic = TRUE, 33 | geom = "text", 34 | geomcol = 1, 35 | geomfill = "white", 36 | main = NULL, 37 | sub = NULL, 38 | xlab = NULL, 39 | ylab = NULL, 40 | acol, 41 | alpha = 0.3, 42 | bg.col = "white"){ 43 | 44 | m <- FALSE 45 | 46 | if(missing(...)){ 47 | 48 | ncurve <- 1 49 | 50 | if(missing(xmax)){ 51 | xmax <- 6.5 52 | } 53 | 54 | if(missing(ymax)){ 55 | ymax <- 6.5 56 | } 57 | 58 | if(type == "concave") { 59 | # Example indifference curve 60 | curve <- data.frame(Hmisc::bezier(c(0, xmax - 1.5, xmax), 61 | c(ymax, ymax - 1.5, 0))) 62 | m <- TRUE 63 | } 64 | 65 | if(type == "line") { 66 | curve <- data.frame(x = c(0, xmax), 67 | y = c(ymax, 0)) 68 | m <- TRUE 69 | } 70 | } else{ 71 | 72 | curve <- list(...) 73 | ncurve <- length(curve) 74 | 75 | class <- vector("character", ncurve) 76 | 77 | for(i in 1:ncurve) { 78 | 79 | class[i] <- class(curve[[i]]) 80 | 81 | } 82 | 83 | if(any(class != "data.frame")) { 84 | stop("You can only pass data frames to the '...' argument") 85 | } 86 | 87 | 88 | if(ncurve == 1){ 89 | m <- TRUE 90 | } 91 | } 92 | 93 | if(missing(linecol)){ 94 | 95 | if(missing(...)){ 96 | linecol <- 1 97 | } 98 | 99 | if(!missing(...) & ncurve == 1){ 100 | linecol <- 1 101 | } 102 | 103 | if(!missing(...) & ncurve > 1){ 104 | linecol <- rep(1, ncurve) 105 | } 106 | } else { 107 | 108 | if(!missing(...) & length(linecol) == 1){ 109 | linecol <- rep(linecol, ncurve) 110 | } 111 | } 112 | 113 | if(missing(labels) & !missing(x)){ 114 | labels <- LETTERS[1:length(x)] 115 | } 116 | 117 | if(!missing(x)){ 118 | 119 | if(any(x < 0) | any(x > max(data.frame(curve)$y))) { 120 | warning("There are values on the 'x' argument lower than 0 or greater than the maximun value of the curve") 121 | x <- x[x <= max(data.frame(curve)$y)] 122 | } 123 | 124 | # Calculate the intersections of the curves 125 | intersections <- tibble() 126 | 127 | if(missing(...) | length(curve) == 1) { 128 | 129 | for(i in 1:length(x)) { 130 | intersections <- intersections %>% 131 | bind_rows(curve_intersect(data.frame(x = c(0, 10000), y = rep(x[i], 2)), data.frame(curve))) 132 | 133 | } 134 | }else { 135 | 136 | intersections <- vector("list", ncurve) 137 | for(i in 1:ncurve){ 138 | 139 | for(j in 1:length(x)) { 140 | 141 | intersections[[i]][[j]] <- bind_rows(curve_intersect(data.frame(x = 1:1000, y = rep(x[j], nrow(curve[[1]]))), curve[[i]])) 142 | } 143 | } 144 | 145 | intersections <- bind_rows(intersections) 146 | } 147 | 148 | print(intersections) 149 | } 150 | 151 | p <- ggplot(mapping = aes(x = x, y = y)) 152 | 153 | 154 | if(!missing(acol)){ 155 | 156 | p <- p + geom_ribbon(data = data.frame(curve), 157 | aes(x = x, 158 | ymax = y), ymin = 0, 159 | alpha = alpha, fill = acol) 160 | } 161 | 162 | if(missing(...) | m){ 163 | p <- p + geom_line(data = data.frame(curve), color = linecol, size = 1, linetype = 1) 164 | } else { 165 | 166 | for(i in 1:length(curve)) { 167 | p <- p + geom_line(data = data.frame(curve[[i]]), color = linecol[i], size = 1, linetype = 1) 168 | } 169 | } 170 | 171 | if(!missing(x)){ 172 | p <- p + geom_segment(data = intersections, 173 | aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") + 174 | 175 | geom_segment(data = intersections, 176 | aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") + 177 | geom_point(data = intersections, size = 3) 178 | 179 | 180 | if(geom == "label") { 181 | for(i in 1:length(x)){ 182 | 183 | p <- p + annotate(geom = "label", x = unlist(intersections[1][i, ]) + 0.25, y = unlist(intersections[2][i, ]) + 0.25, label = rev(labels)[i], 184 | size = 4, fill = "white", color = geomcol) 185 | } 186 | } 187 | 188 | if(geom == "text") { 189 | for(i in 1:length(x)){ 190 | 191 | p <- p + annotate(geom = "text", x = unlist(intersections[1][i, ]) + 0.25, y = unlist(intersections[2][i, ]) + 0.25, label = rev(labels)[i], 192 | size = 4, color = geomcol) 193 | } 194 | } 195 | 196 | if(generic == FALSE) { 197 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + 1), breaks = intersections$x, labels = round(intersections$x, 2)) + 198 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + 1), breaks = intersections$y, labels = round(intersections$y, 2)) 199 | } else { 200 | 201 | if(ncurve == 1 | missing(...)){ 202 | 203 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + 1), 204 | breaks = intersections$x, labels = sapply(length(x):1, function(i) as.expression(bquote(X[.(LETTERS[i])])))) + 205 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + 1), 206 | breaks = intersections$y, labels = sapply(length(x):1, function(i) as.expression(bquote(Y[.(LETTERS[i])])))) 207 | } else { 208 | 209 | labels <- sapply(length(intersections$x):1, function(i) as.expression(bquote(X[.(LETTERS[i])]))) 210 | 211 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + 1), 212 | breaks = intersections$x, labels = labels) + 213 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + 1), 214 | breaks = x, labels =sapply(length(x):1, function(i) as.expression(bquote(Y[.(LETTERS[i])])))) 215 | } 216 | 217 | } 218 | } else { 219 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + 1)) + 220 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + 1)) 221 | } 222 | 223 | p <- p + labs(x = xlab, y = ylab, title = main, subtitle = sub) 224 | 225 | p <- p + 226 | # coord_equal() + 227 | theme_classic() + 228 | theme(plot.title = element_text(size = rel(1.3)), 229 | # axis.text.x = element_text(colour = linecol), 230 | axis.title.y = element_text(margin = margin(t = 0, r = 10, b = 0, l = 0), angle = 0, vjust = 1), 231 | axis.title.x = element_text(margin = margin(t = 0, r = 25, b = 0, l = 0), angle = 0, hjust = 1), 232 | plot.background = element_rect(fill = bg.col), 233 | plot.margin = margin(0.5, 1, 0.5, 0.5, "cm")) 234 | 235 | if(!missing(x)){ 236 | return(list(p = p, intersections = intersections, curve = curve)) 237 | } else { 238 | return(list(p = p, curve = curve)) 239 | } 240 | } 241 | -------------------------------------------------------------------------------- /R/ptvalue.R: -------------------------------------------------------------------------------- 1 | 2 | #' @title Value function in Prospect Theory 3 | #' 4 | #' @description Produces asymmetric S-shaped value function according to lessons 5 | #' from Prospect Theory that losses are felt more intensely than gains. 6 | #' 7 | #' @param x Numeric. Vector of gain / loss values for x. 8 | #' @param sigma Number. Exponent of functions, should be less than 1 to make an 9 | #' 'S' shaped curve. 10 | #' @param lambda Number. Extent of asymmetry between losses and gains. Should be 11 | #' less than -1 for losses to be more 'intense' than gains (as suggested by 12 | #' Prospect Theory). Between -1 and 0 for gains to be more intense than 13 | #' losses. Greater than 0 for losses to have positive value. 14 | #' @param xint Numeric. Symmetric intersections. X-intercept values where to 15 | #' highlight points -- will be placed at both `xint` and `abs(xint)` to 16 | #' demonstrate asymmetry in `value`. 17 | #' @param xintcol Color of dashed lines calling-out `xint`. 18 | #' @param main Main title of the plot. 19 | #' @param sub Subtitle of the plot. 20 | #' @param xlab Name of the X-axis. 21 | #' @param ylab Name of the Y-axis. 22 | #' @param col Color of function segment. 23 | #' @param bg.col Background color. 24 | #' @param ticks TOOD 25 | #' @param xlabels TRUE / FALSE : whether x labels are included. 26 | #' @param ylabels TRUE / FALSE : whether y labels are included. 27 | #' @param by_x Number. Increment of the x-axis labels. 28 | #' @param by_y Number. Increment of the x-axis labels. 29 | #' 30 | #' @details TODO 31 | #' 32 | #' @importFrom stats approxfun 33 | #' @references Tversky, Amos; Kahneman, Daniel (1992). "Advances in prospect 34 | #' theory: Cumulative representation of uncertainty". Journal of Risk and 35 | #' Uncertainty. 5 (4): 297–323. 36 | #' @examples 37 | #' 38 | #' ptvalue( 39 | #' sigma = 0.25, 40 | #' xint = 20, 41 | #' xintcol = 'blue', 42 | #' main = "Prospect Theory Shows That Gains & Losses are Felt Assymetrically", 43 | #' sub = "Losses are More Intense" 44 | #' ) 45 | #' 46 | #' @export 47 | ptvalue <- function(x, sigma = 0.30, lambda = -2.25, xint, xintcol = 1, 48 | main = NULL, sub = NULL, xlab = "Loss / Gain", ylab = "Value", 49 | col = 1, bg.col = "white", ticks = TRUE, 50 | xlabels = TRUE, ylabels = TRUE, by_x = 10, by_y = 20){ 51 | 52 | if(sigma >= 1) warning("sigma should be less than 1 to produce an 'S' shaped curve.") 53 | if(lambda >= -1) warning("lambda should be less than -1 in order that losses be represented as more intense than gains.") 54 | 55 | if(missing(x)) { 56 | 57 | x_pos <- seq(from = log(1), to = log(101), length.out = 1000) %>% 58 | exp() %>% 59 | {. - 1} 60 | 61 | x <- c(sort(-x_pos), 0, x_pos) 62 | 63 | } 64 | 65 | # Tversky & Kahneman, 1992 66 | value <- function(x, sigmaf = sigma, lambdaf = lambda) { 67 | 68 | if (x >= 0) { 69 | return(x ^ sigmaf) 70 | } 71 | 72 | if (x < 0) { 73 | return(lambdaf * (-x) ^ sigmaf) 74 | } 75 | } 76 | 77 | value <- Vectorize(value, vectorize.args = "x") 78 | 79 | maxv <- max(abs(value(x))) 80 | p <- ggplot(data = tibble(x = x), mapping = aes(x)) 81 | 82 | 83 | if(ticks == TRUE) { 84 | # Axis ticks 85 | 86 | 87 | ## X-axis 88 | 89 | x_axis_max <- max(x) 90 | x_axis_min <- -x_axis_max 91 | 92 | tick_frame_x <- data.frame(ticks = seq(x_axis_min, x_axis_max, by = by_x), zero = 0) %>% 93 | subset(ticks != 0) 94 | 95 | 96 | ## Y-axis 97 | 98 | y_axis_max <- max(abs(value(x, sigma, lambda))) 99 | y_axis_min <- -y_axis_max 100 | 101 | tick_frame_y <- data.frame(ticks = seq(y_axis_min, y_axis_max, by = by_y), zero = 0) %>% 102 | subset(ticks != 0) 103 | 104 | 105 | 106 | tick_sz_y <- 0.02 * x_axis_max 107 | tick_sz_x <- 0.02 * y_axis_max 108 | 109 | p <- p + geom_segment(data = tick_frame_x, 110 | aes(x = ticks, xend = ticks, 111 | y = zero, yend = zero + tick_sz_x)) + 112 | geom_segment(data = tick_frame_y, 113 | aes(x = zero, xend = zero + tick_sz_y, 114 | y = ticks, yend = ticks)) 115 | 116 | } 117 | 118 | 119 | # Labels 120 | 121 | if(xlabels == TRUE) { 122 | p <- p + geom_text(data = tick_frame_x, aes(x = ticks, y = zero, label = round(ticks, 2)), vjust = 1.5) 123 | } 124 | 125 | if(ylabels == TRUE) { 126 | p <- p + geom_text(data = tick_frame_y, aes(x = zero, y = ticks, label = round(ticks, 2)), hjust = 1.25) 127 | } 128 | 129 | p <- p + geom_line(aes(x = x, y = value(x)), col = col) 130 | 131 | if(!missing(xint)) { 132 | 133 | curve <- data.frame(x = x, y = value(x)) 134 | 135 | aprox <- approxfun(curve$x, curve$y) 136 | 137 | a <- aprox(xint) 138 | b <- aprox(-xint) 139 | len <- length(xint) 140 | 141 | data <- data.frame(xint = xint, y = rep(0, len), a = a, b = b) 142 | 143 | p <- p + geom_segment(data = data, aes(x = xint, y = y, xend = xint, yend = a), lty = "dashed", colour = xintcol) + 144 | geom_segment(data = data, aes(x = xint, y = a, xend = y, yend = a), lty = "dashed", colour = xintcol) + 145 | geom_point(data = data, aes(x = xint, y = a), size = 3) + 146 | 147 | geom_segment(data = data, aes(x = -xint, y = y, xend = -xint, yend = b), lty = "dashed", colour = xintcol) + 148 | geom_segment(data = data, aes(x = -xint, y = b, xend = y, yend = b), lty = "dashed", colour = xintcol) + 149 | geom_point(data = data, aes(x = -xint, y = b), size = 3) 150 | 151 | } 152 | 153 | p <- p + labs(x = ylab, y = xlab, title = main, subtitle = sub) + 154 | geom_hline(yintercept = 0) + 155 | geom_vline(xintercept = 0) + 156 | scale_y_continuous(limits = c(-maxv, maxv)) + 157 | theme_void() + 158 | theme(plot.title = element_text(size = rel(1.3)), 159 | axis.title.y = element_text(margin = margin(t = 0, r = 10, b = 0, l = 0), angle = 0, vjust = 0.5), 160 | axis.title.x = element_text(margin = margin(t = 0, r = 25, b = 0, l = 0), angle = 0, hjust = 0.5), 161 | plot.background = element_rect(fill = bg.col), 162 | plot.margin = margin(0.5, 1, 0.5, 0.5, "cm")) 163 | 164 | return(p) 165 | 166 | } 167 | 168 | 169 | 170 | # ptvalue(col = 2, xint = seq(0, 100, 25), xintcol = 4, 171 | # by_x = 25, by_y = 50, 172 | # main = "Prospect Theory Value Function") 173 | 174 | -------------------------------------------------------------------------------- /R/sdcurve.R: -------------------------------------------------------------------------------- 1 | #' @title Supply and demand curves 2 | #' 3 | #' @description Create supply and demand curves. By default, the function will use a default supply and a default demand curve, but this can be overridden passing new curves as additional arguments or modifying the `xmax` and `ymax` arguments. 4 | #' Moreover, the function provides several arguments to customize the final output, like displaying the equilibrium points, the name of the curves, customizing the title, subtitle or axis labels, among others. 5 | #' 6 | #' @param ... Specify the demand and supply curve or curves separated by commas (as `data.frame`) you want to display in the graph, starting with supply. This will override the sample curves. 7 | #' @param xmax Numeric. Allows modifying the maximum X value for the default functions. 8 | #' @param ymax Numeric. Allows modifying the maximum Y value for the default functions. 9 | #' @param max.price Price ceiling. 10 | #' @param min.price Price floor. 11 | #' @param generic Boolean. If `TRUE`, the axis labels shows generic names. If `FALSE`, the axis labels are the actual data of the axis that corresponds to the intersection points between the two curves. 12 | #' @param equilibrium Boolean. If `TRUE`, shows the intersection points between the two curves. 13 | #' @param main Main title of the plot. 14 | #' @param sub Subtitle of the plot. 15 | #' @param xlab Name of the X-axis. 16 | #' @param ylab Name of the Y-axis. 17 | #' @param curve_names Boolean. If `TRUE`, the function adds default names to each. 18 | #' @param names If `curve_names = TRUE`, are custom names for the curves. 19 | #' @param linescol Color of the curves. It must be a vector of the same length as the number of displayed curves. 20 | #' @param bg.col Background color of the plot. 21 | #' 22 | #' 23 | #' @examples 24 | #' sdcurve() # Default supply and demand plot 25 | # Custom data 26 | #' supply1 <- data.frame(x = c(1, 9), y = c(1, 9)) 27 | #' supply1 28 | #' 29 | #' demand1 <- data.frame(x = c(7, 2), y = c(2, 7)) 30 | #' demand1 31 | #' 32 | #' supply2 <- data.frame(x = c(2, 10), y = c(1, 9)) 33 | #' supply2 34 | #' 35 | #' demand2 <- data.frame(x = c(8, 2), y = c(2, 8)) 36 | #' demand2 37 | #' 38 | #' p <- sdcurve(supply1, # Custom data 39 | #' demand1, 40 | #' supply2, 41 | #' demand2, 42 | #' equilibrium = TRUE, # Calculate the equilibrium 43 | #' bg.col = "#fff3cd") # Background color 44 | #' p + annotate("segment", x = 2.5, xend = 3, y = 6.5, yend = 7, # Add more layers 45 | #' arrow = arrow(length = unit(0.3, "lines")), colour = "grey50") 46 | #' 47 | #' 48 | #' @import ggplot2 dplyr 49 | #' @export 50 | sdcurve <- function(..., 51 | xmax, 52 | ymax, 53 | max.price, 54 | min.price, 55 | generic = TRUE, 56 | equilibrium = TRUE, 57 | main = NULL, 58 | sub = NULL, 59 | xlab = NULL, 60 | ylab = NULL, 61 | curve_names = TRUE, 62 | names, 63 | linescol, 64 | bg.col = "white") { 65 | 66 | # if(empirical == FALSE && missing(domain)){ 67 | # stop("Provide a domain for the empirical curves") 68 | # } 69 | 70 | if(missing(xmax)) { 71 | xmax <- 9 72 | } 73 | 74 | if(missing(ymax)) { 75 | ymax <- 9 76 | } 77 | 78 | if(missing(...)) { 79 | curves <-list(data.frame(Hmisc::bezier(c(1, 8, xmax), 80 | c(1, 5, xmax))), data.frame(Hmisc::bezier(c(1, 3, xmax), 81 | c(ymax, 3, 1)))) 82 | ncurves <- 1 83 | 84 | } else { 85 | ncurves <- length(list(...))/2 86 | curves <- list(...) 87 | 88 | class <- vector("character", length(curves)) 89 | 90 | for(i in 1:length(curves)) { 91 | 92 | class[i] <- class(curves[[i]]) 93 | 94 | } 95 | 96 | if(any(class != "data.frame")) { 97 | stop("You can only pass data frames to the '...' argument") 98 | } 99 | 100 | } 101 | 102 | if(ncurves %% 2 == 0){ 103 | par <- TRUE 104 | } 105 | 106 | if(missing(linescol)){ 107 | linescol <- 1:length(curves) 108 | } 109 | 110 | # print(ncurves) 111 | # print(curves) 112 | 113 | if(equilibrium == TRUE) { 114 | 115 | # Calculate the intersections of the curves 116 | intersections <- tibble() 117 | j <- 2 118 | 119 | for(i in 1:ncurves) { 120 | intersections <- intersections %>% 121 | bind_rows(curve_intersect(data.frame(curves[j - 1]), data.frame(curves[j]))) 122 | j <- j + 2 123 | } 124 | 125 | print(intersections) 126 | } 127 | 128 | # Max X Coordinates of the curves 129 | coord <- vector("list", length = length(curves)) 130 | for(i in 1:length(curves)){ 131 | 132 | coord[[i]] <- curves[[i]][which.max(curves[[i]][, 1]), ] 133 | } 134 | 135 | p <- ggplot(mapping = aes(x = x, y = y)) 136 | 137 | for(i in 1:length(curves)) { 138 | p <- p + geom_line(data = data.frame(curves[i]), color = linescol[i], size = 1, linetype = 1) 139 | 140 | } 141 | 142 | if(equilibrium == TRUE) { 143 | p <- p + geom_segment(data = intersections, 144 | aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") + 145 | geom_segment(data = intersections, 146 | aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") + 147 | geom_point(data = intersections, size = 3) 148 | } 149 | 150 | 151 | if(!missing(max.price) & !missing(min.price)) { 152 | if(min.price >= max.price) { 153 | stop("'max.price' must be greater than 'min.price'") 154 | } 155 | } 156 | 157 | if(!missing(max.price)){ 158 | 159 | 160 | # Calculate the intersections of the curves and the line 161 | # intersections <- tibble() 162 | # j <- 2 163 | # 164 | # for(i in 1:ncurves) { 165 | # intersections_max <- intersections %>% 166 | # bind_rows(curve_intersect(data.frame(curves[j - 1]), data.frame(curves[j]))) 167 | # j <- j + 2 168 | # } 169 | # 170 | # print(intersections_max) 171 | 172 | p <- p + geom_segment(data = data.frame(x = seq(min(unlist(curves)), max(unlist(curves)), length.out = 2), y = rep(max.price, 2)), 173 | aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") 174 | } 175 | 176 | 177 | if(!missing(min.price)){ 178 | 179 | 180 | # Calculate the intersections of the curves and the line 181 | # intersections <- tibble() 182 | # j <- 2 183 | # 184 | # for(i in 1:ncurves) { 185 | # intersections_max <- intersections %>% 186 | # bind_rows(curve_intersect(data.frame(curves[j - 1]), data.frame(curves[j]))) 187 | # j <- j + 2 188 | # } 189 | # 190 | # print(intersections_max) 191 | 192 | p <- p + geom_segment(data = data.frame(x = seq(min(unlist(curves)), max(unlist(curves)), length.out = 2), y = rep(min.price, 2)), 193 | aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") 194 | } 195 | 196 | 197 | 198 | # Curve labels 199 | 200 | if(curve_names == TRUE) { 201 | 202 | labelyfun <- numeric(length(curves)) 203 | 204 | for(i in 1:length(curves)){ 205 | 206 | labelyfun[i] <- approxfun(curves[[i]]$x, curves[[i]]$y)(max(coord[[i]] - 0.5)) 207 | } 208 | 209 | if(!missing(names)) { 210 | 211 | for(i in 1:length(curves)){ 212 | 213 | p <- p + annotate(geom = "label", x = max(coord[[i]] - 0.5), y = labelyfun[i], label = names[i], parse = TRUE, 214 | size = 4, fill = i, color = "white") 215 | } 216 | 217 | } else { 218 | 219 | for(i in 1:length(curves)){ 220 | 221 | l <- ifelse(i %% 2 == 0, "D", "S") 222 | 223 | p <- p + annotate(geom = "label", x = max(coord[[i]] - 0.5), y = labelyfun[i], label = l, parse = TRUE, 224 | size = 4, fill = i, color = "white") 225 | } 226 | 227 | } 228 | 229 | } 230 | 231 | if(equilibrium == TRUE) { 232 | 233 | if(generic == TRUE){ 234 | 235 | p <- p + scale_x_continuous(expand = c(0, 0), breaks = unique(intersections$x),limits = c(0, max(unlist(curves)) + 1), 236 | labels = sapply(1:length(unique(intersections$x)), function(i) as.expression(bquote(Q[.(i)])))) + 237 | scale_y_continuous(expand = c(0, 0), breaks = unique(round(intersections$y, 2)), limits = c(0, max(unlist(curves)) + 1), 238 | labels = sapply(1:length(unique(round(intersections$y, 2))), function(i) as.expression(bquote(P[.(i)])))) 239 | 240 | } else { 241 | 242 | p <- p + scale_x_continuous(expand = c(0, 0), breaks = unique(intersections$x), limits = c(0, max(unlist(curves)) + 1), 243 | labels = round(unique(intersections$x), 2)) + 244 | scale_y_continuous(expand = c(0, 0), breaks = unique(intersections$y), limits = c(0, max(unlist(curves)) + 1), 245 | labels = round(unique(intersections$y, 2))) 246 | } 247 | 248 | } else { 249 | 250 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curves)) + 1)) + 251 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curves)) + 1)) 252 | 253 | } 254 | 255 | p <- p + labs(x = xlab, y = ylab, title = main, subtitle = sub) + 256 | # coord_equal() + 257 | theme_classic() + 258 | theme(plot.title = element_text(size = rel(1.3)), 259 | axis.title.y = element_text(margin = margin(t = 0, r = 10, b = 0, l = 0), angle = 0, vjust = 1), 260 | axis.title.x = element_text(margin = margin(t = 0, r = 25, b = 0, l = 0), angle = 0, hjust = 1), 261 | plot.background = element_rect(fill = bg.col), 262 | plot.margin = margin(0.5, 1, 0.5, 0.5, "cm")) 263 | 264 | return(p) 265 | } 266 | 267 | 268 | 269 | 270 | 271 | -------------------------------------------------------------------------------- /R/supply.R: -------------------------------------------------------------------------------- 1 | #' @title Supply curves 2 | #' 3 | #' @description Create supply curves. The function allows specifying the number of curves to generate or use custom curves, the type of curve (convex or linear), create intersection points along the Y-axis and customize other arguments related to the style of the final output. 4 | #' 5 | #' @param ... Specify the supply curve or curves separated by comma (as `data.frame`) you want to display in the graph. This will override the sample curve. 6 | #' @param ncurves Number of supply curves to be generated based on the sample data. 7 | #' @param xmax Numeric. Allows modifying the maximum X value for the default supply function. 8 | #' @param ymax Numeric. Allows modifying the maximum Y value for the default supply function. 9 | #' @param type Possible values are `"convex"` (default) and `"line"` to plot a convex or a linear supply function by default, respectively. 10 | #' @param x Y-axis values where to create intersections with the demand curves. 11 | #' @param curve_names Boolean. If `TRUE`, the function adds default names to each. 12 | #' @param names If `curve_names = TRUE` are custom names for the curves. 13 | #' @param linecol Line color of the curves. 14 | #' @param labels If `x` is specified are the labels for the intersection points. 15 | #' @param generic Boolean. If `TRUE` and `x` is specified, the axis labels shows generic names. If `FALSE`, the axis labels are the actual data of the axis that corresponds to the intersection points. 16 | #' @param geom Possible values are `"text"` to display the labels of the intersection points with text and `"label"` to show them with labels. 17 | #' @param geomcol Color of the labels of the intersection points. 18 | #' @param geomfill If `geom = "label"` is the background color of the label. 19 | #' @param main Main title of the plot. 20 | #' @param sub Subtitle of the plot. 21 | #' @param xlab Name of the X-axis. 22 | #' @param ylab Name of the Y-axis. 23 | #' @param bg.col Background color of the plot. 24 | #' @import ggplot2 dplyr 25 | #' 26 | #' 27 | #' 28 | #' 29 | #' 30 | #' @export 31 | supply <- function(..., 32 | ncurves = 1, 33 | xmax, 34 | ymax, 35 | type = "convex", 36 | x, 37 | curve_names = TRUE, 38 | names, # Names of the supply curves 39 | linecol, 40 | labels, # Label points 41 | generic = TRUE, 42 | geom = "text", 43 | geomcol = 1, 44 | geomfill = "white", 45 | main = NULL, 46 | sub = NULL, 47 | xlab = NULL, 48 | ylab = NULL, 49 | bg.col = "white") { 50 | 51 | if(!missing(labels)){ 52 | 53 | if(length(labels) == 1) { 54 | if(labels == "") { 55 | labels <- rep("", length(x)) 56 | } 57 | } 58 | 59 | if(length(labels) != length(x)) { 60 | warning(paste("The number of labels provided must be equal to the intersections, so length(labels) must be:", length(x) * ncurves)) 61 | } 62 | 63 | } 64 | 65 | m <- FALSE 66 | 67 | if(missing(...)){ 68 | ncurve <- ncurves 69 | 70 | if(missing(xmax)){ 71 | xmax <- 9 72 | } 73 | 74 | if(missing(ymax)){ 75 | ymax <- 9 76 | } 77 | 78 | if(type == "convex") { 79 | # Example indifference curve 80 | curve <- data.frame(Hmisc::bezier(c(1, 8, xmax), 81 | c(1, 5, ymax))) 82 | 83 | m <- TRUE 84 | } 85 | 86 | if(type == "line") { 87 | curve <- data.frame(x = c(0.9, xmax), 88 | y = c(0.9, ymax)) 89 | m <- TRUE 90 | } 91 | } else { 92 | curve <- list(...) 93 | ncurve <- length(curve) 94 | 95 | class <- vector("character", ncurve) 96 | 97 | for(i in 1:ncurve) { 98 | 99 | class[i] <- class(curve[[i]]) 100 | 101 | } 102 | 103 | if(any(class != "data.frame")) { 104 | stop("You can only pass data frames to the '...' argument") 105 | } 106 | 107 | if(ncurve == 1){ 108 | m <- TRUE 109 | } 110 | } 111 | 112 | 113 | if(missing(linecol)){ 114 | 115 | if(missing(...)){ 116 | linecol <- 1 117 | } 118 | 119 | if(!missing(...) & ncurve == 1){ 120 | linecol <- 1 121 | } 122 | 123 | if(!missing(...) & ncurve > 1){ 124 | linecol <- rep(1, ncurve) 125 | } 126 | } else { 127 | 128 | if(!missing(...) & length(linecol) == 1){ 129 | linecol <- rep(linecol, ncurve) 130 | } 131 | } 132 | 133 | if(!missing(x)){ 134 | 135 | if(any(x < 0) | any(x > max(data.frame(curve)$y))) { 136 | warning("There are values on the 'x' argument lower than 0 or greater than the maximun value of the curve") 137 | x <- x[x <= max(data.frame(curve)$y)] 138 | } 139 | 140 | # Calculate the intersections of the curves 141 | intersections <- tibble() 142 | 143 | if((missing(...) | length(curve) == 1) & ncurves == 1) { 144 | 145 | for(i in 1:length(x)) { 146 | intersections <- intersections %>% 147 | bind_rows(curve_intersect(data.frame(x = c(0, 10000), y = rep(x[i], 2)), data.frame(curve))) 148 | 149 | } 150 | } else { 151 | 152 | intersections <- vector("list", ncurve) 153 | 154 | if(ncurves > 1) { 155 | 156 | if(length(x) == 1) { 157 | w <- 0 158 | for(i in 1:ncurve){ 159 | 160 | for(j in 1:length(x)) { 161 | 162 | intersections[[i]][[j]] <- bind_rows(curve_intersect(data.frame(x = 1:1000, y = rep(x[j], nrow(curve))), data.frame(x = curve$x + w, y = curve$y))) 163 | w <- w + 1 164 | } 165 | } 166 | 167 | intersections <- bind_rows(intersections) 168 | } else { 169 | stop("Multiple intersections with ncurves > 1 is not implemented yet") 170 | } 171 | 172 | } else { 173 | 174 | for(i in 1:ncurve){ 175 | 176 | for(j in 1:length(x)) { 177 | 178 | intersections[[i]][[j]] <- bind_rows(curve_intersect(data.frame(x = 1:1000, y = rep(x[j], nrow(curve[[1]]))), curve[[i]])) 179 | } 180 | } 181 | 182 | intersections <- bind_rows(intersections) 183 | 184 | } 185 | } 186 | # print(intersections) 187 | } 188 | 189 | if(missing(labels) & !missing(x)){ 190 | labels <- LETTERS[1:nrow(intersections)] 191 | } 192 | 193 | p <- ggplot(mapping = aes(x = x, y = y)) 194 | 195 | 196 | if(missing(...) | m){ 197 | 198 | for(i in 0:(ncurves - 1)) { 199 | p <- p + geom_line(data = data.frame(x = curve$x + i, y = curve$y), color = linecol, size = 1, linetype = 1) 200 | } 201 | 202 | } else { 203 | 204 | for(i in 1:length(curve)) { 205 | p <- p + geom_line(data = data.frame(curve[[i]]), color = linecol[i], size = 1, linetype = 1) 206 | } 207 | } 208 | 209 | if(curve_names == TRUE) { 210 | 211 | if(ncurves == 1) { 212 | 213 | if(missing(names)) { 214 | names <- "S" 215 | } 216 | 217 | p <- p + annotate(geom = "text", x = max(as.data.frame(curve)$x) + 0.5, y = max(as.data.frame(curve)$y), label = names, parse = TRUE, 218 | size = 4, color = geomcol) 219 | } else { 220 | 221 | if(missing(names)) { 222 | names <- sapply(1:ncurves, function(i) paste0("S[", i, "]")) 223 | } 224 | 225 | j <- 0 226 | for(i in 1:ncurves){ 227 | p <- p + annotate(geom = "text", x = max(as.data.frame(curve)$x) + j + 0.35, y = max(as.data.frame(curve)$y), label = names[i], parse = TRUE, 228 | size = 4, color = geomcol) 229 | j <- j + 1 230 | } 231 | } 232 | 233 | } 234 | 235 | if(!missing(x)) { 236 | p <- p + geom_segment(data = intersections, 237 | aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") + 238 | 239 | geom_segment(data = intersections, 240 | aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") + 241 | geom_point(data = intersections, size = 3) 242 | 243 | 244 | if(geom == "label") { 245 | for(i in 1:nrow(intersections)){ 246 | 247 | p <- p + annotate(geom = "label", x = unlist(intersections[1][i, ]) + 0.35, y = unlist(intersections[2][i, ]), label = labels[i], 248 | size = 4, fill = geomfill, color = geomcol) 249 | } 250 | } 251 | 252 | if(geom == "text") { 253 | 254 | for(i in 1:nrow(intersections)){ 255 | 256 | p <- p + annotate(geom = "text", x = unlist(intersections[1][i, ]) + 0.35, y = unlist(intersections[2][i, ]), label = labels[i], 257 | size = 4, color = geomcol) 258 | } 259 | } 260 | 261 | if(generic == FALSE) { 262 | 263 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 264 | breaks = intersections$x, labels = round(intersections$x, 2)) + 265 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + 1), 266 | breaks = unique(round(intersections$y, 2)), labels = unique(round(intersections$y, 2))) 267 | 268 | } else { 269 | 270 | if(ncurve == 1 & missing(...)){ 271 | 272 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 273 | breaks = intersections$x, labels = sapply(1:length(x), function(i) as.expression(bquote(X[.(LETTERS[i])])))) + 274 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 275 | breaks = round(intersections$y, 2), labels = sapply(1:length(x), function(i) as.expression(bquote(Y[.(LETTERS[i])])))) 276 | } else { 277 | 278 | labels <- rev(sapply(length(intersections$x):1, function(i) as.expression(bquote(P[.(LETTERS[i])])))) 279 | 280 | 281 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 282 | breaks = intersections$x, labels = labels) + 283 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves), 284 | breaks = x, labels = sapply(length(x):1, function(i) as.expression(bquote(Q[.(LETTERS[i])])))) 285 | } 286 | 287 | } 288 | } else { 289 | p <- p + scale_x_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves)) + 290 | scale_y_continuous(expand = c(0, 0), limits = c(0, max(unlist(curve)) + ncurves)) 291 | } 292 | 293 | p <- p + labs(x = xlab, y = ylab, title = main, subtitle = sub) 294 | 295 | p <- p + 296 | # coord_equal() + 297 | theme_classic() + 298 | theme(plot.title = element_text(size = rel(1.3)), 299 | # axis.text.x = element_text(colour = linecol), 300 | axis.title.y = element_text(margin = margin(t = 0, r = 10, b = 0, l = 0), angle = 0, vjust = 1), 301 | axis.title.x = element_text(margin = margin(t = 0, r = 25, b = 0, l = 0), angle = 0, hjust = 1), 302 | plot.background = element_rect(fill = bg.col), 303 | plot.margin = margin(0.5, 1, 0.5, 0.5, "cm")) 304 | 305 | if(!missing(x)){ 306 | return(list(p = p, intersections = intersections, curve = curve)) 307 | } else { 308 | return(list(p = p, curve = curve)) 309 | } 310 | } 311 | -------------------------------------------------------------------------------- /R/tax.R: -------------------------------------------------------------------------------- 1 | #' @title Tax graph 2 | #' 3 | #' @description TODO 4 | #' 5 | #' @param demand_fun TODO 6 | #' @param supply_fun TODO 7 | #' @param supply_tax TODO 8 | #' @param names TODO 9 | #' @param title TODO 10 | #' @param xlab TODO 11 | #' @param ylab TODO 12 | #' @param colors TODO 13 | #' @param shaded TODO 14 | #' @param xlim TODO 15 | #' @param ylim TODO 16 | #' @param max_x TODO 17 | #' @param bg.col TODO 18 | #' 19 | #' @author 20 | #' \itemize{ 21 | #' \item{Weiss, Andrew.} 22 | #' } 23 | #' 24 | #' @examples 25 | #' 26 | #' # Data 27 | #' demand <- function(Q) 20 - 0.5 * Q 28 | #' demand_new <- function(Q) demand(Q) + 5 29 | #' supply <- function(Q) 2 + 0.25 * Q 30 | #' supply_new <- function(Q) supply(Q) + 5 31 | #' 32 | #' supply_tax <- function(Q) supply(Q) + 5 33 | #' 34 | #' demand_elastic <- function(Q) 10 - 0.05 * Q 35 | #' demand_inelastic <- function(Q) 20 - 2 * Q 36 | #' 37 | #' supply_elastic <- function(Q) 2 + 0.05 * Q 38 | #' supply_elastic_tax <- function(Q) supply_elastic(Q) + 5 39 | #' supply_inelastic <- function(Q) 2 + 1.5 * Q 40 | #' supply_inelastic_tax <- function(Q) supply_inelastic(Q) + 5 41 | #' 42 | #' normal_taxes <- tax_graph(demand, supply, supply_tax, NULL) 43 | #' normal_taxes_shaded <- tax_graph(demand, supply, supply_tax, shaded = TRUE) 44 | #' normal_taxes_shaded$p 45 | #' 46 | #' @import ggplot2 dplyr 47 | #' @export 48 | tax_graph <- function(demand_fun, supply_fun, supply_tax, names = c("Consumer surplus", "Producer surplus", "DWL", "Consumer tax burden", "Producer tax burden"), 49 | title = NULL, xlab = "Product (Q)", 50 | ylab = "Price (P)", colors, shaded = FALSE, xlim = c(0, 45), 51 | ylim = c(0, 20), max_x = 45, bg.col = "white") { 52 | 53 | if(missing(colors)) { 54 | # Aurora and Frost color palettes from Nord 55 | # https://github.com/arcticicestudio/nord 56 | nord_red <- "#BF616A" # nord11 57 | nord_orange <- "#D08770" # nord12 58 | nord_yellow <- "#EBCB8B" # nord13 59 | nord_green <- "#A3BE8C" # nord14 60 | nord_purple <- "#B48EAD" # nord15 61 | nord_lt_blue <- "#81A1C1" # nord9 62 | nord_dk_blue <- "#5E81AC" # nord10 63 | } else { 64 | 65 | if(length(colors) != 7 ) { 66 | 67 | warning("You must provide 7 colors. Default colors will be used instead") 68 | 69 | nord_red <- "#BF616A" # nord11 70 | nord_orange <- "#D08770" # nord12 71 | nord_yellow <- "#EBCB8B" # nord13 72 | nord_green <- "#A3BE8C" # nord14 73 | nord_purple <- "#B48EAD" # nord15 74 | nord_lt_blue <- "#81A1C1" # nord9 75 | nord_dk_blue <- "#5E81AC" # nord10 76 | 77 | } else { 78 | 79 | nord_red <- colors[1] 80 | nord_orange <- colors[2] 81 | nord_yellow <- colors[3] 82 | nord_green <- colors[4] 83 | nord_purple <- colors[5] 84 | nord_lt_blue <- colors[6] 85 | nord_dk_blue <- colors[7] 86 | 87 | } 88 | 89 | } 90 | 91 | midpoint <- function(ymin, ymax) { 92 | ymax + (ymin - ymax) / 2 93 | } 94 | 95 | print_details <- function(coordinates, areas, areas_intermediate) { 96 | coordinates_r <- lapply(coordinates, round, digits = 2) 97 | areas_r <- lapply(areas, round, digits = 2) 98 | areas_intermediate_r <- lapply(areas_intermediate, round, digits = 2) 99 | 100 | glue::glue(" 101 | - Pre-tax quantity: **{coordinates_r$qstar_comp}** 102 | - Pre-tax price: **\\${coordinates_r$pstar_comp}** 103 | - Pre-tax consumer surplus: **\\${areas_r$con_surplus}** ($1/2 \\times {areas_intermediate_r$con_surplus_base} \\times {areas_intermediate_r$con_surplus_height}$) 104 | - Pre-tax producer surplus: **\\${areas_r$pro_surplus}** ($1/2 \\times {areas_intermediate_r$pro_surplus_base} \\times {areas_intermediate_r$pro_surplus_height}$) 105 | 106 | - Post-tax quantity: **{coordinates_r$qstar_tax}** 107 | - Post-tax price: **\\${coordinates_r$pstar_tax}** 108 | - Post-tax consumer surplus: **\\${areas_r$con_surplus_tax}** ($1/2 \\times {areas_intermediate_r$con_surplus_tax_base} \\times {areas_intermediate_r$con_surplus_tax_height}$) 109 | - Post-tax producer surplus: **\\${areas_r$pro_surplus_tax}** ($1/2 \\times {areas_intermediate_r$pro_surplus_tax_base} \\times {areas_intermediate_r$pro_surplus_tax_height}$) 110 | 111 | - Deadweight loss: **\\${areas_r$dwl}** ($1/2 \\times {areas_intermediate_r$dwl_base} \\times {areas_intermediate_r$dwl_height}$) 112 | 113 | - Total tax incidence (revenue raised): **\\${areas_r$total_incidence}** ($({coordinates_r$pstar_tax} - {coordinates_r$psupplied_tax}) \\times {coordinates_r$qstar_tax}$) 114 | - Consumer tax incidence: **\\${areas_r$con_incidence}** ($({coordinates_r$pstar_tax} - {coordinates_r$pstar_comp}) \\times {coordinates_r$qstar_tax}$) 115 | - Producer tax incidence: **\\${areas_r$pro_incidence}** ($({coordinates_r$pstar_comp} - {coordinates_r$psupplied_tax}) \\times {coordinates_r$qstar_tax}$) 116 | - Percent of tax borne by consumers: **{scales::percent(areas$con_incidence_pct)}** (${areas_r$con_incidence} / {areas_r$total_incidence}$) 117 | - Percent of tax borne by producers: **{scales::percent(areas$pro_incidence_pct)}** (${areas_r$pro_incidence} / {areas_r$total_incidence}$) 118 | ") 119 | } 120 | 121 | 122 | pts <- function(x) { 123 | as.numeric(grid::convertUnit(grid::unit(x, "pt"), "mm")) 124 | } 125 | 126 | # update_geom_defaults("text", list(family = "IBM Plex Sans Condensed SemiBold")) 127 | # update_geom_defaults("label", list(family = "IBM Plex Sans Condensed SemiBold")) 128 | 129 | theme_econ <- function(base_size = 11, axis_line = FALSE) { 130 | # update_geom_defaults("label", list(family = "IBM Plex Sans Condensed Light")) 131 | # update_geom_defaults("text", list(family = "IBM Plex Sans Condensed Light")) 132 | 133 | ret <- theme_bw(base_size) + 134 | theme(axis.title.y = element_text(margin = margin(r = 10)), 135 | axis.title.x = element_text(margin = margin(t = 10)), 136 | plot.title = element_text(size = rel(1.4), face = "plain"), 137 | plot.subtitle = element_text(size = rel(1), face = "plain"), 138 | plot.caption = element_text(size = rel(0.8), color = "grey50", face = "plain"), 139 | strip.text = element_text(size = rel(1), face = "plain"), 140 | legend.title = element_text(size = rel(0.8)), 141 | panel.border = element_blank(), 142 | axis.ticks = element_blank(), 143 | strip.background = element_rect(fill = "#ffffff", colour=NA), 144 | panel.spacing.y = unit(1.5, "lines"), 145 | legend.key = element_blank(), 146 | legend.spacing = unit(0.1, "lines"), 147 | legend.box.margin = margin(t = -0.25, unit = "lines"), 148 | legend.margin = margin(t = 0)) 149 | 150 | if (axis_line) { 151 | ret <- ret + theme(axis.line = element_line(color = "black", size = 0.25)) 152 | } 153 | 154 | ret 155 | } 156 | 157 | equilibrium <- uniroot(function(x) supply_fun(x) - demand_fun(x), c(0, max_x))$root 158 | equilibrium_tax <- uniroot(function(x) supply_tax(x) - demand_fun(x), c(0, max_x))$root 159 | 160 | x_q_tax <- seq(0, equilibrium_tax, 0.1) 161 | x_q_dwl <- seq(equilibrium_tax, equilibrium, 0.1) 162 | 163 | surplus_labels <- tribble( 164 | ~x, ~y, ~text, ~fill, 165 | 1, midpoint(demand_fun(equilibrium_tax), max(demand_fun(x_q_tax))), 166 | names[1], nord_green, 167 | 1, midpoint(min(supply_fun(x_q_tax)), supply_fun(equilibrium_tax)), 168 | names[2], nord_lt_blue, 169 | equilibrium_tax + 1, midpoint(min(supply_fun(x_q_dwl)), max(demand_fun(x_q_dwl))), 170 | names[3], nord_purple, 171 | 1, midpoint(demand_fun(equilibrium), demand_fun(equilibrium_tax)), 172 | names[4], nord_yellow, 173 | 1, midpoint(supply_fun(equilibrium), supply_fun(equilibrium_tax)), 174 | names[5], nord_yellow 175 | ) 176 | 177 | 178 | if (shaded) { 179 | base_plot <- ggplot(data = tibble(x = 0:max_x), mapping = aes(x = x)) + 180 | geom_ribbon(data = tibble(x = x_q_tax), 181 | aes(x = x, 182 | ymin = demand_fun(equilibrium_tax), ymax = demand_fun(x_q_tax)), 183 | alpha = 0.3, fill = nord_green) + 184 | geom_ribbon(data = tibble(x = x_q_tax), 185 | aes(x = x, 186 | ymin = supply_fun(x_q_tax), ymax = supply_fun(equilibrium_tax)), 187 | alpha = 0.3, fill = nord_lt_blue) + 188 | geom_ribbon(data = tibble(x = x_q_dwl), 189 | aes(x = x, 190 | ymin = supply_fun(x_q_dwl), ymax = demand_fun(x_q_dwl)), 191 | alpha = 0.3, fill = nord_purple) + 192 | geom_ribbon(data = tibble(x = x_q_tax), 193 | aes(x = x, 194 | ymin = demand_fun(equilibrium), ymax = demand_fun(equilibrium_tax)), 195 | alpha = 0.3, fill = nord_yellow) + 196 | geom_ribbon(data = tibble(x = x_q_tax), 197 | aes(x = x, 198 | ymin = supply_fun(equilibrium), ymax = supply_fun(equilibrium_tax)), 199 | alpha = 0.3, fill = nord_yellow) 200 | } else { 201 | base_plot <- ggplot(data = tibble(x = 0:max_x), mapping = aes(x = x)) 202 | } 203 | 204 | full_plot <- base_plot + 205 | geom_segment(aes(x = equilibrium, xend = equilibrium, 206 | y = -Inf, yend = supply_fun(equilibrium)), 207 | color = "grey50", size = 0.5, linetype = "dashed") + 208 | geom_segment(aes(x = -Inf, xend = equilibrium, 209 | y = supply_fun(equilibrium), yend = supply_fun(equilibrium)), 210 | color = "grey50", size = 0.5, linetype = "dashed") + 211 | geom_segment(aes(x = equilibrium_tax, xend = equilibrium_tax, 212 | y = -Inf, yend = supply_tax(equilibrium_tax)), 213 | color = "grey50", size = 0.5, linetype = "dashed") + 214 | geom_segment(aes(x = -Inf, xend = equilibrium_tax, 215 | y = supply_tax(equilibrium_tax), yend = supply_tax(equilibrium_tax)), 216 | color = "grey50", size = 0.5, linetype = "dashed") + 217 | geom_segment(aes(x = -Inf, xend = equilibrium_tax, 218 | y = supply_fun(equilibrium_tax), yend = supply_fun(equilibrium_tax)), 219 | color = "grey50", size = 0.5, linetype = "dashed") + 220 | stat_function(fun = supply_fun, size = 1.5, color = nord_red) + 221 | stat_function(fun = supply_tax, size = 1.5, color = nord_orange) + 222 | stat_function(fun = demand_fun, size = 1.5, color = nord_dk_blue) + 223 | annotate(geom = "label", x = 38, y = supply_fun(38), label = "S", 224 | size = 4, fill = nord_red, color = "white") + 225 | annotate(geom = "label", x = 38, y = supply_tax(38), label = "S[tax]", 226 | size = 4, fill = nord_orange, color = "white", parse = TRUE) + 227 | annotate(geom = "label", x = 38, y = demand_fun(38), label = "D", 228 | size = 4, fill = nord_dk_blue, color = "white") + 229 | scale_x_continuous(expand = c(0, 0)) + 230 | scale_y_continuous(expand = c(0, 0), labels = scales::dollar) + 231 | coord_cartesian(xlim, ylim) + 232 | labs(x = xlab, y = ylab, title = title) + 233 | theme_econ(13, axis_line = TRUE) + 234 | theme(panel.grid = element_blank(), 235 | plot.background = element_rect(fill = bg.col), 236 | plot.margin = margin(0.5, 1, 0.5, 0.5, "cm")) 237 | 238 | if (shaded) { 239 | final_plot <- full_plot + 240 | geom_label(data = surplus_labels, aes(x = x, y = y, label = text, fill = fill), 241 | hjust = "left", size = 4, color = "white") + 242 | scale_fill_identity() 243 | } else { 244 | final_plot <- full_plot 245 | } 246 | 247 | coordinates <- list(qstar_comp = equilibrium, 248 | pstar_comp = demand_fun(equilibrium), 249 | qstar_tax = equilibrium_tax, 250 | pstar_tax = demand_fun(equilibrium_tax), 251 | psupplied_tax = supply_fun(equilibrium_tax)) 252 | 253 | # Consumer surplus pre tax 254 | con_surplus_height <- demand_fun(0) - coordinates$pstar_comp 255 | con_surplus_base <- coordinates$qstar_comp 256 | con_surplus <- 0.5 * con_surplus_base * con_surplus_height 257 | 258 | # Consumer surplus post tax 259 | con_surplus_tax_height <- demand_fun(0) - coordinates$pstar_tax 260 | con_surplus_tax_base <- coordinates$qstar_tax 261 | con_surplus_tax <- 0.5 * con_surplus_tax_base * con_surplus_tax_height 262 | 263 | # Producer surplus pre tax 264 | pro_surplus_height <- coordinates$pstar_comp - supply_fun(0) 265 | pro_surplus_base <- coordinates$qstar_comp 266 | pro_surplus <- 0.5 * pro_surplus_base * pro_surplus_height 267 | 268 | # Producer surplus pre tax 269 | pro_surplus_tax_height <- coordinates$psupplied_tax - supply_fun(0) 270 | pro_surplus_tax_base <- coordinates$qstar_tax 271 | pro_surplus_tax <- 0.5 * pro_surplus_tax_base * pro_surplus_tax_height 272 | 273 | # DWL 274 | dwl_height <- coordinates$pstar_tax - coordinates$psupplied_tax 275 | dwl_base <- coordinates$qstar_comp - coordinates$qstar_tax 276 | dwl <- 0.5 * dwl_base * dwl_height 277 | 278 | # Tax incidence 279 | incidence_base <- coordinates$qstar_tax 280 | con_incidence_height <- coordinates$pstar_tax - coordinates$pstar_comp 281 | pro_incidence_height <- coordinates$pstar_comp - coordinates$psupplied_tax 282 | 283 | con_incidence <- incidence_base * con_incidence_height 284 | pro_incidence <- incidence_base * pro_incidence_height 285 | total_incidence <- con_incidence + pro_incidence 286 | con_incidence_pct <- con_incidence / total_incidence 287 | pro_incidence_pct <- pro_incidence / total_incidence 288 | 289 | areas <- list(con_surplus = con_surplus, 290 | con_surplus_tax = con_surplus_tax, 291 | pro_surplus = pro_surplus, 292 | pro_surplus_tax = pro_surplus_tax, 293 | dwl = dwl, 294 | con_incidence = con_incidence, 295 | pro_incidence = pro_incidence, 296 | total_incidence = total_incidence, 297 | con_incidence_pct = con_incidence_pct, 298 | pro_incidence_pct = pro_incidence_pct) 299 | 300 | areas_intermediate <- list(con_surplus_height = con_surplus_height, 301 | con_surplus_base = con_surplus_base, 302 | con_surplus_tax_height = con_surplus_tax_height, 303 | con_surplus_tax_base = con_surplus_tax_base, 304 | pro_surplus_height = pro_surplus_height, 305 | pro_surplus_base = pro_surplus_base, 306 | pro_surplus_tax_height = pro_surplus_tax_height, 307 | pro_surplus_tax_base = pro_surplus_tax_base, 308 | dwl_height = dwl_height, 309 | dwl_base = dwl_base, 310 | incidence_base = incidence_base, 311 | con_incidence_height = con_incidence_height, 312 | pro_incidence_height = pro_incidence_height) 313 | 314 | return(list(p = final_plot, coordinates = coordinates, 315 | areas = areas, areas_intermediate = areas_intermediate, 316 | details = print_details(coordinates, areas, areas_intermediate))) 317 | } 318 | 319 | 320 | 321 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | #=================== 2 | # On load 3 | #=================== 4 | .onAttach <- function(libname, pkgname) { 5 | packageStartupMessage("~~ Package econocharts\nVisit https://r-coder.com/ for R tutorials ~~") 6 | } 7 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # econocharts package 2 | Microeconomics/macroeconomics graphs made with ggplot2 3 | 4 | This package allows creating microeconomics or macroeconomics charts in R with simple functions. This package inspiration is [reconPlots](https://github.com/andrewheiss/reconPlots) by Andrew Heiss. 5 | 6 | THE PACKAGE IS UNDER HEAVY DEVELOPMENT. WORK IN PROGRESS. You can suggest ideas by submitting an Issue or contributing submitting Pull Requests. 7 | 8 | ## TODO 9 | - [ ] Finish documentation 10 | - [x] Price control (in `sdcurve` function) 11 | - [ ] Allow drawing custom functions 12 | - [ ] Add graph for budget constraints 13 | - [ ] Fix `linecol` argument 14 | - [x] Tax graph 15 | - [ ] Shade producer and consumer surplus 16 | - [ ] Add Edgeworth box 17 | - [ ] General equilibrium (suggested by Ilya) 18 | - [x] Prospect theory value function (suggested by @brshallo) 19 | - [x] Neoclassical labor supply (suggested by @hilton1) 20 | 21 | 22 | ## Index 23 | - [Installation](#installation) 24 | - [Supply curve](#supply) 25 | - [Demand curve](#demand) 26 | - [Supply and demand](#supply-and-demand) 27 | - [Neoclassical labor supply](#neoclassical-labor-supply) 28 | - [Indifference curves](#indifference-curves) 29 | - [Production–possibility frontier](#productionpossibility-frontier) 30 | - [Tax graph](#tax-graph) 31 | - [Prospect Theory value function](#prospect-theory-value-function) 32 | - [Laffer curve](#laffer-curve) 33 | - [Calculating the intersections](#intersections) 34 | - [Citation](#citation) 35 | 36 | ## Installation 37 | 38 | ### GitHub 39 | ```r 40 | # Install the development version from GitHub: 41 | # install.packages("devtools") 42 | devtools::install_github("R-CoderDotCom/econocharts") 43 | ``` 44 | 45 | ### CRAN 46 | The package will be on CRAN as soon as possible 47 | 48 | ## Supply 49 | 50 | ```r 51 | supply() # Default plot 52 | ``` 53 | 54 |

55 | 56 |

57 | 58 | 59 | ```r 60 | supply(ncurves = 1, # Number of supply curves to be plotted 61 | type = "line", # Type of the curve 62 | x = c(2, 4, 5), # Y-axis values where to create intersections 63 | linecol = 2, # Color of the curves 64 | geom = "label", # Label type of the intersection points 65 | geomfill = "pink", # If geom = "label", is the background color of the label 66 | main = "Supply curve") # Title of the plot 67 | ``` 68 | 69 |

70 | 71 |

72 | 73 | ```r 74 | supply(ncurves = 3, # Three supply curves 75 | xlab = "X", # X-axis label 76 | ylab = "Y", # Y-axis label 77 | bg.col = "lightblue") # Background color 78 | ``` 79 | 80 |

81 | 82 |

83 | 84 | 85 | ## Demand 86 | 87 | ```r 88 | demand(x = 3:6, # Intersections 89 | generic = FALSE) # Axis values with the actual numbers 90 | ``` 91 |

92 | 93 |

94 | 95 | 96 | ```r 97 | demand(main = "Demand", # Title 98 | sub = "curve", # Subtitle 99 | xlab = "X", # X-axis label 100 | ylab = "Y", # Y-axis label 101 | names = "D[1]", # Custom name for the curve 102 | geomcol = 2) # Color of the custom name of the curve 103 | ``` 104 | 105 |

106 | 107 |

108 | 109 | 110 | ## Supply and demand 111 | 112 | ```r 113 | sdcurve() # Default supply and demand plot 114 | ``` 115 | 116 |

117 | 118 |

119 | 120 | 121 | ```r 122 | # Custom data 123 | supply1 <- data.frame(x = c(1, 9), y = c(1, 9)) 124 | supply1 125 | 126 | demand1 <- data.frame(x = c(7, 2), y = c(2, 7)) 127 | demand1 128 | 129 | supply2 <- data.frame(x = c(2, 10), y = c(1, 9)) 130 | supply2 131 | 132 | demand2 <- data.frame(x = c(8, 2), y = c(2, 8)) 133 | demand2 134 | 135 | p <- sdcurve(supply1, # Custom data 136 | demand1, 137 | supply2, 138 | demand2, 139 | equilibrium = TRUE, # Calculate the equilibrium 140 | bg.col = "#fff3cd") # Background color 141 | p + annotate("segment", x = 2.5, xend = 3, y = 6.5, yend = 7, # Add more layers 142 | arrow = arrow(length = unit(0.3, "lines")), colour = "grey50") 143 | ``` 144 | 145 |

146 | 147 |

148 | 149 | ## Neoclassical labor supply 150 | 151 | ```r 152 | neolabsup(x = c(2, 3, 5, 7), xlab = "Quantity of\n labor supplied", ylab = "Wage rate") 153 | ``` 154 | 155 |

156 | 157 |

158 | 159 | ## Indifference curves 160 | 161 | ```r 162 | indifference() # Default indifference curve 163 | ``` 164 | 165 |

166 | 167 |

168 | 169 | ```r 170 | indifference(ncurves = 2, # Two curves 171 | x = c(2, 4), # Intersections 172 | main = "Indifference curves", 173 | xlab = "Good X", 174 | ylab = "Good Y", 175 | linecol = 2, # Color of the curves 176 | pointcol = 2) # Color of the intersection points 177 | ``` 178 | 179 |

180 | 181 |

182 | 183 | 184 | ```r 185 | p <- indifference(ncurves = 2, x = c(2, 4), main = "Indifference curves", xlab = "Good X", ylab = "Good Y") 186 | 187 | int <- bind_rows(curve_intersect(data.frame(x = 1:1000, y = rep(3, nrow(p$curve))), p$curve + 1)) 188 | 189 | p$p + geom_segment(data = int, aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") + 190 | geom_segment(data = int, aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") + 191 | geom_point(data = int, size = 3) 192 | ``` 193 | 194 |

195 | 196 |

197 | 198 | 199 | ```r 200 | indifference(ncurves = 2, # Two curves 201 | type = "pcom", # Perfect complements 202 | main = "Indifference curves", 203 | sub = "Perfect complements", 204 | xlab = "Good X", 205 | ylab = "Good Y", 206 | bg.col = "#fff3cd", # Background color 207 | linecol = 1) # Color of the curve 208 | ``` 209 | 210 |

211 | 212 |

213 | 214 | 215 | ```r 216 | indifference(ncurves = 5, # Five curves 217 | type = "psubs", # Perfect substitutes 218 | main = "Indifference curves", 219 | sub = "Perfect substitutes", 220 | xlab = "Good X", 221 | ylab = "Good Y", 222 | bg.col = "#fff3cd", # Background color 223 | linecol = 1) # Color of the curve 224 | ``` 225 | 226 | 227 |

228 | 229 |

230 | 231 | ## Production–possibility frontier 232 | 233 | ```r 234 | ppf(x = 1:6, # Intersections 235 | main = "PPF", 236 | geom = "text", 237 | generic = TRUE, # Generic axis labels 238 | xlab = "X", 239 | ylab = "Y", 240 | labels = 1:6, 241 | acol = 3)$p 242 | ``` 243 | 244 |

245 | 246 |

247 | 248 | ```r 249 | p <- ppf(x = 4:6, # Intersections 250 | main = "PPF", 251 | geom = "text", 252 | generic = TRUE, # Generic labels 253 | labels = c("A", "B", "C"), # Custom labels 254 | xlab = "BIKES", 255 | ylab = "CARS", 256 | acol = 3) # Color of the area 257 | 258 | p$p + geom_point(data = data.frame(x = 5, y = 5), size = 3) + 259 | geom_point(data = data.frame(x = 2, y = 2), size = 3) + 260 | annotate("segment", x = 3.1, xend = 4.25, y = 5, yend = 5, 261 | arrow = arrow(length = unit(0.5, "lines")), colour = 3, lwd = 1) + 262 | annotate("segment", x = 4.25, xend = 4.25, y = 5, yend = 4, 263 | arrow = arrow(length = unit(0.5, "lines")), colour = 3, lwd = 1) 264 | ``` 265 | 266 | 267 |

268 | 269 |

270 | 271 | ## Tax graph 272 | 273 | Original function by Andrew Heiss. 274 | 275 | ``` r 276 | # Data 277 | demand <- function(Q) 20 - 0.5 * Q 278 | supply <- function(Q) 2 + 0.25 * Q 279 | supply_tax <- function(Q) supply(Q) + 5 280 | 281 | # Chart 282 | tax_graph(demand, supply, supply_tax, NULL) 283 | ``` 284 |

285 | 286 |

287 | 288 | ``` r 289 | # Chart with shaded areas 290 | tax_graph(demand, supply, supply_tax, shaded = TRUE) 291 | ``` 292 | 293 |

294 | 295 |

296 | 297 | ## Prospect theory value function 298 | 299 | ```r 300 | ptvalue(sigma = 0.3, 301 | lambda = -2.25, 302 | col = 2, # Color of the curve 303 | xint = seq(0, 75, 25), # Intersections 304 | xintcol = 4, # Color of the intersection segments 305 | ticks = TRUE, # Display ticks on the axes 306 | xlabels = TRUE, # Display the X-axis tick labels 307 | ylabels = TRUE, # Display the Y-axis tick labels 308 | by_x = 25, by_y = 50, # Axis steps 309 | main = "Prospect Theory Value Function") 310 | ``` 311 | 312 |

313 | 314 |

315 | 316 | 317 | 318 | ## Laffer curve 319 | ```r 320 | laffer(ylab = "T", xlab = "t", 321 | acol = "lightblue", # Color of the area 322 | pointcol = 4) # Color of the maximum point 323 | ``` 324 | 325 |

326 | 327 |

328 | 329 | 330 | ```r 331 | laffer(xmax = 20, # Modify the curve 332 | t = c(3, 6, 9), # Intersections 333 | generic = FALSE, 334 | ylab = "T", 335 | xlab = "t", 336 | acol = "lightblue", # Color of the area 337 | alpha = 0.6, # Transparency of the area 338 | pointcol = 4) # Color of the maximum point 339 | 340 | ``` 341 | 342 |

343 | 344 |

345 | 346 | 347 | 348 | ## Intersections 349 | 350 | The functions above can have a limited functionality if you want a fully customized plot. The `curve_intersection` function allows you to calculate the intersection points between two curves. You can use this function to create your custom charts. 351 | 352 | Credits to [Andrew Heiss](https://www.andrewheiss.com/) for this function and examples. 353 | 354 | 355 | ### Curved Bézier lines with empirical data 356 | 357 | ```r 358 | # Curves 359 | curve1 <- data.frame(Hmisc::bezier(c(1, 8, 9), c(1, 5, 9))) 360 | curve2 <- data.frame(Hmisc::bezier(c(1, 3, 9), c(9, 3, 1))) 361 | 362 | # Calculate the intersections 363 | curve_intersection <- curve_intersect(curve1, curve2) 364 | 365 | # Create the chart 366 | ggplot(mapping = aes(x = x, y = y)) + 367 | geom_line(data = curve1, color = "red", size = 1) + 368 | geom_line(data = curve2, color = "blue", size = 1) + 369 | geom_vline(xintercept = curve_intersection$x, linetype = "dotted") + 370 | geom_hline(yintercept = curve_intersection$y, linetype = "dotted") + 371 | theme_classic() 372 | ``` 373 | 374 |

375 | 376 |

377 | 378 | 379 | ### Curved lines defined with functions 380 | 381 | Specify a X-axis range and set `empirical = FALSE`. 382 | 383 | ```r 384 | # Define curves with functions 385 | curve1 <- function(q) (q - 10)^2 386 | curve2 <- function(q) q^2 + 2*q + 8 387 | 388 | # X-axis range 389 | x_range <- 0:5 390 | 391 | # Calculate the intersections between the two curves 392 | curve_intersection <- curve_intersect(curve1, curve2, empirical = FALSE, 393 | domain = c(min(x_range), max(x_range))) 394 | 395 | # Create your custom plot 396 | ggplot(data.frame(x = x_range)) + 397 | stat_function(aes(x = x), color = "blue", size = 1, fun = curve1) + 398 | stat_function(aes(x = x), color = "red", size = 1, fun = curve2) + 399 | geom_vline(xintercept = curve_intersection$x, linetype = "dotted") + 400 | geom_hline(yintercept = curve_intersection$y, linetype = "dotted") + 401 | theme_classic() 402 | ``` 403 |

404 | 405 |

406 | 407 | ## Citation 408 | 409 | ```r 410 | To cite package ‘econocharts’ in publications use: 411 | 412 | José Carlos Soage González and Andrew Heiss (2020). econocharts: Microeconomics and Macroeconomics Charts Made with 'ggplot2'. R package version 1.0. 413 | https://r-coder.com/, https://r-coder.com/economics-charts-r/. 414 | 415 | A BibTeX entry for LaTeX users is 416 | 417 | @Manual{, 418 | title = {econocharts: Microeconomics and Macroeconomics Charts Made with 'ggplot2'}, 419 | author = {José Carlos {Soage González} and Andrew Heiss}, 420 | year = {2020}, 421 | note = {R package version 1.0}, 422 | url = {https://r-coder.com/, https://r-coder.com/economics-charts-r/}, 423 | } 424 | 425 | ``` 426 | 427 | ## Social Media 428 | - Facebook: [https://www.facebook.com/RCODERweb](https://www.facebook.com/RCODERweb) 429 | - Twitter: [https://twitter.com/RCoderWeb](https://twitter.com/RCoderWeb) 430 | -------------------------------------------------------------------------------- /econocharts.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | -------------------------------------------------------------------------------- /man/curve_intersect.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/intersect.R 3 | \name{curve_intersect} 4 | \alias{curve_intersect} 5 | \title{Intersection of two curves} 6 | \usage{ 7 | curve_intersect(curve1, curve2, empirical = TRUE, domain = NULL) 8 | } 9 | \arguments{ 10 | \item{curve1}{Either a \code{data.frame} with columns named \code{x} and \code{y} or a function.} 11 | 12 | \item{curve2}{Either \code{data.frame} with columns named \code{x} and \code{y} or a function.} 13 | 14 | \item{empirical}{If true (default) indicates that the curves are data frames of empirical data. If false, indicates that the curves are actual functions.} 15 | 16 | \item{domain}{Two-value numeric vector indicating the bounds along the x-axis where the intersection should be found when \code{empirical} is false} 17 | } 18 | \value{ 19 | A list with \code{x} and \code{y} values. 20 | } 21 | \description{ 22 | Calculate where two lines or curves intersect. Curves are defined as data 23 | frames with x and y columns providing cartesian coordinates for the lines. 24 | This function works on both linear and nonlinear curves. 25 | } 26 | \details{ 27 | For now, \code{curve_intersect} will only find one intersection. 28 | 29 | If you define curves with empirical data frames (i.e. provide actual values 30 | for x and y), ensure that \code{empirical = TRUE}. 31 | 32 | If you define curves with functions (i.e. \code{curve1 <- x^2}), ensure that 33 | \code{empirical = FALSE} and provide a range of x-axis values to search for 34 | an intersection using \code{domain}. 35 | } 36 | \examples{ 37 | # Straight lines (empirical) 38 | line1 <- data.frame(x = c(1, 9), y = c(1, 9)) 39 | line2 <- data.frame(x = c(9, 1), y = c(1, 9)) 40 | 41 | curve_intersect(line1, line2) 42 | 43 | # Curved lines (empirical) 44 | curve1 <- data.frame(Hmisc::bezier(c(1, 8, 9), c(1, 5, 9))) 45 | curve2 <- data.frame(Hmisc::bezier(c(1, 3, 9), c(9, 3, 1))) 46 | 47 | curve_intersect(curve1, curve2) 48 | 49 | # Curved lines (functional) 50 | curve1 <- function(q) (q - 10)^2 51 | curve2 <- function(q) q^2 + 2*q + 8 52 | 53 | curve_intersect(curve1, curve2, empirical = FALSE, domain = c(0, 5)) 54 | } 55 | \author{ 56 | \itemize{ 57 | \item{Weiss, Andrew.} 58 | } 59 | } 60 | -------------------------------------------------------------------------------- /man/demand.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/demand.R 3 | \name{demand} 4 | \alias{demand} 5 | \title{demand curves} 6 | \usage{ 7 | demand( 8 | ..., 9 | ncurves = 1, 10 | xmax, 11 | ymax, 12 | type = "convex", 13 | x, 14 | curve_names = TRUE, 15 | names, 16 | linecol, 17 | labels, 18 | generic = TRUE, 19 | geom = "text", 20 | geomcol = 1, 21 | geomfill = "white", 22 | main = NULL, 23 | sub = NULL, 24 | xlab = NULL, 25 | ylab = NULL, 26 | bg.col = "white" 27 | ) 28 | } 29 | \arguments{ 30 | \item{...}{Specify the demand curve or curves separated by commas (as \code{data.frame}) you want to display in the graph. This will override the sample curve.} 31 | 32 | \item{ncurves}{Number of demand curves to be generated based on the sample data.} 33 | 34 | \item{xmax}{Numeric. Allows modifying the maximum X value for the default demand function.} 35 | 36 | \item{ymax}{Numeric. Allows modifying the maximum Y value for the default demand function.} 37 | 38 | \item{type}{Possible values are \code{"convex"} (default) and \code{"line"} to plot a convex or a linear demand function by default, respectively.} 39 | 40 | \item{x}{Y-axis values where to create intersections with the demand curves.} 41 | 42 | \item{curve_names}{Boolean. If \code{TRUE}, the function adds default names to each.} 43 | 44 | \item{names}{If \code{curve_names = TRUE} are custom names for the curves.} 45 | 46 | \item{linecol}{Line color of the curves.} 47 | 48 | \item{labels}{If \code{x} is specified, are the labels for the intersection points.} 49 | 50 | \item{generic}{Boolean. If \code{TRUE} and \code{x} is specified, the axis labels shows generic names. If \code{FALSE}, the axis labels are the actual data of the axis that corresponds to the intersection points.} 51 | 52 | \item{geom}{Possible values are \code{"text"} to display the labels of the intersection points with text and \code{"label"} to show them with labels.} 53 | 54 | \item{geomcol}{Color of the labels of the intersection points.} 55 | 56 | \item{geomfill}{If \code{geom = "label"} is the background color of the label.} 57 | 58 | \item{main}{Main title of the plot.} 59 | 60 | \item{sub}{Subtitle of the plot.} 61 | 62 | \item{xlab}{Name of the X-axis.} 63 | 64 | \item{ylab}{Name of the Y-axis.} 65 | 66 | \item{bg.col}{Background color of the plot.} 67 | } 68 | \description{ 69 | TODO 70 | } 71 | -------------------------------------------------------------------------------- /man/econocharts-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/econocharts-package.R 3 | \docType{package} 4 | \name{econocharts-package} 5 | \alias{econocharts-package} 6 | \title{econocharts: Microeconomics and Macroeconomics charts Made with 'ggplot2'} 7 | \description{ 8 | This package allows creating microeconomics and macroeconomics charts, like supply and demand curves, production-possibility frontiers, indifference curves, Laffer curves or customized charts with very simple functions. 9 | } 10 | \details{ 11 | \itemize{ 12 | \item{Package: econocharts} 13 | \item{Version: 1.0} 14 | \item{Maintainer: José Carlos Soage González \email{jsoage@uvigo.es}} 15 | } 16 | } 17 | \seealso{ 18 | \itemize{ 19 | \item{\href{https://r-coder.com/}{R tutorials}} 20 | } 21 | } 22 | \author{ 23 | \itemize{ 24 | \item{Soage González, José Carlos.} 25 | \item{Weiss, Andrew.} 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /man/indifference.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/indiference.R 3 | \name{indifference} 4 | \alias{indifference} 5 | \title{Indifference curves} 6 | \usage{ 7 | indifference( 8 | ..., 9 | ncurves = 1, 10 | xmax, 11 | ymax, 12 | type = "normal", 13 | x, 14 | pointcol = 1, 15 | curve_names = TRUE, 16 | names, 17 | linecol, 18 | labels, 19 | generic = TRUE, 20 | geom = "text", 21 | geomcol = 1, 22 | geomfill = "white", 23 | main = NULL, 24 | sub = NULL, 25 | xlab = NULL, 26 | ylab = NULL, 27 | bg.col = "white" 28 | ) 29 | } 30 | \arguments{ 31 | \item{...}{Specify the curve or curves separated by commas (as \code{data.frame}) you want to display in the graph. This will override the sample curve.} 32 | 33 | \item{ncurves}{If \code{...} is not specified, is the number of indifference curves to be generated based on the sample data.} 34 | 35 | \item{xmax}{Numeric. Allows modifying the maximum X value for the default indifference function.} 36 | 37 | \item{ymax}{Numeric. Allows modifying the maximum Y value for the default indifference function.} 38 | 39 | \item{type}{Possible values are \verb{"normal}, for a normal indifference function, \code{"psubs"} for perfect substitute and \code{"pcom"} for perfect complements.} 40 | 41 | \item{x}{Y-axis values where to create intersections with the indifference curves.} 42 | 43 | \item{pointcol}{If \code{x} is specified, is the color of the points that represents the intersections.} 44 | 45 | \item{curve_names}{Boolean. If \code{TRUE}, the function adds default names to each.} 46 | 47 | \item{names}{If \code{curve_names = TRUE} are custom names for the curves.} 48 | 49 | \item{linecol}{Line color of the curves.} 50 | 51 | \item{labels}{If \code{x} is specified are the labels for the intersection points.} 52 | 53 | \item{generic}{Boolean. If \code{TRUE} and \code{x} is specified, the axis labels shows generic names. If \code{FALSE}, the axis labels are the actual data of the axis that corresponds to the intersection points.} 54 | 55 | \item{geom}{Possible values are \code{"text"} to display the labels of the intersection points with text and \code{"label"} to show them with labels.} 56 | 57 | \item{geomcol}{Color of the labels of the intersection points.} 58 | 59 | \item{geomfill}{If \code{geom = "label"} is the background color of the label.} 60 | 61 | \item{main}{Main title of the plot.} 62 | 63 | \item{sub}{Subtitle of the plot.} 64 | 65 | \item{xlab}{Name of the X-axis.} 66 | 67 | \item{ylab}{Name of the Y-axis.} 68 | 69 | \item{bg.col}{Background color of the plot.} 70 | } 71 | \description{ 72 | TODO 73 | } 74 | -------------------------------------------------------------------------------- /man/laffer.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/laffer.R 3 | \name{laffer} 4 | \alias{laffer} 5 | \title{Laffer curve} 6 | \usage{ 7 | laffer( 8 | curve, 9 | t, 10 | xmax, 11 | ymax, 12 | pointcol = 1, 13 | generic = TRUE, 14 | showmax = TRUE, 15 | main = NULL, 16 | sub = NULL, 17 | xlab = NULL, 18 | ylab = NULL, 19 | acol, 20 | alpha = 0.3, 21 | bg.col = "white" 22 | ) 23 | } 24 | \arguments{ 25 | \item{curve}{Specify a custom curve (as \code{data.frame}). This will override the sample curve.} 26 | 27 | \item{t}{Y-axis values where to create intersections with the Laffer curve.} 28 | 29 | \item{xmax}{Numeric. Allows modifying the maximum X value for the default Laffer curve.} 30 | 31 | \item{ymax}{Numeric. Allows modifying the maximum Y value for the default Laffer curve.} 32 | 33 | \item{pointcol}{Color of the point that represents the optimum point.} 34 | 35 | \item{generic}{Boolean. If \code{TRUE} and \code{x} is specified, the axis labels shows generic names. If \code{FALSE}, the axis labels are the actual data of the axis that corresponds to the intersection points and the optimal point.} 36 | 37 | \item{showmax}{If \code{TRUE}, shows the optimal point.} 38 | 39 | \item{main}{Main title of the plot.} 40 | 41 | \item{sub}{Subtitle of the plot.} 42 | 43 | \item{xlab}{Name of the X-axis.} 44 | 45 | \item{ylab}{Name of the Y-axis.} 46 | 47 | \item{acol}{Color of the area of the curve.} 48 | 49 | \item{alpha}{Transparency of the colored area.} 50 | 51 | \item{bg.col}{Background color of the plot.} 52 | } 53 | \description{ 54 | Creates Laffer curves. The function allows specifying a custom Laffer curve, modifying the maximum X and Y axis values, creating intersections along the values of the Y-axis and the curve and customizing the final output with other arguments. 55 | } 56 | -------------------------------------------------------------------------------- /man/neolabsup.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/neolabsup.R 3 | \name{neolabsup} 4 | \alias{neolabsup} 5 | \title{Neoclassical labor supply} 6 | \usage{ 7 | neolabsup( 8 | ..., 9 | ncurves = 1, 10 | x, 11 | curve_names = TRUE, 12 | names, 13 | linecol, 14 | labels, 15 | generic = TRUE, 16 | geom = "text", 17 | geomcol = 1, 18 | geomfill = "white", 19 | main = NULL, 20 | sub = NULL, 21 | xlab = NULL, 22 | ylab = NULL, 23 | bg.col = "white" 24 | ) 25 | } 26 | \arguments{ 27 | \item{...}{Custom curve.} 28 | 29 | \item{ncurves}{Number of curves to be created.} 30 | 31 | \item{x}{Y-axis values where to create intersections with the demand curves.} 32 | 33 | \item{curve_names}{Boolean. If \code{TRUE}, the function adds default names to each.} 34 | 35 | \item{names}{If \code{curve_names = TRUE} are custom names for the curves.} 36 | 37 | \item{linecol}{Line color of the curves.} 38 | 39 | \item{labels}{If \code{x} is specified are the labels for the intersection points.} 40 | 41 | \item{generic}{Boolean. If \code{TRUE} and \code{x} is specified, the axis labels shows generic names. If \code{FALSE}, the axis labels are the actual data of the axis that corresponds to the intersection points.} 42 | 43 | \item{geom}{Possible values are \code{"text"} to display the labels of the intersection points with text and \code{"label"} to show them with labels.} 44 | 45 | \item{geomcol}{Color of the labels of the intersection points.} 46 | 47 | \item{geomfill}{If \code{geom = "label"} is the background color of the label.} 48 | 49 | \item{main}{Main title of the plot.} 50 | 51 | \item{sub}{Subtitle of the plot.} 52 | 53 | \item{xlab}{Name of the X-axis.} 54 | 55 | \item{ylab}{Name of the Y-axis.} 56 | 57 | \item{bg.col}{Background color of the plot.} 58 | } 59 | \description{ 60 | Function to create a charts for neoclassical labor supply curves 61 | } 62 | -------------------------------------------------------------------------------- /man/ppf.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ppf.R 3 | \name{ppf} 4 | \alias{ppf} 5 | \title{Production–possibility frontier} 6 | \usage{ 7 | ppf( 8 | ..., 9 | xmax, 10 | ymax, 11 | type = "concave", 12 | x, 13 | linecol, 14 | labels, 15 | generic = TRUE, 16 | geom = "text", 17 | geomcol = 1, 18 | geomfill = "white", 19 | main = NULL, 20 | sub = NULL, 21 | xlab = NULL, 22 | ylab = NULL, 23 | acol, 24 | alpha = 0.3, 25 | bg.col = "white" 26 | ) 27 | } 28 | \arguments{ 29 | \item{...}{Specify the production–possibility frontiers separated by comma (as \code{data.frame}) you want to display in the graph. This will override the sample curve.} 30 | 31 | \item{xmax}{Numeric. Allows modifying the maximum X value for the default production–possibility frontier.} 32 | 33 | \item{ymax}{Numeric. Allows modifying the maximum Y value for the default production–possibility frontier.} 34 | 35 | \item{type}{Possible values are \code{"concave"} (default) and \code{"line"} to plot a concave or a linear production–possibility frontier function by default, respectively.} 36 | 37 | \item{x}{Y-axis values where to create intersections with the production–possibility frontier} 38 | 39 | \item{linecol}{Line color of the curves.} 40 | 41 | \item{labels}{If \code{x} is specified are the labels for the intersection points.} 42 | 43 | \item{generic}{Boolean. If \code{TRUE} and \code{x} is specified, the axis labels shows generic names. If \code{FALSE}, the axis labels are the actual data of the axis that corresponds to the intersection points.} 44 | 45 | \item{geom}{Possible values are \code{"text"} to display the labels of the intersection points with text and \code{"label"} to show them with labels.} 46 | 47 | \item{geomcol}{Color of the labels of the intersection points.} 48 | 49 | \item{geomfill}{If \code{geom = "label"} is the background color of the label.} 50 | 51 | \item{main}{Main title of the plot.} 52 | 53 | \item{sub}{Subtitle of the plot.} 54 | 55 | \item{xlab}{Name of the X-axis.} 56 | 57 | \item{ylab}{Name of the Y-axis.} 58 | 59 | \item{acol}{Color of the area of the below the production–possibility frontier} 60 | 61 | \item{alpha}{Transparency of the colored area} 62 | 63 | \item{bg.col}{Background color of the plot} 64 | } 65 | \description{ 66 | Creates production–possibility frontiers. The function allows specifying custom frontiers, modifying the type of the curves (concave or linear), creating intersections along the values of the Y-axis and the curve and customizing the final output with further arguments. 67 | } 68 | -------------------------------------------------------------------------------- /man/ptvalue.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ptvalue.R 3 | \name{ptvalue} 4 | \alias{ptvalue} 5 | \title{Value function in Prospect Theory} 6 | \usage{ 7 | ptvalue( 8 | x, 9 | sigma = 0.3, 10 | lambda = -2.25, 11 | xint, 12 | xintcol = 1, 13 | main = NULL, 14 | sub = NULL, 15 | xlab = "Loss / Gain", 16 | ylab = "Value", 17 | col = 1, 18 | bg.col = "white", 19 | ticks = TRUE, 20 | xlabels = TRUE, 21 | ylabels = TRUE, 22 | by_x = 10, 23 | by_y = 20 24 | ) 25 | } 26 | \arguments{ 27 | \item{x}{Numeric. Vector of gain / loss values for x.} 28 | 29 | \item{sigma}{Number. Exponent of functions, should be less than 1 to make an 30 | 'S' shaped curve.} 31 | 32 | \item{lambda}{Number. Extent of asymmetry between losses and gains. Should be 33 | less than -1 for losses to be more 'intense' than gains (as suggested by 34 | Prospect Theory). Between -1 and 0 for gains to be more intense than 35 | losses. Greater than 0 for losses to have positive value.} 36 | 37 | \item{xint}{Numeric. Symmetric intersections. X-intercept values where to 38 | highlight points -- will be placed at both \code{xint} and \code{abs(xint)} to 39 | demonstrate asymmetry in \code{value}.} 40 | 41 | \item{xintcol}{Color of dashed lines calling-out \code{xint}.} 42 | 43 | \item{main}{Main title of the plot.} 44 | 45 | \item{sub}{Subtitle of the plot.} 46 | 47 | \item{xlab}{Name of the X-axis.} 48 | 49 | \item{ylab}{Name of the Y-axis.} 50 | 51 | \item{col}{Color of function segment.} 52 | 53 | \item{bg.col}{Background color.} 54 | 55 | \item{ticks}{TOOD} 56 | 57 | \item{xlabels}{TRUE / FALSE : whether x labels are included.} 58 | 59 | \item{ylabels}{TRUE / FALSE : whether y labels are included.} 60 | 61 | \item{by_x}{Number. Increment of the x-axis labels.} 62 | 63 | \item{by_y}{Number. Increment of the x-axis labels.} 64 | } 65 | \description{ 66 | Produces asymmetric S-shaped value function according to lessons 67 | from Prospect Theory that losses are felt more intensely than gains. 68 | } 69 | \details{ 70 | TODO 71 | } 72 | \examples{ 73 | 74 | ptvalue( 75 | sigma = 0.25, 76 | xint = 20, 77 | xintcol = 'blue', 78 | main = "Prospect Theory Shows That Gains & Losses are Felt Assymetrically", 79 | sub = "Losses are More Intense" 80 | ) 81 | 82 | } 83 | \references{ 84 | Tversky, Amos; Kahneman, Daniel (1992). "Advances in prospect 85 | theory: Cumulative representation of uncertainty". Journal of Risk and 86 | Uncertainty. 5 (4): 297–323. 87 | } 88 | -------------------------------------------------------------------------------- /man/sdcurve.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sdcurve.R 3 | \name{sdcurve} 4 | \alias{sdcurve} 5 | \title{Supply and demand curves} 6 | \usage{ 7 | sdcurve( 8 | ..., 9 | xmax, 10 | ymax, 11 | max.price, 12 | min.price, 13 | generic = TRUE, 14 | equilibrium = TRUE, 15 | main = NULL, 16 | sub = NULL, 17 | xlab = NULL, 18 | ylab = NULL, 19 | curve_names = TRUE, 20 | names, 21 | linescol, 22 | bg.col = "white" 23 | ) 24 | } 25 | \arguments{ 26 | \item{...}{Specify the demand and supply curve or curves separated by commas (as \code{data.frame}) you want to display in the graph, starting with supply. This will override the sample curves.} 27 | 28 | \item{xmax}{Numeric. Allows modifying the maximum X value for the default functions.} 29 | 30 | \item{ymax}{Numeric. Allows modifying the maximum Y value for the default functions.} 31 | 32 | \item{max.price}{Price ceiling.} 33 | 34 | \item{min.price}{Price floor.} 35 | 36 | \item{generic}{Boolean. If \code{TRUE}, the axis labels shows generic names. If \code{FALSE}, the axis labels are the actual data of the axis that corresponds to the intersection points between the two curves.} 37 | 38 | \item{equilibrium}{Boolean. If \code{TRUE}, shows the intersection points between the two curves.} 39 | 40 | \item{main}{Main title of the plot.} 41 | 42 | \item{sub}{Subtitle of the plot.} 43 | 44 | \item{xlab}{Name of the X-axis.} 45 | 46 | \item{ylab}{Name of the Y-axis.} 47 | 48 | \item{curve_names}{Boolean. If \code{TRUE}, the function adds default names to each.} 49 | 50 | \item{names}{If \code{curve_names = TRUE}, are custom names for the curves.} 51 | 52 | \item{linescol}{Color of the curves. It must be a vector of the same length as the number of displayed curves.} 53 | 54 | \item{bg.col}{Background color of the plot.} 55 | } 56 | \description{ 57 | Create supply and demand curves. By default, the function will use a default supply and a default demand curve, but this can be overridden passing new curves as additional arguments or modifying the \code{xmax} and \code{ymax} arguments. 58 | Moreover, the function provides several arguments to customize the final output, like displaying the equilibrium points, the name of the curves, customizing the title, subtitle or axis labels, among others. 59 | } 60 | \examples{ 61 | #TODO 62 | 63 | 64 | } 65 | -------------------------------------------------------------------------------- /man/supply.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/supply.R 3 | \name{supply} 4 | \alias{supply} 5 | \title{Supply curves} 6 | \usage{ 7 | supply( 8 | ..., 9 | ncurves = 1, 10 | xmax, 11 | ymax, 12 | type = "convex", 13 | x, 14 | curve_names = TRUE, 15 | names, 16 | linecol, 17 | labels, 18 | generic = TRUE, 19 | geom = "text", 20 | geomcol = 1, 21 | geomfill = "white", 22 | main = NULL, 23 | sub = NULL, 24 | xlab = NULL, 25 | ylab = NULL, 26 | bg.col = "white" 27 | ) 28 | } 29 | \arguments{ 30 | \item{...}{Specify the supply curve or curves separated by comma (as \code{data.frame}) you want to display in the graph. This will override the sample curve.} 31 | 32 | \item{ncurves}{Number of supply curves to be generated based on the sample data.} 33 | 34 | \item{xmax}{Numeric. Allows modifying the maximum X value for the default supply function.} 35 | 36 | \item{ymax}{Numeric. Allows modifying the maximum Y value for the default supply function.} 37 | 38 | \item{type}{Possible values are \code{"convex"} (default) and \code{"line"} to plot a convex or a linear supply function by default, respectively.} 39 | 40 | \item{x}{Y-axis values where to create intersections with the demand curves.} 41 | 42 | \item{curve_names}{Boolean. If \code{TRUE}, the function adds default names to each.} 43 | 44 | \item{names}{If \code{curve_names = TRUE} are custom names for the curves.} 45 | 46 | \item{linecol}{Line color of the curves.} 47 | 48 | \item{labels}{If \code{x} is specified are the labels for the intersection points.} 49 | 50 | \item{generic}{Boolean. If \code{TRUE} and \code{x} is specified, the axis labels shows generic names. If \code{FALSE}, the axis labels are the actual data of the axis that corresponds to the intersection points.} 51 | 52 | \item{geom}{Possible values are \code{"text"} to display the labels of the intersection points with text and \code{"label"} to show them with labels.} 53 | 54 | \item{geomcol}{Color of the labels of the intersection points.} 55 | 56 | \item{geomfill}{If \code{geom = "label"} is the background color of the label.} 57 | 58 | \item{main}{Main title of the plot.} 59 | 60 | \item{sub}{Subtitle of the plot.} 61 | 62 | \item{xlab}{Name of the X-axis.} 63 | 64 | \item{ylab}{Name of the Y-axis.} 65 | 66 | \item{bg.col}{Background color of the plot.} 67 | } 68 | \description{ 69 | Create supply curves. The function allows specifying the number of curves to generate or use custom curves, the type of curve (convex or linear), create intersection points along the Y-axis and customize other arguments related to the style of the final output. 70 | } 71 | -------------------------------------------------------------------------------- /man/tax_graph.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tax.R 3 | \name{tax_graph} 4 | \alias{tax_graph} 5 | \title{Tax graph} 6 | \usage{ 7 | tax_graph( 8 | demand_fun, 9 | supply_fun, 10 | supply_tax, 11 | names = c("Consumer surplus", "Producer surplus", "DWL", "Consumer tax burden", 12 | "Producer tax burden"), 13 | title = NULL, 14 | xlab = "Product (Q)", 15 | ylab = "Price (P)", 16 | colors, 17 | shaded = FALSE, 18 | xlim = c(0, 45), 19 | ylim = c(0, 20), 20 | max_x = 45, 21 | bg.col = "white" 22 | ) 23 | } 24 | \arguments{ 25 | \item{demand_fun}{TODO} 26 | 27 | \item{supply_fun}{TODO} 28 | 29 | \item{supply_tax}{TODO} 30 | 31 | \item{names}{TODO} 32 | 33 | \item{title}{TODO} 34 | 35 | \item{xlab}{TODO} 36 | 37 | \item{ylab}{TODO} 38 | 39 | \item{colors}{TODO} 40 | 41 | \item{shaded}{TODO} 42 | 43 | \item{xlim}{TODO} 44 | 45 | \item{ylim}{TODO} 46 | 47 | \item{max_x}{TODO} 48 | 49 | \item{bg.col}{TODO} 50 | } 51 | \description{ 52 | TODO 53 | } 54 | \examples{ 55 | 56 | # Data 57 | demand <- function(Q) 20 - 0.5 * Q 58 | demand_new <- function(Q) demand(Q) + 5 59 | supply <- function(Q) 2 + 0.25 * Q 60 | supply_new <- function(Q) supply(Q) + 5 61 | 62 | supply_tax <- function(Q) supply(Q) + 5 63 | 64 | demand_elastic <- function(Q) 10 - 0.05 * Q 65 | demand_inelastic <- function(Q) 20 - 2 * Q 66 | 67 | supply_elastic <- function(Q) 2 + 0.05 * Q 68 | supply_elastic_tax <- function(Q) supply_elastic(Q) + 5 69 | supply_inelastic <- function(Q) 2 + 1.5 * Q 70 | supply_inelastic_tax <- function(Q) supply_inelastic(Q) + 5 71 | 72 | normal_taxes <- tax_graph(demand, supply, supply_tax, NULL) 73 | normal_taxes_shaded <- tax_graph(demand, supply, supply_tax, shaded = TRUE) 74 | normal_taxes_shaded$p 75 | 76 | } 77 | \author{ 78 | \itemize{ 79 | \item{Weiss, Andrew.} 80 | } 81 | } 82 | --------------------------------------------------------------------------------