I'm fairly new to R and I'm trying to write code to solve the Spelling Bee game on the NYTimes website to see how I'm doing. I tried writing a function to compare two strings ('given' and 'test_word') that returns TRUE if you can spell 'test_word' with only the letters from 'given' and FALSE otherwise. I got that to work, so I downloaded the enable1 wordlist and tried to apply that function to every word in the list. Instead of giving me a new column in the dataframe with the result of the function on each word, it just returns FALSE for every row, and I'm just confused as to what I'm doing wrong. It looks like it's just taking the value of the function for the first entry in the wordlist instead of looking at each word individually.
Here's my code:
library(dplyr)
is_good <- function(given, test_word) {
diffs <- paste(unlist(setdiff(strsplit(test_word,'')[[1]],strsplit(given,'')[[1]])),collapse='')
match = case_when(
diffs == '' ~ TRUE,
diffs != '' ~ FALSE
)
return(match)
}
given <- 'CLEXION'
#words = read.csv('c:/Users/Dave/Documents/R/enable1.txt', header=FALSE)
# edited to add sample list of words
V1 <- c('AAHED','LEXICON','LION','COLLECTION')
words <- data.frame(V1)
names(words) <- c('word')
words <- filter(words, nchar(word)>=4)
words$word <- toupper(words$word)
words <- words %>% mutate(is_match = is_good(given,word))
After running all this, I get this output:
> filter(words, is_match == TRUE)
[1] word is_match
<0 rows> (or 0-length row.names)
Just to check I ran a filter on a word I know should work and got
> filter(words, word=='LEXICON')
word is_match
1 LEXICON FALSE
If I run the function on its own with one word I get the expected result:
> is_good(given,'LEXICON')
[1] TRUE
Why is the function call in my mutate step not applying the function to each row? I'm getting comfortable with the idea of lists and data frames but there's obviously something I'm missing when putting it into practice.
UPDATE: I researched the lapply function and it did what I hoped - my new code looks like
test_split <- lapply(test_word, function(w) {strsplit(w,'')[[1]]})
given_split <- strsplit(given,'')[[1]]
diff_1 <- lapply(test_split, function(x) {paste(unlist(setdiff(x, given_split)),collapse='')})
match = lapply(diff_1, function(x) {
case_when(
x == '' ~ TRUE,
x != '' ~ FALSE
)})
Answer to match the OP's view
is_good <- function(given, test_word) {
test_split <- strsplit(test_word, split = "") # don't need lapply here since strsplit is already vectorized
given_split <- strsplit(given,'')[[1]]
diff_1 <- lapply(test_split, function(x) {paste(unlist(setdiff(x, given_split)),collapse='')})
# From here, it is back to simple things!
diff_1 <- unlist(diff_1)
match <- diff_1 == ""
return(match)
}
Thanks for providing sample data. It makes it easier to solve.
It is probably overkill, but here is the dplyr / tidyverse answer.
Note that |> is the base pipe (similar to %>%).(will work for R>=4.1.0)
Note you will need extra packages ( stringr and tidyr). Check if you have them installed.
If not already installed, run
install.packages(c("tidyr", "stringr")
purrr::map() is used to manipulate elements of a list
purrr::map_lgl() ensures you return a logical vector
Solution for dealing with duplicated letters
library(dplyr)
is_good <- function(given, test_word) {
# Standardizing to upper case
given <- toupper(given)
test_word <- toupper(test_word)
# Extracting letters
given_letters <- stringr::str_split(given, pattern = "")
given_letters <- unlist(given_letters)
# This part deals with duplicated letters
# there is probably a base R way to do it.
given_letters <- tibble(given_letter = given_letters) |>
group_by(given_letter) |>
mutate(letter = paste0(given_letter, row_number())) |>
pull(letter)
# For word "DREAD", it will return ("D1", "R1", "E1", "D2")
# Manipulating test_word
letters_in_test_words <- stringr::str_split(test_word, pattern = "")
# a little bit more complicated, but similar to previously to mark duplicated
# letters. It outputs a list. Example: for input "THIN", "MINI"
# a list of 2
# [[1]] : "T1", "H1", "I1", "N1"
# [[2]] : "M1", "I1", "N1" "I2"
letters_in_test_words <- tibble(
word_id = 1:length(letters_in_test_words),
letter = letters_in_test_words
) |>
tidyr::unnest(letter) |>
group_by(word_id, letter) |>
mutate(letter = paste0(letter, dplyr::row_number())) |>
ungroup() |>
tidyr::nest(data = letter) |>
mutate(data = purrr::map(data, 1)) |>
pull(data)
# iterates over the words to find if there is a complete match
match <- purrr::map_lgl(letters_in_test_words, ~ all(.x %in% given_letters))
match
}
given <- 'CLEXION'
#words = read.csv('c:/Users/Dave/Documents/R/enable1.txt', header=FALSE)
# edited to add sample list of words
V1 <- c('AAHED','LEXICON','LION','COLLECTION')
words <- data.frame(word = V1)
words <- filter(words, nchar(word)>=4)
words$word <- toupper(words$word) # a good idea to be put inside the function
is_good("AHMED","LEXICO1N")
#> [1] FALSE
words <- words %>% mutate(is_match = is_good(given,word))
words |>
filter(is_match)
#> word is_match
#> 1 LEXICON TRUE
#> 2 LION TRUE
# My solution checks for duplicated letters
# You probably don't want this as TRUE.
is_good(given = "TRUCE", test_word = "TRUCEE")
#> [1] FALSE
Created on 2022-06-17 by the reprex package (v2.0.1)
Note:
My function could probably exist in base R as well, but I am better with tables. It is also overkill since it checks for duplicates.
A solution that doesn't check for duplicates (much simpler)
library(dplyr)
is_good <- function(given, test_word) {
# Standardizing
given <- toupper(given)
test_word <- toupper(test_word)
# Extracting letters
given_letters <- stringr::str_split(given, pattern = "")
given_letters <- unlist(given_letters)
# Manipulating test_word
letters_in_test_words <- stringr::str_split(test_word, pattern = "")
# a little bit more complicated, but simi
# iterates over the words to find if there is a complete match
match <- purrr::map_lgl(letters_in_test_words, ~ all(.x %in% given_letters))
match
}
given <- 'CLEXION'
#words = read.csv('c:/Users/Dave/Documents/R/enable1.txt', header=FALSE)
# edited to add sample list of words
V1 <- c('AAHED','LEXICON','LION','COLLECTION')
words <- data.frame(word = V1)
words <- filter(words, nchar(word)>=4)
words$word <- toupper(words$word) # a good idea to be put inside the function
is_good("AHMED","LEXICO1N")
#> [1] FALSE
words <- words %>% mutate(is_match = is_good(given,word))
words |>
filter(is_match)
#> word is_match
#> 1 LEXICON TRUE
#> 2 LION TRUE
# You probably don't want this as TRUE. but it will come out as TRUE without the
# Duplicated letters are ignored.
is_good(given = "TRUCE", test_word = "TRUCEE")
#> [1] TRUE
Created on 2022-06-17 by the reprex package (v2.0.1)
Related
I have a data frame which I would like to group according to the value in a given row and column of the data frame
my_data <- data.frame(matrix(ncol = 3, nrow = 4))
colnames(my_data) <- c('Position', 'Group', 'Data')
my_data[,1] <- c('A1','B1','C1','D1')
my_data[,3] <- c(1,2,3,4)
grps <- list(c('A1','B1'),
c('C1','D1'))
grp.names = c("Control", "Exp1", "EMPTY")
my_data$Group <- case_when(
my_data$Position %in% grps[[1]] ~ grp.names[1],
my_data$Position %in% grps[[2]] ~ grp.names[2]
)
OR
my_data$Group <- with(my_data, ifelse(Position %in% grps[[1]], grp.names[1],
ifelse(Position %in% grps[[2]], grp.names[2],
grp.names[3])))
These examples work and produce a Group column with appropriate labels, however I need to have flexibility in the length of the grps list from 1 to approximately 25.
I see no way to iterate through case_with or ifelse in a for loop eg.
my_data$Group <- for (i in 1:length(grps)){
case_when(
my_data$Well %in% grps[[i]] ~ grp.names[i])
}
This example simply deletes the Group column
What is the most appropriate way to handle a variable grps length?
I believe your question implies that the grps variable is a list and every element in that list is itself an array that holds all the positions that belong to that group.
Specifically, in your grps variable below, if the Position is "A1" or "B1" it belongs to the whatever your first entry is grp.names. Similarly, if the position is "C1" or "D1" it belongs to whatever your second entry is in grp.names
> grps
[[1]]
[1] "A1" "B1"
[[2]]
[1] "C1" "D1"
Assuming that to be the case you can do the following:
matching_group_df <- sapply(grps, function(x){ my_data$Position %in% x})
selected_group <- apply(matching_group_df, 1, function(x){which(x == TRUE)})
my_data$Group <- grp.names[selected_group]
Position Group Data
1 A1 Control 1
2 B1 Control 2
3 C1 Exp1 3
4 D1 Exp1 4
The way it works is as follows:
matching_group_df is a matrix of True/False (created via the sapply function) that specifies what group index the position belongs to:
> matching_group_df
[,1] [,2]
[1,] TRUE FALSE
[2,] TRUE FALSE
[3,] FALSE TRUE
[4,] FALSE TRUE
You then select the column that has the TRUE value row by row using an apply command:
selected_group <- apply(matching_group_df, 1, function(x){which(x == TRUE)})
> selected_group
[1] 1 1 2 2
Finally you pass those indices to your grp.names list to select the appropriate ones and set them into your original dataframe.
grp.names[selected_group]
[1] "Control" "Control" "Exp1" "Exp1"
This also has the small side benefit of just using base R functions if that is important to you.
Approach 1: Hash table
I would opt for a different approach here, as group makeup might change during analysis, specifically a lookup table of key-value pairs, and write a small accessor function.
library(tidyverse)
# First, a small adjustment to `grps` to reflect an empty group.
grps <- list(c('A1','B1'),
c('C1','D1'),
NULL)
names <- unlist(grps, use.names = F)
values <- rep(grp.names, map_dbl(grps, length))
h = as.list(values) %>%
set_names(names) %>%
list2env()
# find x in h
f <- Vectorize(function(x) h[[x]], c("x")) # scoping here
This takes some time to setup, but usage is quite convenient:
my_data %>%
mutate(Groups = f(Position))
Position Group Data
1 A1 Control 1
2 B1 Control 2
3 C1 Exp1 3
4 D1 Exp1 4
This avoids having to change your code in multiple places, and can take on arbitrary length of groups.
Approach 2: Dynamic switch
Alternatively, we can make an arbitrary length switch expression, building it from the group names and their unique values.
constructor <- function(ids, names){
purrr::imap_chr(as.character(ids), ~paste(paste0("\"", .x ,"\""),
paste0("\"", names[.y], "\""),
sep = "=")) %>%
paste0(collapse = ", ") %>%
paste0("Vectorize(function(x) switch(as.character(x), ", ., ", NA))", collapse = "") %>%
str2expression()
}
my_data %>%
mutate(Group = eval(constructor(names, values)))
In this case, it would evaluate the expression
expression(Vectorize(function(x) switch(as.character(x), A1 = "Control",
B1 = "Control", C1 = "Exp1", D1 = "Exp1",
NA)))
For each item in my_data$Position you want to go through each of the grps and look for a match and assign grp.names, if so. If you don't find a match in any grp, assign grp.names[3]:
my_data$Group <- lapply(my_data$Position, function(position){ # Goes through each my_data$Position
for(i in 1:length(grps)){
if(position %in% grps[[i]]){
return(grp.names[i]) # Give matching index of grp.names to grps
} else if (i == length(grps)){ # if no matches assign grp.names[3]
return(grp.names[3])
}
}
}) %>% unlist() # Put the list into a vector
I am struggling to separate a single string input into a series of inputs. The user gives a list of FASTA formatted sequences (see example below). I'm able to separate the inputs into their own
ex:
">Rosalind_6404
CCTGCGGAAGATCGGCACTAGAATAGCCAGAACCGTTTCTCTGAGGCTTCCGGCCTTCCC
TCCCACTAATAATTCTGAGG
.>Rosalind_5959
CCATCGGTAGCGCATCCTTAGTCCAATTAAGTCCCTATCCAGGCGCTCCGCCGAAGGTCT
ATATCCATTTGTCAGCAGACACGC
"
[1] "Rosalind_6404CCTGCGGAAGATCGGCACTAGAATAGCCAGAACCGTTTCTCTGAGGCTTCCGGCCTTCCCTCCCACTAATAATTCTGAGG"
[2] "Rosalind_5959CCATCGGTAGCGCATCCTTAGTCCAATTAAGTCCCTATCCAGGCGCTCCGCCGAAGGTCTATATCCATTTGTCAGCAGACACGC"
But I am struggling to find a way to create a function that splits the "Rosalind_6404" from the gene sequence to the unknown amount of FASTA sequences while creating new vectors for the split elements.
Ultimately, the result would look something such as:
.> "Rosalind_6404" "Rosalind5959"
.> "CCTGCGGAAGATCGGCACTAGAATAGCCAGAACCGTTTCTCTGAGGCTTCCGGCCTTCCCTCCCACTAATAATTCTGAGG","CCATCGGTAGCGCATCCTTAGTCCAATTAAGTCCCTATCCAGGCGCTCCGCCGAAGGTCTATATCCATTTGTCAGCAGACACGC"
I was hoping the convert_entries function would allow me to iterate over all the elements of the prepped_s character vector and split the elements into two new vectors with the same index number.
s <- ">Rosalind_6404
CCTGCGGAAGATCGGCACTAGAATAGCCAGAACCGTTTCTCTGAGGCTTCCGGCCTTCCC
TCCCACTAATAATTCTGAGG
>Rosalind_5959
CCATCGGTAGCGCATCCTTAGTCCAATTAAGTCCCTATCCAGGCGCTCCGCCGAAGGTCT
ATATCCATTTGTCAGCAGACACGC"
split_s <- strsplit(s, ">")
ul_split_s<- unlist(split_s)
fixed_s <- gsub("\n","", ul_split_s)
prepped_s <- fixed_s[-1]
prepped_s
nchar(prepped_s[2])
print(prepped_s[2])
entry_tags <- list()
entry_seqs <- list()
entries <- length(prepped_s)
unlist(entries)
first <- prepped_s[1]
convert_entries <- function() {
for (i in entries) {
tag <- substr(prepped_s[i], start = 1, stop = 13)
entry_tags <- append(entry_tags, tag)
return(entry_tags)
}
}
entry_tags <- convert_entries()
print(entry_tags)
Please help in any way you can, thanks!
One option with tidyverse
library(dplyr)
library(tidyr)
library(stringr)
tibble(col1 = s) %>%
separate_rows(col1, sep="\n") %>%
group_by(grp = cumsum(str_detect(col1, '^>'))) %>%
summarise(prefix = first(col1),
col1 = str_c(col1[-1], collapse=""), .groups = 'drop') %>%
select(-grp)
-output
# A tibble: 2 x 2
prefix col1
<chr> <chr>
1 >Rosalind_6404 CCTGCGGAAGATCGGCACTAGAATAGCCAGAACCGTTTCTCTGAGGCTTCCGGCCTTCCCTCCCACTAATAATTCTGAGG
2 >Rosalind_5959 CCATCGGTAGCGCATCCTTAGTCCAATTAAGTCCCTATCCAGGCGCTCCGCCGAAGGTCTATATCCATTTGTCAGCAGACACGC
Using seqinr package:
library(seqinr)
# example fasta file
write(">Rosalind_6404
CCTGCGGAAGATCGGCACTAGAATAGCCAGAACCGTTTCTCTGAGGCTTCCGGCCTTCCC
TCCCACTAATAATTCTGAGG
>Rosalind_5959
CCATCGGTAGCGCATCCTTAGTCCAATTAAGTCCCTATCCAGGCGCTCCGCCGAAGGTCT
ATATCCATTTGTCAGCAGACACGC", "myFile.fasta")
# read the fasta file
x <- read.fasta("myFile.fasta", as.string = TRUE, forceDNAtolower = FALSE)
# get the names
names(x)
# [1] "Rosalind_6404" "Rosalind_5959"
# get the seq
x$Rosalind_6404
# [1] "CCTGCGGAAGATCGGCACTAGAATAGCCAGAACCGTTTCTCTGAGGCTTCCGGCCTTCCCTCCCACTAATAATTCTGAGG"
# attr(,"name")
# [1] "Rosalind_6404"
# attr(,"Annot")
# [1] ">Rosalind_6404"
# attr(,"class")
# [1] "SeqFastadna"
In base R you could do:
t(gsub('\n', '', regmatches(s, gregexec("([A-Z][a-z_0-9]+)\n([A-Z\n]+)", s))[[1]][-1,]))
[,1] [,2]
[1,] "Rosalind_6404" "CCTGCGGAAGATCGGCACTAGAATAGCCAGAACCGTTTCTCTGAGGCTTCCGGCCTTCCCTCCCACTAATAATTCTGAGG"
[2,] "Rosalind_5959" "CCATCGGTAGCGCATCCTTAGTCCAATTAAGTCCCTATCCAGGCGCTCCGCCGAAGGTCTATATCCATTTGTCAGCAGACACGC"
NOTE: I transposed the matrix so that you may vie the results. Ignore the use of t function
Another base R solution:
read.table(text=sub('\n', ' ', gsub('(\\D)\n', '\\1', unlist(strsplit(s, '>')))))
V1 V2
1 Rosalind_6404 CCTGCGGAAGATCGGCACTAGAATAGCCAGAACCGTTTCTCTGAGGCTTCCGGCCTTCCCTCCCACTAATAATTCTGAGG
2 Rosalind_5959 CCATCGGTAGCGCATCCTTAGTCCAATTAAGTCCCTATCCAGGCGCTCCGCCGAAGGTCTATATCCATTTGTCAGCAGACACGC
or even
proto <- data.frame(name = character(), value = character())
new_s <- gsub('\n', '', unlist(strsplit(s, '>')))
strcapture("([A-Z][a-z_0-9]+)([A-Z]+)", grep('\\w', new_s, value = T), proto)
name value
1 Rosalind_6404 CCTGCGGAAGATCGGCACTAGAATAGCCAGAACCGTTTCTCTGAGGCTTCCGGCCTTCCCTCCCACTAATAATTCTGAGG
2 Rosalind_5959 CCATCGGTAGCGCATCCTTAGTCCAATTAAGTCCCTATCCAGGCGCTCCGCCGAAGGTCTATATCCATTTGTCAGCAGACACGC
I have a dataframe containing a column of strings. I want to check whether any of the elements in each string match any of the elements in one or more predefined vectors, and then return a new logical column. This is easily accomplished using grepl().
However (and this is the part I need help with), I also want to check whether the strings contain any elements other than those contained in the keyword vectors.
Example data:
matchvector1 <- c("Apple","Banana","Orange")
matchvector2 <- c("Strawberry","Kiwi","Grapefruit")
id <- c(1,2,3)
string_column <- c(paste0(c("Apple","Banana"),collapse=", "), paste0(c("Strawberry","Kiwi"), collapse = ", "), paste0(c("Apple","Pineapple"), collapse = ", "))
df <- data.frame(id, string_column)
df$string_column <- as.character(df$string_column)
matches_vector1 <- grepl(paste(matchvector1, collapse = "|"), df$string_column)
matches_vector2 <- grepl(paste(matchvector2, collapse = "|"), df$string_column)
The output should look something like:
matches_vector1: TRUE FALSE TRUE
matches_vector2: FALSE TRUE FALSE
unmatched_words: FALSE FALSE TRUE
I'm stuck on this last part. Is there an easy way to match on anything except something in a list of keywords using grepl() (or another function)? I suspect it will involve using negative lookaround somehow but the few existing threads on this didn't seem to answer my question.
One option is to split the 'string_column' with separate_rows, grouped by 'id', check if there are not any elements from 'string_column' %in% the concatenated vectors
library(dplyr)
library(tidyr)
df %>%
separate_rows(string_column) %>%
group_by(id) %>%
summarise(unmatched = any(!string_column %in% c(matchvector1, matchvector2)) )
# A tibble: 3 x 2
# id unmatched
#* <dbl> <lgl>
#1 1 FALSE
#2 2 FALSE
#3 3 TRUE
or in base R
lengths(sapply(strsplit(df$string_column, ",\\s*"),
setdiff, c(matchvector1, matchvector2))) > 0
#[1] FALSE FALSE TRUE
I need to prepare a certain dataset for analysis. What I have is a table with column names (obviously). The column names are as follows (sample colnames):
"X99_NORM", "X101_NORM", "X76_110_T02_09747", "X30_NORM"
(this is a vector, for those not familiair with R colnames() function)
Now, what I want is simply to flip the values in front of, and after the underscore. e.g. X99_NORM becomes NORM_X99. Note that I want this only for the column names which contain NORM in their name.
Some other base R options
1)
Use sub to switch the beginning and end - we can make use of capturing groups here.
x <- sub(pattern = "(^X\\d+)_(NORM$)", replacement = "\\2_\\1", x = x)
Result
x
# [1] "NORM_X99" "NORM_X101" "X76_110_T02_09747" "NORM_X30"
2)
A regex-free approach that might be more efficient using chartr, dirname and paste. But we need to get the indices of the columns that contain "NORM" first
idx <- grep(x = x, pattern = "NORM", fixed = TRUE)
x[idx] <- paste0("NORM_", dirname(chartr("_", "/", x[idx])))
x
data
x <- c("X99_NORM", "X101_NORM", "X76_110_T02_09747", "X30_NORM")
x = c("X99_NORM", "X101_NORM", "X76_110_T02_09747", "X30_NORM")
replace(x,
grepl("NORM", x),
sapply(strsplit(x[grepl("NORM", x)], "_"), function(x){
paste(rev(x), collapse = "_")
}))
#[1] "NORM_X99" "NORM_X101" "X76_110_T02_09747" "NORM_X30"
A tidyverse solution with stringr:
library(tidyverse)
library(stringr)
my_data <- tibble(column = c("X99_NORM", "X101_NORM", "X76_110_T02_09747", "X30_NORM"))
my_data %>%
filter(str_detect(column, "NORM")) %>%
mutate(column_2 = paste0("NORM", "_", str_extract(column, ".+(?=_)"))) %>%
select(column_2)
# A tibble: 3 x 1
column_2
<chr>
1 NORM_X99
2 NORM_X101
3 NORM_X30
I have variables with names such as r1a r3c r5e r7g r9i r11k r13g r15i etc. I am trying to select variables which starts with r5 - r12 and create a dataframe in R.
The best code that I could write to get this done is,
data %>% select(grep("r[5-9][^0-9]" , names(data), value = TRUE ),
grep("r1[0-2]", names(data), value = TRUE))
Given my experience with regular expressions span a day, I was wondering if anyone could help me write a better and compact code for this!
Here's a regex that gets all the columns at once:
data %>% select(grep("r([5-9]|1[0-2])", names(data), value = TRUE))
The vertical bar represents an 'or'.
As the comments have pointed out, this will fail for items such as r51, and can also be shortened. Instead, you will need a slightly longer regex:
data %>% select(matches("r([5-9]|1[0-2])([^0-9]|$)"))
Suppose that in the code below x represents your names(data). Then the following will do what you want.
# The names of 'data'
x <- scan(what = character(), text = "r1a r3c r5e r7g r9i r11k r13g r15i")
y <- unlist(strsplit(x, "[[:alpha:]]"))
y <- as.numeric(y[sapply(y, `!=`, "")])
x[y > 4]
#[1] "r5e" "r7g" "r9i" "r11k" "r13g" "r15i"
EDIT.
You can make a function with a generalization of the above code. This function has three arguments, the first is the vector of variables names, the second and the third are the limits of the numbers you want to keep.
var_names <- function(x, from = 1, to = Inf){
y <- unlist(strsplit(x, "[[:alpha:]]"))
y <- as.integer(y[sapply(y, `!=`, "")])
x[from <= y & y <= to]
}
var_names(x, 5)
#[1] "r5e" "r7g" "r9i" "r11k" "r13g" "r15i"
Remove the non-digits, scan the remainder in and check whether each is in 5:12 :
DF <- data.frame(r1a=1, r3c=2, r5e=3, r7g=4, r9i=5, r11k=6, r13g=7, r15i=8) # test data
DF[scan(text = gsub("\\D", "", names(DF)), quiet = TRUE) %in% 5:12]
## r5e r7g r9i r11k
## 1 3 4 5 6
Using magrittr it could also be written like this:
library(magrittr)
DF %>% .[scan(text = gsub("\\D", "", names(.)), quiet = TRUE) %in% 5:12]
## r5e r7g r9i r11k
## 1 3 4 5 6