workloopR - package reviewThis report contains documents associated with the review of rOpenSci submitted package:
workloopR: ropensci/software-review issue #326.Description:
Functions for the import, transformation, and analysis of data from muscle physiology experiments. The work loop technique is used to evaluate the mechanical work and power output of muscle. Josephson (1985) https://jeb.biologists.org/content/114/1/493 modernized the technique for application in comparative biomechanics. Although our initial motivation was to provide functions to analyze work loop experiment data, as we developed the package we incorporated the ability to analyze data from experiments that are often complementary to work loops. There are currently three supported experiment types: work loops, simple twitches, and tetanus trials. Data can be imported directly from .ddf files or via an object constructor function. Through either method, data can then be cleaned or transformed via methods typically used in studies of muscle physiology. Data can then be analyzed to determine the timing and magnitude of force development and relaxation (for isometric trials) or the magnitude of work, net power, and instantaneous power among other things (for work loops). Although we do not provide plotting functions, all resultant objects are designed to be friendly to visualization via either base-R plotting or βtidyverseβ functions.
Author: Vikram B. Baliga vbaliga87@gmail.com [cre, aut] (https://orcid.org/0000-0002-9367-8974), Shreeram Senthivasan shreeramsenthi@gmail.com [aut] (https://orcid.org/0000-0002-7118-9547)
repo url: https://github.com/vbaliga/workloopR
website url: https://vbaliga.github.io/workloopR/
key review checks:
Please be respectful and kind to the authors in your reviews. The rOpenSci code of conduct is mandatory for everyone involved in our review process.
sessionInfo()
#> R version 3.6.1 (2019-07-05)
#> Platform: x86_64-pc-linux-gnu (64-bit)
#> Running under: Ubuntu 18.04.3 LTS
#>
#> Matrix products: default
#> BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.7.1
#> LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.7.1
#>
#> locale:
#> [1] LC_CTYPE=en_DK.UTF-8 LC_NUMERIC=C
#> [3] LC_TIME=nb_NO.UTF-8 LC_COLLATE=en_DK.UTF-8
#> [5] LC_MONETARY=nb_NO.UTF-8 LC_MESSAGES=en_DK.UTF-8
#> [7] LC_PAPER=nb_NO.UTF-8 LC_NAME=C
#> [9] LC_ADDRESS=C LC_TELEPHONE=C
#> [11] LC_MEASUREMENT=nb_NO.UTF-8 LC_IDENTIFICATION=C
#>
#> attached base packages:
#> [1] stats graphics grDevices utils datasets methods base
#>
#> other attached packages:
#> [1] devtools_2.2.1 usethis_1.5.1 magrittr_1.5
#>
#> loaded via a namespace (and not attached):
#> [1] Rcpp_1.0.2 knitr_1.25 pkgload_1.0.2
#> [4] R6_2.4.0 rlang_0.4.0 stringr_1.4.0
#> [7] tools_3.6.1 pkgbuild_1.0.5 xfun_0.10
#> [10] sessioninfo_1.1.1 cli_1.1.0 withr_2.1.2
#> [13] remotes_2.1.0 htmltools_0.4.0 ellipsis_0.3.0
#> [16] rprojroot_1.3-2 yaml_2.2.0 digest_0.6.21
#> [19] assertthat_0.2.1 crayon_1.3.4 processx_3.4.1
#> [22] callr_3.3.2 fs_1.3.1 ps_1.3.0
#> [25] testthat_2.2.1 memoise_1.1.0 glue_1.3.1
#> [28] evaluate_0.14 rmarkdown_1.16 stringi_1.4.3
#> [31] compiler_3.6.1 backports_1.1.5 desc_1.2.0
#> [34] prettyunits_1.0.2workloopR install:install(pkg_dir, dependencies = T, build_vignettes = T)
#>
#>
checking for file β/home/jro049/Naukowe/automated_review_workloopR/workloopR/DESCRIPTIONβ ...
β checking for file β/home/jro049/Naukowe/automated_review_workloopR/workloopR/DESCRIPTIONβ
#>
β preparing βworkloopRβ:
#>
checking DESCRIPTION meta-information ...
β checking DESCRIPTION meta-information
#>
β installing the package to build vignettes
#>
creating vignettes ...
β creating vignettes (9.9s)
#>
β checking for LF line-endings in source and make files and shell scripts
#>
β checking for empty or unneeded directories
#>
β building βworkloopR_1.0.1.tar.gzβ
#>
Warning: invalid uid value replaced by that for user 'nobody'
#>
#>
Running /usr/lib/R/bin/R CMD INSTALL \
#> /tmp/Rtmp9ESOfr/workloopR_1.0.1.tar.gz --install-tests
#> * installing to library β/home/jro049/R/x86_64-pc-linux-gnu-library/3.6β
#> * installing *source* package βworkloopRβ ...
#> ** using staged installation
#> ** R
#> ** inst
#> ** tests
#> ** byte-compile and prepare package for lazy loading
#> ** help
#> *** installing help indices
#> ** building package indices
#> ** installing vignettes
#> ** testing if installed package can be loaded from temporary location
#> ** testing if installed package can be loaded from final location
#> ** testing if installed package keeps a record of temporary installation path
#> * DONE (workloopR)remove.packages("workloopR")
#> Removing package from '/home/jro049/R/x86_64-pc-linux-gnu-library/3.6'
#> (as 'lib' is unspecified)workloopR from GitHub with:devtools::install_github("vbaliga/workloopR", dependencies = T, build_vignettes = T)
#> Downloading GitHub repo vbaliga/workloopR@master
#>
#>
checking for file β/tmp/Rtmp9ESOfr/remotes6cfc385f79b9/vbaliga-workloopR-51ca633/DESCRIPTIONβ ...
β checking for file β/tmp/Rtmp9ESOfr/remotes6cfc385f79b9/vbaliga-workloopR-51ca633/DESCRIPTIONβ
#>
β preparing βworkloopRβ:
#> checking DESCRIPTION meta-information ...
β checking DESCRIPTION meta-information
#>
β installing the package to build vignettes
#>
creating vignettes ...
β creating vignettes (10s)
#>
β checking for LF line-endings in source and make files and shell scripts
#>
β checking for empty or unneeded directories
#>
β building βworkloopR_1.0.1.tar.gzβ
#>
Warning: invalid uid value replaced by that for user 'nobody'
#>
#>
#> Installing package into '/home/jro049/R/x86_64-pc-linux-gnu-library/3.6'
#> (as 'lib' is unspecified)workloopR source:devtools::check(pkg_dir)
#> Updating workloopR documentation
#> Warning: Version of roxygen2 last used with this package is 6.1.1.9000. You
#> only have version 6.1.1
#> Writing NAMESPACE
#> Loading workloopR
#> Writing NAMESPACE
#> ββ Building βββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββ workloopR ββ
#> Setting env vars:
#> β CFLAGS : -Wall -pedantic
#> β CXXFLAGS : -Wall -pedantic
#> β CXX11FLAGS: -Wall -pedantic
#> ββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββ
#>
checking for file β/home/jro049/Naukowe/automated_review_workloopR/workloopR/DESCRIPTIONβ ...
β checking for file β/home/jro049/Naukowe/automated_review_workloopR/workloopR/DESCRIPTIONβ
#>
β preparing βworkloopRβ:
#>
checking DESCRIPTION meta-information ...
β checking DESCRIPTION meta-information
#>
β installing the package to build vignettes
#>
creating vignettes ...
β creating vignettes (10.8s)
#>
β checking for LF line-endings in source and make files and shell scripts
#>
β checking for empty or unneeded directories
#>
β building βworkloopR_1.0.1.tar.gzβ
#>
Warning: invalid uid value replaced by that for user 'nobody'
#>
#>
ββ Checking βββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββ workloopR ββ
#> Setting env vars:
#> β _R_CHECK_CRAN_INCOMING_USE_ASPELL_: TRUE
#> β _R_CHECK_CRAN_INCOMING_REMOTE_ : FALSE
#> β _R_CHECK_CRAN_INCOMING_ : FALSE
#> β _R_CHECK_FORCE_SUGGESTS_ : FALSE
#> ββ R CMD check ββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββ
#> * using log directory β/tmp/Rtmp9ESOfr/workloopR.Rcheckβ
#> * using R version 3.6.1 (2019-07-05)
#> * using platform: x86_64-pc-linux-gnu (64-bit)
#> * using session charset: UTF-8
#> * using options β--no-manual --as-cranβ
#> * checking for file βworkloopR/DESCRIPTIONβ ... OK
#> * checking extension type ... Package
#> * this is package βworkloopRβ version β1.0.1β
#> * package encoding: UTF-8
#> * checking package namespace information ... OK
#> * checking package dependencies ... OK
#> * checking if this is a source package ... OK
#> * checking if there is a namespace ... OK
#> * checking for executable files ... OK
#> * checking for hidden files and directories ... OK
#> * checking for portable file names ... OK
#> * checking for sufficient/correct file permissions ... OK
#> * checking serialization versions ... OK
#> * checking whether package βworkloopRβ can be installed ... OK
#> * checking installed package size ... OK
#> * checking package directory ... OK
#> * checking for future file timestamps ... OK
#> * checking βbuildβ directory ... OK
#> * checking DESCRIPTION meta-information ... OK
#> * checking top-level files ... OK
#> * checking for left-over files ... OK
#> * checking index information ... OK
#> * checking package subdirectories ... OK
#> * checking R files for non-ASCII characters ... OK
#> * checking R files for syntax errors ... OK
#> * checking whether the package can be loaded ... OK
#> * checking whether the package can be loaded with stated dependencies ... OK
#> * checking whether the package can be unloaded cleanly ... OK
#> * checking whether the namespace can be loaded with stated dependencies ... OK
#> * checking whether the namespace can be unloaded cleanly ... OK
#> * checking loading without being on the library search path ... OK
#> * checking dependencies in R code ... OK
#> * checking S3 generic/method consistency ... OK
#> * checking replacement functions ... OK
#> * checking foreign function calls ... OK
#> * checking R code for possible problems ... OK
#> * checking Rd files ... OK
#> * checking Rd metadata ... OK
#> * checking Rd line widths ... OK
#> * checking Rd cross-references ... OK
#> * checking for missing documentation entries ... OK
#> * checking for code/documentation mismatches ... OK
#> * checking Rd \usage sections ... OK
#> * checking Rd contents ... OK
#> * checking for unstated dependencies in examples ... OK
#> * checking installed files from βinst/docβ ... OK
#> * checking files in βvignettesβ ... OK
#> * checking examples ... OK
#> * checking for unstated dependencies in βtestsβ ... OK
#> * checking tests ...
#> Running βtestthat.Rβ
#> OK
#> * checking for unstated dependencies in vignettes ... OK
#> * checking package vignettes in βinst/docβ ... OK
#> * checking re-building of vignette outputs ... OK
#> * DONE
#>
#> Status: OK
#> ββ R CMD check results βββββββββββββββββββββββββββββββ workloopR 1.0.1 ββββ
#> Duration: 26.2s
#>
#> 0 errors β | 0 warnings β | 0 notes βworkloopR source:devtools::test(pkg_dir)
#> Loading workloopR
#>
#> Attaching package: 'testthat'
#> The following object is masked from 'package:devtools':
#>
#> test_file
#> The following objects are masked from 'package:magrittr':
#>
#> equals, is_less_than, not
#> Testing workloopR
#> β | OK F W S | Context
#>
β | 0 | selecting cycles
β Ή | 3 | selecting cycles
β | 10 | selecting cycles [0.2 s]
#>
β | 0 | analyzing workloops
β | 9 | analyzing workloops
#>
β | 0 | summarizing multiple analyzed workloop trials
β | 1 | summarizing multiple analyzed workloop trials
β | 3 | summarizing multiple analyzed workloop trials [0.2 s]
#>
β | 0 | time correcting for muscle degradation
β | 3 | time correcting for muscle degradation
#>
β | 0 | importing manually
β | 16 | importing manually
#>
β | 0 | timing isometric data
β | 2 | timing isometric data
β | 7 | timing isometric data [0.1 s]
#>
β | 0 | printing muscle_stim objects
β | 1 | printing muscle_stim objects
β | 5 | printing muscle_stim objects [0.1 s]
#>
β | 0 | summarizing muscle_stim objects# Workloop Data:
#>
#>
#> File ID: workloop.ddf
#> Mod Time (mtime): 2019-10-08 11:35:12
#> Sample Frequency: 10000Hz
#>
#> data.frame Columns:
#> Position (mm)
#> Force (mN)
#> Stim (TTL)
#> Cycle (letters)
#> Inst_Velocity (m/s)
#> Filt_Velocity (m/s)
#> Inst_Power (W)
#> Percent_of_Cycle (NA)
#>
#> Stimulus Offset: 0.012s
#> Stimulus Frequency: 300Hz
#> Stimulus Width: 0.2ms
#> Stimulus Pulses: 4
#> Gear Ratio: 1
#>
#> Cycle Frequency: 28Hz
#> Total Cycles (L0-to-L0): 6
#> Cycles Retained: 3
#> Amplitude: 3.15mm
#>
#>
#> Cycle Work Net_Power
#> a A 0.002263076 0.06903262
#> b B 0.002708145 0.08220278
#> c C 0.003007098 0.09085517
#>
β | 6 | summarizing muscle_stim objects
#>
β | 0 | reading and analyzing single ddf files
β | 5 | reading and analyzing single ddf files
#>
β | 0 | reading and analyzing ddf files by directory
β | 2 | reading and analyzing ddf files by directory
β Ή | 3 | reading and analyzing ddf files by directory
β | 4 | reading and analyzing ddf files by directory [0.3 s]
#>
β | 0 | importing ddf files
β ¦ | 7 | importing ddf files
β | 19 | importing ddf files [0.1 s]
#>
β | 0 | importing ddf files by directory
β Ή | 3 | importing ddf files by directory
β | 7 | importing ddf files by directory [0.2 s]
#>
β | 0 | pulling metadata
β | 2 | pulling metadata
#>
β | 0 | transforming muscle_stim objects
β | 10 | transforming muscle_stim objects
#>
β | 0 | transformation
β | 1 | transformation
#>
#> ββ Results βββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββ
#> Duration: 1.5 s
#>
#> OK: 107
#> Failed: 0
#> Warnings: 0
#> Skipped: 0workloopR for goodpractice:goodpractice::gp(pkg_dir)
#> Preparing: covr
#> Preparing: cyclocomp
#>
#>
checking for file β/tmp/Rtmp9ESOfr/remotes6cfc65bb947b/workloopR/DESCRIPTIONβ ...
β checking for file β/tmp/Rtmp9ESOfr/remotes6cfc65bb947b/workloopR/DESCRIPTIONβ
#>
β preparing βworkloopRβ:
#>
checking DESCRIPTION meta-information ...
β checking DESCRIPTION meta-information
#>
checking vignette meta-information ...
β checking vignette meta-information
#>
β checking for LF line-endings in source and make files and shell scripts
#>
β checking for empty or unneeded directories
#>
β building βworkloopR_1.0.1.tar.gzβ
#>
Warning: invalid uid value replaced by that for user 'nobody'
#>
#>
#> Preparing: description
#> Preparing: lintr
#> Preparing: namespace
#> Preparing: rcmdcheck
#> ββ GP workloopR βββββββββββββββββββββββββββββββββββββββββββββββββββββββββββ
#>
#> It is good practice to
#>
#> β use '<-' for assignment instead of '='. '<-' is the standard,
#> and R users and developers are used it and it is easier to
#> read your code for them if you use '<-'.
#>
#> R/data_analysis_functions.R:61:4
#> R/data_analysis_functions.R:63:11
#> R/data_analysis_functions.R:476:13
#> R/data_import_functions.R:275:11
#>
#> β avoid long code lines, it is bad for readability. Also, many
#> people prefer editor windows that are about 80 characters
#> wide. Try make your lines shorter than 80 characters
#>
#> R/data_analysis_functions.R:132:1
#> R/data_analysis_functions.R:224:1
#> R/data_analysis_functions.R:228:1
#> R/data_analysis_functions.R:249:1
#> R/data_analysis_functions.R:250:1
#> ... and 98 more lines
#>
#> β avoid sapply(), it is not type safe. It might return a vector,
#> or a list, depending on the input data. Consider using
#> vapply() instead.
#>
#> R/data_analysis_functions.R:506:15
#> R/data_analysis_functions.R:507:17
#> R/data_analysis_functions.R:516:7
#> R/data_analysis_functions.R:518:7
#> R/data_import_functions.R:582:26
#> ... and 24 more lines
#>
#> β avoid 1:length(...), 1:nrow(...), 1:ncol(...), 1:NROW(...) and
#> 1:NCOL(...) expressions. They are error prone and result 1:0
#> if the expression on the right hand side is zero. Use
#> seq_len() or seq_along() instead.
#>
#> R/data_import_functions.R:275:13
#> R/data_import_functions.R:605:32
#>
#> β fix this R CMD check WARNING: LaTeX errors when creating PDF
#> version. This typically indicates Rd problems.
#> βββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββdevtools::spell_check(pkg_dir)
#> DESCRIPTION does not contain 'Language' field. Defaulting to 'en-US'.online documentation: https://vbaliga.github.io/workloopR/
workloopR function help files:help(package = "workloopR")workloopR vignettes:vignette(package = "workloopR")
#> no vignettes foundlibrary("workloopR")exports <-ls("package:workloopR")
exports
#> [1] "analyze_workloop" "as_muscle_stim"
#> [3] "fix_GR" "get_wl_metadata"
#> [5] "invert_position" "isometric_timing"
#> [7] "library.dynam.unload" "muscle_stim"
#> [9] "print_muscle_stim_header" "print.analyzed_workloop"
#> [11] "print.muscle_stim" "read_analyze_wl"
#> [13] "read_analyze_wl_dir" "read_ddf"
#> [15] "read_ddf_dir" "read_tetanus.ddf"
#> [17] "read_twitch.ddf" "read_wl.ddf"
#> [19] "rescale_data" "select_cycles"
#> [21] "summarize_wl_trials" "summary.analyzed_workloop"
#> [23] "summary.muscle_stim" "summary.tetanus"
#> [25] "summary.workloop" "system.file"
#> [27] "tetanus" "time_correct"
#> [29] "trapezoidal_integration" "twitch"
#> [31] "workloop"pkgreviewr::pkgreview_print_source("workloopR")
#> ## analyze_workloop
#> function(x,
#> simplify = FALSE,
#> GR = 1,
#> M = -1,
#> vel_bf = 0.05,
#> ...){
#> if(!any(class(x)=="workloop"))
#> stop("Input data should be of class `workloop`")
#> if(!any(names(x)=='Cycle'))
#> stop('The Cycle column is missing with no default. Please use select_cycles() to generate this column or check that the column is named correctly.')
#> if(!is.numeric(GR))
#> stop('Gear ratio (GR) must be numeric')
#> if(!is.numeric(M))
#> stop('Velocity multiplier (M) must be numeric and is recommended to be either -1 or 1.')
#>
#> # transform variables
#> x<-fix_GR(x,GR)
#>
#> # first chop up the data by cycle:
#> cycle_names<-unique(x$Cycle)
#> x_by_cycle<-lapply(cycle_names,function(cycle)x[x$Cycle==cycle,])
#>
#> # create a percent cycle index column
#> percent_of_cycle<-lapply(x_by_cycle,function(x)seq(0,100,100/(nrow(x)-1)))
#>
#> # work is calculated as the path integral of Force with respect to Position
#> # (displacement)
#> # Position and Force are each divided by 1000 to convert mm to meters and mN
#> # to N prior to taking the integral. This ensures that the integral reports
#> # work in J. The negative is used to match conventions for work
#> work<-lapply(x_by_cycle,function(x)-trapezoidal_integration(x$Position/1000,
#> x$Force/1000))
#> names(work)<-cycle_names
#>
#> # velocity is the instantanous change in length (i.e. position) multiplied by sampling frequency
#> # the result is divided by 1000 to convert to m/s and multiplied by the velocity multiplier, M
#> velocity<-lapply(x_by_cycle,function(x)(x$Position-c(NA,utils::head(x$Position,-1)))*attributes(x)$sample_frequency/1000*M)
#>
#> # apply a butterworth filter to velocity to smooth it out a bit
#> buttah<-signal::butter(2,vel_bf)
#> filt_velocity<-lapply(velocity,function(v)c(NA,signal::filtfilt(buttah,v[-1])))
#>
#> # instantaneous power is calculated as the product of instantaneous velocity
#> # and force. However since velocity is calculated between two time points,
#> # corresponding pairs of force measurements are averaged first
#> # the result is divided by 1000 to convert mW to W
#> instant_power<-mapply(function(x,v)x$Force*v/1000,x_by_cycle,filt_velocity,
#> SIMPLIFY=FALSE)
#>
#> # net power is simply the mean of all instantaneous power
#> net_power<-lapply(instant_power,mean,na.rm=TRUE)
#>
#> # Early escape for simplified output
#> summary_table<-data.frame(
#> Cycle=paste0(toupper(cycle_names)),
#> Work=unlist(work),
#> Net_Power=unlist(net_power)
#> )
#> if(simplify) return(summary_table)
#>
#> # combine everything into one useful object
#> result<-mapply(
#> function(x,v,filt_v,w,inst_p,net_p,perc){
#> x$Inst_Velocity<-v
#> x$Filt_Velocity<-filt_v
#> x$Inst_Power<-inst_p
#> x$Percent_of_Cycle<-perc
#> attr(x,"work")<-w
#> attr(x,"net_power")<-net_p
#> if(!all(is.na(attr(x,"units"))))
#> attr(x,"units")<-c(attr(x,"units"),"m/s","m/s","W")
#> x
#> },
#> x_by_cycle,
#> velocity,
#> filt_velocity,
#> work,
#> instant_power,
#> net_power,
#> percent_of_cycle,
#> SIMPLIFY=FALSE)
#> attr(x,"row.names")<-attr(x,"names")<-NULL
#> attributes(result)<-attributes(x)
#> attr(result,"summary")<-summary_table
#> class(result)<-c("analyzed_workloop","list")
#>
#> stats::setNames(result,paste0("cycle_",cycle_names))
#> }
#> <bytecode: 0x5651cc021ec8>
#> <environment: namespace:workloopR>
#> ---
#>
#> ## as_muscle_stim
#> function(x,
#> type,
#> sample_frequency,
#> ...){
#> # Check for missing information
#> if(missing(type))stop("Please specify the experiment type! The type argument should be one of: workloop, tetanus, or twitch.")
#> if(!(type %in% c("workloop","tetanus","twitch"))|length(type)!=1)
#> stop("Invalid experiment type! The type argument should be one of: workloop, tetanus, or twitch.")
#> if(!all(c("Position","Force","Stim") %in% names(x)))
#> stop("Couldn't find one or more of the following necessary columns: Position, Force, Stim. Please ensure that the columns match the naming conventions.")
#> if(missing(sample_frequency)&!("Time" %in% names(x)))
#> stop("Insufficient information to infer the sampling frequency. Please provide a value for the sample_frequency argument or include a column named `Time` in the dataframe.")
#>
#> # Consolidate time / sample frequency information
#> if(!missing(sample_frequency))
#> x$Time=(1:nrow(x)-1)/sample_frequency
#> else
#> sample_frequency<-1/(x$Time[2]-x$Time[1])
#>
#> # Generate a list of acceptable attributes given experiment type
#> valid_args <-
#> c(
#> "units",
#> "header",
#> "units_table",
#> "protocol_table",
#> "stim_table",
#> "stimulus_pulses",
#> "stimulus_offset",
#> "stimulus_width",
#> "gear_ratio",
#> "file_id",
#> "mtime"
#> )
#> switch(
#> type,
#> "workloop" = valid_args <-
#> c(
#> valid_args,
#> "stimulus_frequency",
#> "cycle_frequency",
#> "total_cycles",
#> "cycle_def",
#> "amplitude",
#> "phase",
#> "position_inverted"
#> ),
#> "tetanus" = valid_args <-
#> c(valid_args, "stimulus_frequency", "stimulus_length")
#> )
#>
#> # Check for invalid attributes and assign valids
#> args<-list(...)
#> if(!all(names(args) %in% valid_args))
#> warning("One or more provided attributes do not match known attributes. These will attributes will not be assigned.")
#> for(i in intersect(names(args),valid_args))
#> attr(x,i)<-args[[i]]
#> for(i in setdiff(valid_args,names(args)))
#> attr(x,i)<-NA
#> attr(x,"sample_frequency")<-sample_frequency
#> if(is.na(attr(x,"gear_ratio"))) attr(x,"gear_ratio")<-1
#> if(type=="workloop")
#> if(is.na(attr(x,"position_inverted"))) attr(x,"position_inverted")<-FALSE
#>
#> # Assign classes and return
#> class(x)<-c("muscle_stim","data.frame")
#> switch(type,
#> "workloop"=class(x)<-c("workloop",class(x)),
#> "tetanus"=class(x)<-c("tetanus","isometric",class(x)),
#> "twitch"=class(x)<-c("twitch","isometric",class(x)))
#> x
#> }
#> <bytecode: 0x5651cc50e360>
#> <environment: namespace:workloopR>
#> ---
#>
#> ## fix_GR
#> function(x,
#> GR = 1)
#> {
#> # Check that x is correct type of object
#> if (!any(class(x) == "muscle_stim"))
#> stop("Input data should be of class `muscle_stim`")
#>
#> # check that gear ratio is numeric
#> if (!is.numeric(GR))
#> {
#> stop('Gear ratio (GR) must be numeric')
#> }
#>
#> x$Position<-x$Position*(1/GR)
#>
#> x$Force<-x$Force*GR
#>
#> attr(x,"gear_ratio")<-attr(x,"gear_ratio")*GR
#> if("workloop" %in% class(x))
#> if(!is.na(attr(x,"amplitude")))
#> attr(x,"amplitude")<-attr(x,"amplitude")*(1/GR)
#> return(x)
#> }
#> <bytecode: 0x5651c8029870>
#> <environment: namespace:workloopR>
#> ---
#>
#> ## get_wl_metadata
#> function(filepath,
#> pattern = "*.ddf"){
#> exp_list<-file.info(list.files(path=filepath,pattern=pattern,
#> full.names=TRUE,recursive=TRUE))
#> exp_list$exp_names<-rownames(exp_list)
#> # re-order by run order, using time stamps
#> exp_list<-exp_list[with(exp_list, order(as.POSIXct(mtime))), ]
#> return(exp_list)
#> }
#> <environment: namespace:workloopR>
#> ---
#>
#> ## invert_position
#> function(x)
#> {
#> if(!any(class(x) == "muscle_stim"))
#> stop("Input data should be of class `muscle_stim`")
#> x$Position<-x$Position*-1
#> attr(x,"position_inverted")<-TRUE
#> return(x)
#> }
#> <environment: namespace:workloopR>
#> ---
#>
#> ## isometric_timing
#> function(x,
#> rising = c(10, 90),
#> relaxing = c(90, 50)){
#> # check input data
#> if(!("isometric" %in% class(x)))
#> stop("Please ensure that your data is from an isometric experiment!")
#> if("tetanus" %in% class(x))
#> relaxing=c()
#>
#> # check that set points are numeric between 0 and 100
#> if(any(!is.numeric(rising) | rising < 0 | rising > 100))
#> stop("Please ensure that all rising set points are numeric values between 0 and 100.")
#> if(any(!is.numeric(relaxing) | relaxing < 0 | relaxing > 100))
#> stop("Please ensure that all relaxing set points are numeric values between 0 and 100.")
#>
#> # convert precents to proportions for easier math
#> rising<-rising/100
#> relaxing<-relaxing/100
#>
#> # find position of peak force and stimulus in dataset
#> stim_row<-which.max(x$Stim)
#> pf_row<-which.max(x$Force)
#>
#> # get force and timing for peak force and stim
#> main_results<-data.frame(
#> 'file_id'=attr(x,"file_id"),
#> 'time_stim'=x$Time[stim_row],
#> 'force_stim'=x$Force[stim_row],
#> 'time_peak'=x$Time[pf_row],
#> 'force_peak'=x$Force[pf_row],
#> stringsAsFactors=FALSE)
#>
#> # calculate absolute force at optional set points
#> rising_forces<-rising*(x$Force[pf_row]-x$Force[stim_row])+x$Force[stim_row]
#> relaxing_forces<-relaxing*(x$Force[pf_row]-x$Force[stim_row])+x$Force[stim_row]
#>
#> # calculate corresponding position in dataset
#> rising_row<-sapply(rising_forces,function(i)utils::head(which(x$Force>i),1))
#> relaxing_row<-sapply(relaxing_forces,function(i)utils::tail(which(x$Force>i),1))
#>
#> # extract time and force at these positions, bind together into a vector
#> set_point_results<-
#> c(unlist(lapply(rising_row, function(i) c(x$Time[i],x$Force[i]))),
#> unlist(lapply(relaxing_row, function(i) c(x$Time[i],x$Force[i]))))
#>
#> # add names and convert to data.frame
#> names(set_point_results)<-
#> c(sapply(rising*100, function(i) c(paste0("time_rising_",i),
#> paste0("force_rising_",i))),
#> sapply(relaxing*100, function(i) c(paste0("time_relaxing_",i),
#> paste0("force_relaxing_",i))))
#> set_point_results<-data.frame(as.list(set_point_results))
#>
#> # return both result
#> cbind(main_results,set_point_results)
#> }
#> <bytecode: 0x5651ca26ae80>
#> <environment: namespace:workloopR>
#> ---
#>
#> ## library.dynam.unload
#> function (chname, libpath, verbose = getOption("verbose"), file.ext = .Platform$dynlib.ext)
#> {
#> dll_list <- .dynLibs()
#> if (missing(chname) || nchar(chname, "c") == 0L)
#> if (.Platform$OS.type == "windows")
#> stop("no DLL was specified")
#> else stop("no shared object was specified")
#> libpath <- normalizePath(libpath, "/", TRUE)
#> chname1 <- paste0(chname, file.ext)
#> file <- if (nzchar(.Platform$r_arch))
#> file.path(libpath, "libs", .Platform$r_arch, chname1)
#> else file.path(libpath, "libs", chname1)
#> pos <- which(vapply(dll_list, function(x) x[["path"]] ==
#> file, NA))
#> if (!length(pos))
#> if (.Platform$OS.type == "windows")
#> stop(gettextf("DLL %s was not loaded", sQuote(chname1)),
#> domain = NA)
#> else stop(gettextf("shared object %s was not loaded",
#> sQuote(chname1)), domain = NA)
#> if (!file.exists(file))
#> if (.Platform$OS.type == "windows")
#> stop(gettextf("DLL %s not found", sQuote(chname1)),
#> domain = NA)
#> else stop(gettextf("shared object '%s' not found", sQuote(chname1)),
#> domain = NA)
#> if (verbose)
#> message(gettextf("now dyn.unload(\"%s\") ...", file),
#> domain = NA)
#> dyn.unload(file)
#> .dynLibs(dll_list[-pos])
#> invisible(dll_list[[pos]])
#> }
#> <bytecode: 0x5651cb71eb50>
#> <environment: namespace:base>
#> ---
#>
#> ## muscle_stim
#> function(data,
#> units,
#> sample_frequency,
#> header,
#> units_table,
#> protocol_table,
#> stim_table,
#> file_id,
#> mtime,
#> ...){
#> attr(data, "units") <- units
#> attr(data, "sample_frequency") <- sample_frequency
#> attr(data, "header") <- header
#> attr(data, "units_table") <- units_table
#> attr(data, "protocol_table") <- protocol_table
#> attr(data, "stim_table") <- stim_table
#> attr(data, "stimulus_pulses") <- stim_table$pulses[1]
#> attr(data, "stimulus_offset") <- stim_table$offset[1]
#> attr(data, "stimulus_width") <- stim_table$width[1]
#> attr(data, "gear_ratio") <- 1
#> attr(data, "file_id") <- file_id
#> attr(data, "mtime") <- mtime
#> class(data) <- c(class(data), "muscle_stim", "data.frame")
#> data
#> }
#> <bytecode: 0x5651cc2ff050>
#> <environment: namespace:workloopR>
#> ---
#>
#> ## print_muscle_stim_header
#> function(x,include_time=TRUE){
#> type<-paste(toupper(substring(class(x)[1],1,1)),
#> substring(class(x)[1],2),sep="")
#> if(include_time)
#> cat(paste0("# ",type," Data: ",
#> ncol(x)-1," channels recorded over ",
#> nrow(x)/attr(x,"sample_frequency"),"s\n"))
#> else
#> cat(paste0("# ",type," Data:\n\n"))
#> }
#> <environment: namespace:workloopR>
#> ---
#>
#> ## print.analyzed_workloop
#> function(x, n = 6, ...){
#> cat(paste0("File ID: ",
#> attr(x,"file_id")))
#> cat(paste0("\nCycles: ",
#> length(attr(x,"retained_cycles")),
#> " cycles kept out of ",
#> attr(x,"total_cycles")))
#> cat(paste0("\nMean Work: ",
#> round(mean(attr(x,"summary")$Work),5),
#> " J"))
#> cat(paste0("\nMean Power: ",
#> round(mean(attr(x,"summary")$Net_Power),5),
#> " W\n\n"))
#> }
#> <environment: namespace:workloopR>
#> ---
#>
#> ## print.muscle_stim
#> function(x, n = 6, ...){
#> print_muscle_stim_header(x)
#> cat(paste0("File ID: ",attr(x,"file_id"),"\n\n"))
#> class(x)<-"data.frame"
#> print(utils::head(x,n=n))
#> if(n < nrow(x))
#> cat(paste0("# \u2026 with ",nrow(x)-n," more rows\n"))
#> }
#> <environment: namespace:workloopR>
#> ---
#>
#> ## read_analyze_wl
#> function(filename,
#> ...){
#> valid_args<-c("file_id","rename_cols","skip_cols","phase_from_peak","cycle_def","keep_cycles","bworth_order","bworth_freq","simplify","GR","M","vel_bf")
#> arg_names<-names(list(...))
#> if(!all(arg_names %in% valid_args)) warning("One or more provided attributes do not match known attributes. These will attributes will not be assigned.")
#>
#> fulldata<-read_ddf(filename,...)
#> if(!("workloop" %in% class(fulldata)))
#> stop(paste0("The provided file ",filename," does not appear to contain data from a workloop experiment!"))
#> analyze_workloop(select_cycles(fulldata,...),...)
#> }
#> <environment: namespace:workloopR>
#> ---
#>
#> ## read_analyze_wl_dir
#> function(filepath,
#> pattern = "*.ddf",
#> sort_by = "mtime",
#> ...){
#> # Generate list of filenames
#> filename_list<-list.files(path=filepath,pattern=pattern,full.names=TRUE)
#> if(length(filename_list)==0) stop("No files matching the pattern found at the given directory!")
#>
#> # Generate list of analyzed workloop objects
#> wl_list<-lapply(filename_list,function(i) read_analyze_wl(i,...))
#>
#> # Sort list, likely by modification time
#> if(is.null(attr(wl_list[[1]],sort_by))){
#> warning("The provided sort_by argument is not a valid attribute. Defaulting to `mtime`.")
#> sort_by<-"mtime"
#> }
#> wl_list<-wl_list[order(sapply(wl_list,function(i)attr(i,sort_by)))]
#> }
#> <environment: namespace:workloopR>
#> ---
#>
#> ## read_ddf
#> function(filename,
#> file_id = NA,
#> rename_cols = list(c(2, 3), c("Position", "Force")),
#> skip_cols = 4:11,
#> phase_from_peak = FALSE,
#> ...)
#> {
#> # Import and checks
#> if(missing(filename)) stop("A filename is required")
#> if(!file.exists(filename)) stop(paste0("File ",filename," not found!"))
#> f<-file(filename,"r")
#> if(!grepl("DMC.*Data File",readLines(f,1))){
#> close(f)
#> stop("The input file does not appear to be a DMC Datafile (ddf)")
#> }
#> if(is.na(file_id)) file_id<-basename(filename)
#>
#> # get metadata
#> mtime<-file.info(filename)$mtime
#>
#> # Setup for reading in file
#> header<-c()
#> units_table<-c()
#> protocol_table<-c()
#>
#> # Read in Header
#> while(!grepl("Calibration Data",(l<-readLines(f,1))))
#> header<-c(header,l)
#> sample_frequency<-as.numeric(sub(".*: ","",header[1]))
#>
#> # Read in Calibration Table
#> while(!grepl("Comments",(l<-readLines(f,1))))
#> units_table<-c(units_table,l)
#> units_table<-t(utils::read.table(text=units_table,
#> row.names=1,
#> sep="\t",
#> stringsAsFactors=FALSE))
#> rownames(units_table)<-c()
#> colnames(units_table)<-sub(" .*","",colnames(units_table))
#> units_table<-data.frame(units_table,stringsAsFactors=FALSE)
#> units_table[3:5]<-lapply(units_table[3:5],as.numeric)
#> units<-c("s",units_table$Units[-skip_cols+1],"TTL")
#> if(!all(units %in% c("s","mm","mN","TTL")))
#> warning("Non-standard units detected in ddf file! Please note that calculations currently assume raw data are in seconds, millimeters, and millinewtons.")
#>
#> # Read in Protocol Array
#> while(!grepl("Protocol",readLines(f,1))) {}
#> readLines(f,1) # Discard empty line
#> while((l<-readLines(f,1))!="")
#> protocol_table<-c(protocol_table,l)
#> protocol_table<-utils::read.table(text=protocol_table,
#> sep="\t",
#> stringsAsFactors=FALSE,
#> col.names=c("Wait.s",
#> "Then.action",
#> "On.port",
#> "Units",
#> "Parameters"))
#>
#> # Read in data
#> while(!grepl("Test Data",(l<-readLines(f,1)))){}
#> readLines(f,1)
#> dataz<-utils::read.table(text=readLines(f),
#> header=TRUE,
#> sep="\t",
#> stringsAsFactors=FALSE)
#> if(any(!apply(dataz,2,is.numeric))) warning("The ddf file includes non-numeric data. Please ensure that this is intentional before proceeding.")
#> close(f)
#>
#> # Parse file type
#> read_filetype.ddf<-NULL
#> switch(
#> grep("Stim",protocol_table[[2]],value=TRUE)[1],
#> "Stimulus-Train"=read_filetype.ddf<-read_wl.ddf,
#> "Stimulus-Twitch"=read_filetype.ddf<-read_twitch.ddf,
#> "Stimulus-Tetanus"=read_filetype.ddf<-read_tetanus.ddf,
#> stop("Could not parse experiment type (workloop, twitch, or tetanus)! Please ensure that the protocol section of the ddf header includes a label with one of the following: Stimulus-Train, Stimulus-Twitch, or Stimulus-Tetanus.")
#> )
#> read_filetype.ddf(file_id=file_id,
#> mtime=mtime,
#> header=header,
#> units_table=units_table,
#> units=units,
#> protocol_table=protocol_table,
#> raw_data=dataz,
#> sample_frequency=sample_frequency,
#> rename_cols=rename_cols,
#> skip_cols=skip_cols,
#> phase_from_peak=phase_from_peak)
#> }
#> <bytecode: 0x5651c84fd2f0>
#> <environment: namespace:workloopR>
#> ---
#>
#> ## read_ddf_dir
#> function(filepath,
#> pattern = "*.ddf",
#> sort_by = "mtime",
#> ...){
#> # Generate list of filenames
#> filename_list<-list.files(path=filepath,pattern=pattern,full.names=TRUE)
#> if(length(filename_list)==0) stop("No files matching the pattern found at the given directory!")
#>
#> # Generate list of muscle_stim objects
#> ms_list<-lapply(filename_list,function(i) read_ddf(i,...))
#>
#> # Sort list, likely by modification time
#> if(is.null(attr(ms_list[[1]],sort_by))){
#> warning("The provided sort_by argument is not a valid attribute. Defaulting to `mtime`.")
#> sort_by<-"mtime"
#> }
#> ms_list<-ms_list[order(sapply(ms_list,function(i)attr(i,sort_by)))]
#>
#> ms_list
#> }
#> <environment: namespace:workloopR>
#> ---
#>
#> ## read_tetanus.ddf
#> function(raw_data,
#> units_table,
#> protocol_table,
#> sample_frequency,
#> rename_cols=list(c(2,3),c("Position","Force")),
#> skip_cols=4:11,
#> ...)
#> {
#> #get info on experimental parameters
#> stim_table <-
#> utils::read.table(
#> text = protocol_table[grepl("Stim",protocol_table$Then.action),"Units"],
#> sep=",",
#> col.names=c("offset","frequency","width","length")
#> )
#> stim_table$pulses<-
#> as.integer(floor(stim_table$frequency * stim_table$length))
#>
#> #use scale (and maybe offset) to convert Volts into units
#> rescaled_data<-rescale_data(raw_data,
#> units_table,
#> sample_frequency,
#> rename_cols,
#> skip_cols)
#>
#> #construct and return workloop object
#> tetanus(data=rescaled_data,
#> sample_frequency=sample_frequency,
#> units_table=units_table,
#> protocol_table=protocol_table,
#> stim_table=stim_table,
#> ...)
#> }
#> <environment: namespace:workloopR>
#> ---
#>
#> ## read_twitch.ddf
#> function(raw_data,
#> units_table,
#> protocol_table,
#> sample_frequency,
#> rename_cols=list(c(2,3),c("Position","Force")),
#> skip_cols=4:11,
#> ...)
#> {
#> #get info on experimental parameters
#> stim_table<-
#> utils::read.table(
#> text=protocol_table[grepl("Stim",protocol_table$Then.action),"Units"],
#> sep=",",
#> col.names=c("offset","width")
#> )
#> stim_table$pulses<-rep(1,nrow(stim_table))
#>
#> #use scale (and maybe offset) to convert Volts into units
#> rescaled_data<-rescale_data(raw_data,
#> units_table,
#> sample_frequency,
#> rename_cols,
#> skip_cols)
#>
#> #construct and return workloop object
#> twitch(data=rescaled_data,
#> sample_frequency=sample_frequency,
#> units_table=units_table,
#> protocol_table=protocol_table,
#> stim_table=stim_table,
#> ...)
#> }
#> <environment: namespace:workloopR>
#> ---
#>
#> ## read_wl.ddf
#> function(raw_data,
#> units_table,
#> protocol_table,
#> sample_frequency,
#> rename_cols,
#> skip_cols,
#> ...)
#> {
#> #get info on experimental parameters
#> stim_table<-
#> utils::read.table(
#> text=protocol_table[grepl("Stim",protocol_table$Then.action),"Units"],
#> sep=",",
#> col.names=c("offset","frequency","width","pulses","cycle_frequency")
#> )
#> cycle_table<-
#> utils::read.table(
#> text=protocol_table[grepl("Sine",protocol_table$Then.action),"Units"],
#> sep=",",
#> col.names=c("frequency","amplitude","total_cycles")
#> )
#>
#> #use scale (and maybe offset) to convert Volts into units
#> rescaled_data<-rescale_data(raw_data,
#> units_table,
#> sample_frequency,
#> rename_cols,
#> skip_cols)
#>
#> #construct and return workloop object
#> workloop(data=rescaled_data,
#> sample_frequency=sample_frequency,
#> units_table=units_table,
#> protocol_table=protocol_table,
#> stim_table=stim_table,
#> cycle_table=cycle_table,
#> ...)
#> }
#> <bytecode: 0x5651c98cc7e0>
#> <environment: namespace:workloopR>
#> ---
#>
#> ## rescale_data
#> function(dataz,
#> unitz,
#> sample_frequency,
#> rename_cols,
#> skip_cols){
#> rescaled<-mapply(function(raw,offset,scale){
#> if(!is.numeric(raw))
#> return(raw)
#> else
#> (raw+offset)*scale},
#> dataz[unitz$Channel],
#> unitz$Offset,
#> unitz$Scale)
#>
#> rescaled<-data.frame(Time=(1:nrow(dataz))/sample_frequency,
#> rescaled,
#> Stim=dataz$Stim)
#>
#> #rename columns, if desired
#> if(!is.null(rename_cols))
#> names(rescaled)[rename_cols[[1]]]<-rename_cols[[2]]
#>
#> rescaled[,-skip_cols]
#> }
#> <bytecode: 0x5651cb8a6730>
#> <environment: namespace:workloopR>
#> ---
#>
#> ## select_cycles
#> function(x,
#> cycle_def,
#> keep_cycles = 4:6,
#> bworth_order = 2,
#> bworth_freq = 0.05,
#> ...)
#> {
#> if(!any(class(x) == "workloop"))
#> stop("Input data should be of class `workloop`")
#> if(!is.numeric(keep_cycles))
#> stop("keep_cycles should be numeric")
#> if(missing(cycle_def)){
#> cycle_def<-"lo"
#> warning("Cycle definition not supplied! Defaulting to L0-to-L0")
#> }
#> if(is.na(attr(x,"cycle_frequency")))
#> stop("Length-out cycle frequency is needed to identify cycles! Please set the `cycle_frequency` attribute accordingly.")
#>
#> # get cycle frequency and sample frequency
#> cyc_freq<-attr(x,"cycle_frequency")
#> samp_freq<-attr(x,"sample_frequency")
#>
#> # Use butterworth-filtered position data to identify peaks
#> bworth<-signal::butter(bworth_order,bworth_freq)
#> smPos<-signal::filtfilt(bworth,x$Position)
#>
#> # Calculate minimum number of ups before a peak from proportion ups
#> qf<-floor(0.25*(1/cyc_freq)*samp_freq)-1
#> peaks<-stats::setNames(data.frame(pracma::findpeaks(smPos,nups=qf)[,2:4]),
#> c("peak","start","end"))
#>
#> switch(cycle_def,
#> # L0-to-Lo assumes position cycle starts and ends on an L0
#> # Most L0 are found by averaging indices of a peak and previous trough
#> "lo"={splits<-round((peaks$start+peaks$peak)/2)
#> # The first L0 is the lowest point before first peak
#> splits[1]<-peaks$start[1]
#> # The last L0 is the last peak
#> splits[length(splits)]<-peaks$peak[nrow(peaks)]
#> splits<-c(0,splits,nrow(x))},
#> "p2p"=splits<-c(0,peaks$peak,nrow(x)),
#> "t2t"=splits<-c(0,peaks$start,utils::tail(peaks$end,1),nrow(x)),
#> stop("Invalid cycle definition! Please select one of:\n
#> 'lo': L0-to-L0
#> 'p2p': peak-to-peak
#> 't2t': trough-to-trough")
#> )
#> splits<-(splits-c(NA,utils::head(splits,-1)))[-1]
#>
#> cycle<-unlist(sapply(seq_along(splits), function(i)rep(i-1,splits[i])))
#> x$Cycle<-replace(cycle,cycle==max(cycle),0)
#>
#> # Update cycle definition and total cycles
#> attr(x,"cycle_def")<-cycle_def
#> attr(x,"total_cycles")<-max(x$Cycle)
#>
#> # Subset by keep_cycles and rename cycles by letters
#> if(any(keep_cycles<0 | keep_cycles>max(x$Cycle)))
#> warning("The keep_cycles argument includes cycles that don't exist (negative or greater than total_cycles). These are being ignored.")
#> x<-x[x$Cycle %in% keep_cycles,]
#> x$Cycle<-letters[as.factor(x$Cycle)]
#> if(!all(is.na(attr(x,"units")))) attr(x,"units")<-c(attr(x,"units"),"letters")
#> attr(x,"retained_cycles")<-keep_cycles
#> x
#> }
#> <bytecode: 0x5651c775b7f8>
#> <environment: namespace:workloopR>
#> ---
#>
#> ## summarize_wl_trials
#> function(wl_list){
#> if(class(wl_list)[[1]]!="list")
#> stop("Please provide a list of analyzed workloop objects")
#> if(!all(sapply(wl_list,function(x) 'analyzed_workloop' %in% class(x))))
#> stop("The provided list includes elements that are not analyzed workloop objects")
#>
#> data.frame(
#> File_ID = sapply(wl_list,function(i)attr(i,"file_id")),
#> Cycle_Frequency = sapply(wl_list,function(i)attr(i,"cycle_frequency")),
#> Amplitude = sapply(wl_list,function(i)attr(i,"amplitude")),
#> Phase = sapply(wl_list,function(i)attr(i,"phase")),
#> Stimulus_Pulses = sapply(wl_list,function(i)attr(i,"stimulus_pulses")),
#> Stimulus_Frequency = sapply(wl_list,function(i)attr(i,"stimulus_frequency")),
#> mtime = sapply(wl_list,function(i)attr(i,"mtime")),
#> Mean_Work = sapply(wl_list,function(i)mean(attr(i,"summary")$Work)),
#> Mean_Power = sapply(wl_list,function(i)mean(attr(i,"summary")$Net_Power))
#> )
#> }
#> <bytecode: 0x5651c60d9ba8>
#> <environment: namespace:workloopR>
#> ---
#>
#> ## summary.analyzed_workloop
#> function(object, ...){
#> summary(object[[1]],include_time=FALSE)
#> cat("\n")
#> print(attr(object,"summary"))
#> }
#> <environment: namespace:workloopR>
#> ---
#>
#> ## summary.muscle_stim
#> function(object, ...){
#> print_muscle_stim_header(object,...)
#> cat(paste0("\nFile ID: ",attr(object,"file_id")))
#> cat(paste0("\nMod Time (mtime): ",attr(object,"mtime")))
#> cat(paste0("\nSample Frequency: ",attr(object,"sample_frequency"),"Hz\n\n"))
#> cat(paste0("data.frame Columns: \n"))
#> for(i in 2:ncol(object))
#> cat(paste0(" ",colnames(object)[i]," (",attr(object,"units")[i],")\n"))
#> cat(paste0("\nStimulus Offset: ",attr(object,"stimulus_offset"),"s\n"))
#> cat(paste0("Stimulus Frequency: ",attr(object,"stimulus_frequency"),"Hz\n"))
#> cat(paste0("Stimulus Width: ",attr(object,"stimulus_width"),"ms\n"))
#> cat(paste0("Stimulus Pulses: ",attr(object,"stimulus_pulses"),"\n"))
#> cat(paste0("Gear Ratio: ",attr(object,"gear_ratio"),"\n"))
#> }
#> <bytecode: 0x5651cc53b1d0>
#> <environment: namespace:workloopR>
#> ---
#>
#> ## summary.tetanus
#> function(object, ...){
#> NextMethod()
#> cat(paste0("Stimulus Length: ",attr(object,"stimulus_length"),"s\n\n"))
#> }
#> <environment: namespace:workloopR>
#> ---
#>
#> ## summary.workloop
#> function(object, ...){
#> NextMethod()
#> cat(paste0("\nCycle Frequency: ",attr(object,"cycle_frequency"),"Hz\n"))
#> cat(paste0("Total Cycles (",
#> switch(attr(object,"cycle_def"),
#> "lo"="L0-to-L0",
#> "p2p"="peak-to-peak",
#> "t2t"="trough-to-trough",
#> "undefined"),
#> "): ",
#> attr(object,"total_cycles"),"\n"))
#> if(!is.null(attr(object,"retained_cycles")))
#> cat(paste0("Cycles Retained: ",
#> length(attr(object,"retained_cycles")),
#> "\n"))
#> cat(paste0("Amplitude: ",
#> attr(object,"amplitude"),
#> attr(object,"units")[grep("Position",colnames(object))],"\n\n"))
#> if(attr(object,"position_inverted"))
#> cat("\nPlease note that Position is inverted!\n\n")
#> }
#> <bytecode: 0x5651c7f92420>
#> <environment: namespace:workloopR>
#> ---
#>
#> ## system.file
#> function (..., package = "base", lib.loc = NULL, mustWork = FALSE)
#> {
#> if (nargs() == 0L)
#> return(file.path(.Library, "base"))
#> if (length(package) != 1L)
#> stop("'package' must be of length 1")
#> packagePath <- find.package(package, lib.loc, quiet = TRUE)
#> ans <- if (length(packagePath)) {
#> FILES <- file.path(packagePath, ...)
#> present <- file.exists(FILES)
#> if (any(present))
#> FILES[present]
#> else ""
#> }
#> else ""
#> if (mustWork && identical(ans, ""))
#> stop("no file found")
#> ans
#> }
#> <bytecode: 0x5651c3c6f278>
#> <environment: namespace:base>
#> ---
#>
#> ## tetanus
#> function(data,stim_table,...){
#> attr(data,"stimulus_frequency")<-stim_table$frequency[1]
#> attr(data,"stimulus_length")<-stim_table$length[1]
#> class(data)<-c("tetanus","isometric")
#> muscle_stim(data=data,
#> stim_table=stim_table,
#> ...)
#> }
#> <environment: namespace:workloopR>
#> ---
#>
#> ## time_correct
#> function(x){
#> if(class(x)[[1]]!="data.frame")
#> stop("Please provide a data.frame of summarized workloop trial data generated by summarize_wl_trials")
#> if(!all(c("Mean_Work","Mean_Power","mtime") %in% names(x)))
#> stop("Please provide summarized workloop trial data generated by summarize_wl_trials")
#>
#> x$Time_Corrected_Work <-
#> x$Mean_Work-(utils::tail(x$Mean_Work,1)-utils::head(x$Mean_Work,1)) /
#> (utils::tail(x$mtime,1)-utils::head(x$mtime,1))*(x$mtime-utils::head(x$mtime,1))
#> x$Time_Corrected_Power <-
#> x$Mean_Power-(utils::tail(x$Mean_Power,1)-utils::head(x$Mean_Power,1)) /
#> (utils::tail(x$mtime,1)-utils::head(x$mtime,1))*(x$mtime-utils::head(x$mtime,1))
#> attr(x,"power_difference") <-
#> utils::tail(x$Mean_Power,1)-utils::head(x$Mean_Power,1)
#> attr(x,"time_difference") <-
#> utils::tail(x$mtime,1)-utils::head(x$mtime,1)
#> attr(x,"time_correction_rate") <-
#> attr(x,"power_difference") / attr(x,"time_difference")
#> x
#> }
#> <bytecode: 0x5651ca2c34a8>
#> <environment: namespace:workloopR>
#> ---
#>
#> ## trapezoidal_integration
#> function(x,
#> f)
#> {
#> if(!is.numeric(x))
#> stop('The variable (first argument) is not numeric.')
#> if(!is.numeric(f))
#> stop('The integrand (second argument) is not numeric.')
#> if (length(x) != length(f))
#> stop('The lengths of the variable and the integrand are not equal.')
#>
#> # obtain length of variable of integration and integrand
#> n=length(x)
#> # integrate using the trapezoidal rule
#> integral=0.5*sum((x[2:n]-x[1:(n-1)])*(f[2:n]+f[1:(n-1)]))
#> # return the definite integral
#> return(integral)
#> }
#> <bytecode: 0x5651cc618918>
#> <environment: namespace:workloopR>
#> ---
#>
#> ## twitch
#> function(data,...){
#> class(data)<-c("twitch","isometric")
#> muscle_stim(data=data,...)
#> }
#> <environment: namespace:workloopR>
#> ---
#>
#> ## workloop
#> function(data,
#> stim_table,
#> cycle_table,
#> sample_frequency,
#> phase_from_peak,
#> ...) {
#> attr(data, "stimulus_frequency") <- stim_table$frequency[1]
#> attr(data, "cycle_frequency") <- cycle_table$frequency[1]
#> attr(data, "total_cycles") <- cycle_table$total_cycles[1]
#> attr(data, "cycle_def") <- "lo"
#> attr(data, "amplitude") <- cycle_table$amplitude[1]
#>
#> # Calculate Phase
#> phase<-(which.max(data$Stim)-which.max(data$Position))/sample_frequency*stim_table$cycle_frequency[1]
#> if(!phase_from_peak)
#> phase<-phase+0.25
#> # convert 0-1 scale to -50 to +50
#> attr(data,"phase")<-(((phase+0.5)%%1)-0.5)*100
#>
#> attr(data,"position_inverted")<-FALSE
#> class(data)<-c("workloop")
#> muscle_stim(data=data,
#> stim_table=stim_table,
#> sample_frequency=sample_frequency,
#> ...)
#> }
#> <bytecode: 0x5651cbf312d0>
#> <environment: namespace:workloopR>
#> ---
#>
#> $analyze_workloop
#> NULL
#>
#> $as_muscle_stim
#> NULL
#>
#> $fix_GR
#> NULL
#>
#> $get_wl_metadata
#> NULL
#>
#> $invert_position
#> NULL
#>
#> $isometric_timing
#> NULL
#>
#> $library.dynam.unload
#> NULL
#>
#> $muscle_stim
#> NULL
#>
#> $print_muscle_stim_header
#> NULL
#>
#> $print.analyzed_workloop
#> NULL
#>
#> $print.muscle_stim
#> NULL
#>
#> $read_analyze_wl
#> NULL
#>
#> $read_analyze_wl_dir
#> NULL
#>
#> $read_ddf
#> NULL
#>
#> $read_ddf_dir
#> NULL
#>
#> $read_tetanus.ddf
#> NULL
#>
#> $read_twitch.ddf
#> NULL
#>
#> $read_wl.ddf
#> NULL
#>
#> $rescale_data
#> NULL
#>
#> $select_cycles
#> NULL
#>
#> $summarize_wl_trials
#> NULL
#>
#> $summary.analyzed_workloop
#> NULL
#>
#> $summary.muscle_stim
#> NULL
#>
#> $summary.tetanus
#> NULL
#>
#> $summary.workloop
#> NULL
#>
#> $system.file
#> NULL
#>
#> $tetanus
#> NULL
#>
#> $time_correct
#> NULL
#>
#> $trapezoidal_integration
#> NULL
#>
#> $twitch
#> NULL
#>
#> $workloop
#> NULL* might not be suitable for large packages with many exported functions
comments: