意料之外的卷积结果

14

我正在尝试在R中实现以下卷积,但没有得到预期的结果:

$$ C_{\sigma}[i]=\sum\limits_{k=-P}^P SDL_{\sigma}[i-k,i] \centerdot S[i] $$ enter image description here

其中$S[i]$是一个频谱强度向量(一个洛伦兹信号/NMR谱),且$i \in [1,N]$,其中$N$是数据点数(例如,实际示例可能有32K个值)。这是Jacob、Deborde和Moing在2013年发表于《分析生物化学》杂志上的第一篇文章的方程式1(DOI 10.1007/s00216-013-6852-y)。

$SDL_{\sigma}$是用于计算洛伦兹曲线的二阶导数的函数,我已按照论文中方程式2的基础进行了实现:

SDL <- function(x, x0, sigma = 0.0005){
    if (!sigma > 0) stop("sigma must be greater than zero.")
    num <- 16 * sigma * ((12 * (x-x0)^2) - sigma^2)
    denom <- pi * ((4 * (x - x0)^2) + sigma^2)^3
    sdl <-  num/denom
    return(sdl)
    }

sigma是半峰宽度,x0是洛伦兹信号的中心。

我相信SDL工作正常(因为返回的值形状类似于经验Savitzky-Golay 2阶导数)。我的问题在于实现$C_{\sigma}$,我已经将其编写为:

CP <- function(S = NULL, X = NULL, method = "SDL", W = 2000, sigma = 0.0005) {
    # S is the spectrum, X is the frequencies, W is the window size (2*P in the eqn above)
    # Compute the requested 2nd derivative
    if (method == "SDL") {

        P <- floor(W/2)
        sdl <- rep(NA_real_, length(X)) # initialize a vector to store the final answer

        for(i in 1:length(X)) {
            # Shrink window if necessary at each extreme
            if ((i + P) > length(X)) P <- (length(X) - i + 1)
            if (i < P) P <- i
            # Assemble the indices corresponding to the window
            idx <- seq(i - P + 1, i + P - 1, 1)
            # Now compute the sdl
            sdl[i] <- sum(SDL(X[idx], X[i], sigma = sigma))
            P <- floor(W/2) # need to reset at the end of each iteration
            }
        }

    if (method == "SG") {
        sdl <- sgolayfilt(S, m = 2)     
        }

    # Now convolve!  There is a built-in function for this!
    cp <- convolve(S, sdl, type = "open")
    # The convolution has length 2*(length(S)) - 1 due to zero padding
    # so we need rescale back to the scale of S
    # Not sure if this is the right approach, but it doesn't affect the shape
    cp <- c(cp, 0.0)
    cp <- colMeans(matrix(cp, ncol = length(cp)/2)) # stackoverflow.com/q/32746842/633251
    return(cp)
    }

根据参考文献,为了节省时间,二阶导数的计算仅限于大约2000个数据点的窗口。我认为这部分工作良好,应该只会产生微不足道的扭曲。
下面是整个过程和问题的演示:
require("SpecHelpers")
require("signal")
# Create a Lorentzian curve
loren <- data.frame(x0 = 0, area = 1, gamma = 0.5)
lorentz1 <- makeSpec(loren, plot = FALSE, type = "lorentz", dd = 100, x.range = c(-10, 10))
#
# Compute convolution
x <- lorentz1[1,] # Frequency values
y <- lorentz1[2,] # Intensity values
sig <- 100 * 0.0005 # per the reference
cpSDL <- CP(S = y, X = x, sigma = sig)
sdl <- sgolayfilt(y, m = 2)
cpSG <- CP(S = y, method = "SG")
#
# Plot the original data, compare to convolution product
ylabel <- "data (black), Conv. Prod. SDL (blue), Conv. Prod. SG (red)"
plot(x, y, type = "l", ylab = ylabel, ylim = c(-0.75, 0.75))
lines(x, cpSG*100, col = "red")
lines(x, cpSDL/2e5, col = "blue")

graphic

如您所见,使用SDL的卷积乘积(蓝色)与使用SG方法的CP的卷积乘积(红色,除了比例不正确外)不相似。我预计使用SDL方法得到的结果应该具有类似的形状但不同的比例。
如果您迄今为止一直跟着我,a)感谢您,b)您能看出问题在哪里吗?毫无疑问,我有一个基本的误解。

1
为什么这个被迁移到这里? - KannarKK
1
@KannarKK 我请求将其迁移。24小时后,在CV上仅收到3或4个浏览量,而目前他们似乎有时每分钟会得到3-6个问题。因此,它很快就沉没了,不见了。 - Bryan Hanson
1
然而,这似乎更适合于CV,因为它关注的是是否存在概念问题。也许只是需要更高的赏金? - russellpierce
@rpierce,当它在简历上时,并没有赏金。我猜我们将看到在此会发生什么,但我可能要求它返回。我同意,我的问题很可能是概念性的,这就是为什么我从CV开始的原因。Mathoverflow上也有很多关于卷积的问题,但当然它们更加符号化而不是概念性或编程性的... - Bryan Hanson
2个回答

4
您进行手动卷积时存在一些问题。如果您查看在“Savitzky-Golay滤波器”的维基百科页面上定义的卷积函数,可以在这里找到和您引用的方程中S[i]术语冲突的y[j+i]术语。我认为您所引用的方程可能是错误/有错字的。
我修改了您的函数,并似乎现在可以生成与sgolayfilt()版本相同的形状,尽管我不确定我的实现是否完全正确。请注意,选择sigma很重要,确实会影响结果形状。如果您最初没有获得相同的形状,请尝试显着调整sigma参数。
CP <- function(S = NULL, X = NULL, method = "SDL", W = 2000, sigma = 0.0005) {
    # S is the spectrum, X is the frequencies, W is the window size (2*P in the eqn above)
    # Compute the requested 2nd derivative
    if (method == "SDL") {
        sdl <- rep(NA_real_, length(X)) # initialize a vector to store the final answer

        for(i in 1:length(X)) {
            bound1 <- 2*i - 1
            bound2 <- 2*length(X) - 2*i + 1
            P <- min(bound1, bound2)
            # Assemble the indices corresponding to the window
            idx <- seq(i-(P-1)/2, i+(P-1)/2, 1)
            # Now compute the sdl
            sdl[i] <- sum(SDL(X[idx], X[i], sigma = sigma) * S[idx])
            }
        }

    if (method == "SG") {
        sdl <- sgolayfilt(S, m = 2)     
        }

    # Now convolve!  There is a built-in function for this!
    cp <- convolve(S, sdl, type = "open")
    # The convolution has length 2*(length(S)) - 1 due to zero padding
    # so we need rescale back to the scale of S
    # Not sure if this is the right approach, but it doesn't affect the shape
    cp <- c(cp, 0.0)
    cp <- colMeans(matrix(cp, ncol = length(cp)/2)) # stackoverflow.com/q/32746842/633251
    return(cp)
}

谢谢!我没有考虑到方程可能有问题。我注意到sigma值可能会产生很大的影响。如果不确保sigma与原始数据的比例尺相同,结果会有所不同。 - Bryan Hanson
很高兴能帮到你。你能确认它在你自己的数据上运行正常吗? - Special Sauce
1
请注意,仅将 * S[idx] 项添加到您原来的 CP 函数中似乎也可以工作。 您可能希望将我的实现与您的实现进行比较,看看它们是否真正等效或哪个版本更好。 - Special Sauce
我只是在进行一次并排比较,但需要有一段时间来更详细地研究。它似乎可以处理更复杂的测试数据集,例如重叠的Lorenztian曲线。我将不得不搜索以查看作者是否对原始论文进行了更正。非常感谢。我之前使用SG方法进行了解决,但我真的想更好地理解卷积,你帮了我很多。 - Bryan Hanson

3
你的代码存在一些问题。在计算SDL时,你似乎试图在$C_{\sigma}$方程中进行求和,但这个求和是卷积的定义。
当你实际计算SDL时,你改变了x0的值,但这个值是Lorentzian的均值,应该是恒定的(在这种情况下为0)。
最后,你可以计算卷积的边界,并提取具有原始边界的信号。
CP <- function(S = NULL, X = NULL, method = "SDL", W = 2000, sigma = 0.0005) {
# S is the spectrum, X is the frequencies, W is the window size (2*P in the eqn above)
# Compute the requested 2nd derivative
if (method == "SDL") {


    sdl <- rep(NA_real_, length(X)) # initialize a vector to store the final answer

    for(i in 1:length(X)) {
        sdl[i] <- SDL(X[i], 0, sigma = sigma)
        }
    }

if (method == "SG") {
    sdl <- sgolayfilt(S, m = 2)     
    }

# Now convolve!  There is a built-in function for this!
cp <- convolve(S, sdl, type = "open")
shift <- floor(length(S)/2) #both signals are the same length and symmetric around zero
                             #so the fist point of the convolution is half the signal 
                             #before the first point of the signal   
print(shift)      
cp <- cp[shift:(length(cp)-shift)]
return (cp)
}

运行这个测试。

require("SpecHelpers")
require("signal")
# Create a Lorentzian curve
loren <- data.frame(x0 = 0, area = 1, gamma = 0.5)
lorentz1 <- makeSpec(loren, plot = FALSE, type = "lorentz", dd = 100,    x.range = c(-10, 10))
#
# Compute convolution
x <- lorentz1[1,] # Frequency values
y <- lorentz1[2,] # Intensity values
sig <- 100 * 0.0005 # per the reference
cpSDL <- CP(S = y, X = x, sigma = sig)

#
# Plot the original data, compare to convolution product

plot(x, cpSDL)

期望的形状结果如下:

cpSDL

我也不确定您的SDL定义是否正确。这篇文章给出了一个更复杂的洛伦兹函数二阶导数的公式。


感谢您的建议和澄清,以及提供的参考资料。也许原始论文中的两个方程都有错误,我需要仔细研究一下。您关于求和实际上是卷积过程的一部分的评论尤其有帮助。 - Bryan Hanson

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接