简化Deriv的输出并提取R中的系数

时间:2016-06-04 14:33:56

标签: r

我有两个关于R中方程的偏导数的计算。

p_deriv_m <- Deriv(eqn, 'm')
#"-(2 * (6 - (b + m)) + 4 * (5 - (2 * m + b)) + 6 * (7 - (3 * m + b)) + 8 * (10 - (4 * m + b)))"

p_deriv_b <- Deriv(eqn, 'b')
#"-(2 * (10 - (4 * m + b)) + 2 * (5 - (2 * m + b)) + 2 * (6 - (b +     m)) + 2 * (7 - (3 * m + b)))"

我想......

(1)将这些方程简化为类似形式(在此构成系数)p_deriv_m = 8 + 9b - 10m,p_deriv_b = 10 + 15b + 8m

(2)从这些偏导数方程中提取系数,这样当偏导数均等于0时,我可以求解m,b。使用我在上面(1)中编写的例子......

9b - 10m = -8

15b + 8m = -10

将这些数字弹出到矩阵中并在此解决此解决方案 - Solving simultaneous equations with R输出和m和b。

如果有人知道如何做(1)和/或(2),我们将非常感谢帮助。

我的其余代码供参考:

library(Ryacas)
library(Deriv)

x_p <- c(1,2,3,4)
y_p <- c(6,5,7,10)

# Turn m and b into symbols
b <- Ryacas::Sym("b")
m <- Ryacas::Sym("m")

# Create a function
rss <- function(b,m,x_points, y_points)
   (y_points[1] - (b + x_points[1]*m))^2 + 
   (y_points[2] - (b + x_points[2]*m))^2 + 
   (y_points[3] - (b + x_points[3]*m))^2 + 
   (y_points[4] - (b + x_points[4]*m))^2

# Create the equation
eqn <- rss(b,m,x_p,y_p)
p_deriv_m <- Deriv(eqn, 'm')
p_deriv_b <- Deriv(eqn, 'b')

答案:结束手动

sls_manual.R
# Doing a linear regression manually - want to find m and b
# Such that rss is minimized
library(Ryacas)
library(Deriv)
source('get_coeff.r')

# Sample Points - keeping the number of points small for now for 
# the purposes of this example
x_p <- c(1,2,3,4)
y_p <- c(6,5,7,10)

b <- Ryacas::Sym("b")
m <- Ryacas::Sym("m")

# Create a function
rss <- function(b,m,x_points, y_points)
   (y_points[1] - (b + x_points[1]*m))^2 + 
   (y_points[2] - (b + x_points[2]*m))^2 + 
   (y_points[3] - (b + x_points[3]*m))^2 + 
   (y_points[4] - (b + x_points[4]*m))^2

# Create the equation
eqn <- rss(b,m,x_p,y_p)
p_deriv_m <- Deriv(eqn, 'm')
p_deriv_b <- Deriv(eqn, 'b')

simplified_m_deriv <- yacas(Expand(p_deriv_m))
simplified_b_deriv<- yacas(Expand(p_deriv_b))

row_1_coeff <- get_coefficients(simplified_m_deriv)               
row_2_coeff <- get_coefficients(simplified_b_deriv)

r_1_coeff <- c(row_1_coeff[[1]][1], row_1_coeff[[2]][1], row_1_coeff[[3]][1])
r_2_coeff <- c(row_2_coeff[[1]][1], row_2_coeff[[2]][1], row_2_coeff[[3]][1])

A <- matrix(data=c(r_1_coeff[1], r_1_coeff[2]
              ,r_2_coeff[1], r_2_coeff[2])
              ,nrow=2, ncol=2, byrow=TRUE)

b <- matrix(data=c((-1*r_1_coeff[3]),(-1*r_2_coeff[3]))
              ,nrow=2, ncol=1, byrow=TRUE)

result <- solve(A,b)
m_coeff = result[1]
b_coeff = result[2]

# Last step is to verify that this does the same thing as lm:w
# fit <- lm(y_p ~ x_p)
# fit

get_coeff.R

get_coefficients <- function(exp) {     
# Take out the whitespace    
g <- gsub(" ", "", as.character(exp))    
# Sub the minuses for a +-    
g2 <- gsub("-", "+-", g)    
g3 <- gsub("[()]", "", g2)    
# break at the plusses    
g4 <- strsplit(g3, "[//+]")    

b_coeff = 0    
m_coeff = 0    
other_coeff = 0    

i = 1    
while(i <= 3)    
{    
    piece <- as.character(g4[[1]][i])    
    contains_b = grepl("b",piece)     
    contains_m = grepl("m",piece)    
    contains_both = contains_b & contains_m    
    if (contains_b == TRUE){    
        b_coeff = as.numeric(gsub("[//*b|b//*]", "", piece))    
    } else if (contains_m == TRUE){    
        m_coeff = as.numeric(gsub("[//*m|m//*]", "", piece))    
    } else if (contains_both == FALSE) {    
        other_coeff = as.numeric(piece)    
    } else {     
    }     
    i = i + 1    
}    

output <- list(m_coeff,b_coeff, other_coeff)
return(output)
}    

0 个答案:

没有答案