R:自动化解决数据框中的许多方程组

huangapple go评论58阅读模式
英文:

R: Automate solving many systems of equations in data frame

问题

我正在处理一个数据集,该数据集将解决包含2个未知数的2个方程组的简单等式系统。然而,由于有数百个这样的系统,我需要找到一种算法,也许是一个循环,可以在数据帧的n行中执行该任务。

考虑以下数据帧:

df <- as.data.frame(rbind(c(1, 0.214527122, 166486.7605, 1, -0.003217907, 0),
            c(1, 0.227828903, 160088.1385, 1, -0.003417434, 0),
            c(1, 0.214324606, 154445.4132, 1, -0.003214869, 0),
            c(1, 0.218698883, 147921.278, 1, -0.003280483, 0),
            c(1, 0.201444364, 151268.6711, 1, -0.003021665, 0)))
colnames(df) = c("y1", "x1", "b1", "y2", "x2", "b2")

请注意,该数据集中的每一行都包含两个线性方程,对于两个未知数x和y。

> df
  y1        x1       b1 y2           x2 b2
1  1 0.2145271 166486.8  1 -0.003217907  0
2  1 0.2278289 160088.1  1 -0.003417434  0
3  1 0.2143246 154445.4  1 -0.003214869  0
4  1 0.2186989 147921.3  1 -0.003280483  0
5  1 0.2014444 151268.7  1 -0.003021665  0

这两个方程代表了经济模型中的供应曲线和需求曲线。我想要计算数据帧中每一行的平衡价格和数量。

例如,我可以使用以下代码解决第一行:

A <- rbind(c(df$y1[1], df$x1[1]), 
           c(df$y2[1], df$x2[1]))

B <- c(df$b1[1], df$b2[1])

> solve(A, B)
[1]   2460.396 764595.000

在平衡时,价格为2460.4,数量为764,595。然后,我可以将此结果添加到数据帧中的两个新列中:

df$Price[1] <- solve(A, B)[1]
df$Quantity[1] <- solve(A, B)[2]

> df
  y1        x1       b1 y2           x2 b2    Price Quantity
1  1 0.2145271 166486.8  1 -0.003217907  0 2460.396   764595
2  1 0.2278289 160088.1  1 -0.003417434  0       NA       NA
3  1 0.2143246 154445.4  1 -0.003214869  0       NA       NA
4  1 0.2186989 147921.3  1 -0.003280483  0       NA       NA
5  1 0.2014444 151268.7  1 -0.003021665  0       NA       NA

这是第一行的处理方式。但我还没有找到一种很好的自动化方法来解决数据帧中的每一行。我认为某种类型的循环可能是一个选项,但是我还没有成功解决它。

英文:

I'm working on a dataset that will solve simple equation systems of 2 equations with 2 unknowns. However, as there are hundreds of such systems, I will need to find some algorithm, perhaps a loop, that will perform the task for n rows in a data frame.

Consider the following data frame:

df &lt;- as.data.frame(rbind(c(1,	0.214527122,	166486.7605,	1,	-0.003217907,	0),
            c(1,	0.227828903,	160088.1385,	1,	-0.003417434,	0),
            c(1,	0.214324606,	154445.4132,	1,	-0.003214869,	0),
            c(1,	0.218698883,	147921.278,	    1,	-0.003280483,	0),
            c(1,	0.201444364,	151268.6711,	1,	-0.003021665,	0)))
colnames(df) = c(&quot;y1&quot;,	&quot;x1&quot;,	&quot;b1&quot;,	&quot;y2&quot;,	&quot;x2&quot;,	&quot;b2&quot;)

Notice how each row in this data set contains two linear equations, for two unknowns, x and y.

&gt; df
  y1        x1       b1 y2           x2 b2
1  1 0.2145271 166486.8  1 -0.003217907  0
2  1 0.2278289 160088.1  1 -0.003417434  0
3  1 0.2143246 154445.4  1 -0.003214869  0
4  1 0.2186989 147921.3  1 -0.003280483  0
5  1 0.2014444 151268.7  1 -0.003021665  0

The two equations represent supply and demand curves in an economic model. I want to calculate the resulting equilibrium price and quantity for each row in the data frame.

I can, for example, solve the first row with the following code:

A &lt;- rbind(c(df$y1[1], df$x1[1]), 
           c(df$y2[1], df$x2[1]))

B &lt;- c(df$b1[1],df$b2[1])

&gt; solve(A,B)
[1]   2460.396 764595.000

At equilibrium, price is 2460.4 and quantity is 764 595. I can then add this result to the data frame in two new columns:

df$Price[1] &lt;- solve(A,B)[1]
df$Quantity[1] &lt;- solve(A,B)[2]

&gt; df
  y1        x1       b1 y2           x2 b2    Price Quantity
1  1 0.2145271 166486.8  1 -0.003217907  0 2460.396   764595
2  1 0.2278289 160088.1  1 -0.003417434  0       NA       NA
3  1 0.2143246 154445.4  1 -0.003214869  0       NA       NA
4  1 0.2186989 147921.3  1 -0.003280483  0       NA       NA
5  1 0.2014444 151268.7  1 -0.003021665  0       NA       NA

That was the first row. But I haven't figured out a good way of automating this to solve for each row in the data frame. I suppose some type of loop might be an option, but I've had no luck in solving it.

答案1

得分: 2

重新排列列,使前4列是矩阵,然后运行以下的 apply

df2 <- df[c("y1", "y2", "x1", "x2", "b1", "b2")]
t(apply(df2, 1, function(x) solve(matrix(x[1:4], 2), x[5:6])))

得到结果如下:

             [,1]   [,2]
[1,] 2460.396 764595
[2,] 2365.835 692284
[3,] 2282.444 709965
[4,] 2186.029 666374
[5,] 2235.497 739823
英文:

Rearrange the columns so that the first 4 are the matrix and then run the following apply :

df2 &lt;- df[c(&quot;y1&quot;, &quot;y2&quot;, &quot;x1&quot;, &quot;x2&quot;, &quot;b1&quot;, &quot;b2&quot;)]
t(apply(df2, 1, function(x) solve(matrix(x[1:4], 2), x[5:6])))

giving

         [,1]   [,2]
[1,] 2460.396 764595
[2,] 2365.835 692284
[3,] 2282.444 709965
[4,] 2186.029 666374
[5,] 2235.497 739823

答案2

得分: 1

一种dplyr选项

library(dplyr)
library(purrr)
df |>
  dplyr::rowwise() |>
  dplyr::mutate(
    Price = (solve(rbind(
      c(cur_data()$y1, cur_data()$x1),
      c(cur_data()$y2, cur_data()$x2)
    ), c(
      cur_data()$b1,
      cur_data()$b2
    )) |>
      pluck(1)
    ),
    Quantity = (solve(rbind(
      c(cur_data()$y1, cur_data()$x1),
      c(cur_data()$y2, cur_data()$x2)
    ), c(
      cur_data()$b1,
      cur_data()$b2
    )) |>
      pluck(2)
    )
  )

输出:

# A tibble: 5 × 8
# Rowwise: 
     y1    x1      b1    y2       x2    b2 Price Quantity
  <dbl> <dbl>   <dbl> <dbl>    <dbl> <dbl> <dbl>    <dbl>
1     1 0.215 166487.     1 -0.00322     0 2460.  764595.
2     1 0.228 160088.     1 -0.00342     0 2366.  692284.
3     1 0.214 154445.     1 -0.00321     0 2282.  709965.
4     1 0.219 147921.     1 -0.00328     0 2186.  666374.
5     1 0.201 151269.     1 -0.00302     0 2235.  739823.
英文:

One dplyr option

library(dplyr)
library(purrr)
df |&gt;
  dplyr::rowwise() |&gt;
  dplyr::mutate(
    Price = (solve(rbind(
      c(cur_data()$y1, cur_data()$x1),
      c(cur_data()$y2, cur_data()$x2)
    ), c(
      cur_data()$b1,
      cur_data()$b2
    )) |&gt;
      pluck(1)
    ),
    Quantity = (solve(rbind(
      c(cur_data()$y1, cur_data()$x1),
      c(cur_data()$y2, cur_data()$x2)
    ), c(
      cur_data()$b1,
      cur_data()$b2
    )) |&gt;
      pluck(2)
    )
  )

Output:

# A tibble: 5 &#215; 8
# Rowwise: 
     y1    x1      b1    y2       x2    b2 Price Quantity
  &lt;dbl&gt; &lt;dbl&gt;   &lt;dbl&gt; &lt;dbl&gt;    &lt;dbl&gt; &lt;dbl&gt; &lt;dbl&gt;    &lt;dbl&gt;
1     1 0.215 166487.     1 -0.00322     0 2460.  764595.
2     1 0.228 160088.     1 -0.00342     0 2366.  692284.
3     1 0.214 154445.     1 -0.00321     0 2282.  709965.
4     1 0.219 147921.     1 -0.00328     0 2186.  666374.
5     1 0.201 151269.     1 -0.00302     0 2235.  739823.

答案3

得分: 1

要添加两个新列,请考虑使用mapply,这是apply家族中的逐元素处理成员:

get_equilibrium <- function(y1, x1, b1, y2, x2, b2) {
  A <- rbind(c(y1, x1), c(y2, x2))
  B <- c(b1, b2)
  solve(A, B)
}

df[c("Price", "Quantity")] <- t(mapply(
  get_equilibrium, df$y1, df$x1, df$b1, df$y2, df$x2, df$b2
))

df
#   y1        x1       b1 y2           x2 b2    Price Quantity
# 1  1 0.2145271 166486.8  1 -0.003217907  0 2460.396   764595
# 2  1 0.2278289 160088.1  1 -0.003417434  0 2365.835   692284
# 3  1 0.2143246 154445.4  1 -0.003214869  0 2282.444   709965
# 4  1 0.2186989 147921.3  1 -0.003280483  0 2186.029   666374
# 5  1 0.2014444 151268.7  1 -0.003021665  0 2235.497   739823
英文:

To add two new columns, consider mapply, elementwise processing member of apply family:

get_equilibrium &lt;- function(y1, x1, b1, y2, x2, b2) {
  A &lt;- rbind(c(y1, x1), c(y2, x2))
  B &lt;- c(b1, b2)
  solve(A, B)
}

df[c(&quot;Price&quot;, &quot;Quantity&quot;)] &lt;- t(mapply(
  get_equilibrium, df$y1, df$x1, df$b1, df$y2, df$x2, df$b2
))

df
#   y1        x1       b1 y2           x2 b2    Price Quantity
# 1  1 0.2145271 166486.8  1 -0.003217907  0 2460.396   764595
# 2  1 0.2278289 160088.1  1 -0.003417434  0 2365.835   692284
# 3  1 0.2143246 154445.4  1 -0.003214869  0 2282.444   709965
# 4  1 0.2186989 147921.3  1 -0.003280483  0 2186.029   666374
# 5  1 0.2014444 151268.7  1 -0.003021665  0 2235.497   739823

huangapple
  • 本文由 发表于 2023年3月7日 03:35:32
  • 转载请务必保留本文链接:https://go.coder-hub.com/75655098.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定