R-使用值位置对矩阵值执行功能

时间:2019-03-20 18:35:17

标签: r matrix apply

我正在构建一个利用R矩阵计算来构建热图的软件。假设我将以下内容作为起始矩阵:

// Add Shortcode
    function custom_shortcode() {

    <div class="intro"> /* line no 79 */
        <div class="intro_boxes_wrap">

            <div class="d-flex flex-row align-items-start justify-content-start flex-wrap">
                <?php 
                    $query = new WP_Query(array(
                        'post_type'     => 'intro',
                        'post_per_page' => 3,
                    ));
                    while($query->have_posts()): $query->the_post(); 
                ?>
                <!-- Intro Box -->
                <div class="intro_box d-flex flex-column align-items-center justify-content-center text-center">
                    <?php the_post_thumbnail(); ?>
                    <div class="intro_box_title"><h3><?php the_title(); ?></h3></div>
                    <div class="intro_box_text">
                        <?php echo get_the_content(); ?>
                    </div>
                </div>
                <?php endwhile; wp_reset_query();?>

            </div>
        </div>
    </div>

}
add_shortcode( 'kollol', 'custom_shortcode' );

我如何将其转换为以下内容?

        -1.8784 -1.8783 -1.8782
53.5919       0       0       0
53.592        0      50       0
53.5921       0       0       0

即我想做的是通过增加周围的值在某个点上减小该值,以在地图上提供更稳定的梯度。

我尝试利用apply,但是我似乎无法弄清楚如何将当前正在处理的索引的位置传递给函数。显然,for循环是一个选项,但是在R中它们的速度很慢,我非常想对此进行某种程度的优化。

除了遍历矩阵中的每个值之外,还有其他更优雅的解决方案吗?

1 个答案:

答案 0 :(得分:0)

以下内容可能会做您想要的。我相信,这确实有可能更加优雅。但是,我的线性代数距离我太远了,无法做到。

首先,我构造一些玩具数据。

“平滑”的矩阵:

x <- 0*diag(10)  
x[8,4] <- x[6,7] <- x[3,3] <- 50
print(x)
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]    0    0    0    0    0    0    0    0    0     0
 [2,]    0    0    0    0    0    0    0    0    0     0
 [3,]    0    0   50    0    0    0    0    0    0     0
 [4,]    0    0    0    0    0    0    0    0    0     0
 [5,]    0    0    0    0    0    0    0    0    0     0
 [6,]    0    0    0    0    0    0   50    0    0     0
 [7,]    0    0    0    0    0    0    0    0    0     0
 [8,]    0    0    0   50    0    0    0    0    0     0
 [9,]    0    0    0    0    0    0    0    0    0     0
[10,]    0    0    0    0    0    0    0    0    0     0

接下来,我们定义一个可用于矩阵矩阵乘法的辅助矩阵:

b <- 0*diag(10)
b[col(b) == row(b) + 1] <- 0.5
b[col(b) == row(b) - 1] <- 0.5
print(b)  # A symmetric matrix with the first off-diagonal set to 0.5
       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]  0.0  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [2,]  0.5  0.0  0.5  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [3,]  0.0  0.5  0.0  0.5  0.0  0.0  0.0  0.0  0.0   0.0
 [4,]  0.0  0.0  0.5  0.0  0.5  0.0  0.0  0.0  0.0   0.0
 [5,]  0.0  0.0  0.0  0.5  0.0  0.5  0.0  0.0  0.0   0.0
 [6,]  0.0  0.0  0.0  0.0  0.5  0.0  0.5  0.0  0.0   0.0
 [7,]  0.0  0.0  0.0  0.0  0.0  0.5  0.0  0.5  0.0   0.0
 [8,]  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.0  0.5   0.0
 [9,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.0   0.5
[10,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5   0.0

进行计算:

res <- x %*% b + b %*% x + x
res
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]    0    0    0    0    0    0    0    0    0     0
 [2,]    0    0   25    0    0    0    0    0    0     0
 [3,]    0   25   50   25    0    0    0    0    0     0
 [4,]    0    0   25    0    0    0    0    0    0     0
 [5,]    0    0    0    0    0    0   25    0    0     0
 [6,]    0    0    0    0    0   25   50   25    0     0
 [7,]    0    0    0   25    0    0   25    0    0     0
 [8,]    0    0   25   50   25    0    0    0    0     0
 [9,]    0    0    0   25    0    0    0    0    0     0
[10,]    0    0    0    0    0    0    0    0    0     0

编辑,结果相同:

d <- 0.5*diag(10)
d[col(d) == row(d) + 1] <- 0.5
d[col(d) == row(d) - 1] <- 0.5

res2 <- x %*% d + d %*% x  # or crossprod(d, x) + tcrossprod(x, d)
print(res2)