R/read.R

In jlucasmckay/motionTools: Miscellaneous tools for human movement data and statistics

#read.R

#' Return personal.dat file based on NRM file location
#' @export
FindPersonalData = function(nrm.file){
  f = file.path(dirname(nrm.file),"personal.dat")
  if(!file.exists(f)){f = ""}
  f
}

#' Read subject data (height, weight, MRN) from personal.dat files generated by Orthotrack
#' @export
ReadPersonalData = function(file.name) read_delim(file.name, delim = ":", col_names = F, n_max = 16) |> pivot_wider(names_from="X1",values_from="X2")

#' Read the estimated joint centers from the .trbcoord files.
#' @export
ReadTrbCoord = function(file.name){
  t = read_tsv(file.name)
  n = names(t)
  outcome.names.x = n[seq(3,length(n),3)] |> str_replace_all("  X",".X") |> str_remove_all(" ") |> str_replace_all("/",".")
  outcome.names.y = outcome.names.x |> str_replace(".X$",".Y")
  outcome.names.z = outcome.names.x |> str_replace(".X$",".Z")
  names(t) = c(n[1:2],rbind(outcome.names.x,outcome.names.y,outcome.names.z) |> c())
  t = t |> pivot_longer(-c(Frame,`Time(sec)`),names_to = "Landmark", values_to="Position") |>
    dplyr::arrange(Landmark,Frame) |>
    dplyr::mutate(Coordinate = str_sub(Landmark, start= -1)) |>
    dplyr::mutate(Landmark = str_sub(Landmark, end = -3))
  t |> rename(frame_num = Frame, time_sec = `Time(sec)`, variable = Landmark, value = Position, coordinate = Coordinate)
  t
}

#' Read the average data from the nrm file. note that in some cases a large number of empty columns are generated; only extract the first three.
#' @export
ReadNrmAverages = function(nrm_file) read_tsv(nrm_file,n_max=27,col_types = cols(Side = "c", Right = "d", Left = "d"))[,1:3] |>
rename(Variable = Side, lft = Left, rt = Right) |>
  pivot_longer(-Variable, names_to = "Side", values_to = "Value") |>
  left_join(
    tibble(
      Variable = c(
        "Step Length  Avg (cm)",
        "Number of Steps",
        "Stride Length Avg (cm)",
        "Number of Strides",
        "Forward Velocity Avg (cm/s)",
        "Cadence Avg (steps/min)",
        "Total  Support Time (%)",
        "Swing Phase (%)",
        "Initial Double Support Time (%)",
        "Single Support Time (%)",
        "Step Width (cm)"
      ),
      new.name = c(
        "step_leng_ave",
        "num_steps",
        "strid_leng_ave",
        "num_strides",
        "for_vel",
        "cad_ave",
        "tot_sup_time",
        "swing_phas",
        "int_2x_sup_time",
        "single_sup_time",
        "step_width"
      )
    ),
    by = "Variable") |>
  na.exclude() |>
  mutate(Variable = paste(new.name,Side,sep="_")) |>
  select(-c(new.name,Side)) |>
  unique() |>
  group_by(Variable) |>
  summarize(Value = min(Value, na.rm=T)) |>
  ungroup() |>
  pivot_wider(names_from="Variable",values_from="Value") |>
  rename(step_width = step_width_rt) |> select(-step_width_lft) |>
  select(
    step_leng_ave_rt,
    step_leng_ave_lft,
    strid_leng_ave_rt,
    strid_leng_ave_lft,
    for_vel_rt,
    for_vel_lft,
    cad_ave_rt,
    cad_ave_lft,
    tot_sup_time_rt,
    tot_sup_time_lft,
    swing_phas_rt,
    swing_phas_lft,
    int_2x_sup_time_rt,
    int_2x_sup_time_lft,
    single_sup_time_rt,
    single_sup_time_lft,
    step_width,
    num_steps_rt,
    num_steps_lft,
    num_strides_rt,
    num_strides_lft)


#' Read the timeseries data from the nrm file. this produces raw data of 100x46 doubles.
#' to scale, you should add to database. to get done, you should do in memory.
#' keeping the kinematic marker data will definitely need a database.
#' @export
ReadNrmTimeseries = function(nrm_file){
  raw = read_tsv(nrm_file,skip=28) |> select(-dplyr::starts_with("SD"))
  raw[,1:46] |>
    dplyr::mutate(percent_gait_cycle = row_number()) |>
    select(percent_gait_cycle, tidyselect::everything())
}

#' Read anthropemetric data from personal.dat.
#' @export
ReadPersonalData = function(file.name) read_delim(file.name, delim = ":", col_names = F, n_max = 16) |>
  pivot_wider(names_from="X1",values_from="X2") |>
  select(-ends_with("Name")) |>
  select(-ends_with("Date")) |>
  select(-ends_with("ID#")) |>
  FixNames() |>
  mutate(across(-marker.set,as.numeric))

#' Read single row of a .trc file
#' @export
ReadTrcRow = function(file.name, skip = 0) read.delim(file.name, skip = skip, nrows = 1, header = F)

#' Read trc file header.
#' Note that on read-in, backslashes in filenames are rendered as "\\" this is the backslash character in r, no need to attempt to remove.
#' @export
ReadTrcHeader = function(file.name){
  source.file = ReadTrcRow(file.name,0)[4]
  names(source.file) = "SourceFile"
  parameter.names = ReadTrcRow(file.name,1)
  parameters = ReadTrcRow(file.name,2)
  names(parameters) = parameter.names
  dplyr::bind_cols(source.file,parameters)
}

#' Read in the first 60 (or n.markers) variable names.
#' @export
ReadTrcVariableNames = function(file.name, n.markers = 60){
  # the first two columns are frame number and time
  n.cols = n.markers*3 + 2
  variable.stubs = as.character(zoo::na.locf(t(read.delim(file.name, skip = 3, nrows = 1, header = F)[1:n.cols])))
  variable.coordinates = as.character(t(read.delim(file.name, skip = 4, nrows = 1, header = F)[1:n.cols]) |> stringr::str_extract("[XYZ]"))
  variable.names = character(length = length(variable.stubs))
  for(i in 1:length(variable.names)){
    if(i>2){
      variable.names[i] = paste0(variable.stubs[i],".",variable.coordinates[i])
    }else{variable.names[i] = variable.stubs[i]}
  }
  variable.names[variable.names=="Frame#"] = "Frame"
  return(variable.names)
}

#' Read in the first 60 (or n.markers) columns of data from a .trc file.
#' @export
ReadTrcData = function(file.name, n.markers = 60){
  n.cols = n.markers*3 + 2
  variable.names = ReadTrcVariableNames(file.name, n.markers)
  numeric.data = read.delim(file.name,skip=6,header=F)[,1:n.cols]
  names(numeric.data) = variable.names
  trc.data = tidyr::as_tibble(numeric.data)
}

#' Read a PKMAS .csv file.
#' @export
ReadPkmasData = function(fileName){

  # read the patient information
  patient = readr::read_csv(fileName, col_names = F, n_max = 9) |>
    dplyr::rename(Var = X1, Val = X2) |>
    dplyr::select(dplyr::starts_with("V"))

  datetimeStr = patient$Val[patient$Var == "Test Time"]
  datetime = lubridate::mdy_hm(datetimeStr)

  walkData = tibble::tibble(
    tec_mrn = patient$Val[patient$Var == "Medical Record"],
    pkmasDatetime = datetime,
    Memo = patient$Val[patient$Var == "Memo"]
  )

  # read the walk information, omit the "# Samples" data
  walk = readr::read_csv(fileName, col_names = T, skip = 11, n_max = 14)
  
 names(walk)[1] = "Meas"
  names(walk)[2] = "Side"

  walk$Side[is.na(walk$Side)] = "Bilateral"
  walk$Description = paste0(walk$Meas, ", ", walk$Side)
  walk = walk |>
    dplyr::select(-Meas, -Side) |>
    dplyr::select(Description, tidyselect::everything())

  walk = walk[!grepl("#Samples", walk$Description),]

  # convert to long format
  # add |> drop_na(Measurement) to delete missing data
  walkLong = walk |>
    tidyr::pivot_longer(-Description, names_to="Variable", values_to="Measurement") |>
    dplyr::select(Variable, tidyselect::everything()) |>
    tidyr::drop_na(Measurement)|>
    dplyr::mutate(Outcome = paste0(Variable, ", ", Description)) |>
    dplyr::select(Outcome, Measurement)

  # convert to wide format
  walkWide = walkLong |>
    tidyr::pivot_wider(names_from = Outcome, values_from = Measurement)

  # convert to tall format
  walkData = dplyr::bind_cols(walkData, walkWide)
}

#' Read an APDM .csv file.
#' @export
ReadApdmGaitCycle = function(f){
  # check for identified gait cycles
  g = read_csv(f, skip = 9, n_max = 1, col_names = F)
  
  # if gait cycles were identified, load data, otherwise return null
  if( grepl("Found \\d+ valid gait cycles",g[1,"X2"])==T ){
  # read data
  d = read_csv(f, skip=215, n_max = 2, col_names = F) %>%
    select(-c(X2:X5)) %>%
    pivot_longer(-X1, names_to = "n") %>% 
    arrange(X1,n) %>% 
    group_by(X1) %>% 
    mutate(cycle = row_number()) %>% 
    rename(outcome = X1) %>% 
    select(outcome, cycle, value)
  }else{
    d = NA
    }
  return(d)
}