From 687f5bc92cdf2e73da97372492c09a91c75d1fa0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=98ystein=20S=C3=B8rensen?= Date: Fri, 28 Feb 2020 10:48:11 +0100 Subject: [PATCH] Created examples and cleaned up imports --- DESCRIPTION | 3 +- NAMESPACE | 17 ------ R/data.R | 5 ++ ...redict_asymmetry.R => predict_dominance.R} | 56 +++++++----------- R/utils-tidy-eval.R | 47 --------------- README.Rmd | 20 ++++++- README.md | 42 ++++++++++++- data/example_data1.rda | Bin 0 -> 207 bytes data/example_data2.rda | Bin 0 -> 4769 bytes man/example_data1.Rd | 14 +++++ man/example_data2.Rd | 14 +++++ man/predict_dominance.Rd | 41 ++++--------- man/tidyeval.Rd | 51 ---------------- 13 files changed, 128 insertions(+), 182 deletions(-) create mode 100644 R/data.R rename R/{predict_asymmetry.R => predict_dominance.R} (66%) delete mode 100644 R/utils-tidy-eval.R create mode 100644 data/example_data1.rda create mode 100644 data/example_data2.rda create mode 100644 man/example_data1.Rd create mode 100644 man/example_data2.Rd delete mode 100644 man/tidyeval.Rd diff --git a/DESCRIPTION b/DESCRIPTION index c8018a8..60ad7d7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,8 +15,7 @@ Imports: ICC (>= 2.3.0), purrr (>= 0.3.2), rlang (>= 0.3.4), tidyr (>= 0.8.3), - tmvtnorm (>= 1.4-10), - truncnorm (>= 1.0-8) + tmvtnorm (>= 1.4-10) Suggests: ggplot2 (>= 3.1.0), roxygen2, diff --git a/NAMESPACE b/NAMESPACE index 75c2d46..e97fcf5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,21 +1,4 @@ # Generated by roxygen2: do not edit by hand -export(":=") -export(.data) -export(as_label) -export(as_name) -export(enquo) -export(enquos) -export(expr) export(predict_dominance) -export(sym) -export(syms) -importFrom(rlang,":=") importFrom(rlang,.data) -importFrom(rlang,as_label) -importFrom(rlang,as_name) -importFrom(rlang,enquo) -importFrom(rlang,enquos) -importFrom(rlang,expr) -importFrom(rlang,sym) -importFrom(rlang,syms) diff --git a/R/data.R b/R/data.R new file mode 100644 index 0000000..62dc041 --- /dev/null +++ b/R/data.R @@ -0,0 +1,5 @@ +#' Example dataset with a single measurement of three individuals. +"example_data1" + +#' Example dataset with three measurements each on 100 individuals. +"example_data2" diff --git a/R/predict_asymmetry.R b/R/predict_dominance.R similarity index 66% rename from R/predict_asymmetry.R rename to R/predict_dominance.R index 9c86b62..307ea51 100644 --- a/R/predict_asymmetry.R +++ b/R/predict_dominance.R @@ -31,37 +31,23 @@ #' columns of \code{data}. #' @export #' @examples -#' ## Simple test dataset -#' data <- data.frame( -#' listening = c(-20, -23, -14), -#' handedness = "left", -#' stringsAsFactors = FALSE -#' ) -#' ## Compute predictions -#' predict_dominance(data) +#' # The package comes with two example datasets. +#' # The first contains single measurements on three subjects. +#' # We can first take a look at the data +#' example_data1 +#' # Next, compute predictions. +#' # Since there is no ID column, predict_dominance() will print a message telling +#' # the user that the rows are assumed to contain observations from different subjects. +#' predict_dominance(example_data1) #' -#' ## More interesting example, with multiple measurements per individual. -#' library(dplyr); library(purrr); library(tidyr); library(truncnorm) -#' ## First we sample test data -#' n <- 100 # number of individuals -#' reps <- 3 # number of measurements per individual -#' ## The distribution of subject means has standard deviation 10, and the -#' ## actual measurements for each subject are distributed with a standard -#' ## deviation of 10 around this mean. -#' set.seed(234) -#' data <- tibble( -#' ID = factor(1:n), -#' subject_mean = rtruncnorm(n, a = 0, b = 100, mean = 10, sd = 10), -#' handedness = "left") %>% -#' mutate( -#' listening = map(subject_mean, ~ rtruncnorm(reps, a = -100, b = 100, -#' mean = .x, sd = 10)) -#' ) %>% -#' unnest(listening) +#' # The next example dataset contains repeated measurements +#' example_data2 #' -#' predict_dominance(data) +#' # We compute the predictions as before: +#' predict_dominance(example_data2) #' #' +#' @importFrom rlang .data predict_dominance <- function(data, parameters = dplyr::tibble( dominance = rep(c("left", "right", "none"), each = 2), @@ -82,11 +68,11 @@ predict_dominance <- function(data, data$ID = as.character(seq(1, nrow(data), by = 1)) } - dat1 <- dplyr::select(data, .data$ID, .data$listening, .data$handedness) + dat1 <- dplyr::select_at(data, dplyr::vars("ID", "listening", "handedness")) dat1 <- dplyr::inner_join(dat1, parameters, by = "handedness") - dat1 <- dplyr::select(dat1, .data$ID, .data$handedness, .data$dominance, - .data$prob_dominance, .data$mean_li, .data$sd_li, .data$listening) - dat2 <- tidyr::nest(dat1, df = c(.data$listening, .data$mean_li, .data$sd_li)) + dat1 <- dplyr::select_at(dat1, dplyr::vars("ID", "handedness", "dominance", + "prob_dominance", "mean_li", "sd_li", "listening")) + dat2 <- tidyr::nest(dat1, df = c("listening", "mean_li", "sd_li")) dat3 <- dplyr::mutate(dat2, log_prob_listening = purrr::map_dbl(.data$df, function(x) { tmvtnorm::dtmvnorm(x$listening, @@ -100,10 +86,10 @@ predict_dominance <- function(data, log_posterior = log(.data$prob_dominance) + .data$log_prob_listening, probability = exp(.data$log_posterior) ) - dat4 <- dplyr::group_by(dat3, .data$ID) - dat5 <- dplyr::mutate(dat4, probability = .data$probability / sum(.data$probability)) + dat4 <- dplyr::group_by_at(dat3, dplyr::vars("ID")) + dat5 <- dplyr::mutate_at(dat4, dplyr::vars("probability"), ~ . / sum(.)) - dplyr::select(dplyr::ungroup(dat5), .data$ID, .data$handedness, - .data$dominance, .data$probability) + dplyr::select_at(dplyr::ungroup(dat5), dplyr::vars("ID", "handedness", + "dominance", "probability")) } diff --git a/R/utils-tidy-eval.R b/R/utils-tidy-eval.R deleted file mode 100644 index af7c474..0000000 --- a/R/utils-tidy-eval.R +++ /dev/null @@ -1,47 +0,0 @@ -#' Tidy eval helpers -#' -#' @description -#' -#' * \code{\link[rlang:quotation]{sym}()} creates a symbol from a string and -#' \code{\link[rlang:quotation]{syms}()} creates a list of symbols from a -#' character vector. -#' -#' * \code{\link[rlang:quotation]{enquo}()} and -#' \code{\link[rlang:quotation]{enquos}()} delay the execution of one or -#' several function arguments. \code{enquo()} returns a single quoted -#' expression, which is like a blueprint for the delayed computation. -#' \code{enquos()} returns a list of such quoted expressions. -#' -#' * \code{\link[rlang:quotation]{expr}()} quotes a new expression _locally_. It -#' is mostly useful to build new expressions around arguments -#' captured with [enquo()] or [enquos()]: -#' \code{expr(mean(!!enquo(arg), na.rm = TRUE))}. -#' -#' * \code{\link[rlang]{as_name}()} transforms a quoted variable name -#' into a string. Supplying something else than a quoted variable -#' name is an error. -#' -#' That's unlike \code{\link[rlang]{as_label}()} which also returns -#' a single string but supports any kind of R object as input, -#' including quoted function calls and vectors. Its purpose is to -#' summarise that object into a single label. That label is often -#' suitable as a default name. -#' -#' If you don't know what a quoted expression contains (for instance -#' expressions captured with \code{enquo()} could be a variable -#' name, a call to a function, or an unquoted constant), then use -#' \code{as_label()}. If you know you have quoted a simple variable -#' name, or would like to enforce this, use \code{as_name()}. -#' -#' To learn more about tidy eval and how to use these tools, visit -#' \url{https://tidyeval.tidyverse.org} and the -#' \href{https://adv-r.hadley.nz/metaprogramming.html}{Metaprogramming -#' section} of \href{https://adv-r.hadley.nz}{Advanced R}. -#' -#' @md -#' @name tidyeval -#' @keywords internal -#' @importFrom rlang expr enquo enquos sym syms .data := as_name as_label -#' @aliases expr enquo enquos sym syms .data := as_name as_label -#' @export expr enquo enquos sym syms .data := as_name as_label -NULL diff --git a/README.Rmd b/README.Rmd index a500cfe..89f227f 100644 --- a/README.Rmd +++ b/README.Rmd @@ -19,7 +19,7 @@ knitr::opts_chunk$set( [![Travis build status](https://travis-ci.org/LCBC-UiO/BayesianLaterality.svg?branch=master)](https://travis-ci.org/LCBC-UiO/BayesianLaterality) -The goal of BayesianLaterality is to predict latent hemispheric dominance based on observed laterality. +The goal of BayesianLaterality is to predict latent hemispheric dominance based on observed laterality using Bayes' theorem. ## Installation @@ -32,5 +32,23 @@ remotes::install_github("LCBC-UiO/BayesianLaterality") ``` +## Application Example + +```{r} +library(BayesianLaterality) +``` + + +The main (and only) function of the package is `predict_dominance()`. To see the arguments that can be set by the user and a more extended example, type `?predict_dominance` in the R terminal. Here is a simple example. The dataset `example_data1` contains three laterality measurements on three right-handed individuals. + +```{r} +example_data1 +``` + +We then obtain predicted hemispheric dominance as follows. The ID column reflects the row in the original dataset. + +```{r} +predict_dominance(example_data1) +``` diff --git a/README.md b/README.md index ea0f389..2847025 100644 --- a/README.md +++ b/README.md @@ -10,7 +10,7 @@ status](https://travis-ci.org/LCBC-UiO/BayesianLaterality.svg?branch=master)](ht The goal of BayesianLaterality is to predict latent hemispheric -dominance based on observed laterality. +dominance based on observed laterality using Bayes’ theorem. ## Installation @@ -21,3 +21,43 @@ with: # install.packages("remotes") remotes::install_github("LCBC-UiO/BayesianLaterality") ``` + +## Application Example + +``` r +library(BayesianLaterality) +``` + +The main (and only) function of the package is `predict_dominance()`. To +see the arguments that can be set by the user and a more extended +example, type `?predict_dominance` in the R terminal. Here is a simple +example. The dataset `example_data1` contains three laterality +measurements on three right-handed individuals. + +``` r +example_data1 +#> listening handedness +#> 1 20 right +#> 2 23 right +#> 3 14 right +``` + +We then obtain predicted hemispheric dominance as follows. The ID column +reflects the row in the original dataset. + +``` r +predict_dominance(example_data1) +#> No ID column in data, assuming one subject per row. +#> # A tibble: 9 x 4 +#> ID handedness dominance probability +#> +#> 1 1 right left 0.994 +#> 2 1 right right 0.00583 +#> 3 1 right none 0 +#> 4 2 right left 0.996 +#> 5 2 right right 0.00402 +#> 6 2 right none 0 +#> 7 3 right left 0.988 +#> 8 3 right right 0.0122 +#> 9 3 right none 0 +``` diff --git a/data/example_data1.rda b/data/example_data1.rda new file mode 100644 index 0000000000000000000000000000000000000000..0e504a9e6e83f8fbcf2be8aa3918395b27327fa7 GIT binary patch literal 207 zcmV;=05JbTT4*^jL0KkKS;URCj{pE~f587UNB{r@G=M|^5J11@+`vEp00Xc9xgn&O zH8mOxng^z)o`@NyrZ51}p`!@NpwXs)!6K4+Y7HKvKn8#SXs)@$CsgEOfjQL}2=MPf z`)#y>&dB`bLPEOG+UJ;wQ5rk-gpxFZU<@9%Dp(~ZlHs}mJqm<$LsAWBjjxX?>>6e# zlJX1|JL#d)Gc<-`ugQ@*1-z8(#HaD#Y_5u`orj@CXn1yOJrw JgoY$-tazn$U5Nky literal 0 HcmV?d00001 diff --git a/data/example_data2.rda b/data/example_data2.rda new file mode 100644 index 0000000000000000000000000000000000000000..07553df3c12df9bde5a73af186f2d89a41d1e8d4 GIT binary patch literal 4769 zcmai%_ct4kdXEAS8G&URAHJN?oo(WLP248 zzYh+VkDp$2hmO7UYH4)H6Z29Htpxwf2e)Zs_65pkkywN-xGC}CNlkoVVR40fXecHV z%D{lTEak*hEhuP)sMYN0Y9q18!3=CDrUp~URz3t@$-F`0F68EoOq;_H9OXMtrBLtJ}27SzX zuD^!F@*-HP-!Lr5F`k8%Plf;23dX!sK0HMz#;Gg z%6SNt5Vxckty=*?8i|n0=8qw~kXG_S)L>BOx*CQ2F*tT4ZUvpHR#WZU|cJ{@@>Sr}3SeeGkIu6Mx-6{uKAg(}XKD=y>SivM#7<^gOp z3jj6<0Ki!?8ybV7q5=@dC<3Se|FuE@cqRX(LWm;)>;_T%Kz2=C?RZ}BmIQ>bxWutQ z0*b`l*6fFa6$})FLQ|8Hpt@8H+Ev4E1my}Hy^uKU1bpHRe`)DfYR!HqVjoRJ(uRpf zyQ}S$Unqt;kyKwu>xH5VQ8NODSh~?7Kg}Le#*voSB-xpUVo%Q$W6^1E5kha-O!GJx z1177;P{)~*0SAc2mt)U0lU7~$vkP_wD3(D*0?F&I#73_b_40lL^ch`V7%)~54zWn) zV}vNV4eT_tDeXSOk|flEUv5;7<&UsAq=Xn7vl8@6@~i(!DL_eL!i|&s#Q9Zbm&lq* zzzop=xmR8{C!RTv4%()fRqEgO15NJ=O4OP{mP?BZWZUmc-} zVtHh2ymmpBBVURm_Xj+Y7*Lkjxcta3xma@X!JI%ktMPi>Qc7=`V?_ozCVgIYn6iu4-$+ZohXE!OP#e zd2#?ZeP@|;PfcdhzDz#}inVb2+i3!vGB=P5YoYP{n45hfyjAQx7@_G&9tIs^IfK?G z4Do^!Nho-va+W>ec%~Pt!-vJ4IsM~%`*p=y%pC#=W_DE>yZTaW@8@WHSh-)V+p17J zf+Xs5us-#VZmx*+0HdyBc({Seys|Fzk%OEs)YGyWVz#vN(R68n3bg(MZ>uDJM4b#61E;Nglu%!N3y=;kysVud1`c%J1w zJS{L`uikp9w)a)*S`w;dHEJ&_F({O{D;hW2o44(#s6Q~cOaVqysV(INwX-`xo1{6DT5JDd*5-%X1-l|B zzx2~TLfUtoblVx|i^>^Y@tDCm`@mjr34E;@+;g@#%Wqx;86(qpidV z&8XW{7%O!QP?aL~1>3D;qoU*a^6$RFCFIA6qR%z5`Lzoq9VfFn5RI@b(*%Px%DmD5 z$NRXxI@*j8O7Rg&Q@b=&tWeSBd;Ki5orp3Sf&r<94%tPA>^s_|iqmG=&eez$M8!5B zLM^+TSA+3k|J#L}iYx=>)#Hq{AKfVln@a=6Ddqd#cHHqScJYtIN2W7!n=^rhObzD` z`Ps(fmn>uSNy}af{*NWkVtpVV#R%zThW2E-HaC}Wn_C7cF#3PUV_{@k60N93^2ti6 zbUdM9o@2BM6e2?G5tT7=P8I#Lo(Y3zno(gN&va75%O2Np={9R6>252;@V4nLX=?7Z zy0nd|EG?36nxV&#TNzT~TQ;QYGX=FYJozp@av)&}x9pK*5BtS1^1S-rRdOml7@7E| zLZ-RHy;;sS<=Og`p&U>wz*6(%oge0lF9bd0ED%{-N4I>E!w8!)W=w>ge9;-HaRb> zwajj_dvh^NZKls)R(HDy4vt}fX`E>Wx=K zWIC^jsXxIAfm{62lizE*OHID+%v};{K5R9!p|#FWHu$?-;;k+Ak-#TF&wk~nBgTcE zli=XOUvO>V8>5GcJFqO^dXZZon3Y=7LUsBPedpey=%-ak*tF&x+k;P4$Hr5!;=^Um zO2Ttb_jq;Dq7U2mxX`cRao46-P_n7l0opWmt=I%v@P%E2m6xfuk67NCPdeT^A%1QFfs(3U}8Z_o@F}ufaIXWQP=of7KJq(&|exys#P4a;v zpXR`bcY)kylot7W>^QdK5~hgxK}7pl@A(sQhhGkP>~hpp=-{n__xZy9m3%9~+l}9T z7;@Ext>p^zeqOvLNwmEbP-yb6MC6o?i8gR?^mF*Ux$pXiQi7umF=9UGZ5mB#u$*sm zSQ&VoP3TkLu6a|U(df>XyM!s( zFN(5F^f;NLR96S5!~#ZVU+TbyXo^s$(YaYB;@#FFtc454=(~F68CA)W7o~io zO5ZMVO1CK+QGWrg=lM)C{NO7H%uA7%%aBz7>;bK}a(bOO95xRd37QB3H95NvG*aTQGR+@8W$v-M8bxZLJZYrz)5%i)FuU%yKPvN%Q`Uc$cT8d^`0qjv{3K=BnqJ z12QxBcICKN^aIgKA43g3{lc7l1=OZ)`gtc)^Tm_pXW`Z#Uf*PJi%bfqU;SNrj-(6! z7Ji?Al6dkmhGNgZbFXYeZB;ZbeCOe+a=fKB_hXV=`m~kzt^p(;haAs$#b51;>nRX5 zUw^>%AEo=9T>iwTANylugEh1b;|eNWcO#40Fq6pX?&Ihdpq@*%Gt`>CIxcdnhhs@45=ptxPf_J-*?u>W*lOl$V4J;nN$=TW| zuWzlaNsh&ueYZ02LV!rMLOyoR*d6j=RiS^I^ZS?N2i@>}tv&)j*5%2E`Hh5$QoR$g z;#0)IQvQzQ$p7`@N-oyTI_vp?n(u=Ut_U-Ag}&HyK>ZVRjq(clv`)^gaisQZ3G{oM zrw;U+fjsh4@>8Cg!*R_BKEl!$jT2s*zVNz-<8(zWfBAfozph@gf*uRxDXy_4D79VVD-|kHV306+d+Oc-3uF2lHg3%M_1fm z;?g%LmB|5Rh+4&3I~8LoP*jn4Cb+1tZ&rLd&^fPkt@G&*PnO+-htscvcXWNLd)$N=oopS+c-M zwd~ze!7nzn2!4{yNES_I>5?apxRC*Dy11z(;WC~xA<_(betmNkC@v;DKF39bXWzB?9p*{I4PP1 zSP}TV?noiV%(e`hDc!Vz+l3qag{Wzh;=Qw}r2fI~M5Sty`*uV_#n`&><=6E0f81x) zAJHl41R80@mXc*g%b|$b%<4z&1_Zx-VKcu}f>FbN5(7KvuPmixe4~DK^P1Y5UsD2K zz0!SS!ACESPe)2W%_q&eCA4HmAm;h_2Bk6#eu>xAY6WkTRQVYYt(Rs#{(9H;lP<+g zU?#-&^6Q*?Klg5dhUy!L}ylq(8g)?4VCc}GaT5h)56$%QN@5I^m z>`e63(->xkQDO0dEBGWGKT!IHUn}_{?d0pt8;yag10t~iCoTFBJO!<(7Oe-D<#eC(J!&63a7H;<^5Zs8^931rNB zCRq(Okr2CRC~11!RzH2>BYjBxb%SqO6bCn#mr3sL_IhY}gAw zNJU@Qwsl?W?Axo2qy_}-j10;c1#jx_n!=a$8k>rGnP=YuNcSvyH-$%t@v%hKX!yud zX7<;$J1>J(znxOMlw(=wAG$u7!|PrrdC6$Zy{s5vp0_nZyD;}`>nAb6FGaWM#RFx} z6`5O4k1DsRvh%AVR0_VAyLq;QHPS^O&h$s8RWd3)%a)V+RihbNy z-z3J-oj@~05mJptginY@LGMQaGcQuI?>kY~@ik?to3mJ8axl@ieJN4a#9-QChGz25aG-&G6(@kvubnuHf`aj2dk)+HCEsh^Z3 zA2dLH?zC6`n&t4vLdl12dcIHWd&Sgw&u`T~?|=K~E!mqGZ#w5nh4V^v^0zxZ@iiLv z99p)0mHn0qu{cXnXvKaLucxHb&g-EzXm;>eFZ}rDySSbf`84+|hkuo5YoVEv\% - mutate( - listening = map(subject_mean, ~ rtruncnorm(reps, a = -100, b = 100, - mean = .x, sd = 10)) - ) \%>\% - unnest(listening) +# The next example dataset contains repeated measurements +example_data2 -predict_dominance(data) +# We compute the predictions as before: +predict_dominance(example_data2) } diff --git a/man/tidyeval.Rd b/man/tidyeval.Rd deleted file mode 100644 index 5b97416..0000000 --- a/man/tidyeval.Rd +++ /dev/null @@ -1,51 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils-tidy-eval.R -\name{tidyeval} -\alias{tidyeval} -\alias{expr} -\alias{enquo} -\alias{enquos} -\alias{sym} -\alias{syms} -\alias{.data} -\alias{:=} -\alias{as_name} -\alias{as_label} -\title{Tidy eval helpers} -\description{ -\itemize{ -\item \code{\link[rlang:quotation]{sym}()} creates a symbol from a string and -\code{\link[rlang:quotation]{syms}()} creates a list of symbols from a -character vector. -\item \code{\link[rlang:quotation]{enquo}()} and -\code{\link[rlang:quotation]{enquos}()} delay the execution of one or -several function arguments. \code{enquo()} returns a single quoted -expression, which is like a blueprint for the delayed computation. -\code{enquos()} returns a list of such quoted expressions. -\item \code{\link[rlang:quotation]{expr}()} quotes a new expression \emph{locally}. It -is mostly useful to build new expressions around arguments -captured with \code{\link[=enquo]{enquo()}} or \code{\link[=enquos]{enquos()}}: -\code{expr(mean(!!enquo(arg), na.rm = TRUE))}. -\item \code{\link[rlang]{as_name}()} transforms a quoted variable name -into a string. Supplying something else than a quoted variable -name is an error. - -That's unlike \code{\link[rlang]{as_label}()} which also returns -a single string but supports any kind of R object as input, -including quoted function calls and vectors. Its purpose is to -summarise that object into a single label. That label is often -suitable as a default name. - -If you don't know what a quoted expression contains (for instance -expressions captured with \code{enquo()} could be a variable -name, a call to a function, or an unquoted constant), then use -\code{as_label()}. If you know you have quoted a simple variable -name, or would like to enforce this, use \code{as_name()}. -} - -To learn more about tidy eval and how to use these tools, visit -\url{https://tidyeval.tidyverse.org} and the -\href{https://adv-r.hadley.nz/metaprogramming.html}{Metaprogramming -section} of \href{https://adv-r.hadley.nz}{Advanced R}. -} -\keyword{internal}