[R] Finding combination of states
Bert Gunter
bgunter@4567 @end|ng |rom gm@||@com
Tue Sep 5 13:52:45 CEST 2023
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 <ericjberger using 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.4567 using 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.4567 using 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 <ericjberger using 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.4567 using 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.4567 using 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 <tebert using 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-bounces using r-project.org> On Behalf Of Eric
> Berger
> >>>>>> Sent: Monday, September 4, 2023 10:17 AM
> >>>>>> To: Christofer Bogaso <bogaso.christofer using gmail.com>
> >>>>>> Cc: r-help <r-help using 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.christofer using 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 using 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 using 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 using 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]]
More information about the R-help
mailing list