Movatterモバイル変換


[0]ホーム

URL:


Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

Sign up
Appearance settings

Commitc71c3ca

Browse files
committed
Added random_terms() to package
1 parent097f86f commitc71c3ca

File tree

12 files changed

+98
-17
lines changed

12 files changed

+98
-17
lines changed

‎DESCRIPTION‎

Lines changed: 2 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -27,15 +27,10 @@ Roxygen: list(markdown = TRUE)
2727
RoxygenNote: 7.2.1
2828
Suggests:
2929
igraph,
30-
graphics,
31-
testthat (>= 3.0.0),
30+
mosaicData,
3231
moderndive,
3332
palmerpenguins,
34-
babynames,
35-
knitr,
36-
rmarkdown,
37-
stringdist,
38-
mosaicData
33+
stringdist
3934
Config/testthat/edition: 3
4035
VignetteBuilder: knitr
4136
URL: https://dtkaplan.github.io/LSTbook/

‎NAMESPACE‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ export(model_values)
3232
export(ntiles)
3333
export(point_plot)
3434
export(random_levels)
35+
export(random_terms)
3536
export(regression_summary)
3637
export(resample)
3738
export(sample)

‎NEWS.md‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,3 +15,7 @@ First CRAN release
1515
* Adding documentation stubs for data sources that are too big to include in the package but are available on the web, such as`Natality_2014`.
1616

1717
* Changed the name of the FEV data frame to CRDS ("childhood respiratory disease study") to avoid confusion with the FEV variable.
18+
19+
* model_eval() mistakenly changed name of first column to .response even when handed evaluation data directly. Fixed.
20+
21+
* Added random_terms() to generate random columns in a model matrix.

‎R/AAUP.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@
1919
#' - `fem`: fraction of the workforce that is female
2020
#' - `unemp`: unemployment rate in the discipline
2121
#' - `nonac`: fraction of the workforce that is non-academic,
22-
#' - `licenced`: Does work in the profession require a license (from George Cobb's paper)
22+
#' - `licensed`: Does work in the profession require a license (from George Cobb's paper)
2323
#'
2424
#' @references M Bellas & BF Reskin (1994) "On comparable worth" *Academe* **80**:83-85
2525
#'

‎R/FARS.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@
1919
#' involved in an incident or not. (billions of miles)
2020
#' - `population` the population of the US (thousands of people)
2121
#' - `registered_vehicles` the number of motor vehicles registered in the US (thousands)
22-
#' - `licenced_drivers` the number of licenced drivers in the US (thousands)
22+
#' - `licensed_drivers` the number of licenced drivers in the US (thousands)
2323
#'
2424
#'
2525
#' @keywords datasets

‎R/data_from_tilde.R‎

Lines changed: 8 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -45,11 +45,16 @@ eval_exp_list <- function(EL, data) {
4545
if (ncol(res[[k]])==1) {
4646
names(res[[k]])<- deparse(EL[[k]])
4747
}else {
48-
# just pull outthe variable asone column, leaving the multi-column
48+
# just pull out one column, leaving the multi-column
4949
# stuff for the annotation based on the model
5050
the_var<- all.vars(EL[[k]])[1]
51-
res[[k]]<-data[the_var]
52-
names(res[[k]])<-the_var
51+
if (is.na(the_var)) {
52+
# the column is not based on a variable
53+
res[[k]]<-NULL
54+
}else {
55+
res[[k]]<-data[the_var]
56+
names(res[[k]])<-the_var
57+
}
5358
}
5459
}
5560

‎R/model_eval.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -51,11 +51,11 @@ model_eval <- function(mod, data=NULL, ..., skeleton=FALSE, ncont=3,
5151
training_data<- data_from_tilde(get_training_data(mod),
5252
formula_from_mod(mod))
5353
eval_data<-training_data
54+
names(eval_data)[1]<-".response"
5455
response_in_data<-TRUE
5556
}
5657
}else {
5758
eval_data<-training_data<-data
58-
names(training_data)[1]<-".response"
5959
# the argument data might or might not have the response name
6060
response_in_data<-response_var_name%in% names(data)
6161
}
@@ -81,7 +81,7 @@ model_eval <- function(mod, data=NULL, ..., skeleton=FALSE, ncont=3,
8181

8282
if (response_in_data) {
8383
Residuals<-data.frame(.resid=eval_data[[response_var_name]]-Fitted$.output)
84-
names(training_data)[1]<-".response"# give it a generic name
84+
names(training_data)[names(training_data)==response_var_name]<-".response"# give it a generic name
8585
return(dplyr::bind_cols(training_data,Fitted,Residuals))
8686
}else {
8787
return(dplyr::bind_cols(eval_data,Fitted))

‎R/random_terms.R‎

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,40 @@
1+
#' create columns with random numbers
2+
#'
3+
#' For demonstration purposes, add the specified number of
4+
#' random columns to a model matrix. This is intended to be used
5+
#' in modeling functions, e.g. `model_train()`, `lm()`, and so on
6+
#' to explore the extent to which random columns "explain" the
7+
#' response variable.
8+
#'
9+
#' @param df How many columns to add
10+
#' @param rdist Function to generate each column's numbers (default: `rnorm`)
11+
#' @param args A list holding the parameters (if any) to be used for the `rdist` argument
12+
#' @param n OPTIONALLY, dictate the number of rows in the output
13+
#' @param seed Integer seed for the random-number generator
14+
#'
15+
#' @details `random_terms()` will try to guess a suitable value for `n` based on
16+
#' the calling function.
17+
#'
18+
#' @examples
19+
#' mtcars |> model_train(mpg ~ wt + random_terms(4)) |> conf_interval()
20+
#' mtcars |> model_train(mpg ~ wt + random_terms(4)) |> anova_report()
21+
#' # must state number of rows if not part of a modeling tilde expression
22+
#' goo <- mtcars |> bind_cols(r = random_terms(3))
23+
#' @export
24+
random_terms<-function (df=1,rdist=rnorm,args=list(),n,seed=NULL)
25+
{
26+
if (missing(n)) {
27+
arg<- sys.call(1)[[2]]
28+
# walk down the stack until reaching the first argument to this function
29+
while(length(arg)>1)arg<-arg[[2]]
30+
# if it's a data frame, we have our answer.
31+
if (inherits(eval(arg),"data.frame"))n= nrow(eval(arg))
32+
else stop("Need to specify argument <n> in random_terms().")
33+
}
34+
if (!is.null(seed)) {
35+
set.seed(seed)
36+
}
37+
result<-matrix(do.call(rdist,args= c(list(n=df*n),
38+
args)),nrow=n)
39+
return(result)
40+
}

‎R/zzz.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22

33
pkgs_to_attach<- c("ggplot2","dplyr")
44
optional_packages<- c("ggformula","mosaicData","moderndive",
5-
"palmerpenguins","babynames")
5+
"palmerpenguins")
66
# if an optional package is installed, .onLoad() will attach it.
77
add_to_attach<-function(pkg) {
88
if (requireNamespace(pkg,quietly=TRUE))

‎man/AAUP.Rd‎

Lines changed: 1 addition & 1 deletion
Some generated files are not rendered by default. Learn more aboutcustomizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)

[8]ページ先頭

©2009-2025 Movatter.jp