Target multiple variables for a function within a custom function - r

I would like to build a function which runs a chi square test if calc=TRUE. The problem appears to be targeting the variables used within the wtd.chi.sq function.
Thank you very much in advance.
library(weights); library(sjstats)
testfunction <- function(dta, x, y, calc=TRUE, annotate=note){
if(isTRUE(calc)){
testresult<-wtd.chi.sq(dta[[x]], dta[[y]])
return(testresult["p.value"])
}
else {
annotate <- paste0(note, "... and no calc necessary")
}
return(annotate)
}
testfunction(dta=df, x=f1, y=s12x, calc=TRUE, annotate=note)
Error in tbl_subset2(x, j = i, j_arg = substitute(i)) :
object 'f1' not found

Related

Can R recognize the type of distribution used as a function argument?

Background
I have a simple function called TBT. This function has a single argument called x. A user can provide any type rdistribution_name() (e.g., rnorm(), rf(), rt(), rbinom() etc.) existing in R for argument x, EXCEPT ONE: "rcauchy()".
Question
I was wondering how R could recognize that a user has provided an rcauchy() as the input for x, and when this is the case, then R issues a warning message?
Here is my R code with no success:
TBT = function(x) {
if( x == rcauchy(...) ) { warning("\n\tThis type of distribution is not supported.") }
}
TBT( x = rcauchy(1e4) )
Error in TBT(rcauchy(10000)) : '...' used in an incorrect context
If you are expeciting them do call to random function when they call your function, you could so
TBT <- function(x) {
xcall <- match.call()$x
if (class(xcall)=="call" && xcall[[1]]=="rcauchy") {
warning("\n\tThis type of distribution is not supported.")
}
}
TBT( x = rcauchy(1e4) )
But this would not catch cases like
x <- rcauchy(1e4)
TBT( x )
R can't track where the data in the x variable came from

How to apply a running function inR

I need to develop a function in R which can be used to compute time varying variable API which is defines as: api(t)=k*api(t-1)+ppt(t).
ppt=round(c(0.0,0.0,0.0,runif(25, 0.0, 15.5),0.0,0.0),digit=1)
api=c(5.75,rep(NA,29))
k=0.85
f <- function(k,api,ppt,...){
for (i in 2:30){
api[i]=k*api[i-1]+ppt[i]
return(api)}}
f(k=k,api=api,ppt=ppt)
when I apply the above function I am only getting the first value.
I appreciate you help.
You can use simple recursion:
calculateP <- function(startP, t, k, j) {
if (t == 0) {
return (stp)
}
return (k[t]*calcP(stp, t-1, k,j) + j[t])
}
Seems to work pretty well.

Order of methods in R reference class and multiple files

There is one thing I really don't like about R reference class: the order you write the methods matters. Suppose your class goes like this:
myclass = setRefClass("myclass",
fields = list(
x = "numeric",
y = "numeric"
))
myclass$methods(
afunc = function(i) {
message("In afunc, I just call bfunc...")
bfunc(i)
}
)
myclass$methods(
bfunc = function(i) {
message("In bfunc, I just call cfunc...")
cfunc(i)
}
)
myclass$methods(
cfunc = function(i) {
message("In cfunc, I print out the sum of i, x and y...")
message(paste("i + x + y = ", i+x+y))
}
)
myclass$methods(
initialize = function(x, y) {
x <<- x
y <<- y
}
)
And then you start an instance, and call a method:
x = myclass(5, 6)
x$afunc(1)
You will get an error:
Error in x$afunc(1) : could not find function "bfunc"
I am interested in two things:
Is there a way to work around this nuisance?
Does this mean I can never split a really long class file into multiple files? (e.g. one file for each method.)
Calling bfunc(i) isn't going to invoke the method since it doesn't know what object it is operating on!
In your method definitions, .self is the object being methodded on (?). So change your code to:
myclass$methods(
afunc = function(i) {
message("In afunc, I just call bfunc...")
.self$bfunc(i)
}
)
(and similarly for bfunc). Are you coming from C++ or some language where functions within methods are automatically invoked within the object's context?
Some languages make this more explicit, for example in Python a method with one argument like yours actually has two arguments when defined, and would be:
def afunc(self, i):
[code]
but called like:
x.afunc(1)
then within the afunc there is the self variable which referes to x (although calling it self is a universal convention, it could be called anything).
In R, the .self is a little bit of magic sprinkled over reference classes. I don't think you could change it to .this even if you wanted.

Capture a function from parameter in NESTED function (closure function)

Consider a code snippet as follow:
f = function(y) function() y()
f(version)()
Error in f(version)() : could not find function "y"
P.s. It seems that the closure mechanism is quite different from C# Lambda. (?)
Q: How can I capture a function in the closure?
--EDIT--
Scenario: Actually, I would like to write a function factory, and I don't want to add parameter to the nested function.
Like this:
theme_factory = function(theme_fun)
{
function(device)
{
if (!is.onMac()) # Not Mac
{
(device == "RStudioGD") %?% theme_fun(): theme_fun(base_family="Heiti")
}
else
{
theme_fun(base_family="STHeiti")
}
}
}
And I defined two customized theme function for ggplot
theme_bw_rmd = theme_factory(theme_bw)
theme_grey_rmd = theme_factory(theme_grey)
Then I use them like:
function(device)
ggplot(data) + geom_point() something like that + theme_bw_rmd(device)
Thanks.
So the problem is with passing parameter? What about something like this:
alwaysaddone <- function(f) function(...) f(...)+1
biggersum <- alwaysaddone(sum)
sum(1:3)
# 6
biggersum(1:3)
# 7
You can use ... to "pass-through" any parameters you like.
Use eval(func, envir = list(... captured parameters)) or substitute(func, envir) to eval the captured function in a specific environment.

Incorporating point error information into a distance function--how to do it in R?

I have been working with the proxy package in R to implement a distance measure that weights Euclidean distance by the propagated errors of each individual point. The formula to do this is
sqrt((xi - xj)2) + (yi - yj)2) + ...(ni - nj)2) ÷ sqrt((σxi2 + σxj2) + (σyi2 + σyj2) + ...(σni2 + σnj2)).
I was able to get proxy to work for me in a basic sense (see proxy package in R, can't make it work) and replicated plain Euclidean distance functionality, hooray for the amateur.
However, once I started writing the function for the error-weighted distance, I immediately ran into a difficulty: I need to read in the errors as distinct from the points and have them processed distinctly.
I know that R has very strong functionality and I'm sure it can do this, but for the life of me, I don't know how. It looks like proxy's dist can handle two matrix inputs, but how would I tell it that matrix X is the points and matrix Y is the errors, and then have each go to its appropriate part of the function before being ultimately combined into the distance measure?
I had been hoping to use proxy directly, but I also realized that it looks like I can't. I believe I was able to come up with a function that works. First, the distance function:
DistErrAdj <- function(x,y) {
sing.err <- sqrt((x^2) + (y^2))
sum(sing.err)
}
Followed, of course, by
library(proxy)
pr_DB$set_entry(FUN=DistErrAdj,names="DistErrAdj")
Then, I took code already kindly written from augix (http://augix.com/wiki/Make%20trees%20in%20R,%20test%20its%20stability%20by%20bootstrapping.html) and altered it to suit my needs, to wit:
boot.errtree <- function(x, q, B = 1001, tree = "errave") {
library(ape)
library(protoclust)
library(cluster)
library(proxy)
func <- function(x,y) {
tr = agnes((dist(x, method = "euclidean")/dist(q, method = "DistErrAdj")), diss = TRUE, method = "average")
tr = as.phylo(as.hclust(tr))
return(tr)
}
if (tree == "errprot") {
func <- function(x,y) {
tr = protoclust((dist(x, method = "euclidean")/dist(q, method = "DistErrAdj")))
tr = as.phylo(tr)
return(tr)
}
}
if (tree == "errdiv") {
func <- function(x,y) {
tr = diana((dist(x, method = "euclidean")/dist(q, method = "DistErrAdj")), diss=TRUE)
tr = as.phylo(as.hclust(tr))
return(tr)
}
}
tr_real = func(x)
plot(tr_real)
bp <- boot.phylo(tr_real, x, FUN=func, B=B)
nodelabels(bp)
return(bp)
}
It seems to work.

Resources