# Function "ktsolve" . This document is copyright 2010 by Carl Witthoft.
# Permission given to copy and modify as desired so long as the document
# or derivative works are not sold or made part of a commercial product.
# Please contact the author, carl@witthoft.com, for permission to
# include in a specified commercial package.
#
# Definitions:
# known -- list or vector of known values. The elements must be named
# and the names must match variable names in yfunc.
# guess -- list or vector of initial guesses for the unknown values. S ame rules as for 'known,' AND length(guess)
# must be same as number of y[j] equations in yfunc, to avoid over- or under-defined system.
# yfunc -- is a function of the form:
# yfunc<-function(x) {
# y<-vector()
# y[1]<-f1(x)
# y[2]<-f2(x)
# y[length(x)]<-fn(x)
# y
# }
# where y[j] are dummies which will be driven to zero,
# and x[j] is a dummy vector which will be filled in with 'guess'
# So, eqns in the form A=f(x) must be entered as y[j] <- f(x)-A
# Example: d = a + sqrt(b) and a = sin(a/b) + g*exp(f*a) become
# y[1]<- a - d +sqrt(b) and y[2]<- sin(a/b) +g*exp(f*a) -a ,
# and e.g.
# known <- list(a=3,d=5,g=.1) are the fixed parameters and
# guess <- list(b=1,f=1) are the initializers for BBsolve() .
#
# Oh, and BTW the function name is an homage to my alltime favorite
# app: TK!Solver
#
ktsolve<-function(yfunc,known,guess){
require(BB)
# length(body(y)) is one greater than number of lines due to"{}"
# first, assign the 'known' values
for (i in 1:length(known)) {
if(length(grep(names(known)[i], body(yfunc)[-1]))<1) warning("Input '", names(known)[i], '" not found in func')
# make a search string which distinguishes a variable from part of a string
lookfor<-paste("\\b",names(known)[i],"\\b",sep="",collapse="")
parse(text=gsub(lookfor,known[i],body(yfunc)[-1])) -> body(yfunc)[-1]
}
# Now reconfigure yfunc's body to have x[n] for each 'guess' name
for (i in 1:length(guess)) {
if(length(grep(names(guess)[i], body(yfunc)[-1]))<1) warning("Guess '", names(guess)[i],"' not found in func")
subpat<-paste("x\\[",i,"\\]",sep="")
lookfive<-paste("\\b",names(guess)[i],"\\b",sep="",collapse="")
parse(text=gsub(lookfive, subpat, body(yfunc)[-1])) -> body(yfunc)[-1]
}
# are yfunc and guess same length? (yfunc() fails if guess is shorter)
# Also, yfunc() fails if any undefined values, which is helpful
if(length(yfunc(unlist(guess)))bbsolution
#too lazy to make nice formatted table
cat('solution is:\n')
print(bbsolution$par)
cat('"known" inputs were:\n')
print(rbind(known))
outs<-list(bbsolution=bbsolution, yfunc=body(yfunc))
return(invisible(outs))
}