我有下面的代码,问题是滑块没有从中间位置开始 - 它从位置 4/5 开始,而不是 600。图片上显示的图表正确地是从中间位置开始的图表t=650
(t=600
)。同时,标题显示在t=700
,但我们暂时忽略它,除非您知道原因。
library(plotly)
x <- seq(0, 50, by = 0.1)
t_values <- seq(500, 700, by = 50) # Adjusted t values
# Fixed y-axis range
y_range <- c(0, get_density(0, inc, 700, get_u(inc, 700, target_population))) # Adjust this to your desired y-axis range
# create steps and plot all traces
steps <- list()
fig <- plot_ly()
aval <- list()
slider_steps <- list()
initial_slider_value <- 600 # Initial slider value
for (i in 1:length(t_values)) {
t_value <- t_values[i]
# Update u value based on the current t value
u <- get_u(inc, t_value, target_population)
# Update the border and population based on the new u value
border_value <- get_border(target_border, inc, t_value, u)
population_value <- get_population(inc, t_value, u)
# Update the title to include the current t_value
title_text <- paste("Transport cost:", t_value)
aval[[i]] <- list(visible = t_value == initial_slider_value, # Show line for the initial slider value
name = paste0('v = ', t_value),
x = x,
y = get_density(x, inc, t_value, u))
fig <- add_lines(fig, x = aval[i][[1]]$x, y = aval[i][[1]]$y, visible = aval[i][[1]]$visible,
name = aval[i][[1]]$name, type = 'scatter', mode = 'lines', hoverinfo = 'name',
line = list(color = '00CED1'), showlegend = FALSE)
step <- list(args = list('visible', rep(FALSE, length(aval))),
method = 'restyle')
step$args[[2]][i] = TRUE
steps[[i]] = step
# Define the slider step
slider_steps[[i]] <- list(
label = t_value,
method = 'restyle',
args = list('visible', rep(FALSE, length(t_values)))
)
slider_steps[[i]]$args[[2]][i] = TRUE
}
# Find the index of the initial slider value
initial_slider_index <- which(t_values == initial_slider_value)
# add slider control to plot
fig <- fig %>%
layout(sliders = list(
list(currentvalue = list(prefix = "Transport cost: "),
steps = slider_steps,
active = initial_slider_index # Set the initial active slider
)
),
title = title_text, # Set the initial title
yaxis = list(range = y_range), # Set fixed y-axis range
xaxis = list(range = c(0, 50)) # Set the desired x-axis range
)
fig
所以我特别指定,我希望它从 600 标记(中间)开始。
如果你想测试代码,请在上面添加:
alpha = 0.86 # Expenditure share on all other goods
beta = 0.6 # Cost share of housing capital in housing production function
g = 0.0005 # Scaling on housing production function
theta = 3 # Radians available for construction (benchmark is 3)
target_population <- 2000000
target_border <- 40
inc <- 70000
t <- 600
ra <- 45000
u <- 5353.65
x <- 0
get_price <- function(x,inc,t,u) {
(((alpha^alpha) * ((1 - alpha)^(1 - alpha)) * (inc - t * x)) / u)^(1 / (1 - alpha))
}
get_quantity <- function(x,inc,t,u) {
(((1 - alpha) * (inc - t * x)) / (((alpha^alpha) * ((1 - alpha)^(1 - alpha)) * (inc - t * x)) / u)^(1 / (1 - alpha)))
}
get_capital_intensitinc <- function(x,inc,t,u) {
(1 / (get_price(x,inc,t,u) * (beta) * (g)))^(1 / (beta - 1))
}
get_rent <- function(x,inc,t,u) {
(get_price(x,inc,t,u) * (g)) * ((1/(get_price(x,inc,t,u) * (beta) * (g)))^(beta / (beta - 1))) - 1 * ((1 / (get_price(x,inc,t,u) * (beta) * (g)))^(1 / (beta - 1)))
}
get_far <- function(x,inc,t,u) {
(g) * get_capital_intensitinc(x,inc,t,u)^(beta)
}
get_density <- function(x,inc,t,u) {
get_far(x,inc,t,u) / get_quantity(x,inc,t,u)
}
get_border <- function(target_border,inc,t,u) {
uniroot(\(x) get_rent(x,inc,t,u) - ra, lower = 0, upper = 100)$root
}
get_population <- function(inc,t,u) {
theta * integrate(\(x) {x * get_density(x,inc,t,u)},lower = 0, upper = get_border(target_border,inc,t,u))$value
}
get_u <- function(inc,t,target_population) {
uniroot(\(u) get_population(inc,t,u) - target_population, c(4500, 6500))$root
}
u <- get_u(inc,t,target_population)
R 列表的索引从 1 开始。Plotly 的滑块从 0 开始索引。
which(...)
在将列表交给 之前,只需从列表中得到的值减去 1 即可active
。