在 R 中自动调整绘图轴

Question

我正在分析捕获多年信息的历史股票价格数据。作为分析的一部分，我想挑选出较短的时间段，并通过枢轴点绘制直线，即通过高点和低点，出现在股票图表上。

有人可以分享一个 R 中的脚本示例，它会自动调整 y 和 x 轴以拉伸和加宽或压缩它们，从而导致通过枢轴点绘制的直线的斜率等于 1或 -1（即 y=x 或 y=-x）？

我已尝试搜索解决方案，但找不到任何提供自动调整轴的方法。如果可能的话，我希望计算机确定如何调整轴以实现 Y 轴上价格单位的变化与 X 轴上时间单位的变化相比的统一变化。谢谢

# =============================================
# Clear environment
# =============================================
rm(list=ls())
# =============================================


# =============================================
# Load packages
# =============================================
if (!require("cwhmisc")) install.packages("cwhmisc")
library( cwhmisc )

if (!require("BatchGetSymbols")) install.packages("BatchGetSymbols")
library( BatchGetSymbols )
# =============================================


# =============================================
# inflect function
# =============================================
inflect <- function(x, threshold = 1){
  up   <- sapply(1:threshold, function(n) c(x[-(seq(n))], rep(NA, n)))
  down <-  sapply(-1:-threshold, function(n) c(rep(NA,abs(n)), x[-seq(length(x), length(x) - abs(n) + 1)]))
  a    <- cbind(x,up,down)
  list(minima = which(apply(a, 1, min) == a[,1]), maxima = which(apply(a, 1, max) == a[,1]))
}

# =============================================
# Set dates
# =============================================
W1.date <- as.Date("2020-01-03") # Whole Range Start Date
W2.date <- as.Date("2020-02-22") # Whole Range End   Date
# =============================================

# =============================================
frequency <- 'daily' # set frequency
ticker    <- "PBR"   # set ticker
# =============================================


# =============================================
# Pull out data from Yahoo
# =============================================
l.out <- BatchGetSymbols(tickers = ticker, 
                         first.date   = W1.date,
                         last.date    = W2.date, 
                         freq.data    = frequency,
                         cache.folder = file.path(tempdir(), 'BGS_Cache') ) # cache in tempdir()
# =============================================
#l.out
#names(l.out)
#names(l.out$df.tickers)
# =============================================


# =============================================
# Create Whole Range dataframe
# =============================================
sDF <- as.data.frame(l.out$df.tickers)
#Check# sDF
# =============================================


# =============================================
# Pick a desired threshold # to plot up to
# =============================================
n <- 2
# Generate Data
# randomwalk <- 100 + cumsum(rnorm(50, 0.2, 1)) # climbs upwards most of the time
randomwalk <- sDF$price.close

bottoms <- lapply(1:n, function(x) inflect(randomwalk, threshold = x)$minima)
tops    <- lapply(1:n, function(x) inflect(randomwalk, threshold = x)$maxima)
# Color functions
cf.1 <- grDevices::colorRampPalette(c("pink","red"))
cf.2 <- grDevices::colorRampPalette(c("cyan","blue"))
par(mar=c(1,1,1,1))
plot(randomwalk, type = 'l', main = "Minima & Maxima\nVariable Thresholds")
for(i in 1:n){
  points(bottoms[[i]], randomwalk[bottoms[[i]]], pch = 16, col = cf.1(n)[i], cex = i/1.5)
}
for(i in 1:n){
  points(tops[[i]], randomwalk[tops[[i]]], pch = 16, col = cf.2(n)[i], cex = i/1.5)
}
legend("topleft", legend = c("Minima",1:n,"Maxima",1:n), 
        pch = rep(c(NA, rep(16,n)), 2), col = c(1, cf.1(n),1, cf.2(n)), 
        pt.cex =  c(rep(c(1, c(1:n) / 1.5), 2)), cex = .75, ncol = 2)
# 
bottoms
tops

Answer 1

我相信您正在寻找的功能如下：

coord_fixed(ratio = 1)

这是 ggplot 包的一个函数部分，您可以为其设置一个比率，在这种情况下您需要 1。可以提供其他参数以将其设置为从 0 等开始。

文档可以在这里找到：

https://ggplot2.tidyverse.org/reference/coord_fixed.html

我在下面的可重现示例中写了一个使用它的快速示例。

library(tidyverse)

# Construct generic data
x = 1:100
y = rep(2, 100)

df <- tibble(x = x, y= y)

# Plot incorrect graph
df %>% 
  ggplot(aes(x = x, y = y)) +
  geom_line() +
  geom_abline(intercept = 0, linetype = 2, color = "red") +
  ylim(c(0, 200))

# Plot graph with x, y axis 1:1
df %>% 
  ggplot(aes(x = x, y = y)) +
  geom_line() +
  coord_fixed(ratio = 1) +
  geom_abline(intercept = 0, linetype = 2, color = "red") +
  ylim(c(0, 200))

^{由reprex package (v2.0.0) 于 2021-04-04 创建}