[R] Finding combination of states

Eric Berger er|cjberger @end|ng |rom gm@||@com
Tue Sep 5 10:03:38 CEST 2023 

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.

More information about the R-help mailing list