merge multiple dbf files with non-matching headers in R - r

I have over 800 dbf files which I need to import and merge in R. I have been able to bring in all of the files using this code:
library(foreign)
setwd("c:/temp/help/")
files <- list.files(pattern="\\.dbf$")
all.the.data <- lapply(files, read.dbf, as.is=FALSE)
DATA <- do.call("rbind",all.the.data)
However, these dbf files have different numbers of columns and even if they sometimes have the same number of columns, those headers may be different. Here are four of the dbf files to provide an example:
file01 <- structure(list(PLOTBUFFER = structure(1L, .Label = "1002_2km", class = "factor"),
VALUE_11 = 11443500, VALUE_31 = 13500, VALUE_42 = 928800,
VALUE_43 = 162000, VALUE_90 = 18900), .Names = c("PLOTBUFFER",
"VALUE_11", "VALUE_31", "VALUE_42", "VALUE_43", "VALUE_90"), row.names = c(NA,
-1L), class = "data.frame", data_types = c("C", "F", "F", "F",
"F", "F"))
file02 <- structure(list(PLOTBUFFER = structure(1L, .Label = "1002_5km", class = "factor"),
VALUE_11 = 66254400, VALUE_21 = 125100, VALUE_31 = 80100,
VALUE_41 = 4234500, VALUE_42 = 3199500, VALUE_43 = 4194000,
VALUE_52 = 376200, VALUE_90 = 72000), .Names = c("PLOTBUFFER",
"VALUE_11", "VALUE_21", "VALUE_31", "VALUE_41", "VALUE_42", "VALUE_43",
"VALUE_52", "VALUE_90"), row.names = c(NA, -1L), class = "data.frame", data_types = c("C",
"F", "F", "F", "F", "F", "F", "F", "F"))
file03 <- structure(list(PLOTBUFFER = structure(1L, .Label = "1003_2km", class = "factor"),
VALUE_11 = 1972800, VALUE_31 = 125100, VALUE_41 = 5316300,
VALUE_42 = 990900, VALUE_43 = 1995300, VALUE_52 = 740700,
VALUE_90 = 1396800, VALUE_95 = 25200), .Names = c("PLOTBUFFER",
"VALUE_11", "VALUE_31", "VALUE_41", "VALUE_42", "VALUE_43", "VALUE_52",
"VALUE_90", "VALUE_95"), row.names = c(NA, -1L), class = "data.frame", data_types = c("C",
"F", "F", "F", "F", "F", "F", "F", "F"))
file04 <- structure(list(PLOTBUFFER = structure(1L, .Label = "1003_5km", class = "factor"),
VALUE_11 = 43950600, VALUE_31 = 270000, VALUE_41 = 12969900,
VALUE_42 = 5105700, VALUE_43 = 12614400, VALUE_52 = 1491300,
VALUE_90 = 2055600, VALUE_95 = 70200), .Names = c("PLOTBUFFER",
"VALUE_11", "VALUE_31", "VALUE_41", "VALUE_42", "VALUE_43", "VALUE_52",
"VALUE_90", "VALUE_95"), row.names = c(NA, -1L), class = "data.frame", data_types = c("C",
"F", "F", "F", "F", "F", "F", "F", "F"))
I would like the dataframe to match this:
merged <- structure(list(PLOTBUFFER = structure(1:2, .Label = c("1002_2km",
"1002_5km"), class = "factor"), VALUE_11 = c(11443500, 66254400
), VALUE_21 = c(0, 125100), VALUE_31 = c(13500, 80100), VALUE_41 = c(0,
4234500), VALUE_42 = c(928800, 3199500), VALUE_43 = c(162000,
4194000), VALUE_52 = c(0, 376200), VALUE_90 = c(18900, 72000)), .Names = c("PLOTBUFFER",
"VALUE_11", "VALUE_21", "VALUE_31", "VALUE_41", "VALUE_42", "VALUE_43",
"VALUE_52", "VALUE_90"), class = "data.frame", row.names = c(NA,
-2L))
Where if there is a missing column from one dataset it simply is filled in with a zero or NULL.
Thanks
-al
The suggestion by #infominer worked for the 4 files I included as an example but when I tried to use merge_recurse on the large list of 802 elements, I received an error.
files <- list.files(pattern="\\.dbf$")
all.the.data <- lapply(files, read.dbf, as.is=FALSE)
merged <- merge_recurse(all.the.data)
Error: evaluation nested too deeply: infinite recursion / options(expressions=)?
Error during wrapup: evaluation nested too deeply: infinite recursion / options(expressions=)?

Use the package reshape
library(reshape)
merged.files <-merge_recurse(list(file01,file02,file03,file04))
Edit:
Try this code thanks to Ramnath
Reduce(function(...) merge(..., all=T),all.the.data)
adapted from https://stackoverflow.com/a/6947326/2747709

Related

Import missing data from a .txt file into existing data frame

I have a data frame with this structure:
structure(list(rowNumber = c(0, 1, 2, 3, 4, 5), rowLabel = c("IPU1",
"IPU1", "IPU1", "IPU1", "IPU1", "IPU1"), SampleTime = c(1.317302056,
1.327302056, 1.337302056, 1.347302056, 1.357302056, 1.367302056
), F0 = c(238.4728491, 238.4728491, 238.4728491, 238.4728491,
230.4871243, 235.301327), mother = c("french", "french", "french",
"french", "french", "french"), level = c("bil", "bil", "bil",
"bil", "bil", "bil"), name = c("clemence", "clemence", "clemence",
"clemence", "clemence", "clemence"), task = c("film", "film",
"film", "film", "film", "film"), lang = c("fr", "fr", "fr", "fr",
"fr", "fr"), f0st = c(94.7721745186803, 94.7721745186803, 94.7721745186803,
94.7721745186803, 94.1825081930544, 94.5403877585993), gender = c("F",
"F", "F", "F", "F", "F"), f0stnorm = c(1.11260538951537, 1.11260538951537,
1.11260538951537, 1.11260538951537, 0.934191841072306, 1.0424743738019
)), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"))
But I realised that some data are missing, for example, I don't have the values for name = alan & task = film & lang = eng but I do have these data in a separate .txt file. Is there a way to import the data from my .txt file directly into the data frame?
Assuming the txt file is has a comma delimiter: Also assuming your df is df1 and txt file is df2.txt
library(data.table)
fwrite(df1, "file location/df2.txt", append = TRUE)
df1<-fread(df2.txt)

Applying colors dynamically to table cells in R

I have a data frame in R that looks like this:
It is 84 rows high and 365 rows wide. The dput is below. What I'm trying to figure out is how to get each cell to change color based on the symbol that's in the cell (also, I don't want to see the column name, row name, or gridlines). I've tried kable, DT, base R, heatmap, and huxtable. The closest I've gotten is with DT:
datatable(cover, rownames=FALSE, options = list(dom = 't')) %>% formatStyle(names(cover), backgroundColor=styleEqual(hex$Symbol, hex$Hex))
Here's the result from that code:
I haven't been able to figure out how to also remove the column names (so the columns are only as wide as the symbol) or the gridlines. I'm sure there's a way to do this but I've been spinning my wheels for a couple days so I thought I'd ask the experts. I'm still fairly new with R (I'm a data analyst, not a professional coder). My ultimate goal is for it to look something like this (which was created with Google Sheets conditional formatting):
dput of the head of the first 10 columns of the data table:
structure(list(`2019-01-01` = c("f", "f", "f", "<U+263D>", "<U+263D>", "<U+263D>"), `2019-01-02` = c("<U+270E>", "<U+270E>", "<U+270E>", "<U+270E>", "<U+270E>", "<U+270E>"), `2019-01-03` = c("t", "t", "t", "d", "d", "d"), `2019-01-04` = c("d", "d", "d", "<U+2699>", "<U+2699>", "<U+2699>"), `2019-01-05` = c("&", "&", "&", "&", "&", "&"), `2019-01-06` = c("<U+2699>", "<U+2699>", "<U+2699>", "&", "&", "&"), `2019-01-07` = c("^", "^", "^", "^", "^", "^"), `2019-01-08` = c("&", "&", "&", "<U+270E>", "<U+270E>", "<U+270E>"), `2019-01-09` = c("<U+2699>", "<U+2699>", "<U+2699>", "<U+2699>", "<U+2699>", "<U+2699>"), `2019-01-10` = c("s", "s", "s", "s", "s", "s")), row.names = c(NA, 6L), class = "data.frame")
dput of the Symbol to Hex lookup table:
structure(list(Symbol = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "a","i", "k", "b", "l", "r", "c", "x", "#", "%", "^", "e", "m", "s", "#", "<U+270E>", "&", "<U+2699>", "d", "t", "y", "n", "<U+25C0>", "<U+263D>", "f", "<U+2689>", "<U+2726>", "<U+0394>", "¥", "p", "u", "<U+2326>", "<U+26AF>", "z", "<U+2714>", "o", "+", "v", "g", "<U+262F>", "<U+2724>", "<U+272B>", "<U+2766>", "j", "q", "h", "<U+2665>", "w"), Hex = c("#572433", "#72375D", "#633666", "#803A6B", "#6C3A6E", "#776B98", "#ADA7C7", "#5C7294", "#7B8EAB", "#707DA2", "#555B7B", "#464563", "#0E365C", "#11416D", "#13477D", "#2C597C", "#396987", "#4781A5", "#35668B", "#5A8FB8", "#3B768F", "#4F93A7", "#5BA3B3", "#90C3CC", "#C4DECC", "#7BAC94", "#5B9071", "#396F52", "#044D33", "#313919", "#424D21", "#4C5826", "#72843C", "#94AB4F", "#AEBF79", "#CCD9B1", "#D8E498", "#FFFB8B", "#FDF9CD", "#FFF1AF", "#FDD755", "#FFC840", "#FFBF57", "#FFA32B", "#FF8B00", "#F67F00", "#F27842", "#FF836F", "#E96A67", "#FF7992", "#E74967", "#BA4A4A", "#B33B4B", "#970B23", "#87071F", "#A7132B", "#913546")), row.names = c(NA, -57L), spec = structure(list(cols = list(Index = structure(list(), class = c("collector_double", "collector")), Color = structure(list(), class = c("collector_double", "collector")), `Color name` = structure(list(), class = c("collector_character", "collector")), Symbol = structure(list(), class = c("collector_character", "collector")), Hex = structure(list(), class = c("collector_character", "collector"))), default = structure(list(), class = c("collector_guess", "collector")), skip = 1), class = "col_spec"), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"))
Here's the code I'm using per the comments below. It worked last week but now it isn't. I've determined through going line by line that value2 isn't rendering properly, but I've checked it against the code provided and it looks exactly the same. I'm calling the dataset "cover" and the color table "hex".
hexcol <- hex$Hex
names(hexcol) <- hex$Symbol
bcol <- function(x){hexcol[as.character(x)]}
x <- cover %>%
dplyr::mutate(row.id = 1:n()) %>%
gather(key = "key", value = "value", -row.id) %>%
mutate(value2 = " ", value2 = cell_spec(value2, background = mapply(bcol, value), color = mapply(bcol, value))) %>%
select(-value) %>%
spread(key = key, value = value2) %>%
select(-row.id) %>%
kable(format = "html", escape = F) %>%
kable_styling(full_width = F)
x2 <- gsub("<thead>.*</thead>", "", x)
x3.splits <- unlist(str_split(x2, pattern = "\n"))
x3.cols <- str_extract(x3.splits, pattern = "#[0-9a-fA-F]{6}")
x3.vals <- str_extract(x3.splits, pattern = "(a-Z0-9)+")
# cycle through each row of HTML code to find and replace any value with HTML/CSS code to color the background of that specific cell
for (i in 1:length(x3.splits)){
if (!is.na(x3.cols[i])){
x2 <- gsub(pattern = x3.splits[i],
replacement = paste0('<td style="text-align:center; background-color: ', x3.cols[i], '; border-top: 1px solid ',
x3.cols[i], ';"><span style="margin-left:5px;margin-right:5px"> </span></td>'), x = x2)
}
}
Here's the session info:
Have you tried using the kableExtra package? I was able to do the following which I think does what you're hoping to do using this package as well as some HTML syntax/regular expression substitutions. Let me know if this doesn't seem to work for you though!
library(kableExtra)
library(stringr)
library(dplyr)
library(tidyr)
library(magick)
library(webshot)
dat <- structure(list(`2019-01-01` = c("f", "f", "f", "<U+263D>", "<U+263D>", "<U+263D>"), `2019-01-02` = c("<U+270E>", "<U+270E>", "<U+270E>", "<U+270E>", "<U+270E>", "<U+270E>"), `2019-01-03` = c("t", "t", "t", "d", "d", "d"), `2019-01-04` = c("d", "d", "d", "<U+2699>", "<U+2699>", "<U+2699>"), `2019-01-05` = c("&", "&", "&", "&", "&", "&"), `2019-01-06` = c("<U+2699>", "<U+2699>", "<U+2699>", "&", "&", "&"), `2019-01-07` = c("^", "^", "^", "^", "^", "^"), `2019-01-08` = c("&", "&", "&", "<U+270E>", "<U+270E>", "<U+270E>"), `2019-01-09` = c("<U+2699>", "<U+2699>", "<U+2699>", "<U+2699>", "<U+2699>", "<U+2699>"), `2019-01-10` = c("s", "s", "s", "s", "s", "s")), row.names = c(NA, 6L), class = "data.frame")
col.tab <- structure(list(Symbol = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "a","i", "k", "b", "l", "r", "c", "x", "#", "%", "^", "e", "m", "s", "#", "<U+270E>", "&", "<U+2699>", "d", "t", "y", "n", "<U+25C0>", "<U+263D>", "f", "<U+2689>", "<U+2726>", "<U+0394>", "¥", "p", "u", "<U+2326>", "<U+26AF>", "z", "<U+2714>", "o", "+", "v", "g", "<U+262F>", "<U+2724>", "<U+272B>", "<U+2766>", "j", "q", "h", "<U+2665>", "w"), Hex = c("#572433", "#72375D", "#633666", "#803A6B", "#6C3A6E", "#776B98", "#ADA7C7", "#5C7294", "#7B8EAB", "#707DA2", "#555B7B", "#464563", "#0E365C", "#11416D", "#13477D", "#2C597C", "#396987", "#4781A5", "#35668B", "#5A8FB8", "#3B768F", "#4F93A7", "#5BA3B3", "#90C3CC", "#C4DECC", "#7BAC94", "#5B9071", "#396F52", "#044D33", "#313919", "#424D21", "#4C5826", "#72843C", "#94AB4F", "#AEBF79", "#CCD9B1", "#D8E498", "#FFFB8B", "#FDF9CD", "#FFF1AF", "#FDD755", "#FFC840", "#FFBF57", "#FFA32B", "#FF8B00", "#F67F00", "#F27842", "#FF836F", "#E96A67", "#FF7992", "#E74967", "#BA4A4A", "#B33B4B", "#970B23", "#87071F", "#A7132B", "#913546")), row.names = c(NA, -57L), spec = structure(list(cols = list(Index = structure(list(), class = c("collector_double", "collector")), Color = structure(list(), class = c("collector_double", "collector")), `Color name` = structure(list(), class = c("collector_character", "collector")), Symbol = structure(list(), class = c("collector_character", "collector")), Hex = structure(list(), class = c("collector_character", "collector"))), default = structure(list(), class = c("collector_guess", "collector")), skip = 1), class = "col_spec"), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"))
color_mapper <- col.tab$Hex
names(color_mapper) <- col.tab$Symbol
c_func <- function(x){
color_mapper[as.character(x)]
}
x <- dat %>%
mutate(row.id = 1:n()) %>%
gather(key = "key", value = "value", -row.id) %>%
mutate(value2 = " ",
value2 = cell_spec(value2, background = mapply(c_func, value), color = mapply(c_func, value))
) %>%
select(-value) %>%
spread(key = key, value = value2) %>%
select(-row.id) %>%
kable(format = "html", escape = F) %>%
kable_styling(full_width = F)
x2 <- gsub("<thead>.*</thead>", "", x)
x3.splits <- unlist(str_split(x2, pattern = "\n"))
x3.cols <- str_extract(x3.splits, pattern = "#[0-9a-fA-F]{6}")
x3.vals <- str_extract(x3.splits, pattern = "(a-Z0-9)+")
## cycle through each row of HTML code to find and replace any value with
## HTML/CSS code to color the background of that specific cell
for (i in 1:length(x3.splits)){
if (!is.na(x3.cols[i])){
x2 <- gsub(
pattern = x3.splits[i],
replacement = paste0('<td style="text-align:center; background-color: ', x3.cols[i], '; border-top: 1px solid ', x3.cols[i], ';"><span style="margin-left:5px;margin-right:5px"> </span></td>'),
x = x2
)
}
}
x2 %>%
save_kable("my_image.png")
With the PNG output:
Here's a quick example using huxtable (I'm the package author):
tmp <- structure(list(`2019-01-01` = c("f", "f", "f", "<U+263D>", "<U+263D>", "<U+263D>"), `2019-01-02` = c("<U+270E>", "<U+270E>", "<U+270E>", "<U+270E>", "<U+270E>", "<U+270E>"), `2019-01-03` = c("t", "t", "t", "d", "d", "d"), `2019-01-04` = c("d", "d", "d", "<U+2699>", "<U+2699>", "<U+2699>"), `2019-01-05` = c("&", "&", "&", "&", "&", "&"), `2019-01-06` = c("<U+2699>", "<U+2699>", "<U+2699>", "&", "&", "&"), `2019-01-07` = c("^", "^", "^", "^", "^", "^"), `2019-01-08` = c("&", "&", "&", "<U+270E>", "<U+270E>", "<U+270E>"), `2019-01-09` = c("<U+2699>", "<U+2699>", "<U+2699>", "<U+2699>", "<U+2699>", "<U+2699>"), `2019-01-10` = c("s", "s", "s", "s", "s", "s")), row.names = c(NA, 6L), class = "data.frame")
ht <- as_hux(tmp)
ht <- map_background_color(ht, by_values("<U+270E>" = "red", "<U+2699>" = "green"))
I haven't used your exact symbol table. If it is large, you might want to do something like do.call(by_values, my_symbols) where my_symbols would be something like list("1" = "#572433", ...).

Mutate_if or mutate_at in dplyr with Dates

I have a data set that is over 100 columns, but for example lets suppose I have a data set that looks like
dput(tib)
structure(list(f_1 = c("A", "O", "AC", "AC", "AC", "O", "A", "AC", "O", "O"), f_2 = c("New", "New",
"New", "New", "Renewal", "Renewal", "New", "Renewal", "New",
"New"), first_dt = c("07-MAY-18", "25-JUL-16", "09-JUN-18", "22-APR-19",
"03-MAR-19", "10-OCT-16", "08-APR-19", "27-FEB-17", "02-MAY-16",
"26-MAY-15"), second_dt = c(NA, "27-JUN-16", NA, "18-APR-19",
"27-FEB-19", "06-OCT-16", "04-APR-19", "27-FEB-17", "25-APR-16",
NA), third_dt = c("04-APR-16", "21-JUL-16", "05-JUN-18", "18-APR-19",
"27-FEB-19", "06-OCT-16", "04-APR-19", "27-FEB-17", "25-APR-16",
"19-MAY-15"), fourth_dt = c("05-FEB-15", "25-JAN-16", "05-JUN-18",
"10-OCT-18", "08-JAN-19", "02-SEP-16", "24-OCT-18", "29-SEP-16",
"27-JAN-15", "14-MAY-15"), fifth_dt = structure(c(1459728000,
1469059200, 1528156800, 1555545600, 1551225600, 1475712000, 1554336000,
1488153600, 1461542400, 1431993600), class = c("POSIXct", "POSIXt"
), tzone = "UTC"), sex = c("M", "M", "F", "F", "M", "F", "F",
"F", "F", "F")), row.names = c(NA, -10L), class = c("tbl_df",
"tbl", "data.frame"))
Most of the date (ends_with(dt)) columns are strings, but I want to convert them into dates. I tried mutate_at but received the following:
tib %>% mutate_at(vars(ends_with("dt")), funs(parse_date_time(.))) %>% glimpse()
Error in mutate_impl(.data, dots) :
Evaluation error: argument "orders" is missing, with no default.
Any thoughts on what caused this error? Should I use a different mutate function?
As akrun noted, one of the columns is already in dttm format. Once that column is ignored the following code works for me:
tib %>%
select(-fifth_dt) %>%
mutate_at(vars(ends_with("dt")), parse_date_time, orders = "%d-%m-%y")
The funs is deprecated. In place, list can be used
library(dplyr)
tib %>%
mutate_at(3:6, list(~ parse_date_time(., "%d-%m-%y")))

Error in ggtexttable (ggpubr)

I'm trying to create a publication-ready table using the ggtexttable function from ggpubr. I have a data frame:
dput(df)
structure(list(feature = list("start_codon", "stop_codon", "intergenic",
"3UTR", "5UTR", "exon", "intron", "ncRNA", "pseudogene"),
observed = list(structure(1L, .Names = "start_codon"), structure(1L, .Names = "stop_codon"),
structure(418L, .Names = "intergenic"), structure(48L, .Names = "3UTR"),
structure(28L, .Names = "5UTR"), structure(223L, .Names = "exon"),
structure(578L, .Names = "intron"), structure(20L, .Names = "ncRNA"),
structure(1L, .Names = "pseudogene")), expected = list(
0.286, 0.286, 369.02, 72.461, 33.165, 257.869, 631.189,
48.491, 3.172), fc = list(3.5, 3.5, 1.1, 0.7, 0.8, 0.9,
0.9, 0.4, 0.3), test = list("enrichment", "enrichment",
"enrichment", "depletion", "depletion", "depletion",
"depletion", "depletion", "depletion"), sig = list("F",
"F", "T", "T", "F", "T", "T", "T", "F"), p_val = list(
"0.249", "0.249", "0.00186", "0.00116", "0.209", "0.00814",
"0.00237", "<1e-04", "0.175")), class = "data.frame", row.names = c(NA,
-9L), .Names = c("feature", "observed", "expected", "fc", "test",
"sig", "p_val"))
And when I try to turn this into a table:
ggtexttable(df)
I get the error:
Error in (function (label, parse = FALSE, col = "black", fontsize =
12, : unused arguments (label.feature = dots[[5]][1],
label.observed = dots[[6]][1], label.expected = dots[[7]][1],
label.fc = dots[[8]][1], label.test = dots[[9]][1], label.sig_val
= dots[[10]][1], label.p_val = dots[[11]][1])
Does anyone know what might be causing this?
This works fine:
df <- head(iris)
ggtexttable(df)
I have found the problem and solution which is going to work for you. First of all your data is not in proper format (nested list) thats why you were getting this error trying to display it. You can check what is the format of the dataset easily by pasting in your console: str(data)
Here is the solution to convert your data to data.frame:
first.step <- lapply(data, unlist)
second.step <- as.data.frame(first.step, stringsAsFactors = F)
Then you can easily use the function ggtexttable(second.step) and it displays the table with your data.

How to search for string patterns in another string and include a separator?

My data is structured as follows:
dput(head(CharacterAnalysis,5))
structure(list(Character = c("A", "a", "B", "b", "C"),
Descriptor = c("Jog", "Change Direction", "Shuffle", "Walk", "Stop"),
.Names = c("Character", "Descriptor"),
row.names = c(NA, 5L), class = "data.frame")
I wish to lookup the Character and relevant Descriptor in the following data frame, but am unsure how to do so:
dput(head(StringAnalysis,3))
structure(list(MovementString = c("ACb", "aAaB", "BbCa"),
.Names = c("MovementString"),
row.names = c(NA, 3L), class = "data.frame")
My expected outcome/ data frame would be:
dput(head(Output,3))
structure(list(MovementString = c("ACb", "aAaB", "BbCa"),
MovementPerformed = c("Jog/ Stop/ Walk", "Change Direction/ Jog/ Change Direction/ Shuffle", "Shuffle/ Walk/ Stop/ Change Direction")
.Names = c("MovementString", "MovementPerformed"),
row.names = c(NA, 3L), class = "data.frame")
I would like a forward stroke (/) or similar to separate each Descriptor as it signals a new movement. Any advice on how to please complete this? My data frame CharacterAnalysis is over 1 million rows long, so I do not wish to have to search for each MovementString separately!
Thank you.
CharacterAnalysis <-
structure(list(Character = c("A", "a", "B", "b", "C"),
Descriptor = c("Jog", "Change Direction", "Shuffle", "Walk", "Stop")),
.Names = c("Character", "Descriptor"),
row.names = c(NA, 5L), class = "data.frame")
Output <-
structure(list(MovementString = c("ACb", "aAaB", "BbCa"),
MovementPerformed = c("Jog/ Stop/ Walk", "Change Direction/ Jog/ Change Direction/ Shuffle", "Shuffle/ Walk/ Stop/ Change Direction")),
.Names = c("MovementString", "MovementPerformed"),
row.names = c(NA, 3L), class = "data.frame")
# A simple approach based on names
# Build the lookup table just once
m <- CharacterAnalysis$Descriptor
names(m) <- CharacterAnalysis$Character
# Build the MovementPerformed column
Output$MovementPerformed <-
sapply(strsplit(Output$MovementString,""),
FUN = function(x) paste(m[x], collapse = "/ "))

Resources