插值步驟

Question

比方說，我有一個線性測量設備的以下數據：

x <- c(0,0,0,0,1,1,1,1,1,2,2,2,2,2,3,3,4,4,5,6,7,8,9,9) 

計算有差異（滯後和迭代的差異）將結束與類似：

c(0,0,0,0,1,0,0,0,0,1,0,0,0,0,1,0,1,0,1,1,1,1,1,0) 

這不是我正在尋找的。 有沒有辦法來插深度光滑如步驟：

c(0,0.25,0.5,0.75,1,1.2,1.4,1.6,1.8,2,2.2,2.4,2.6,2.8,3,3.5,4,4.5,5,6,7,8,9,9....) 

注：該數據是一樣的，在開始時，只是步驟插入到不斷增加。 這樣做的原因是設備的分辨率是不夠的，顯示在之間的步驟，但具有它們作爲兩個時間變化之間繼續增加是綽綽有餘然後採取DIFF（）從的數據計算出速度線性測量裝置。

Answer 1

一個動態的解決方案，還是工作，如果運行之間的差異是> 1

library(data.table) 
rle_x <- rle(x) 
vec <- unlist(sapply(1:(length(rle_x$values) - 1), 
        function(i, x, rle) { 
          shift <- ((x[i+1] - x[i])/rle[i]) 
          seq(x[i], x[i+1] - (shift), by = shift) 
         }, 
       rle = rle_x$lengths, x = rle_x$values)) 

res <- c(vec, rep(rle_x$values[length(rle_x$values)], rle_x$lengths[length(rle_x$lengths)])) 
res 
#[1] 0.00 0.25 0.50 0.75 1.00 1.20 1.40 1.60 1.80 2.00 2.20 2.40 2.60 2.80 3.00 3.50 4.00 4.50 5.00 6.00 
#[21] 7.00 8.00 9.00 9.00 

如果你的輸入向量看起來像：x <- c(0,0,0,0,2,2,2,2,2,3,3,4,4,5,6,7,8,9,9)。其結果將是：

#[1] 0.0 0.5 1.0 1.5 2.0 2.2 2.4 2.6 2.8 3.0 3.5 4.0 4.5 5.0 6.0 7.0 8.0 9.0 9.0 

Answer 2

這是你想要的嗎？

fn=function(x){ 
    un=unique(x) 
    for(i in 1:length(un)){ 
    if(i==1){vet=un[i]} 
    else{ 
     vet=c(vet,seq(un[i-1],un[i],length.out=length(grep(un[(i-1)],x))+1)[-1]) 
    } 
    } 
return(vet) 
} 

Answer 3

使用了一個不同的建議。

> smoothFunc <- function(x) { 
+ tab.x <- table(x) 
+ uni.x <- unique(x) 
+ return(unlist(mapply(seq, from = uni.x, to = uni.x + (tab.x - 1)/tab.x , length.out = tab.x))) 
+ } 
> 
> smoothFunc(x) 
[1] 0.00 0.25 0.50 0.75 1.00 1.20 1.40 1.60 1.80 2.00 2.20 2.40 2.60 2.80 3.00 3.50 4.00 4.50 5.00 6.00 7.00 8.00 9.00 
[24] 9.50 

Answer 4

使用可以使用dplyr

library(dplyr) 
x <- x %>% group_by(x) %>% 
    mutate(a = 1/n(), 
      b = lag(a, default = 0), 
      c = cumsum(b), 
      d = x+c) 
x$d 
# [1] 0.00 0.25 0.50 0.75 1.00 1.20 1.40 1.60 1.80 2.00 2.20 2.40 2.60 2.80 3.00 3.50 4.00 
# [18] 4.50 5.00 6.00 7.00 8.00 9.00 9.50 

Answer 5

我們可以使用函數rle()找到每個值的遊程，姑且稱之爲lens。現在，我們可以計算出1累計總和lens每個連續的值來劃分，在base R：

lens <- rle(x)$lengths 
cumsum(c(0, head(rep(1/lens,lens),-1))) 
#[1] 0.00 0.25 0.50 0.75 1.00 1.20 1.40 1.60 1.80 2.00 2.20 2.40 2.60 2.80 3.00 3.50 4.00 4.50 5.00 6.00 
#[21] 7.00 8.00 9.00 9.50