How to break a string up into overlapping sets of 3 - r

If I have multiple strings like:
skhdsfiiuwkncyeuhrsl
sdskkjheocbsill
sldkjflsdkjb
How can I program the output to be the overlapping triplets, for example, I want it to output:
skh, khd, hds, ..., rsl
sds, dsk, skk, ..., ill
sld, ldk, dkj, ..., kjb

substring works:
x = c("skhdsfiiuwkncyeuhrsl", "sdskkjheocbsill", "sldkjflsdkjb", "ab")
n = 3
lapply(x, function(z)
if ((nc <- nchar(z)) >= n)
substring(z, seq(1, nc - n + 1), seq(n, nc))
else
character(0)
)
which gives
[[1]]
[1] "skh" "khd" "hds" "dsf" "sfi" "fii" "iiu" "iuw" "uwk" "wkn" "knc" "ncy"
[13] "cye" "yeu" "euh" "uhr" "hrs" "rsl"
[[2]]
[1] "sds" "dsk" "skk" "kkj" "kjh" "jhe" "heo" "eoc" "ocb" "cbs" "bsi" "sil"
[13] "ill"
[[3]]
[1] "sld" "ldk" "dkj" "kjf" "jfl" "fls" "lsd" "sdk" "dkj" "kjb"
[[4]]
character(0)

Taking inspiration from this answer, Here's a one-liner:
strings <- c("skhdsfiiuwkncyeuhrsl",
"sdskkjheocbsill",
"sldkjflsdkjb")
sapply(strings, function(x) substring(x, seq(1,nchar(x)-2,1), seq(3,nchar(x),1)))
# $skhdsfiiuwkncyeuhrsl
# [1] "skh" "khd" "hds" "dsf" "sfi" "fii" "iiu" "iuw" "uwk" "wkn" "knc" "ncy" "cye" "yeu" "euh"
# [16] "uhr" "hrs" "rsl"
# $sdskkjheocbsill
# [1] "sds" "dsk" "skk" "kkj" "kjh" "jhe" "heo" "eoc" "ocb" "cbs" "bsi" "sil" "ill"
# $sldkjflsdkjb
# [1] "sld" "ldk" "dkj" "kjf" "jfl" "fls" "lsd" "sdk" "dkj" "kjb"

a <- "skhdsfiiuwkncyeuhrsl"
b <- "sdskkjheocbsill"
c <- "sldkjflsdkjb"
make_triplets <-
function(X){
nTriplets <- length(2:(nchar(X)-1))
triplets <- character(nTriplets)
for(i in 2:(nchar(X)-1)){
triplets[i-1] <- substr(X, i - 1, i + 1)
}
return(triplets)
}
make_triplets(a)
make_triplets(b)
make_triplets(c)

Related

How to replace characters in a string one at a time generating new string for each replacement?

I have a vector of strings
c("YSAHEEHHYDK", "HEHISSDYAGK", "TFAHTESHISK", "ISLGEHEGGGK",
"LSSGYDGTSYK", "FGTGTYAGGEK", "VGASTGYSGLK", "TASGVGGFSTK", "SYASDFGSSAK",
"LYSYYSSTESK")
for each string I would like to replace "Y", "S" or "T" with "pY", "pS" or "pT". But I dont want all the replacements to be in the same final string, I want each replacement to generate a new string, e.g.
"YSAHEEHHYDK" turns into
c("pYSAHEEHHYDK",
"YpSAHEEHHYDK",
"YSAHEEHHpYDK")
Using xx input in the Note at the end (which is as in the question plus some border tests) we use stringi functions. In particular note that stri_sub can insert a p character. If an input string is empty, i.e. "", or does not contain any of Y, S or T then NA is returned for that string.
library(stringi)
add_p <- function(s, loc) {
start <- loc[, "start"]
stri_sub(s, start, start-1) <- "p"
s
}
Map(add_p, xx, stri_locate_all(xx, regex = "[YST]"))
giving
[1] NA
$ABC
[1] NA
$YSAHEEHHYDK
[1] "pYSAHEEHHYDK" "YpSAHEEHHYDK" "YSAHEEHHpYDK"
$HEHISSDYAGK
[1] "HEHIpSSDYAGK" "HEHISpSDYAGK" "HEHISSDpYAGK"
$TFAHTESHISK
[1] "pTFAHTESHISK" "TFAHpTESHISK" "TFAHTEpSHISK" "TFAHTESHIpSK"
# ...snip...
Note
This is the same as in the question exceept we have added the first two strings.
xx <- c("", "ABC", "YSAHEEHHYDK", "HEHISSDYAGK", "TFAHTESHISK", "ISLGEHEGGGK",
"LSSGYDGTSYK", "FGTGTYAGGEK", "VGASTGYSGLK", "TASGVGGFSTK", "SYASDFGSSAK",
"LYSYYSSTESK")
You could write a function in base R:
Edit:
Included the notion of zero-length as shown by #GKi
strings <- c("YSAHEEHHYDK", "HEHISSDYAGK", "TFAHTESHISK", "ISLGEHEGGGK",
"LSSGYDGTSYK", "FGTGTYAGGEK", "VGASTGYSGLK", "TASGVGGFSTK",
"SYASDFGSSAK", "LYSYYSSTESK")
reg <- gregexpr("[YST]", strings)
`regmatches<-`(rep(strings, lengths(reg)),
`attr<-`(unlist(reg), "match.length", 0), value = 'p')
#> [1] "pYSAHEEHHYDK" "YpSAHEEHHYDK" "YSAHEEHHpYDK" "HEHIpSSDYAGK" "HEHISpSDYAGK"
#> [6] "HEHISSDpYAGK" "pTFAHTESHISK" "TFAHpTESHISK" "TFAHTEpSHISK" "TFAHTESHIpSK"
#> [11] "IpSLGEHEGGGK" "LpSSGYDGTSYK" "LSpSGYDGTSYK" "LSSGpYDGTSYK" "LSSGYDGpTSYK"
#> [16] "LSSGYDGTpSYK" "LSSGYDGTSpYK" "FGpTGTYAGGEK" "FGTGpTYAGGEK" "FGTGTpYAGGEK"
#> [21] "VGApSTGYSGLK" "VGASpTGYSGLK" "VGASTGpYSGLK" "VGASTGYpSGLK" "pTASGVGGFSTK"
#> [26] "TApSGVGGFSTK" "TASGVGGFpSTK" "TASGVGGFSpTK" "pSYASDFGSSAK" "SpYASDFGSSAK"
#> [31] "SYApSDFGSSAK" "SYASDFGpSSAK" "SYASDFGSpSAK" "LpYSYYSSTESK" "LYpSYYSSTESK"
#> [36] "LYSpYYSSTESK" "LYSYpYSSTESK" "LYSYYpSSTESK" "LYSYYSpSTESK" "LYSYYSSpTESK"
#> [41] "LYSYYSSTEpSK"
Created on 2023-02-14 with reprex v2.0.2
You can create a small function to help you out.
my_replace <- function(x){
reg <- gregexpr("[YST]", x)
`regmatches<-`(rep(x, lengths(reg)), structure(unlist(reg), match.length = 0), value = "p")
}
Perhaps something like this with stringr and purrr.
str_locate_all() returns a 2-column matrix with start & end of pattern locations, str_sub(string, start) <- "p" conveniently accepts that same matrix for a start. Subtracting 1 from current end-column (i.e [1, 1] becomes [1, 0]) keeps all existing characters and inserts p.
library(stringr)
library(purrr)
str_ <- c("YSAHEEHHYDK", "HEHISSDYAGK", "TFAHTESHISK", "ISLGEHEGGGK",
"LSSGYDGTSYK", "FGTGTYAGGEK", "VGASTGYSGLK", "TASGVGGFSTK",
"SYASDFGSSAK", "LYSYYSSTESK")
map2(set_names(str_),
str_locate_all(str_,"Y|S|T"),
function(x, y) {
y[,2] <- y[,2] - 1
str_sub(x, y) <- "p"
x
})
Result as a named list:
#> $YSAHEEHHYDK
#> [1] "pYSAHEEHHYDK" "YpSAHEEHHYDK" "YSAHEEHHpYDK"
#>
#> $HEHISSDYAGK
#> [1] "HEHIpSSDYAGK" "HEHISpSDYAGK" "HEHISSDpYAGK"
#>
#> $TFAHTESHISK
#> [1] "pTFAHTESHISK" "TFAHpTESHISK" "TFAHTEpSHISK" "TFAHTESHIpSK"
#>
#> $ISLGEHEGGGK
#> [1] "IpSLGEHEGGGK"
#>
#> $LSSGYDGTSYK
#> [1] "LpSSGYDGTSYK" "LSpSGYDGTSYK" "LSSGpYDGTSYK" "LSSGYDGpTSYK" "LSSGYDGTpSYK"
#> [6] "LSSGYDGTSpYK"
#>
#> $FGTGTYAGGEK
#> [1] "FGpTGTYAGGEK" "FGTGpTYAGGEK" "FGTGTpYAGGEK"
#>
#> $VGASTGYSGLK
#> [1] "VGApSTGYSGLK" "VGASpTGYSGLK" "VGASTGpYSGLK" "VGASTGYpSGLK"
#>
#> $TASGVGGFSTK
#> [1] "pTASGVGGFSTK" "TApSGVGGFSTK" "TASGVGGFpSTK" "TASGVGGFSpTK"
#>
#> $SYASDFGSSAK
#> [1] "pSYASDFGSSAK" "SpYASDFGSSAK" "SYApSDFGSSAK" "SYASDFGpSSAK" "SYASDFGSpSAK"
#>
#> $LYSYYSSTESK
#> [1] "LpYSYYSSTESK" "LYpSYYSSTESK" "LYSpYYSSTESK" "LYSYpYSSTESK" "LYSYYpSSTESK"
#> [6] "LYSYYSpSTESK" "LYSYYSSpTESK" "LYSYYSSTEpSK"
Created on 2023-02-15 with reprex v2.0.2
A base variant similar to the method from #G.Grothendieck and #margusl using gregexpr to find the positions of Y, S or T and using regmatches<-, like #onyambu, to insert p at this positions.
sIn <- function(s, i) {
`regmatches<-`(rep(s, length(i)), `attr<-`(i, "match.length", 0), value="p")
}
Map(sIn, s, gregexpr("[YST]", s))
#[[1]]
#[1] ""
#
#$ABC
#[1] "ABC"
#
#$YSAHEEHHYDK
#[1] "pYSAHEEHHYDK" "YpSAHEEHHYDK" "YSAHEEHHpYDK"
#
#$HEHISSDYAGK
#[1] "HEHIpSSDYAGK" "HEHISpSDYAGK" "HEHISSDpYAGK"
#...
Or using str_sub<- and str_locate_all from stringr with a non consuming look ahead (?=[YST]).
library(stringr)
Map(`str_sub<-`, s, str_locate_all(s,"(?=[YST])"), value="p")
#[[1]]
#character(0)
#
#$ABC
#character(0)
#
#$YSAHEEHHYDK
#[1] "pYSAHEEHHYDK" "YpSAHEEHHYDK" "YSAHEEHHpYDK"
#
#$HEHISSDYAGK
#[1] "HEHIpSSDYAGK" "HEHISpSDYAGK" "HEHISSDpYAGK"
#...
Or the same but using stringi.
library(stringi)
Map(`stri_sub<-`, s, stri_locate_all(s, regex="(?=[YST])"), value="p")
#[[1]]
#[1] NA
#
#$ABC
#[1] NA
#
#$YSAHEEHHYDK
#[1] "pYSAHEEHHYDK" "YpSAHEEHHYDK" "YSAHEEHHpYDK"
#
#$HEHISSDYAGK
#[1] "HEHIpSSDYAGK" "HEHISpSDYAGK" "HEHISSDpYAGK"
#...
Data (added the first two strings like #G.Grothendieck)
s <- c("", "ABC", "YSAHEEHHYDK", "HEHISSDYAGK", "TFAHTESHISK", "ISLGEHEGGGK",
"LSSGYDGTSYK", "FGTGTYAGGEK", "VGASTGYSGLK", "TASGVGGFSTK",
"SYASDFGSSAK", "LYSYYSSTESK")

How to make continuous a discontinuous sequence of character numbers with leading zero(s)?

I have this character vector:
dput(t$line)
c("0304", "0305", "0306", "0308", "0311", "0313", "0314", "0316",
"0318", "0321", "0322", "0323", "0324", "0326", "0327", "0330",
"0333", "0337", "0338", "0339", "0342", "0341", "0344", "0346",
"0347", "0348", "0349", "0350", "0352", "0353", "0357", "0359",
"0360", "0362", "0363", "0364", "0365", "0367", "0371", "0370",
"0373", "0375", "0378", "0380", "0381", "0385", "0386", "0387",
"0391", "0395", "0394", "0397", "0398", "0399", "0400", "0402",
"0404", "0405", "0406", "0408", "0412", "0416", "0419", "0423",
"0424", "0425", "0426", "0428", "0429", "0432", "0433", "0436",
"0435", "0439", "0437", "0440", "0441")
The numbers it contains are not completely continuous. I'd like to make them continuous, while preserving the leading zero or zeros where needed. I've come up with this solution:
paste("0", seq(as.numeric(t$line[1]), as.numeric(t$line[1]) + length(t$line), 1), sep = "")
[1] "0304" "0305" "0306" "0307" "0308" "0309" "0310" "0311" "0312" "0313" "0314" "0315" "0316" "0317" "0318" "0319" "0320"
[18] "0321" "0322" "0323" "0324" "0325" "0326" "0327" "0328" "0329" "0330" "0331" "0332" "0333" "0334" "0335" "0336" "0337"
[35] "0338" "0339" "0340" "0341" "0342" "0343" "0344" "0345" "0346" "0347" "0348" "0349" "0350" "0351" "0352" "0353" "0354"
[52] "0355" "0356" "0357" "0358" "0359" "0360" "0361" "0362" "0363" "0364" "0365" "0366" "0367" "0368" "0369" "0370" "0371"
[69] "0372" "0373" "0374" "0375" "0376" "0377" "0378" "0379" "0380" "0381"
This works okay as long as there is exactly one 0 to be added. There may however be more than one leading zero or none at all. How can the sequence be made continuous with appropriate leading zeros?
One stringr option could be:
str_pad(seq.int(min(as.numeric(x)), length.out = length(x)), 4, "left", "0")
[1] "0304" "0305" "0306" "0307" "0308" "0309" "0310" "0311" "0312" "0313" "0314" "0315" "0316"
[14] "0317" "0318" "0319" "0320" "0321" "0322" "0323" "0324" "0325" "0326" "0327" "0328" "0329"
[27] "0330" "0331" "0332" "0333" "0334" "0335" "0336" "0337" "0338" "0339" "0340" "0341" "0342"
[40] "0343" "0344" "0345" "0346" "0347" "0348" "0349" "0350" "0351" "0352" "0353" "0354" "0355"
[53] "0356" "0357" "0358" "0359" "0360" "0361" "0362" "0363" "0364" "0365" "0366" "0367" "0368"
[66] "0369" "0370" "0371" "0372" "0373" "0374" "0375" "0376" "0377" "0378" "0379" "0380"
A more general solution that takes into account the maximum length of the entries and therefore implictly the number of leading zeros:
t$line2 <- c("000517","00524")
Cont.PadZero <- function(vec) sprintf(paste0("%0", max(nchar(vec)), "d"), seq.int(min(as.numeric(vec)), max(as.numeric(vec))))
Cont.PadZero(t$line2)
[1] "000517" "000518" "000519" "000520" "000521" "000522" "000523" "000524"
You want a continuous sequence of length(x) starting at min(x), where nchar of the resulting elements is identical to that of x.
Use sprintf instead of paste0 to format leading zeros. nchar(x)[1] gives the length to which (occasional) padding with zeros is required. If it's not safe that the lengths are equal use max(nchar(x)), but that's slower.
Since x[1] does not necessarily have to be the minimum you may want to use min(as.numeric(x)) as starting point. When you use seq, it's end point should be min(as.numeric(x)) + length(x) - 1 (because the min is already the first element). Or use length.out=length(x) which appears to be faster, combined with seq.int even faster.
sprintf(paste0("%0", nchar(x)[1], "d"), seq.int(min(as.numeric(x)), length.out=length(x)))
# [1] "0304" "0305" "0306" "0307" "0308" "0309" "0310" "0311" "0312" "0313" "0314" "0315"
# [13] "0316" "0317" "0318" "0319" "0320" "0321" "0322" "0323" "0324" "0325" "0326" "0327"
# [25] "0328" "0329" "0330" "0331" "0332" "0333" "0334" "0335" "0336" "0337" "0338" "0339"
# [37] "0340" "0341" "0342" "0343" "0344" "0345" "0346" "0347" "0348" "0349" "0350" "0351"
# [49] "0352" "0353" "0354" "0355" "0356" "0357" "0358" "0359" "0360" "0361" "0362" "0363"
# [61] "0364" "0365" "0366" "0367" "0368" "0369" "0370" "0371" "0372" "0373" "0374" "0375"
# [73] "0376" "0377" "0378" "0379" "0380"
Another option is using colon :, but seq.int above appears to be faster (see benchmark below).
sprintf(paste0("%0", nchar(x)[1], "d"), 0:(length(x) - 1) + min(as.numeric(x)))
NB: To complete the original vector by imputing missings, you may do:
sprintf(paste0("%0", max(nchar(x)), "d"), do.call(`:`, as.list(range(as.numeric(x)))))
# [1] "0304" "0305" "0306" "0307" "0308" "0309" "0310" "0311" "0312" "0313" "0314"
# [12] "0315" "0316" "0317" "0318" "0319" "0320" "0321" "0322" "0323" "0324" "0325"
# [23] "0326" "0327" "0328" "0329" "0330" "0331" "0332" "0333" "0334" "0335" "0336"
# [34] "0337" "0338" "0339" "0340" "0341" "0342" "0343" "0344" "0345" "0346" "0347"
# [45] "0348" "0349" "0350" "0351" "0352" "0353" "0354" "0355" "0356" "0357" "0358"
# [56] "0359" "0360" "0361" "0362" "0363" "0364" "0365" "0366" "0367" "0368" "0369"
# [67] "0370" "0371" "0372" "0373" "0374" "0375" "0376" "0377" "0378" "0379" "0380"
# [78] "0381" "0382" "0383" "0384" "0385" "0386" "0387" "0388" "0389" "0390" "0391"
# [89] "0392" "0393" "0394" "0395" "0396" "0397" "0398" "0399" "0400" "0401" "0402"
# [100] "0403" "0404" "0405" "0406" "0407" "0408" "0409" "0410" "0411" "0412" "0413"
# [111] "0414" "0415" "0416" "0417" "0418" "0419" "0420" "0421" "0422" "0423" "0424"
# [122] "0425" "0426" "0427" "0428" "0429" "0430" "0431" "0432" "0433" "0434" "0435"
# [133] "0436" "0437" "0438" "0439" "0440" "0441"
Benchmark
f1 <- function() sprintf(paste0("%0", max(nchar(x)), "d"),
seq(min(as.numeric(x)), min(as.numeric(x)) + length(x) - 1))
f2 <- function() sprintf(paste0("%0", max(nchar(x)), "d"),
seq(min(as.numeric(x)), length.out=length(x)))
f3 <- function() sprintf(paste0("%0", max(nchar(x)), "d"),
seq.int(min(as.numeric(x)), length.out=length(x)))
f31 <- function() sprintf(paste0("%0", nchar(x[1]), "d"),
seq.int(min(as.numeric(x)), length.out=length(x)))
f4 <- function() sprintf(paste0("%0", nchar(x[1]), "d"),
0:(length(x) - 1) + min(as.numeric(x)))
f5 <- function() stringr::str_pad(seq.int(min(as.numeric(x)),
length.out=length(x)),
nchar(x[1]), "left", "0")
set.seed(5789)
x <- sample(sprintf("%05d", 1:99999))
microbenchmark::microbenchmark(seq_to=f1(), seq_len=f2(), seq.int=f3(),
seq.int1=f31(), colon=f4(), stringr=f5())
# Unit: milliseconds
# expr min lq mean median uq max neval cld
# seq_to 104.22119 106.83928 108.92791 107.81301 109.68406 124.35686 100 f
# seq_len 87.14385 89.89180 92.34962 90.97192 92.09823 110.59426 100 d
# seq.int 85.72324 87.93885 89.91353 89.03327 90.32758 113.41480 100 c
# seq.int1 59.54312 61.63065 62.86618 62.47707 63.53334 76.33471 100 a
# colon 60.94867 63.16109 64.73306 63.88925 64.79997 81.63646 100 b
# stringr 99.08452 101.56649 104.01522 102.74420 104.20269 158.30948 100 e

How to sum list of list of vector in R

Suppose I have a list of list. I would like to divide each vector of Tau by the sum of all vectors of Tau. That is,
Tau[[1]][[1]] / sum(Tau[[1]],Tau[[1]][[2]],Tau[[2]][[1]],Tau[[2]][[1]])
I would like to do this for each element of Tau. I tried the Reduce but it returns me an error.
tau1 <- rnorm(10,0,1)
tau2 <- rnorm(10,0,1)
tau <- list(tau1, tau2)
tau
tau3 <- rnorm(10, 0,1)
tau4 <- rnorm(10,0,1)
tau5 <- list(tau3, tau4)
tau5
Tau <- list(tau, tau5)
Tau
[[1]]
[[1]][[1]]
[1] 0.41435211 -0.28983281 0.96462705 -1.32050463 -0.15736981 0.07512305
[7] -0.73394053 -0.12630874 0.21886818 1.57760128
[[1]][[2]]
[1] -1.31643065 1.24744501 0.09073152 -1.02300779 0.63927688 -2.09642019
[7] 1.25458113 -0.21542568 -0.07314255 1.02092833
[[2]]
[[2]][[1]]
[1] 0.2582012 0.9561437 -0.8351850 0.3028827 -0.7016825 -0.6400293
[7] 0.1925083 -1.0869632 0.3688728 -0.1837725
[[2]][[2]]
[1] -2.560212660 1.953122685 0.087180131 2.252459267 -0.003317207
[6] -1.767479446 -0.298496963 0.015214568 0.300665882 -1.017860244
Reduce("+", Tau)
Error in f(init, x[[i]]) : non-numeric argument to binary operator
Any help, please?
try:
Tau[[1]][[1]] / sum(unlist(Tau))
and since this is 2 level list of list:
lapply(Tau, FUN = function(x) ### to dive into the first level
lapply(x,FUN = function(x) (x/sum(unlist(Tau)))))
You can try a tidyverse solution
library(tidyverse)
Tau %>%
flatten() %>% # This function removes a level hierarchy from the list.
map(function(x) x/sum(unlist(.))) # This function applies a function to each element of the list
[[1]]
[1] -0.3101120 -0.1273576 0.8624357 0.0390124 0.0715351 0.9489481 0.2550256 -0.6999603
[9] -0.3800367 -0.2465854
[[2]]
[1] 0.67728632 0.19908554 0.22174745 0.06124092 -0.30754775 0.98870176 0.27546143 -1.08813227
[9] 0.38806129 -0.26159621
[[3]]
[1] -0.59082848 -0.12060585 -0.56768982 -0.40329663 -0.34583518 -0.93324998 0.46354885 0.08486158
[9] -0.62973290 0.69373770
[[4]]
[1] 0.23596330 -0.16326350 0.49527439 0.48587260 0.45458206 0.38102570 0.30648348 -0.03425584
[9] -0.16928961 -0.21051518
your data. I added a seed for reproducibility
set.seed(123)
tau1 <- rnorm(10,0,1)
tau2 <- rnorm(10,0,1)
tau3 <- rnorm(10, 0,1)
tau4 <- rnorm(10,0,1)
Tau <- list(list(tau1, tau2), list(tau3, tau4))
Tau <- list(tau, tau5) is making a list with two elements, both of which are themselves lists. So the Reduce call tries to add two lists together, which isn't defined.
You need to use append to combine the elements of two lists into a single list:
Tau <- append(tau, tau5)
Reduce("+", Tau)
# [1] -0.7481876 3.2098496 1.9950819 2.8188345 1.4200328 0.2202510
# [7] 0.1448013 0.8132506 -0.7788742 0.5466227
I think you can just use unlist. From its help file:
Given a list structure x, unlist simplifies it to produce a vector which contains all the atomic components which occur in x.
sum(unlist(Tau))

Can't iterate output as a list inside the loop in R

The below code works fine outside the loop but didn't produce iterating results inside the loop.
elvalue <- function(x)
{
height= list(
zmean = mean(x),
zmax = max(x),
zsd = sd(x),
zmin = min(x)
)
return(height)
}
rawlist <- list.files(path = "./data/lidar/lidar_16/clipraw", pattern = ".las$", full.names = T, recursive = FALSE)
for(i in 1:length(rawlist)){
readlas <- readLAS(rawlist[i])
lasdf <- data.frame(readlas#data)
cls2 <- subset(lasdf, lasdf$Classification==2)
ht2 <- elvalue(cls2$Z)
cls3 <- subset(lasdf, lasdf$Classification==3)
ht3 <- elvalue(cls3$Z)
cls4 <- subset(lasdf, lasdf$Classification==4)
ht4 <- elvalue(cls4$Z)
cls5 <- subset(lasdf, lasdf$Classification==5)
ht5 <- elvalue(cls5$Z)
allht <- list(ht2, ht3, ht4, ht5)
It gives the output only for first file which is as follows: The output is in the list format so how can I iterate for all files simultaneously and save it as a separate data frame.
[[1]]
[[1]]$zmean
[1] 434.1715
[[1]]$zmax
[1] 501.41
[[1]]$zsd
[1] 27.11985
[[1]]$zmin
[1] 388.27
[[2]]
[[2]]$zmean
[1] 430.5257
[[2]]$zmax
[1] 501.58
[[2]]$zsd
[1] 26.41594
[[2]]$zmin
[1] 388.33
[[3]]
[[3]]$zmean
[1] 428.083
[[3]]$zmax
[1] 503.12
[[3]]$zsd
[1] 29.06311
[[3]]$zmin
[1] 388.66
[[4]]
[[4]]$zmean
[1] 454.2379
[[4]]$zmax
[1] 520.27
[[4]]$zsd
[1] 26.27641
[[4]]$zmin
[1] 390.61
Now I want to iterate the results and save it in a data.frame for all of the 17 files stored in my folder.
Thanks and Regards,
Yogendra

Get the second value in the row if the dates match in R

I am in the trouble of getting the values which have the same dates from two different data sources in R. The code is
#Monthly data
month_data <- c(580.11, 618.25, 641.24, 604.85, 580.86, 580.07, 632.97,
685.09, 754.50, 680.30, 698.37, 707.38, 480.11, 528.25,
541.24, 614.85, 680.86)
month_dates <- seq(as.Date("2001/06/01"), by = "1 months", length = 17)
month_data <- data.frame(month_dates, month_data)
#the dates_for_match is a list:
dates_for_match<-list(c( "2001-08-01","2001-09-01", "2001-10-01"),c("2001-11-01","2001-12-01","2002-01-01"),c("2002-02-01","2002-03-01","2002-04-01"),c("2002-05-01","2002-06-01","2002-07-01"),c( "2002-08-01","2002-09-01", "2002-10-01"))
Example:
> dates_for_match
[[1]]
[1] "2001-08-01" "2001-09-01" "2001-10-01"
[[2]]
[1] "2001-11-01" "2001-12-01" "2002-01-01"
[[3]]
[1] "2002-02-01" "2002-03-01" "2002-04-01"
[[4]]
[1] "2002-05-01" "2002-06-01" "2002-07-01"
[[5]]
[1] "2002-08-01" "2002-09-01" "2002-10-01"
I want to use the dates_for_match list to get the values from month_data that have the same dates.
You need %in%...
month_data[ month_dates %in% unlist( dates_for_match ) , 2 ]

Resources