Oh I liked that. I was actually thinking about something similar, but couldn't figure it out. The idiom you showed is very clever imo and taught me something about regexes that I never properly understood.
Bert On Tue, Sep 5, 2023, 01:04 Eric Berger <ericjber...@gmail.com> wrote: > Hi Bert, > I really liked your solution. > In the spirit of code golf, I wondered if there is a shorter way to do > the regular expression test. > Kudos to my coding buddy GPT-4 for the following: > > You can replace your statement > > out[-grep(paste(paste0(states,states), collapse = "|"),out)] > > by > > out[-grep("(.)\\1",out)] > > Best, > Eric > > On Tue, Sep 5, 2023 at 3:08 AM Bert Gunter <bgunter.4...@gmail.com> wrote: > > > > ... and just for fun, here is a non-string version (more appropriate for > complex state labels??): > > > > gvec <- function(ntimes, states, init, final, repeats = TRUE) > > ## ntimes: integer, number of unique times > > ## states: vector of unique states > > ## init: initial state > > ## final: final state > > { > > out <- cbind(init, > > as.matrix(expand.grid(rep(list(states),ntimes -2 ))),final) > > if(!repeats) > > out[ apply(out,1,\(x)all(x[-1] != x[-ntimes])), ] > > else out > > } > > > > yielding: > > > > > > > gvec(4, letters[1:5], "b", "e", repeats = TRUE) > > init Var1 Var2 final > > [1,] "b" "a" "a" "e" > > [2,] "b" "b" "a" "e" > > [3,] "b" "c" "a" "e" > > [4,] "b" "d" "a" "e" > > [5,] "b" "e" "a" "e" > > [6,] "b" "a" "b" "e" > > [7,] "b" "b" "b" "e" > > [8,] "b" "c" "b" "e" > > [9,] "b" "d" "b" "e" > > [10,] "b" "e" "b" "e" > > [11,] "b" "a" "c" "e" > > [12,] "b" "b" "c" "e" > > [13,] "b" "c" "c" "e" > > [14,] "b" "d" "c" "e" > > [15,] "b" "e" "c" "e" > > [16,] "b" "a" "d" "e" > > [17,] "b" "b" "d" "e" > > [18,] "b" "c" "d" "e" > > [19,] "b" "d" "d" "e" > > [20,] "b" "e" "d" "e" > > [21,] "b" "a" "e" "e" > > [22,] "b" "b" "e" "e" > > [23,] "b" "c" "e" "e" > > [24,] "b" "d" "e" "e" > > [25,] "b" "e" "e" "e" > > > > > > gvec(4, letters[1:5], "b", "e", repeats = FALSE) > > init Var1 Var2 final > > [1,] "b" "c" "a" "e" > > [2,] "b" "d" "a" "e" > > [3,] "b" "e" "a" "e" > > [4,] "b" "a" "b" "e" > > [5,] "b" "c" "b" "e" > > [6,] "b" "d" "b" "e" > > [7,] "b" "e" "b" "e" > > [8,] "b" "a" "c" "e" > > [9,] "b" "d" "c" "e" > > [10,] "b" "e" "c" "e" > > [11,] "b" "a" "d" "e" > > [12,] "b" "c" "d" "e" > > [13,] "b" "e" "d" "e" > > > > :-) > > > > -- Bert > > > > On Mon, Sep 4, 2023 at 2:04 PM Bert Gunter <bgunter.4...@gmail.com> > wrote: > >> > >> Well, if strings with repeats (as you defined them) are to be excluded, > I think it's simple just to use regular expressions to remove them. > >> > >> e.g. > >> g <- function(ntimes, states, init, final, repeats = TRUE) > >> ## ntimes: integer, number of unique times > >> ## states: vector of unique states > >> ## init: initial state > >> ## final: final state > >> { > >> out <- do.call(paste0,c(init,expand.grid(rep(list(states), ntimes-2)), > final)) > >> if(!repeats) > >> out[-grep(paste(paste0(states,states), collapse = "|"),out)] > >> else out > >> } > >> So: > >> > >> > g(4, LETTERS[1:5], "B", "E", repeats = FALSE) > >> [1] "BCAE" "BDAE" "BEAE" "BABE" "BCBE" "BDBE" "BEBE" "BACE" > >> [9] "BDCE" "BECE" "BADE" "BCDE" "BEDE" > >> > >> Perhaps not the most efficient way to do this, of course. > >> > >> Cheers, > >> Bert > >> > >> > >> On Mon, Sep 4, 2023 at 12:57 PM Eric Berger <ericjber...@gmail.com> > wrote: > >>> > >>> My initial response was buggy and also used a deprecated function. > >>> Also, it seems possible that one may want to rule out any strings > where the same state appears consecutively. > >>> I say that such a string has a repeat. > >>> > >>> myExpand <- function(v, n) { > >>> do.call(tidyr::expand_grid, replicate(n, v, simplify = FALSE)) > >>> } > >>> > >>> no_repeat <- function(s) { > >>> v <- unlist(strsplit(s, NULL)) > >>> sum(v[-1]==v[-length(v)]) == 0 > >>> } > >>> > >>> f <- function(states, nsteps, first, last, rm_repeat=TRUE) { > >>> if (nsteps < 3) stop("nsteps must be at least 3") > >>> out <- paste(first, > >>> myExpand(states, nsteps-2) |> > >>> apply(MAR=1, \(x) paste(x, collapse="")), > >>> last, sep="") > >>> if (rm_repeat) { > >>> ok <- sapply(out, no_repeat) > >>> out <- out[ok] > >>> } > >>> out > >>> } > >>> > >>> f(LETTERS[1:5],4,"B","E") > >>> > >>> # [1] "BABE" "BACE" "BADE" "BCAE" "BCBE" "BCDE" "BDAE" "BDBE" "BDCE" > "BEAE" "BEBE" "BECE" "BEDE" > >>> > >>> On Mon, Sep 4, 2023 at 10:33 PM Bert Gunter <bgunter.4...@gmail.com> > wrote: > >>>> > >>>> Sorry, my last line should have read: > >>>> > >>>> If neither this nor any of the other suggestions is what is desired, > I think the OP will have to clarify his query. > >>>> > >>>> Bert > >>>> > >>>> On Mon, Sep 4, 2023 at 12:31 PM Bert Gunter <bgunter.4...@gmail.com> > wrote: > >>>>> > >>>>> I think there may be some uncertainty here about what the OP > requested. My interpretation is: > >>>>> > >>>>> n different times > >>>>> k different states > >>>>> Any state can appear at any time in the vector of times and can be > repeated > >>>>> Initial and final states are given > >>>>> > >>>>> So modifying Tim's expand.grid() solution a bit yields: > >>>>> > >>>>> g <- function(ntimes, states, init, final){ > >>>>> ## ntimes: integer, number of unique times > >>>>> ## states: vector of unique states > >>>>> ## init: initial state > >>>>> ## final: final state > >>>>> do.call(paste0,c(init,expand.grid(rep(list(states), ntimes-2)), > final)) > >>>>> } > >>>>> > >>>>> e.g. > >>>>> > >>>>> > g(4, LETTERS[1:5], "B", "D") > >>>>> [1] "BAAD" "BBAD" "BCAD" "BDAD" "BEAD" "BABD" "BBBD" "BCBD" > >>>>> [9] "BDBD" "BEBD" "BACD" "BBCD" "BCCD" "BDCD" "BECD" "BADD" > >>>>> [17] "BBDD" "BCDD" "BDDD" "BEDD" "BAED" "BBED" "BCED" "BDED" > >>>>> [25] "BEED" > >>>>> > >>>>> If neither this nor any of the other suggestions is not what is > desired, I think the OP will have to clarify his query. > >>>>> > >>>>> Cheers, > >>>>> Bert > >>>>> > >>>>> On Mon, Sep 4, 2023 at 9:25 AM Ebert,Timothy Aaron <teb...@ufl.edu> > wrote: > >>>>>> > >>>>>> Does this work for you? > >>>>>> > >>>>>> t0<-t1<-t2<-LETTERS[1:5] > >>>>>> al2<-expand.grid(t0, t1, t2) > >>>>>> al3<-paste(al2$Var1, al2$Var2, al2$Var3) > >>>>>> al4 <- gsub(" ", "", al3) > >>>>>> head(al3) > >>>>>> > >>>>>> Tim > >>>>>> > >>>>>> -----Original Message----- > >>>>>> From: R-help <r-help-boun...@r-project.org> On Behalf Of Eric > Berger > >>>>>> Sent: Monday, September 4, 2023 10:17 AM > >>>>>> To: Christofer Bogaso <bogaso.christo...@gmail.com> > >>>>>> Cc: r-help <r-help@r-project.org> > >>>>>> Subject: Re: [R] Finding combination of states > >>>>>> > >>>>>> [External Email] > >>>>>> > >>>>>> The function purrr::cross() can help you with this. For example: > >>>>>> > >>>>>> f <- function(states, nsteps, first, last) { > >>>>>> paste(first, unlist(lapply(purrr::cross(rep(list(v),nsteps-2)), > >>>>>> \(x) paste(unlist(x), collapse=""))), last, sep="") } > f(LETTERS[1:5], 3, "B", "E") [1] "BAE" "BBE" "BCE" "BDE" "BEE" > >>>>>> > >>>>>> HTH, > >>>>>> Eric > >>>>>> > >>>>>> > >>>>>> On Mon, Sep 4, 2023 at 3:42 PM Christofer Bogaso < > bogaso.christo...@gmail.com> wrote: > >>>>>> > > >>>>>> > Let say I have 3 time points.as T0, T1, and T2.(number of such > time > >>>>>> > points can be arbitrary) In each time point, an object can be any > of 5 > >>>>>> > states, A, B, C, D, E (number of such states can be arbitrary) > >>>>>> > > >>>>>> > I need to find all possible ways, how that object starting with > state > >>>>>> > B (say) at time T0, can be on state E (example) in time T2 > >>>>>> > > >>>>>> > For example one possibility is BAE etc. > >>>>>> > > >>>>>> > Is there any function available with R, that can give me a vector > of > >>>>>> > such possibilities for arbitrary number of states, time, and for a > >>>>>> > given initial and final (desired) states? > >>>>>> > > >>>>>> > ANy pointer will be very appreciated. > >>>>>> > > >>>>>> > Thanks for your time. > >>>>>> > > >>>>>> > ______________________________________________ > >>>>>> > R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see > >>>>>> > https://stat/ > >>>>>> > .ethz.ch%2Fmailman%2Flistinfo%2Fr-help&data=05%7C01%7Ctebert% > 40ufl.edu > >>>>>> > > %7C25cee5ce26a8423daaa508dbad51c402%7C0d4da0f84a314d76ace60a62331e1b84 > >>>>>> > > %7C0%7C0%7C638294338934034595%7CUnknown%7CTWFpbGZsb3d8eyJWIjoiMC4wLjAw > >>>>>> > > MDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0%3D%7C3000%7C%7C%7C&sda > >>>>>> > ta=TM4jGF39Gy3PH0T3nnQpT%2BLogkVxifv%2Fudv9hWPwbss%3D&reserved=0 > >>>>>> > PLEASE do read the posting guide > >>>>>> > http://www.r/ > >>>>>> > -project.org%2Fposting-guide.html&data=05%7C01%7Ctebert%40ufl.edu > %7C25 > >>>>>> > > cee5ce26a8423daaa508dbad51c402%7C0d4da0f84a314d76ace60a62331e1b84%7C0% > >>>>>> > > 7C0%7C638294338934034595%7CUnknown%7CTWFpbGZsb3d8eyJWIjoiMC4wLjAwMDAiL > >>>>>> > > CJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0%3D%7C3000%7C%7C%7C&sdata=5n > >>>>>> > PTLmsz0lOz47t41u578t9oI0i7BOgIX53yx8CesLs%3D&reserved=0 > >>>>>> > and provide commented, minimal, self-contained, reproducible code. > >>>>>> > >>>>>> ______________________________________________ > >>>>>> R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see > >>>>>> https://stat.ethz.ch/mailman/listinfo/r-help > >>>>>> PLEASE do read the posting guide > http://www.r-project.org/posting-guide.html > >>>>>> and provide commented, minimal, self-contained, reproducible code. > >>>>>> ______________________________________________ > >>>>>> R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see > >>>>>> https://stat.ethz.ch/mailman/listinfo/r-help > >>>>>> PLEASE do read the posting guide > http://www.R-project.org/posting-guide.html > >>>>>> and provide commented, minimal, self-contained, reproducible code. > [[alternative HTML version deleted]] ______________________________________________ R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide http://www.R-project.org/posting-guide.html and provide commented, minimal, self-contained, reproducible code.