Merge branch 'master' of https://github.com/tbates/umx

NAMESPACE

@@ -58,6 +58,7 @@ export(SE_from_p)
 export(bucks)
 export(deg2rad)
 export(dl_from_dropbox)
+export(fin_NI)
 export(fin_interest)
 export(fin_percent)
 export(fin_valuation)

R/build_run_modify.R

@@ -3785,17 +3785,17 @@ umxSetParameters <- function(model, labels, free = NULL, values = NULL, newlabel
 #' \emph{Tip}: To find labels by name, use the regex parameter of [umxGetParameters()]
 #' 
 #' @param model   An [mxModel()] within which to equate parameters listed in "a" with those in "b"
-#' @param a  one or more parameter labels to equate with b labels
-#' @param b  one or more labels to equate (if newNames is not set, these will set to the a labels, thus equating the parameters
+#' @param a  one or more labels to equate with those in the "b" set.
+#' @param b  one or more labels to equate with those in the 'a' set. (if 'newlabels' is NULL, labels will be set to 'a' list).
 #' @param newlabels (optional) list of new labels for the equated parameters.
-#' @param free    Should parameter(s) initially be free? (default = TRUE)
+#' @param free    Must the parameter(s) initially be free? (default = TRUE)
 #' @param verbose Whether to give verbose feedback (default = TRUE)
 #' @param name    name for the returned model (optional: Leave empty to leave name unchanged)
 #' @param comparison Compare the new model to the old (if updating an existing model: default = TRUE)
 #' @param autoRun Whether to run the model (default), or just to create it and return without running.
 #' @param tryHard Default ('no') uses normal mxRun. "yes" uses mxTryHard. Other options: "ordinal", "search"
-#' @param master  A list of "master" labels to which slave labels will be equated
-#' @param slave   A list of slave labels which will be updated to match master labels, thus equating the parameters
+#' @param master  synonym for 'a'
+#' @param slave   synonym for 'b'
 #' @return - [mxModel()]
 #' @export
 #' @seealso [umxModify()], [umxCompare()]
@@ -4996,21 +4996,20 @@ umxPath <- function(from = NULL, to = NULL, with = NULL, var = NULL, cov = NULL,
 #' 
 #' @docType package
 #' @name umx
-#' @family Teaching and testing Functions
 #' @family Core Model Building Functions
 #' @family Model Summary and Comparison
-#' @family Summary Functions
 #' @family Reporting Functions
-#' @family Plotting functions
 #' @family Super-easy helpers
 #' @family Twin Modeling Functions
 #' @family Twin Data functions
+#' @family Miscellaneous Stats Functions
+#' @family Teaching and testing Functions
 #' @family Get and set
 #' @family Check or test
+#' @family Plotting functions
 #' @family Data Functions
 #' @family File Functions
 #' @family String Functions
-#' @family Miscellaneous Stats Helpers
 #' @family Miscellaneous Utility Functions
 #' @family datasets
 #' @family Advanced Model Building Functions

R/fit_and_reporting.R

@@ -79,7 +79,7 @@ umxDiagnose <- function(model, tryHard = FALSE, diagonalizeExpCov = FALSE){
 #' @param digits (default 2)
 #' @return - Best model
 #' @export
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @seealso - [AIC()]
 #' @references - Wagenmakers E.J., Farrell S. (2004), 192-196. AIC model selection using Akaike weights. *Psychonomic Bulletin and Review*. **11**, 192-196. \url{https://pubmed.ncbi.nlm.nih.gov/15117008/}
 #' @md
@@ -1870,10 +1870,8 @@ umxSummary.MxModelGxE <- umxSummaryGxE
 #' (handy for getting tables into Word, and other text systems!)
 #' @param file file to write html too if report = "html" (defaults to "tmp.html")
 #' @param compareWeightedAIC Show the Wagenmakers AIC weighted comparison (default = FALSE)
-#' @family Core Modelling Functions
 #' @family Model Summary and Comparison
-#' @family Summary functions
-#' @seealso - [mxCompare()], [umxSummary()], [umxRAM()],
+#' @seealso - [umxSummary()], [umxRAM()],[mxCompare()]
 #' @references - <https://github.com/tbates/umx>
 #' @export
 #' @md
@@ -3828,7 +3826,7 @@ print.RMSEA <- function(x, ...) {
 #' @param ... More p-values if you want to offer them up one by one instead of wrapping in a vector for `pvalues`
 #' @return - A meta-analytic p-value
 #' @export
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @references - Fisher, R.A. (1925). *Statistical Methods for Research Workers*. Oliver and Boyd (Edinburgh). ISBN 0-05-002170-2.
 #' Fisher, R. A (1948). "Questions and answers #14". *The American Statistician*. **2**: 30–31. doi:10.2307/2681650. JSTOR 2681650.
 #' See also Stouffer's method for combining Z scores, which allows weighting.
@@ -3853,7 +3851,7 @@ FishersMethod <- function(pvalues, ...){
 #' @param na.rm remove NAs by default.
 #' @return - Geometric mean of x
 #' @export
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @references - <https://en.wikipedia.org/wiki/Geometric_mean>
 #' @md
 #' @examples
@@ -3891,7 +3889,7 @@ geometric_mean = function(x, na.rm = c(TRUE, FALSE)){
 #' @param na.rm remove NAs (default = TRUE).
 #' @return - Harmonic mean of x
 #' @export
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @references - <https://en.wikipedia.org/wiki/Harmonic_mean>
 #' @md
 #' @examples
@@ -4524,7 +4522,7 @@ umxSummarizeTwinData <- function(data = NULL, selVars = NULL, sep = "_T", zyg =
 #' @param alternative A two (default) or one-sided (greater less) test.
 #' @return cocor result.
 #' @export
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @md
 #' @examples
 #' # Is the correlation of mpg with cylinder count different from that 

R/misc_and_utility.R

@@ -1659,7 +1659,7 @@ umx_pad <- function(x, n) {
 #' @return - object
 #' @export
 #' @seealso - [umx_aggregate()] 
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @references - <https://tbates.github.io>,  <https://github.com/tbates/umx>
 #' @md
 #' @examples
@@ -2591,6 +2591,43 @@ fin_interest <- function(principal = 0, deposits = 0, dinflate = 0, interest = 0
 }
 
 
+#' Compute NI given annual Earnings.
+#'
+#' @description
+#' Employees pay contributions at 12%% on annual earnings between £9,568 and £50,270. Above that you pay at 2%%. 
+#' Employers pay at 13.8%% on all annual earnings of more than £8,840, although there are different thresholds 
+#' for those under the age of 21 and for apprentices under the age of 25.
+#'
+#' @details
+#'
+#' @param annualEarnings Employee annual earnings.
+#' @return - NI
+#' @export
+#' @family Miscellaneous Functions
+#' @seealso - [fin_interest()]
+#' @references - <https://www.telegraph.co.uk/tax/tax-hacks/politicians-running-scared-long-overdue-national-insurance-overhaul>
+#' @md
+#' @examples
+#' fin_NI(42e3)
+#' fin_NI(142000)
+#'
+fin_NI <- function(annualEarnings, symbol="£") {
+	if(annualEarnings < 50270){
+		employee = .12 * max(0, (annualEarnings- 9568))
+	} else {
+		employee = (.12 * (annualEarnings- 9568)) + (.02 * (annualEarnings-50270))
+	}
+	employer = .138 * max((annualEarnings - 8840), 0)
+
+	Total = employer + employee
+	class(Total) = 'money'
+	attr(Total, 'symbol') <- symbol
+	cat(paste0("Employer pays: ", bucks(employer, sym=symbol, cat=FALSE), ", and employee pays ", bucks(employee, sym=symbol, cat=FALSE),
+	 ". so ", round((employer+employee)/annualEarnings*100, 2),	"%\n")
+	 )
+	return(Total)
+}
+
 #' Compute the percent change needed to return to the original value after percent off (or on).
 #'
 #' @description
@@ -2915,7 +2952,7 @@ umxPlotFun <- function(fun= dnorm, min= -1, max= 5, xlab = NULL, ylab = NULL, ti
 #' @param alpha for CI (default = 0.05)
 #' @return - List of odds in group 1 and group2, and the resulting OR and CI
 #' @export
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @seealso - [umx_r_test()]
 #' @references - <https://github.com/tbates/umx>, <https://tbates.github.io>
 #' @md
@@ -3011,7 +3048,7 @@ print.oddsratio <- function(x, digits = 3, ...) {
 #' @param type Unused argument for future directions
 #' @return - Matrix of correlations and p-values
 #' @seealso umxHetCor
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @export
 #' @references - <https://github.com/tbates/umx>
 #' @md
@@ -3074,7 +3111,7 @@ rowMin <- function(df, na.rm= TRUE) {
 #' @param digits how many digits to round to (defaults to getOption("digits"))
 #' @param coerce whether to make the column numeric if it is not (default = FALSE)
 #' @return - [mxModel()]
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @export
 #' @references - <https://github.com/tbates/umx>
 #' @md
@@ -3126,7 +3163,7 @@ umx_round <- function(df, digits = getOption("digits"), coerce = FALSE) {
 #' @param upper Upper CI
 #' @return - Standard error
 #' @export
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @seealso - [umxAPA()]
 #' @md
 #' @examples
@@ -3173,7 +3210,7 @@ specify_decimal <- function(x, k){
 #' @param S A square, symmetric, numeric covariance matrix
 #' @return None 
 #' @export
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @seealso - [umx::print.reliability()], 
 #' @references - <https://cran.r-project.org/package=Rcmdr>
 #' @examples
@@ -4188,7 +4225,7 @@ umx_check_names <- function(namesNeeded, data = NA, die = TRUE, no_others = FALS
 #' @param allowCorForFactorCovs When ordinal data are present, use heterochoric correlations in affected cells, in place of covariances. 
 #' @return - [mxModel()]
 #' @export
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @references - <https://tbates.github.io>
 #' @md
 #' @examples
@@ -4318,7 +4355,7 @@ umx_lower.tri <- function(x, diag=FALSE){
 #' @param na.rm passed to mean - defaults to "na.rm"
 #' @return - frame of means
 #' @export
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @examples
 #' tmp = mtcars[,1:4]
 #' tmp$cyl = ordered(mtcars$cyl) # ordered factor
@@ -5031,7 +5068,7 @@ umx_string_to_algebra <- function(algString, name = NA, dimnames = NA) {
 #' @return - new dataframe with scaled variables
 #' @export
 #' @seealso umx_scale_wide_twin_data scale
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @references - <https://github.com/tbates/umx>
 #' @md
 #' @examples
@@ -5759,7 +5796,7 @@ umx_rot <- function(vec, na.last=FALSE){
 #' @param x something that cov2cor can work on (matrix, df, etc.)
 #' @return - A correlation matrix
 #' @export
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @seealso [cov2cor()]
 #' @references - <https://github.com/tbates/umx>
 #' @examples
@@ -7344,7 +7381,7 @@ xmu_make_bin_cont_pair_data <- function(data, vars = NULL, suffixes=NULL){
 #' @param std.err Compute the SEs? (default = FALSE)
 #' @return - A matrix of correlations
 #' @family Data Functions
-#' @family Miscellaneous Stats Helpers
+#' @family Miscellaneous Stats Functions
 #' @export
 #' @md
 #' @examples