फंक्शन (प्रतीकात्मक विधि को प्राथमिकता दी)

Question

मैं अपने डेटा से बहुपद गुणांक मिल गया है:

R <- c(0.256,0.512,0.768,1.024,1.28,1.437,1.594,1.72,1.846,1.972,2.098,2.4029) 
Ic <- c(1.78,1.71,1.57,1.44,1.25,1.02,0.87,0.68,0.54,0.38,0.26,0.17) 
NN <- 3 
ft <- lm(Ic ~ poly(R, NN, raw = TRUE)) 
pc <- coef(ft) 

तो मैं एक बहुपद समारोह बना सकते हैं:

f1 <- function(x) pc[1] + pc[2] * x + pc[3] * x^2 + pc[4] * x^3 

और उदाहरण के लिए, व्युत्पन्न करें:

g1 <- Deriv(f1) 

सार्वभौमिक कार्य कैसे बनाएं ताकि इसे ई के लिए फिर से लिखना न पड़े बहुत नई बहुपद डिग्री NN?

Answer 1

मेरा मूल उत्तर वह नहीं हो सकता है जो आप वास्तव में चाहते हैं, क्योंकि यह संख्यात्मक बल्कि प्रतीकात्मक था। यहां प्रतीकात्मक समाधान है।

## use `"x"` as variable name 
## taking polynomial coefficient vector `pc` 
## can return a string, or an expression by further parsing (mandatory for `D`) 
f <- function (pc, expr = TRUE) { 
    stringexpr <- paste("x", seq_along(pc) - 1, sep = "^") 
    stringexpr <- paste(stringexpr, pc, sep = " * ") 
    stringexpr <- paste(stringexpr, collapse = " + ") 
    if (expr) return(parse(text = stringexpr)) 
    else return(stringexpr) 
    } 

## an example cubic polynomial with coefficients 0.1, 0.2, 0.3, 0.4 
cubic <- f(pc = 1:4/10, TRUE) 

## using R base's `D` (requiring expression) 
dcubic <- D(cubic, name = "x") 
# 0.2 + 2 * x * 0.3 + 3 * x^2 * 0.4 

## using `Deriv::Deriv` 
library(Deriv) 

dcubic <- Deriv(cubic, x = "x", nderiv = 1L) 
# expression(0.2 + x * (0.6 + 1.2 * x)) 

Deriv(f(1:4/10, FALSE), x = "x", nderiv = 1L) ## use string, get string 
# [1] "0.2 + x * (0.6 + 1.2 * x)" 

बेशक

, Deriv उच्च आदेश डेरिवेटिव आसान हो गया है। हम बस nderiv सेट कर सकते हैं। D के लिए, हमें रिकर्सन का उपयोग करना होगा (?D के उदाहरण देखें)।

Deriv(cubic, x = "x", nderiv = 2L) 
# expression(0.6 + 2.4 * x) 

Deriv(cubic, x = "x", nderiv = 3L) 
# expression(2.4) 

Deriv(cubic, x = "x", nderiv = 4L) 
# expression(0) 

यदि हम अभिव्यक्ति का उपयोग करते हैं, तो हम बाद में परिणाम का मूल्यांकन करने में सक्षम होंगे। उदाहरण के लिए,

eval(cubic, envir = list(x = 1:4)) ## cubic polynomial 
# [1] 1.0 4.9 14.2 31.3 

eval(dcubic, envir = list(x = 1:4)) ## its first derivative 
# [1] 2.0 6.2 12.8 21.8 

उपरोक्त का तात्पर्य है कि हम किसी फ़ंक्शन के लिए अभिव्यक्ति को लपेट सकते हैं। फ़ंक्शन का उपयोग करने से कई फायदे होते हैं, एक ऐसा है कि हम इसे curve या plot.function का उपयोग करके साजिश करने में सक्षम हैं।

fun <- function(x, expr) eval.parent(expr, n = 0L) 

ध्यान दें, fun की सफलता प्रतीक x के मामले में एक अभिव्यक्ति होने के लिए expr की आवश्यकता है। यदि expr को y के संदर्भ में परिभाषित किया गया था, उदाहरण के लिए, हमें fun को function (y, expr) के साथ परिभाषित करने की आवश्यकता है। अब चलो curvecubic और dcubic प्लॉट करने के लिए, एक सीमा 0 < x < 5 पर का उपयोग करते हैं:

curve(fun(x, cubic), from = 0, to = 5) ## colour "black" 
curve(fun(x, dcubic), add = TRUE, col = 2) ## colour "red" 

सबसे सुविधाजनक तरीका है, बल्कि f + fun संयोजन कर की तुलना में एक भी समारोह FUN परिभाषित करने के लिए निश्चित रूप से है। इस तरह, हमें f और fun द्वारा उपयोग किए जाने वाले चर नाम पर स्थिरता के बारे में चिंता करने की आवश्यकता नहीं है।

FUN <- function (x, pc, nderiv = 0L) { 
    ## check missing arguments 
    if (missing(x) || missing(pc)) stop ("arguments missing with no default!") 
    ## expression of polynomial 
    stringexpr <- paste("x", seq_along(pc) - 1, sep = "^") 
    stringexpr <- paste(stringexpr, pc, sep = " * ") 
    stringexpr <- paste(stringexpr, collapse = " + ") 
    expr <- parse(text = stringexpr) 
    ## taking derivatives 
    dexpr <- Deriv::Deriv(expr, x = "x", nderiv = nderiv) 
    ## evaluation 
    val <- eval.parent(dexpr, n = 0L) 
    ## note, if we take to many derivatives so that `dexpr` becomes constant 
    ## `val` is free of `x` so it will only be of length 1 
    ## we need to repeat this constant to match `length(x)` 
    if (length(val) == 1L) val <- rep.int(val, length(x)) 
    ## now we return 
    val 
    } 

मान लीजिए हम x <- seq(0, 1, 0.2) पर गुणांक pc <- c(0.1, 0.2, 0.3, 0.4) और उसके डेरिवेटिव के साथ एक घन बहुपदीय का मूल्यांकन करना चाहते, हम बस कर सकते हैं:

FUN(x, pc) 
# [1] 0.1000 0.1552 0.2536 0.4144 0.6568 1.0000 

FUN(x, pc, nderiv = 1L) 
# [1] 0.200 0.368 0.632 0.992 1.448 2.000 

FUN(x, pc, nderiv = 2L) 
# [1] 0.60 1.08 1.56 2.04 2.52 3.00 

FUN(x, pc, nderiv = 3L) 
# [1] 2.4 2.4 2.4 2.4 2.4 2.4 

FUN(x, pc, nderiv = 4L) 
# [1] 0 0 0 0 0 0 

अब की साजिश रचने के लिए आसान भी है:

curve(FUN(x, pc), from = 0, to = 5) 
curve(FUN(x, pc, 1), from = 0, to = 5, add = TRUE, col = 2) 
curve(FUN(x, pc, 2), from = 0, to = 5, add = TRUE, col = 3) 
curve(FUN(x, pc, 3), from = 0, to = 5, add = TRUE, col = 4) 

Answer 2

मेरा अंतिम समाधान प्रतीकात्मक डेरिवेटिव के साथ आयन अंततः बहुत लंबा हो जाता है, मैं संख्यात्मक गणना के लिए एक अलग सत्र का उपयोग करता हूं। हम बहुपद के लिए ऐसा कर सकते हैं, डेरिवेटिव स्पष्ट रूप से ज्ञात हैं ताकि हम उन्हें कोड कर सकें। ध्यान दें, यहां आर अभिव्यक्ति का कोई उपयोग नहीं होगा; सब कुछ सीधे कार्यों का उपयोग करके किया जाता है।

इसलिए हम पहली डिग्री 0 से बहुपद आधार डिग्री p - n को, उत्पन्न तो गुणांक और भाज्य गुणक गुणा। से outer का उपयोग करना अधिक सुविधाजनक है।

x <- seq(0, 1, by = 0.2) 
pc <- 1:4/10 

g(x, pc, 0) 
# [1] 0.1000 0.1552 0.2536 0.4144 0.6568 1.0000 

g(x, pc, 1) 
# [1] 0.200 0.368 0.632 0.992 1.448 2.000 

g(x, pc, 2) 
# [1] 0.60 1.08 1.56 2.04 2.52 3.00 

g(x, pc, 3) 
# [1] 2.4 2.4 2.4 2.4 2.4 2.4 

g(x, pc, 4) 
# [1] 0 0 0 0 0 0 

परिणाम है कि हम क्या प्रतीकात्मक समाधान में FUN साथ है के साथ संगत है:

## use `outer` 
g <- function (x, pc, nderiv = 0L) { 
    ## check missing aruments 
    if (missing(x) || missing(pc)) stop ("arguments missing with no default!") 
    ## polynomial order p 
    p <- length(pc) - 1L 
    ## number of derivatives 
    n <- nderiv 
    ## earlier return? 
    if (n > p) return(rep.int(0, length(x))) 
    ## polynomial basis from degree 0 to degree `(p - n)` 
    X <- outer(x, 0:(p - n), FUN = "^") 
    ## initial coefficients 
    ## the additional `+ 1L` is because R vector starts from index 1 not 0 
    beta <- pc[n:p + 1L] 
    ## factorial multiplier 
    beta <- beta * factorial(n:p)/factorial(0:(p - n)) 
    ## matrix vector multiplication 
    drop(X %*% beta) 
    } 

हम अभी भी उदाहरण x और pc प्रतीकात्मक समाधान में परिभाषित का उपयोग करें। अब प्रदर्शन कैसे हम इस सवाल अपने आप काम कर सकते हैं, आर पैकेज polynom उपयोग करने पर विचार में काफी बहुत प्रयास के बाद

curve(g(x, pc), from = 0, to = 5) 
curve(g(x, pc, 1), from = 0, to = 5, col = 2, add = TRUE) 
curve(g(x, pc, 2), from = 0, to = 5, col = 3, add = TRUE) 
curve(g(x, pc, 3), from = 0, to = 5, col = 4, add = TRUE) 

Answer 3

:

इसी तरह, हम gcurve का उपयोग कर प्लॉट कर सकते हैं। एक छोटे पैकेज के रूप में, इसका उद्देश्य निर्माण, डेरिवेटिव, एकीकरण, अंकगणित और अनियंत्रित बहुपदों की जड़ों की खोज को लागू करना है। यह पैकेज किसी भी संकलित कोड के बिना पूरी तरह से आर भाषा के साथ लिखा गया है।

## install.packages("polynom") 
library(polynom) 

हम अभी भी पहले इस्तेमाल किए गए क्यूबिक बहुपद उदाहरण पर विचार करते हैं।

pc <- 1:4/10 

## step 1: making a "polynomial" object as preparation 
pcpoly <- polynomial(pc) 
#0.1 + 0.2*x + 0.3*x^2 + 0.4*x^3 

## step 2: compute derivative 
expr <- deriv(pcpoly) 

## step 3: convert to function 
g1 <- as.function(expr) 

#function (x) 
#{ 
# w <- 0 
# w <- 1.2 + x * w 
# w <- 0.6 + x * w 
# w <- 0.2 + x * w 
# w 
#} 
#<environment: 0x9f4867c> 

नोट, चरण-दर-चरण निर्माण द्वारा, परिणामस्वरूप फ़ंक्शन के अंदर सभी पैरामीटर हैं। इसे केवल x मान के लिए एक ही तर्क की आवश्यकता है। इसके विपरीत, अन्य दो उत्तरों में कार्य गुणांक और व्युत्पन्न आदेश को अनिवार्य तर्क के रूप में भी ले जाएगा। हम इस समारोह

g1(seq(0, 1, 0.2)) 
# [1] 0.200 0.368 0.632 0.992 1.448 2.000 

फोन ही ग्राफ हम अन्य दो जवाब में देखते उत्पादन करने के लिए कर सकते हैं, हम अन्य डेरिवेटिव के रूप में अच्छी तरह से मिलता है:

g0 <- as.function(pcpoly) ## original polynomial 

## second derivative 
expr <- deriv(expr) 
g2 <- as.function(expr) 
#function (x) 
#{ 
# w <- 0 
# w <- 2.4 + x * w 
# w <- 0.6 + x * w 
# w 
#} 
#<environment: 0x9f07c68> 

## third derivative 
expr <- deriv(expr) 
g3 <- as.function(expr) 
#function (x) 
#{ 
# w <- 0 
# w <- 2.4 + x * w 
# w 
#} 
#<environment: 0x9efd740> 

शायद आप पहले से ही देखा है कि मैं nderiv निर्दिष्ट नहीं किया है, लेकिन एक समय में 1 व्युत्पन्न लेते हैं। यह इस पैकेज का नुकसान हो सकता है।यह उच्च आदेश डेरिवेटिव की सुविधा नहीं देता है।

अब हम एक साजिश

## As mentioned, `g0` to `g3` are parameter-free 
curve(g0(x), from = 0, to = 5) 
curve(g1(x), add = TRUE, col = 2) 
curve(g2(x), add = TRUE, col = 3) 
curve(g3(x), add = TRUE, col = 4)