This code is suppose to take in a word, and compute values for letters of the word, based on the position of the letter in the word. So for a word like "broke" it's suppose to compute the values for the letter "r" and "k"
strg <- 'broke'
#this part stores everything except the first,
#last, and middle position of the word
strg.leng <- nchar(strg)
other.letts <- sequence(strg.leng)
if (length(other.letts) %% 2 != 0) {
oth_let1 <- other.letts[-c(1, ceiling(length(other.letts)/2), length(other.letts))]
} else {
oth_let0 <- other.letts[-c(1, c(1,0) + floor(length(other.letts)/2), length(other.letts))]
}
print(paste("Values of the other letters of: ", strg))
#here is where the computation starts, taking in the objects created above
if ((nchar(strg) %% 2) != 0) {
sapply(oth_let1, function(i) print(paste(oth_let1[i], "L", (.66666*1.00001) - (oth_let1[i] - 1) *.05 )))
} else {
sapply(oth_let0, function(i) print(paste(oth_let0[i], "L", (.66666*1.00001) - (oth_let0[i] - 1) *.05 )))
}
However for "broke" I get this which is only computing the value of "k" and some other stuff:
[1] "4 L 0.5166666666"
[1] "NA L NA"
[1] "4 L 0.5166666666" "NA L NA"
While the desired output should be a value for both "r" and "k", so something like:
[1] "2 L 0.61666666"
[1] "4 L 0.51666666"
What am I doing wrong? Am I using sapply incorrectly?
sapply iterates through the supplied vector or list and supplies each member in turn to the function. In your case, you're getting the values 2 and 4 and then trying to index your vector again using its own values. Since the oth_let1 vector has only two members, you get NA. You could fix your current code by replacing the oth_let1[i] with just i. However, your code could be greatly simplified to:
strg <- 'broke'
lets <- 2:(nchar(strg) - 1)
lets <- lets[-(1:2 + length(lets)) / 2] # removes middle item for odd and middle two for even
cat("Values of the other letters of:", strg, "\n")
#here is where the computation starts, taking in the objects created above
writeLines(paste(lets, "L", 0.66666*1.00001 - (lets - 1) * 0.05, sep = " "))
I'm assuming you want to output the results to the console.
You're using sapply correct, what you're getting wrong is the function inside it. What you want is the i element of the other.letts variable, not from the oth_let1. oth_let1 have the indexes from the other.letts.
The code bellow should work, I also change the name of the variable to oth_let, so you don't have to use other if. For the output be exact what you ask for I used the invisible function.
strg <- 'broke'
strg.leng <- nchar(strg)
other.letts <- sequence(strg.leng)
if(length(other.letts) %% 2 != 0) {
oth_let <- other.letts[-c(1, ceiling(length(other.letts)/2),
length(other.letts))]
}else{
oth_let <- other.letts[-c(1, c(1,0) + floor(length(other.letts)/2),
length(other.letts))]
}
print(paste("Values of the other letters of: ", strg))
invisible(sapply(oth_let,
function(i)
print(paste(other.letts[i], "L", (.66666*1.00001) - (other.letts[i] - 1) *.05 ))))
Related
I have the following function in R. It is working fine, however, I think that must be a better way to run this function.
values <- c("a","b")
print <- function(values){
size <- length(values)
if (size == 1) {
final <- values[1]
}else if(size == 2){
final <- paste0(values[2], " and ", values[1])
}else if(size == 3){
final <- paste0(values[3], " and ",values[2], " and ", values[1])
}
return(final)
}
print(values)
The user can change the size of values, so if he choose values <- c("a","b", "c") the function is gonna run in the last condition. However, the last condition is in art equal to the second conditional plus something new. It is possible to make an if statement, or something in those lines that uses the previous condition . Something like:
values <- c("a","b", "c")
print <- function(values){
size <- length(values)
if (size == 1) {
final <- values[1]
}else if(size == 2){
final <- paste0(values[2], " and ", final )
}else if(size == 3){
final <- paste0(values[3], " and ",final )
}
return(final)
}
print(values)
Try this, which reverses the order of the input vector and pastes "and" between:
newfun <- function(x){
ifelse(length(x)>1, paste(rev(x), collapse = " and "), x)
}
Output:
newfun(letters[1])
# [1] "a"
newfun(letters[1:2])]
# [1] "b and a"
# and so on...
newfun(letters[1:5])
# [1] "e and d and c and b and a"
Testing this against your function to see if it is identical:
all.equal(print(letters[1:3]),
newfun(letters[1:3]))
# [1] TRUE
I would also strongly caution naming user-defined functions names that are already inherent in R (i.e. print() is already a function in R.
Another way of reversing the order of the vectors:
reverse_print <- function(values) paste(values[order(values, decreasing = TRUE)], collapse = " and ")
reverse_print(c("a", "b"))
#[1] "b and a"
reverse_print(c("a", "b", "c", "d"))
#[1] "d and c and b and a"
However, if your main objective is to create a function that recursively uses a condition and the previous conditions, one way of achieving it is to create a direct recursive function, in which the function calls itself (please see #G.Chan's comment for reference). Unfortunately, I failed to create such function for your case. Error: C stack usage 15927520 is too close to the limit was produced. This kind of error is relatively common in recursive functions, as discussed here.
Instead of crating a direct recursive function, I would suggest making the use of while along with incremented index as follows:
revprint <- function(values) {
size <- length(values)
if (size == 1) {
cat(values[1])
} else {
while (size > 1) {
final <- values[size]
appended <- paste0(final, " and ")
size <- size - 1
output <- cat(appended)
}
cat(output, values[1], sep = "")
}
}
revprint("a")
# a
revprint(c("a", "b", "c", "d"))
# d and c and b and a
If the length of the input (a character vector) is larger than 1, this function displays the final character of the input using paste0, and then incrementally reduces the length of the input. In each incremental step, the final character of the new (shorter) input is displayed, appended with the final character of the previous (longer) input.
Because this function uses cat, the result is displayed on the console, but it cannot be assigned directly to an object. To assign it to an object, you can use capture.output()
out <- capture.output(revprint(c("a", "b", "c", "d")))
out
#[1] "d and c and b and a"
I need some pointers on this. Actually, I don't necessarily need a fully-fledged solution here - some pointers to functions and/or packages would be great.
The problem: I want to find specific sequences in a character vector. The sequences can be somewhat "underspecified". That means that some of the elements should be fixed, but for some elements it does not matter how long they are or what they are exactly.
An example: Suppose I want to find the following pattern in a character vector:
The sequence should begin with "Out of" or "out of"
The sequence should end with "reasons"
In between, there should be other elements. But it does not matter how much elements (also zero would be OK) and what the elements exactly are.
In between 1. and 2., there shouldn't be a ".", "!" or "?".
There should be a parameter that controls how long the sequence in 3. can maximally be to still produce a result.
Return value of the function should be the intervening elements and/or their indices in the vector.
So, the function should "behave" like this:
c("Out", "of", "specific", "reasons", ".") Return "specific"
c("Out", "of", "very", "specific", "reasons", ".") Return c("very", "specific")
c("out", "of", "curiosity", ".", "He", "had", "his", "reasons") Return "" or NA or NULL, which one doesn't matter - just a signal that there is no result.
As I said: I don't need a full solution. Any pointers to packages that already implement such functionality are appreciated!
Optimally, I don't want to rely on a solution that first pastes the text and then uses regex for matching.
Thanks a lot!
I would be really curious to learn of a package that serves your needs. My inclination would be to collapse the strings and use regular expressions or find a programmer or use perl. But here's one extensible solution in R with a few more cases to experiment on. Not very elegant, but see if this has some utility.
# Recreate data as a list with a few more edge cases
txt1 <- c(
"Out of specific reasons.",
"Out of very specific reasons.",
"Out of curiosity. He had his reasons.",
"Out of reasons.",
"Out of one's mind.",
"For no particular reason.",
"Reasons are out of the ordinary.",
"Out of time and money and for many good reasons, it seems.",
"Out of a box, a car, and for random reasons.",
"Floop foo bar.")
txt2 <- strsplit(txt1, "[[:space:]]+") # remove space
txt3 <- lapply(txt2, strsplit, "(?=[[:punct:]])", perl = TRUE) #
txt <- lapply(txt3, unlist) # create list of tokens from each line
# Define characters to exclude: [. ! and ?] but not [,]
exclude <- "[.!?]"
# Assign acceptable limit to separation
lim <- 5 # try 7 and 12 to experiment
# Create indices identifying each of the enumerated conditions
fun1 <- function(x, pat) grep(pat, x, ignore.case = TRUE)
index1 <- lapply(txt, fun1, "out")
index2 <- lapply(txt, fun1, "of")
index3 <- lapply(txt, fun1, "reasons")
index4 <- lapply(txt, fun1, exclude)
# Create logical vectors from indices satisfying the conditions
fun2 <- function(set, val) val[1] %in% set
cond1 <- sapply(index1, fun2, val = 1) & sapply(index2, fun2, val = 2)
cond2 <- sapply(index3, "[", 1) < lim + 2 + 2 # position of 'of' + 2
cond3 <- sapply(index3, max, -Inf) < sapply(index4, min, Inf)
# Combine logical vectors to a single logical vector
valid <- cond1 & cond2 & cond3
valid <- ifelse(is.na(valid), FALSE, valid)
# Examine selected original lines
print(txt1[valid])
# Helper function to extract the starting and the ending element
fun3 <- function(index2, index3, valid) {
found <- rep(list(NULL), length(index2))
found[valid] <- Map(seq, index2[valid], index3[valid])
found <- lapply(found, tail, -1)
found <- lapply(found, head, -1)
}
# Extract starting and ending element from valid list members
idx <- fun3(index2, index3, valid)
# Return the results or "" for no intervening text or NULL for no match
ans <- Map(function(x, i) {
if (is.null(i)) NULL # no match found
else if (length(i) == 0) "" # no intervening elements
else x[i]}, # all intervening elements <= lim
txt, idx)
# Show found (non-NULL) values
ans[!sapply(ans, is.null)]
So let's assume your example
x <- c("Out", "of", "very", "specific", "reasons", ".")
We first need to get the beginning of the indicator
i_Beginning <- as.numeric(grep("Out|out", x))
and the ending
i_end <- as.numeric(grep("reasons", x))
Need to also check that Out is followed by of
Is_Of <- grepl("Of|of", x[i_Beginning +1])
And if this is true we extract the other elements
if(Is_Of){
extraction <- x[c(i_Beginning +2, i_end -1)]
}
print(extraction)
I am trying to count the letters in the list by skipping 1 letter and grouping them in three until i find "t a c" in the data frame and then i want to group the rest of them in three by skipping 3 letters until i find "a t t"
example of what i am trying to say:
"agttacgtaattatgat"
it should do:
agt,gtt,tta,tac stop, gta,att stop ,atg,tga,gat
(data frame's name is agen)
my code for that:
y=c()
x=1
while(x<853){
x=x+1
rt<-paste(agen[x],agen[x+1],agen[x+2])
y=c(y,rt)
ff<-data.frame(y)
if(ff=="t a c"){break}
}
ay=c()
while(x<853){
x=x+3
art<-paste(agen[x],agen[x+1],agen[x+2])
ay=c(ay,art)
aff<-data.frame(ay)
if(aff=="a t t"){break}
}
the first one is working fine but the second one does not break.
there will be a lot of stops and starts in the code, so can you help me write a loop that can do the job?
I guess I know just roughly what you need, but here is a code example, that maybe does what you need. I used the example you specified and used a vector with your DNA bases as elements instead of a 'data frame'. I also changed some style things.
agen_string <- "agttacgtaattatgat"
# Is not a data frame, but a vector. I don't know, why you try to use a data frame.
agen <- strsplit(agen_string, split = "")[[1]]
y <- c()
x <- 0 # Start with 0. Otherwise, you wouldn't find 'tac' in the beginning
# Search for 'tac' triplett
while(x < length(agen)){
x <- x + 1
rt <- paste(agen[x], agen[x+1], agen[x+2], sep = "")
print(rt)
y <- c(y, rt)
#ff <- data.frame(y)
if(rt == "tac"){
print("stop")
break
}
}
ay <- c()
while(x < length(agen)) {
x <- x + 3
art <- paste(agen[x], agen[x+1], agen[x+2], sep = "")
print(art)
ay = c(ay,art)
#aff<-data.frame(ay)
if(art == "att"){
print("stop")
break
}
}
If you work more on DNA sequences, you may want to use a more specialized R-package, like Biostrings for example.
Currently the script below is splitting a combined item code into a specific item codes.
rule2 <- c("MR")
df_1 <- test[grep(paste("^",rule2,sep="",collapse = "|"),test$Name.y),]
SpaceName_1 <- function(s){
num <- str_extract(s,"[0-9]+")
if(nchar(num) >3){
former <- substring(s, 1, 4)
latter <- strsplit(substring(s,5,nchar(s)),"")
latter <- unlist(latter)
return(paste(former,latter,sep = "",collapse = ","))
}
else{
return (s)
}
}
df_1$Name.y <- sapply(df_1$Name.y, SpaceName_1)
Example,
Combined item code: Room 324-326 is splitting into MR324 MR325 MR326.
However for this particular Combined item code: Room 309-311 is splitting into MR309 MR300 MR301.
How should I amend the script to give me MR309 MR310 MR311?
You can try something along these lines:
range <- "324-326"
x <- as.numeric(unlist(strsplit(range, split="-")))
paste0("MR", seq(x[1], x[2]))
[1] "MR324" "MR325" "MR326"
I assume that you can obtain the numerical room sequence by some means, and then use the snippet I gave you above.
If your combined item codes always have the form Room xxx-yyy, then you can extract the range using gsub:
range <- gsub("Room ", "", "Room 324-326")
If your item codes were in a vector called codes, then you could obtain a vector of ranges using:
ranges <- sapply(codes, function(x) gsub("Room ", "", x))
We can also evaluate the string after replacing the - with : and then paste the prefix "MR".
paste0("MR", eval(parse(text=sub("\\S+\\s+(\\d+)-(\\d+)", "\\1:\\2", range))))
#[1] "MR324" "MR325" "MR326"
Wrap it as a function for convenience
fChange <- function(prefixStr, RangeStr){
paste0(prefixStr, eval(parse(text=sub("\\S+\\s+(\\d+)-(\\d+)",
"\\1:\\2", RangeStr))))
}
fChange("MR", range)
fChange("MR", range1)
#[1] "MR309" "MR310" "MR311"
For multiple elements, just loop over and apply the function
sapply(c(range, range1), fChange, prefixStr = "MR")
data
range <- "Room 324-326"
range1 <- "Room 309-311"
I'm currently working on a programming project in R (for school) and I'm using a data set made of a large quantity of LastFm users (an application that collects data when you're using a media player).
I want to work on an eventual link between 2 variables present in the dataset which are the "nickname" and the "real name". To do so, I would like to compute a variable that represents the rate of similarity between the characters.
As an example take one individual (regardless of the other variables):
name = 'chris meller'
nickname = 'mellertime'
So far, tried to sort the strings in order to to check for identical characters one by one but I'm stuck here. What i found is just a way to to check if "name" is present inside "nickname" with different kind of functions.
>paste(sort(unlist(strsplit(name, ""))), collapse = "")
[1] "eeeillmmrt"
>paste(sort(unlist(strsplit(nickname, ""))), collapse = "")
[1] " ceehillmrrs"
What I would like to know is if there is a way to count the number of identical letters between 2 character strings, regardless of the order?
I would like to end with something like this:
function(a,b)
[1] 0.63
# a,b are 2 character strings
where the result is the ratio of the number of identical character between the two strings divided by the number of characters in the real name.
Try this:
SimilarityRatio <- function(wholeName, nickname, matchCase) {
n1 <- sort(strsplit(paste(strsplit(wholeName, " ")[[1]], collapse = ""), "")[[1]])
n2 <- sort(strsplit(paste(strsplit(nickname, " ")[[1]], collapse = ""), "")[[1]])
if (!matchCase) {
n1 <- tolower(n1)
n2 <- tolower(n2)
}
MyLen <- tempLen <- length(n1)
j <- 1L
numMatch <- 0L
while (j <= tempLen) {
test1 <- n1[j] %in% n2
if (test1) {
myRemove <- min(which(n2 %in% n1[j]))
n1 <- n1[-j]
n2 <- n2[-myRemove]
numMatch <- numMatch + 1L
tempLen <- tempLen - 1L
} else {
j <- j+1L
}
}
numMatch/MyLen
}
Below are some test cases:
> SimilarityRatio("chris meller", "mellertime", FALSE)
[1] 0.6363636
> SimilarityRatio("SuperMan3000", "The3Musketeers", FALSE)
[1] 0.5
> SimilarityRatio("SuperMan3000", "The3Musketeers", TRUE)
[1] 0.4166667
> SimilarityRatio("should a garbage collection be performed immediately", "same expression can vary considerably depending on whether", FALSE)
[1] 0.7608696