Go to the RMD, R, PDF, or HTML version of this file. Go back to fan’s REconTools Package, R Code Examples Repository (bookdown site), or Intro Stats with R Repository (bookdown site).
What is \(y\) below, with arbitrary base \(x\)? It is \(y=\frac{\log\left(z\right)}{\log\left(x\right)}\), because: \[ \begin{aligned} x^y &= z\\ x^{\frac{\log\left(z\right)}{\log\left(x\right)}}&=z\\ \log\left(x^{\frac{\log\left(z\right)}{\log\left(x\right)}}\right)&=\log\left(z\right)\\ \frac{\log\left(z\right)}{\log\left(x\right)}\log\left(x\right)&=\log\left(z\right)\\ \frac{\log\left(z\right)}{\log\left(x\right)}&=\frac{\log\left(z\right)}{\log\left(x\right)}\\ \end{aligned} \]
Given these, we can compute the exponents, \(y\), for non-standard bases, \(x\), given the value for \(z\).
# base 1.1
x <- 1.1
y <- 5.5
z <- x^y
# given z and knowing x, and what is y?
y_solved <- log(z) / log(x)
# dispaly
print(paste0("y_solved=", y_solved, ", y=", y))
## [1] "y_solved=5.5, y=5.5"
We have a parameter to be estimated, the parameter’s values can range between positive 1 and negative infinity. We want to use an estimator that us unconstrained. Use exponentiation to rescale the parameter so that is become unconstrained, use different bases so that the speed at which the parameter value approaches its bounds can be controlled.
While \(y\) is not bounded, \(f(y;x)\) is bounded: \[ \begin{aligned} &f(y; x) = 1 - x^{y}\\ &\text{where } x >1 \text{ and } -\infty < y < \infty\\ &\text{then, } 1 > f(y; x) > -\infty \end{aligned} \]
With \(x>1\), as \(y\) increases \(f(y;x)\) decreases: \[ \frac{d f(y; x)}{dy} = - x^{y}\log(x) < 0 \text{ when } x > 1 \]
\(x\) controls the speed at which \(f(y)\) approaches its bounds. In the simulation below, we try a number of different bases, at higher bases (2, e=2.71, 10), as \(y\) value changes \(f(y)\) shifts too quickly to the bounds. But a base value of \(x=1.03\) or \(x=1.04\) would work well in an unbounded estimation routine that still generates parameters within bounds, which is below 1 in the case here.
# Vector of unbounded values, high and low
ar_y_vals <- sort(rnorm(20, 0, 20))
# Different base values
ar_bases <- c(1.01, 1.02, 1.03, 1.04, 1.1, 2, 2.71, 10)
# Transform back to f(y) scale with different bases
mt_f_of_y_vary_x <- matrix(NA,
nrow = length(ar_y_vals),
ncol = 1 + length(ar_bases)
)
ar_st_varnames <- c("yvalidx", "y_vals", paste0("base", ar_bases))
mt_f_of_y_vary_x[, 1] <- ar_y_vals
for (it_base in seq(1, length(ar_bases))) {
fl_base <- ar_bases[it_base]
ar_f_y <- 1 - fl_base^ar_y_vals
mt_f_of_y_vary_x[, 1 + it_base] <- ar_f_y
}
# To tibble
tb_f_of_y_vary_x <- as_tibble(mt_f_of_y_vary_x) %>%
rowid_to_column(var = "id") %>%
rename_all(~ c(ar_st_varnames))
# Print
kable(tb_f_of_y_vary_x) %>% kable_styling_fc_wide()
yvalidx | y_vals | base1.01 | base1.02 | base1.03 | base1.04 | base1.1 | base2 | base2.71 | base10 |
---|---|---|---|---|---|---|---|---|---|
1 | -29.9110651 | 0.2574202 | 0.4469560 | 0.5869288 | 0.6906040 | 0.9422036 | 1.000000e+00 | 1.000000e+00 | 1.000000e+00 |
2 | -23.4299716 | 0.2079541 | 0.3712207 | 0.4997073 | 0.6010584 | 0.8928060 | 9.999999e-01 | 1.000000e+00 | 1.000000e+00 |
3 | -21.7290444 | 0.1944348 | 0.3496809 | 0.4739108 | 0.5735366 | 0.8739402 | 9.999997e-01 | 1.000000e+00 | 1.000000e+00 |
4 | -21.6858560 | 0.1940886 | 0.3491245 | 0.4732388 | 0.5728136 | 0.8734203 | 9.999997e-01 | 1.000000e+00 | 1.000000e+00 |
5 | -20.6378147 | 0.1856403 | 0.3354751 | 0.4566649 | 0.5548882 | 0.8601233 | 9.999994e-01 | 1.000000e+00 | 1.000000e+00 |
6 | -14.5222057 | 0.1345457 | 0.2499218 | 0.3490087 | 0.4342320 | 0.7494543 | 9.999575e-01 | 9.999995e-01 | 1.000000e+00 |
7 | -10.2192581 | 0.0966859 | 0.1832058 | 0.2607130 | 0.3302204 | 0.6224300 | 9.991611e-01 | 9.999624e-01 | 1.000000e+00 |
8 | -5.5455757 | 0.0536855 | 0.1040019 | 0.1511906 | 0.1954735 | 0.4105408 | 9.785901e-01 | 9.960287e-01 | 9.999972e-01 |
9 | -2.0838279 | 0.0205213 | 0.0404254 | 0.0597368 | 0.0784785 | 0.1801304 | 7.641123e-01 | 8.747532e-01 | 9.917554e-01 |
10 | -0.2105737 | 0.0020931 | 0.0041612 | 0.0062050 | 0.0082248 | 0.0198698 | 1.358065e-01 | 1.893600e-01 | 3.842190e-01 |
11 | 0.2171756 | -0.0021633 | -0.0043099 | -0.0064401 | -0.0085542 | -0.0209148 | -1.624556e-01 | -2.417391e-01 | -6.488289e-01 |
12 | 2.1270348 | -0.0213903 | -0.0430205 | -0.0648912 | -0.0870024 | -0.2247394 | -3.368188e+00 | -7.335675e+00 | -1.329784e+02 |
13 | 2.6230111 | -0.0264434 | -0.0533152 | -0.0806180 | -0.1083544 | -0.2840250 | -5.160345e+00 | -1.266732e+01 | -4.187698e+02 |
14 | 2.6572992 | -0.0267937 | -0.0540306 | -0.0817137 | -0.1098459 | -0.2882280 | -5.308510e+00 | -1.314259e+01 | -4.532545e+02 |
15 | 4.8633631 | -0.0495821 | -0.1010975 | -0.1546014 | -0.2101503 | -0.5896725 | -2.810839e+01 | -1.265519e+02 | -7.300576e+04 |
16 | 6.1786673 | -0.0634090 | -0.1301539 | -0.2003750 | -0.2742168 | -0.8019869 | -7.143762e+01 | -4.723400e+02 | -1.508923e+06 |
17 | 15.9479847 | -0.1719719 | -0.3713724 | -0.6022411 | -0.8691641 | -3.5722494 | -6.321424e+04 | -8.035031e+06 | -8.871248e+15 |
18 | 20.5982404 | -0.2274751 | -0.5036557 | -0.8383332 | -1.2431423 | -6.1222380 | -1.587406e+06 | -8.287157e+08 | -3.964975e+20 |
19 | 24.3334020 | -0.2739539 | -0.6190917 | -1.0529263 | -1.5970427 | -9.1677497 | -2.113897e+07 | -3.432541e+10 | -2.154775e+24 |
20 | 36.3393124 | -0.4356076 | -1.0536401 | -1.9274934 | -3.1589130 | -30.9287353 | -8.694068e+10 | -5.417592e+15 | -2.184300e+36 |
Define exponents to consider and x-values to consider.
# positive value exponents
ar_exponents_posv <- c(0.05, 0.5, 1, 1.5)
# positive and negative values of the base
ar_baseval_pos <- seq(1e-10, 1.5, length.out = 1000)
# base to power
mt_x2a_val <- matrix(data = NA, nrow = length(ar_exponents_posv), ncol = length(ar_baseval_pos))
# Generate values
it_row_ctr <- 0
for (fl_exponents_posv in ar_exponents_posv) {
it_row_ctr <- it_row_ctr + 1
mt_x2a_val[it_row_ctr, ] <- ar_baseval_pos^fl_exponents_posv
}
Note that the smaller exponents functions are higher when \(x<1\), but lower when \(x>1\). \[\text{if } b > a > 0 \text{, then, } \left(x^a - x^b\right) > 0 \text{, for all } 1 > x >0\] \[\text{if } b > a > 0 \text{, then, } \left(x^a - x^b\right) < 0 \text{, for all } x > 1\] Note we also have: \(\lim_{a\rightarrow 0} x^a = 1\) and \(\lim_{a\rightarrow 1} x^a = x\) bounds. When \(a>1\), function becomes convex.
# x and bounds
ar_xlim <- c(min(ar_baseval_pos), max(ar_baseval_pos))
ar_ylim <- c(0, 1.5)
# function line
st_line_1_y_legend <- paste0("x^", ar_exponents_posv[1])
st_line_2_y_legend <- paste0("x^", ar_exponents_posv[2])
st_line_3_y_legend <- paste0("x^", ar_exponents_posv[3])
st_line_4_y_legend <- paste0("x^", ar_exponents_posv[4])
# Color and line
st_point_1_pch <- 10
st_point_1_cex <- 2
ar_colors <- c("blue", "red", "black", "orange")
ar_ltys <- c("solid", "dashed", "dotted", "dotdash")
# Graph and combine
for (it_graph in c(1, 2, 3, 4)) {
if (it_graph != 1) {
par(new = T)
}
ar_y_current <- mt_x2a_val[it_graph, ]
plot(ar_baseval_pos, ar_y_current,
type = "l",
col = ar_colors[it_graph], lty = ar_ltys[it_graph],
pch = 10, cex = 2, xlim = ar_xlim, ylim = ar_ylim, panel.first = grid(),
ylab = "", xlab = "", yaxt = "n", xaxt = "n", ann = FALSE
)
plot_line <- recordPlot()
}
# CEX sizing Contorl Titling and Legend Sizes
fl_ces_fig_reg <- 1
fl_ces_fig_small <- 0.75
# R Legend
st_title <- paste0("Positive Exponential Graphing")
st_subtitle <- paste0(
"https://fanwangecon.github.io/",
"R4Econ/math/solutions/htmlpdfr/fs_inequality.html"
)
st_x_label <- "x"
st_y_label <- "x^exponent"
title(
main = st_title, sub = st_subtitle, xlab = st_x_label, ylab = st_y_label,
cex.lab = fl_ces_fig_reg,
cex.main = fl_ces_fig_reg,
cex.sub = fl_ces_fig_small
)
axis(1, cex.axis = fl_ces_fig_reg)
axis(2, cex.axis = fl_ces_fig_reg)
grid()
# Legend sizing CEX
legend("bottomright",
inset = c(0, 0),
xpd = TRUE,
c(st_line_1_y_legend, st_line_2_y_legend, st_line_3_y_legend, st_line_4_y_legend),
col = c(ar_colors[1], ar_colors[2], ar_colors[3], ar_colors[4]),
cex = fl_ces_fig_small,
lty = c(ar_ltys[1], ar_ltys[2], ar_ltys[3], ar_ltys[4]),
title = "Legends",
y.intersp = 2
)
Similar to above, but now with negative exonents.
# positive value exponents
ar_exponents_posv <- -c(0.05, 0.5, 1, 1.5)
# positive and negative values of the base
ar_baseval_pos <- seq(1e-10, 1.5, length.out = 1000)
# base to power
mt_x2a_val <- matrix(data = NA, nrow = length(ar_exponents_posv), ncol = length(ar_baseval_pos))
# Generate values
it_row_ctr <- 0
for (fl_exponents_posv in ar_exponents_posv) {
it_row_ctr <- it_row_ctr + 1
mt_x2a_val[it_row_ctr, ] <- ar_baseval_pos^fl_exponents_posv
}
For positive exponents, when \(x<1\), \(x^a<1\), when \(x>1\), \(x^a>1\). For negative exponents, when \(x<1\), \(x^a>1\), and when \(x>1\), \(x^a<1\). Large positive exponents generate small values when \(x<1\), and large negative exponents generate very large values when \(x<1\).
# x and bounds
ar_xlim <- c(min(ar_baseval_pos), max(ar_baseval_pos))
ar_ylim <- c(0, 3)
# function line
st_line_1_y_legend <- paste0("x^", ar_exponents_posv[1])
st_line_2_y_legend <- paste0("x^", ar_exponents_posv[2])
st_line_3_y_legend <- paste0("x^", ar_exponents_posv[3])
st_line_4_y_legend <- paste0("x^", ar_exponents_posv[4])
# Color and line
st_point_1_pch <- 10
st_point_1_cex <- 2
ar_colors <- c("blue", "red", "black", "orange")
ar_ltys <- c("solid", "dashed", "dotted", "dotdash")
# Graph and combine
for (it_graph in c(1, 2, 3, 4)) {
if (it_graph != 1) {
par(new = T)
}
ar_y_current <- mt_x2a_val[it_graph, ]
plot(ar_baseval_pos, ar_y_current,
type = "l",
col = ar_colors[it_graph], lty = ar_ltys[it_graph],
pch = 10, cex = 2, xlim = ar_xlim, ylim = ar_ylim, panel.first = grid(),
ylab = "", xlab = "", yaxt = "n", xaxt = "n", ann = FALSE
)
plot_line <- recordPlot()
}
# CEX sizing Contorl Titling and Legend Sizes
fl_ces_fig_reg <- 1
fl_ces_fig_small <- 0.75
# R Legend
st_title <- paste0("Negative Exponential Graphing")
st_subtitle <- paste0(
"https://fanwangecon.github.io/",
"R4Econ/math/solutions/htmlpdfr/fs_inequality.html"
)
st_x_label <- "x"
st_y_label <- "x^exponent"
title(
main = st_title, sub = st_subtitle, xlab = st_x_label, ylab = st_y_label,
cex.lab = fl_ces_fig_reg,
cex.main = fl_ces_fig_reg,
cex.sub = fl_ces_fig_small
)
axis(1, cex.axis = fl_ces_fig_reg)
axis(2, cex.axis = fl_ces_fig_reg)
grid()
# Legend sizing CEX
legend("topright",
inset = c(0, 0),
xpd = TRUE,
c(st_line_1_y_legend, st_line_2_y_legend, st_line_3_y_legend, st_line_4_y_legend),
col = c(ar_colors[1], ar_colors[2], ar_colors[3], ar_colors[4]),
cex = fl_ces_fig_small,
lty = c(ar_ltys[1], ar_ltys[2], ar_ltys[3], ar_ltys[4]),
title = "Legends",
y.intersp = 2
)
Suppose we have the inequality \(0 < a < b\), if we apply positive exponents to them, the direction of the inequality will stay the same: If \(0 < a < b\), then \(0 < a^{ \mid \alpha\mid} < b^{ \mid \alpha\mid}\) if \(\alpha < 0\). Think about the graphs above, think of \(a\) and \(b\) as points along the x-axis, note that positive exponents are strictly increasing (although some concavely and some convexly) along the x-axis. Comparing \(x^\alpha\) at \(0<b<a\) anywhere along the x-axis has still has \(b^\alpha<a^\alpha\).
In contrast, if \(0 < a < b\), then \(a^{- \mid \alpha\mid} > b^{- \mid \alpha\mid} > 0\) if \(\alpha < 0\). Sign flips. Visually from above, the sign-flipping happens because negative exponential is strictly decreasing along \(x>0\).