R类型转换表达式（）函数（）

我一直在尝试用R写一个程序来实现牛顿的方法。我大部分都很成功，但有两个小障碍一直困扰着我。这是我的密码：

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)
}

当我想要的是f（0）=0，因为sin（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)
}

Newton
出现第一个问题是因为
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)


乔希已经回答了你的问题

对于第二部分，您可以使用

g <- expression( sin(x) )

g[[1]]
# sin(x)

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

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

g顺便说一句，最近写了一个玩具，它根据牛顿方法在复平面上的根收敛性计算分形图案，我可以推荐你加入如下代码（其中主函数的参数列表包括“func”和“varname”）

啊，为什么不呢：这是我的完整功能，供大家使用和享受：-）

#构建牛顿-拉夫森分形
#定义：f（z）牛顿法的收敛性为
#zn+1=zn-f（zn）/f'（zn）
#记录每个起始z0收敛到哪个根，
#为了得到更好的颜色，记录迭代次数。
#投入：
#func：字符串，包括变量。例如，'x+2*x^2'或'sin（x）'
#varname：表示变量名称的字符串
#zreal:Re（z）的向量（优选）
#zim:Im（z）的向量
#rootprec:NewtonRaphson算法的收敛精度
#maxiter：安全开关，最大迭代次数，之后抛出错误
#
谢谢你！还有一个问题：如果我想去掉表达式变量（在你的例子中是g），该怎么办？真的，如果我不清楚你要的是什么，我想这样做。也许你正在寻找这样一种没有g:
f的东西——我想消除g。我希望能够提取g的内容，然后去掉g。使用我的例子：'>gf函数（x）{eval（g[[1]]）}'当我真正想要的是'>f函数（x）{sin（x）}'换句话说，我想消除f对g的依赖性。这有意义吗？谢谢你发布代码。我还没有通读一遍，但我相信我可以通过模拟你的代码来改进我的程序。我指的是
function（）
类中的东西，它们是具体的数学函数。例如，假设我有函数
fOK。这里有一些问题。（1） 比较
class（f）
和
class（body（f））
表明
body（f）
是一个函数调用，而不是函数。（当然，这没关系，因为对于
D（）
来说，你真正想要的是类
expression
，而不是
function
）（2）除非我错了，否则你想要的是一个更像
body（f）
而不是
body（f）[[2]
的导数。（3） 您可能希望使用
as.expression
来执行此操作：
D（as.expression（body（f）），“x”）
。这会让你更接近你想要的位置吗？我认为子集设置（即使用[[2]]）是必要的，否则花括号会导致问题。例如：
>f类（body（f））[1]“{”>class（f）[1]“函数”>class（body（f））[1]“{”>class（body（f）[[2]]）[1]“调用”
，尝试一下你的例子，我得到一个错误：
>D（as.expression（body（f）），“x”）D（as.expression（body（f）），“x”）中的错误：函数“
{
'不在导数表中
我学习数学，所以我很抱歉对术语不太熟悉。明白了。我已经输入了
f哈哈，今天我学到了我不需要用括号括住函数体。谢谢你的帮助。
> eval(f, envir=list(x=0))
# [1] 0

g <- expression( sin(x) )

g[[1]]
# sin(x)

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

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

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

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))
}