आर प्रकार रूपांतरण अभिव्यक्ति() फ़ंक्शन()

Question

मैं आर में एक प्रोग्राम लिखने की कोशिश कर रहा हूं जो न्यूटन की विधि लागू करता है। मैं ज्यादातर सफल रहा हूं, लेकिन दो छोटे स्नैग हैं जो मुझे परेशान कर रहे हैं। यहाँ मेरी कोड है:

Newton<-function(f,f.,guess){ 
    #f <- readline(prompt="Function? ") 
    #f. <- readline(prompt="Derivative? ") 
    #guess <- as.numeric(readline(prompt="Guess? ")) 
    a <- rep(NA, length=1000) 
    a[1] <- guess 
    a[2] <- a[1] - f(a[1])/f.(a[1]) 
    for(i in 2:length(a)){ 
     if(a[i] == a[i-1]){ 
      break 
     } 
     else{ 
      a[i+1] <- a[i] - f(a[i])/f.(a[i]) 
     } 
    } 
    a <- a[complete.cases(a)] 
    return(a) 
} 

1. मैं अगर मैं readline() का उपयोग कर की कोशिश उपयोगकर्ता इनपुट के लिए संकेत करने के लिए आर कार्यों f और f. पहचान करने के लिए नहीं मिल सकता है। मुझे त्रुटि मिलती है "न्यूटन में त्रुटि(): फ़ंक्शन" एफ "नहीं मिल सका।" हालांकि, अगर मैं रीडलाइन (उपरोक्त के रूप में) पर टिप्पणी करता हूं, तो f और f. को पहले से परिभाषित करें, तो सब कुछ ठीक काम करता है।

2. मैं आर को फ़ंक्शन के व्युत्पन्न की गणना करने की कोशिश कर रहा हूं। समस्या यह है कि क्लास ऑब्जेक्ट जिसके साथ आर प्रतीकात्मक डेरिवेटिव ले सकता है expression() है, लेकिन मैं function() का व्युत्पन्न लेना चाहता हूं और यह मुझे function() दे सकता है। संक्षेप में, मुझे expression() और function() के बीच प्रकार रूपांतरण के साथ परेशानी हो रही है।

मैं function() से expression() जाने के लिए एक बदसूरत लेकिन प्रभावी समाधान है। एक समारोह एफ को देखते हुए, D(body(f)[[2]],"x")f का व्युत्पन्न देगा। हालांकि, यह आउटपुट expression() है, और मैं इसे function() में वापस करने में सक्षम नहीं हूं। क्या मुझे eval() या कुछ उपयोग करने की आवश्यकता है? मैंने सबसेटिंग की कोशिश की है, लेकिन इसका कोई फायदा नहीं हुआ है। उदाहरण के लिए:

g <- expression(sin(x)) 
g[[1]] 
sin(x) 
f <- function(x){g[[1]]} 
f(0) 
sin(x) 

जब कि मैं क्या चाहता हूँ च है (0) = 0 के बाद से पाप (0) = 0.

संपादित करें: धन्यवाद सब! यह मेरा नया कोड है:

Newton<-function(f,f.,guess){ 
    g<-readline(prompt="Function? ") 
    g<-parse(text=g) 
    g.<-D(g,"x") 
    f<-function(x){eval(g[[1]])} 
    f.<-function(x){eval(g.)} 
    guess<-as.numeric(readline(prompt="Guess? ")) 
    a<-rep(NA, length=1000) 
    a[1]<-guess 
    a[2]<-a[1]-f(a[1])/f.(a[1]) 
    for(i in 2:length(a)){ 
     if(a[i]==a[i-1]){break 
     }else{ 
     a[i+1]<-a[i]-f(a[i])/f.(a[i]) 
     } 
    } 
a<-a[complete.cases(a)] 
#a<-a[1:(length(a)-1)] 
return(a) 
} 

Answer 1

1. यह पहली समस्या पैदा होती है क्योंकि readline, किसी पाठ स्ट्रिंग में पढ़ता है, जबकि तुम क्या जरूरत है एक अभिव्यक्ति है। आप parse() उपयोग कर सकते हैं एक अभिव्यक्ति के लिए पाठ स्ट्रिंग परिवर्तित करने के लिए:

   f <-readline(prompt="Function? ") 
   sin(x) 
   f 
   # [1] "sin(x)" 
   
   f <- parse(text = f) 
   f 
   # expression(sin(x)) 
   
   g <- D(f, "x") 
   g 
   # cos(x) 
   

2. अभिव्यक्ति में समारोह कॉल में तर्क के लिए मूल्यों में पास करने के लिए (! वाह), आप इसे युक्त आपूर्ति माहौल में eval() कर सकते हैं मान।

   > eval(f, envir=list(x=0)) 
   # [1] 0 
   

Answer 2

जोश भाग 2 के लिए अपने प्रश्न

उत्तर दिया है आप के लिए इस्तेमाल किया जा सकता था

: अच्छी तरह से, आर आप eval() की envir= तर्क को आपूर्ति की एक सूची में उन मूल्यों की आपूर्ति करने की अनुमति देगा

g <- expression(sin(x)) 

g[[1]] 
# sin(x) 

f <- function(x){ eval(g[[1]]) } 

f(0) 
# [1] 0 
f(pi/6) 
# [1] 0.5 

Answer 3

बीटीडब्ल्यू, हाल ही में एक खिलौना लिखा है जो जटिल विमान में न्यूटन की विधि के मूल अभिसरण के आधार पर फ्रैक्टल पैटर्न की गणना करता है, मैं आपको इस तरह टॉस करने की सलाह दे सकता हूं मुझे निम्नलिखित कोड जैसे कोड (जहां मुख्य फ़ंक्शन की तर्क सूची में "func" और "varname" शामिल है)।

func<- gsub(varname, 'zvar', func) 
    funcderiv<- try(D(parse(text=func), 'zvar')) 
    if(class(funcderiv) == 'try-error') stop("Can't calculate derivative") 

आप और अधिक सतर्क हैं, तो आप एक एक तर्क "funcderiv" ​​शामिल हो सकते हैं, और

if(missing(funcderiv)){blah blah} 

आह में मेरी कोड लपेट, क्यों नहीं: यहाँ मेरा पूरा समारोह सब का उपयोग करने के लिए और आनंद लें :-)

# build Newton-Raphson fractal 
#define: f(z) the convergence per Newton's method is 
# zn+1 = zn - f(zn)/f'(zn) 
#record which root each starting z0 converges to, 
# and to get even nicer coloring, record the number of iterations to get there. 
# Inputs: 
# func: character string, including the variable. E.g., 'x+ 2*x^2' or 'sin(x)' 
# varname: character string indicating the variable name 
# zreal: vector(preferably) of Re(z) 
# zim: vector of Im(z) 
# rootprec: convergence precision for the NewtonRaphson algorithm 
# maxiter: safety switch, maximum iterations, after which throw an error 
# 
nrfrac<-function(func='z^5 - 1 ', varname = 'z', zreal= seq(-5,5,by=.1), zim, rootprec=1.0e-5, maxiter=1e4, drawplot=T, drawiterplot=F, ...) { 
    zreal<-as.vector(zreal) 
    if(missing(zim)) zim <- as.vector(zreal) 
# precalculate F/F' 
    # check for differentiability (in R's capability) 
    # and make sure to get the correct variable name into the function 
    func<- gsub(varname, 'zvar', func) 
    funcderiv<- try(D(parse(text=func), 'zvar')) 
    if(class(funcderiv) == 'try-error') stop("Can't calculate derivative") 
# Interesting "feature" of deparse : default is to limit each string to 60 or64 
# chars. Need to avoid that here. Doubt I'd ever see a derivative w/ more 
# than 500 chars, the max allowed by deparse. To do it right, 
# need sum(nchar(funcderiv)) as width, and even then need to do some sort of 
# paste(deparse(...),collapse='') to get a single string 
    nrfunc <- paste(text='(',func,')/(',deparse(funcderiv, width=500),')', collapse='') 
# first arg to outer() will give rows 
# Stupid Bug: I need to REVERSE zim to get proper axis orientation 
    zstart<- outer(rev(zim*1i), zreal, "+") 
    zindex <- 1:(length(zreal)*length(zim)) 
    zvec <- data.frame(zdata=as.vector(zstart), zindex=zindex,  itermap=rep(0,length(zindex)), badroot=rep(0,length(zindex)), rooterr=rep(0,length(zindex))) 

#initialize data.frame for zout. 
    zout=data.frame(zdata=rep(NA,length(zstart)), zindex=rep(NA,length(zindex)),  itermap=rep(0,length(zindex)), badroot=rep(0,length(zindex)), rooterr=rep(0,length(zindex))) 
    # a value for rounding purposes later on; yes it works for rootprec >1 
    logprec <- -floor(log10(rootprec)) 
    newtparam <- function(zvar) {} 
    body(newtparam)[2] <- parse(text=paste('newz<-', nrfunc, collapse='')) 
    body(newtparam)[3] <- parse(text=paste('return(invisible(newz))')) 
    iter <- 1 
    zold <- zvec # save zvec so I can return original values 
    zoutind <- 1 #initialize location to write solved values 
    while (iter <= maxiter & length(zold$zdata)>0) { 
     zold$rooterr <- newtparam(zold$zdata) 
     zold$zdata <- zold$zdata - zold$rooterr 
     rooterr <- abs(zold$rooterr) 
     zold$badroot[!is.finite(rooterr)] <- 1 
     zold$zdata[!is.finite(rooterr)] <- NA 
# what if solvind = FFFFFFF? -- can't write 'nothing' to zout 
     solvind <- (zold$badroot >0 | rooterr<rootprec) 
      if(sum(solvind)>0) zout[zoutind:(zoutind-1+sum(solvind)),] <- zold[solvind,] 
    #update zout index to next 'empty' row 
     zoutind<-zoutind + sum(solvind) 
# update the iter count for remaining elements: 
     zold$itermap <- iter 
# and reduce the size of the matrix being fed back to loop 
     zold<-zold[!solvind,] 
     iter <- iter +1 
    # just wonder if a gc() call here would make any difference 
# wow -- it sure does 
     gc() 
    } # end of while 
# Now, there may be some nonconverged values, so: 
# badroot[] is set to 2 to distinguish from Inf/NaN locations 
     if(zoutind < length(zindex)) { # there are nonconverged values 
# fill the remaining rows, i.e. zout.index:length(zindex) 
      zout[(zoutind:length(zindex)),] <- zold # all of it 
      zold$badroot[] <- 2 # yes this is safe for length(badroot)==0 
      zold$zdata[]<-NA #keeps nonconverged values from messing up results 
      } 
# be sure to properly re-order everything... 
    zout<-zout[order(zout$zindex),] 
    zout$zdata <- complex(re=round(Re(zout$zdata),logprec), im=round(Im(zout$zdata),logprec)) 
    rootvec <- factor(as.vector(zout$zdata), labels=c(1:length(unique(na.omit(as.vector(zout$zdata)))))) 
    #convert from character, too! 
    rootIDmap<-matrix(as.numeric(rootvec), nr=length(zim)) 
# to colorize very simply: 
    if(drawplot) { 
      colorvec<-rainbow(length(unique(as.vector(rootIDmap)))) 
     imagemat<-rootIDmap 
     imagemat[,]<-colorvec[imagemat] #now has color strings 
     dev.new() 
# all '...' arguments used to set up plot 
     plot(range((zreal)),range((zim)), t='n',xlab='real',ylab='imaginary',...) 
     rasterImage(imagemat, range(zreal)[1], range(zim)[1], range(zreal)[2], range(zim)[2], interp=F)  
     } 

    outs <- list(rootIDmap=rootIDmap, zvec=zvec, zout=zout, nrfunc=nrfunc) 
    return(invisible(outs)) 
}