R：log x轴的图中两点之间的差异

时间：2016-05-12 09:42:56

标签： r

我需要在log x轴的两个温度点之间计算每个样品的时间差（使用ID柱可以区分样品）。我得到计算结果，但是对于线性轴，不是log。如何使用我的代码实现对数比例的计算：

  1. 示例数据

    dput(data)
structure(list(id = c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L,2L, 2L),
Zeit = c(0L, 180L, 360L, 420L, 600L, 604L, 0L, 180L,360L, 480L, 600L,
605L), Temp = c(963L, 824L, 666L, 658L, 641L,549L, 957L, 823L, 661L,
660L, 642L, 562L)), .Names = c("id","Zeit", "Temp"), row.names = c(NA,
12L), class = "data.frame")

  2. 代码：

    Zt <- vapply(unique(data$id), function(ID){
    with(data[data$id == ID,], approx(x = Temp, y = Zeit, xout = 600))$y
}, double(1))
data.frame(id = unique(data$id), time = Zt)

    3. approx方法中有一个选项。但是，只指定了两种方法：

    • linear
    • constant

    正如我之前提到的，日志是我正在寻找的

    感谢您的帮助！

    [UPDATE]

    为什么日志在我的情况下有所不同。

    为了解释，我将使用一小组数据，我们可以看到日志如何产生差异：

    这是数据：

    data <-structure(list(id = c(1L, 1L, 1L), Zeit = c(31L, 701L, 902L), 
    Temp = c(930L, 549L, 481L)), .Names = c("id", "Zeit", "Temp"
), row.names = c(NA, 3L), class = "data.frame")

    这是它的情节（第一个是日志轴，第二个是正常的）：

    enter image description here enter image description here

    如果我想看看我需要达到 700°C 的时间，在对数刻度中它将等于 200 秒，对于正常的它等于 325 秒。

2 个答案:

答案 0 :(得分：3)

一些初步项目：

  1. 根据您在下方显示的图表，您的原始代码中的x和y值似乎相反。

  2. 我在这里的功能没有approx()中stats功能的所有功能，但我认为它可以满足您的需求。

    3. 首先，请考虑approx()函数使用以下公式的变体来生成结果：

    等式1：

    http://latex.codecogs.com/gif.download?y_%7Bout%7D%20%3D%20y_0%20+%20%28y_1-y_0%29%5Cfrac%7Bx_%7Bout%7D%20-%20x_0%7D%7Bx_1-x_0%7D

    其中

    要返回对应于对数缩放x轴的http://latex.codecogs.com/gif.download?%24y_%7Bout%7D%24值，我们只需按如下方式记录公式的相关部分：

    公式2：

    http://latex.codecogs.com/gif.download?y_%7Bout%7D%20%3D%20y_0%20+%20%28y_1-y_0%29%5Cfrac%7B%5Clog%20x_%7Bout%7D%20-%20%5Clog%20x_0%7D%7B%5Clog%20x_1-%5Clog%20x_0%7D.

    下面我在一个名为approx_log()

    的新函数中实现这两个公式 
    approx_log <- function(x, y, xout){

  dat <- data.frame(y=y, x=x)
  dat <- dat[with(dat, order(x, y)), ]

  y_in <- dat$y
  x_in <- dat$x

  # find the start of our interval
  int_start <- which(x_in == max(x_in[x_in <= xout]))

  # assign the int_start value to x_0 and the 
  # value from the next highest index to x_1
  x_0 <- x_in[int_start]
  x_1 <- x_in[int_start + 1]

  # repeat for corresponding y-values 
  y_0 <- y_in[int_start]
  y_1 <- y_in[int_start + 1]


  y_out_lin <- y_0 + ((xout-x_0)/(x_1-x_0))*(y_1-y_0)

  y_out_log <- y_0 + ((log(xout)-log(x_0))/(log(x_1)-log(x_0)))*(y_1-y_0)

  # return values 
  list(x = xout, y_lin = y_out_lin, y_log = y_out_log)
}

    可以看出，此函数返回http://latex.codecogs.com/gif.download?x_%7Bout%7D_的列表以及http://latex.codecogs.com/gif.download?%24y_%7Bout%7D%24的对数和线性插值。下面的代码根据发布中的可视插值测试函数。 

    data <-structure(list(id = c(1L, 1L, 1L), Zeit = c(31L, 701L, 902L), 
    Temp = c(930L, 549L, 481L)), .Names = c("id", "Zeit", "Temp"
), row.names = c(NA, 3L), class = "data.frame")

approx_log(x = data$Zeit, y = data$Temp, xout = 200)

## $x
## [1] 200
## 
## $y_lin
## [1] 833.897
## 
## $y_log
## [1] 702.2286

    如你所知，200秒时间的对数缩放版本几乎完全对应于700度。 

    approx_log(x = data$Zeit, y = data$Temp, xout = 325)

## $x
## [1] 325
## 
## $y_lin
## [1] 762.8149
## 
## $y_log
## [1] 642.9125

    325秒时间的线性版本略高（约763度），但根据原始情节合理。作为完整性检查，我们可以看到线性值与approx()函数完全匹配。 

    approx(x = data$Zeit, y = data$Temp, xout = 325)

## $x
## [1] 325
## 
## $y
## [1] 762.8149

    我们也可以根据您的原始请求通过vapply()运行此操作。 

    data <- structure(list(id = c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L,2L, 2L),
               Zeit = c(0L, 180L, 360L, 420L, 600L, 604L, 0L, 180L,360L, 480L, 600L,
                        605L), Temp = c(963L, 824L, 666L, 658L, 641L,549L, 957L, 823L, 661L,
                                        660L, 642L, 562L)), .Names = c("id","Zeit", "Temp"), row.names = c(NA,
                                                                                                           12L), class = "data.frame")

Zt <- vapply(unique(data$id), function(ID){
  with(data[data$id == ID,], approx_log(y = Temp, x = Zeit, xout = 325))$y_log
}, double(1))
data.frame(id = unique(data$id), time = Zt)

##   id     time
## 1  1 689.3140
## 2  2 684.9043

    为了便于比较，您可以单独提取y_lin值。 

    Zt <- vapply(unique(data$id), function(ID){
  with(data[data$id == ID,], approx_log(y = Temp, x = Zeit, xout = 325))$y_lin
}, double(1))
data.frame(id = unique(data$id), time = Zt)

##   id     time
## 1  1 696.7222
## 2  2 692.5000

    修改 给定Ze的原始问题试图解决Zeit（即求解x，给定y）。对于给定的x，上面的代码解决了y的对数内插值。通过重新排列等式2来求解x_out来实现这种情况的逆。 @joemienko的评论中提供的功能是

    x_out_log <- exp((yout*log(x_0)-y_1*log(x_0)-yout*log(x_1)+y_0*log(x_1))/(y_0-y_1))

答案 1 :(得分：1)

最简单的方法是使用approx()。但是你需要做一些事情来获得你想要的行为：

  1. log将输入值转换为approx，然后
  2. 反向日志（即exp）转换回正确单位的答案。

    3. 因此，在你的例子中，要在Temp = 700处求解Zeit，通过插入Zeit的对数变换值，这将是

    exp( approx(x = data$Temp, y = log(data$Zeit), xout = 700))$y )
## 203.6818
相关问题
最新问题