상호 배제 된 데이터 세트의 열을 선택하는 위젯

Question

아래의 내 R 코드는 스크린 샷에서 볼 수있는 인터페이스를 생성합니다. 사용자가 CSV 파일을로드하고로드 된 데이터 세트의 4 개의 열을 선택합니다 (example data file is available here이지만 4 열 이상인 모든 CSV 파일을 사용할 수 있음). 선택한 열에 대해 "상호 배타"를 구현했습니다. 예를 들어 아래 스크린 샷의 예와 같이 사용자가 요인 A로 "연산자"열을 선택하면 요소 B가 자동으로 "일"열로 전환됩니다.

알다시피, 제 코드는 꽤 무거워요. 사용자 사전이 선택할 열의 수를 설정하는보다 정교한 위젯을 상상해보십시오. 어쩌면 나는 루프를 사용하고 목록을 사용하여 객체를 저장하는 열의 수에 관계없이 아래 코드와 동일한 접근법을 구현할 수 있습니다. 그러나 더 나은/쉬운 방법으로 그렇게 할 수 있습니까?

library(gWidgetsRGtk2) 
options("guiToolkit"="RGtk2") 

# defines a new environment to store data 
myenv.data <- new.env() 

# function for storing the data file in myenv.data 
RR_data <- function(filename){ 
    path <- dirname(filename) 
    setwd(path) 
    dat0 <- read.csv(filename,header=TRUE) 
    assign("dat0", dat0, envir=myenv.data) 
} 


### MAIN WIDGET ### 
win <- gwindow("R&R") 
WIDGET <- ggroup(cont=win) 
DataGroup <- gframe("DATA", container = WIDGET, horizontal=FALSE) 

## WIDGET: LOAD DATA ## 
grp.file <- ggroup(horizontal=FALSE, container = DataGroup) 
lbl.file <- glabel("File: ", container = grp.file) 
browse.file <- gfilebrowse(text = "", container = grp.file, quote=FALSE) 

## WIDGET: SELECT COLUMNS ## 
grp.load.data <- gbutton(text="Load data", container = DataGroup, 
    handler = function(h, ...) { 
    enabled(grp.load.data) <- FALSE 
    RR_data(svalue(browse.file)) 
    # 
    dat0 <- get("dat0", envir=myenv.data) 
    SelectGroup <<- gframe("Select columns ", container = DataGroup, horizontal=FALSE) 
    grp.select <<- ggroup(horizontal=FALSE, container = SelectGroup) 
    dat.columns <- colnames(dat0) 
    lbl.factor.A <<- glabel("Factor A (fixed)", container = grp.select) 
    insert.factor.A <<- gcombobox(dat.columns, container = grp.select) 
    lbl.factor.B <<- glabel("Factor B ", container = grp.select) 
    insert.factor.B <<- gcombobox(dat.columns, selected=2, container = grp.select) 
    lbl.factor.C <<- glabel("Factor C ", container = grp.select) 
    insert.factor.C <<- gcombobox(dat.columns, selected=3, container = grp.select) 
    lbl.response <<- glabel("Response ", container = grp.select) 
    insert.response <<- gcombobox(dat.columns, selected=4, container = grp.select) 
    myenv.ABC <<- new.env() 
    assign("Aold", svalue(insert.factor.A), envir=myenv.ABC) 
    assign("Bold", svalue(insert.factor.B), envir=myenv.ABC) 
    assign("Cold", svalue(insert.factor.C), envir=myenv.ABC) 
    assign("Yold", svalue(insert.response), envir=myenv.ABC) 
    addHandlerChanged(insert.factor.A, handler <- function(h,...) { 
     Anew <- svalue(h$obj) 
     if(Anew==svalue(insert.factor.B)){ 
      Aold <- get("Aold", envir=myenv.ABC) 
      svalue(insert.factor.B) <- Aold 
      assign("Bold", Aold, envir=myenv.ABC) 
     } 
     if(Anew==svalue(insert.factor.C)){ 
      Aold <- get("Aold", envir=myenv.ABC) 
      svalue(insert.factor.C) <- Aold 
      assign("Cold", Aold, envir=myenv.ABC) 
     } 
     if(Anew==svalue(insert.response)){ 
      Aold <- get("Aold", envir=myenv.ABC) 
      svalue(insert.response) <- Aold 
      assign("Yold", Aold, envir=myenv.ABC) 
     } 
     assign("Aold", Anew, envir=myenv.ABC) 
     }) 
    addHandlerChanged(insert.factor.B, handler <- function(h,...) { 
     Bnew <- svalue(h$obj) 
     if(Bnew==svalue(insert.factor.A)){ 
      Bold <- get("Bold", envir=myenv.ABC) 
      svalue(insert.factor.A) <- Bold 
      assign("Aold", Bold, envir=myenv.ABC) 
     } 
     if(Bnew==svalue(insert.factor.C)){ 
      Bold <- get("Bold", envir=myenv.ABC) 
      svalue(insert.factor.C) <- Bold 
      assign("Cold", Bold, envir=myenv.ABC) 
     } 
     if(Bnew==svalue(insert.response)){ 
      Bold <- get("Bold", envir=myenv.ABC) 
      svalue(insert.response) <- Bold 
      assign("Yold", Bold, envir=myenv.ABC) 
     } 
     assign("Bold", Bnew, envir=myenv.ABC) 
     }) 
    addHandlerChanged(insert.factor.C, handler <- function(h,...) { 
     Cnew <- svalue(h$obj) 
     if(Cnew==svalue(insert.factor.A)){ 
      Cold <- get("Cold", envir=myenv.ABC) 
      svalue(insert.factor.A) <- Cold 
      assign("Aold", Cold, envir=myenv.ABC) 
     } 
     if(Cnew==svalue(insert.factor.B)){ 
      Cold <- get("Cold", envir=myenv.ABC) 
      svalue(insert.factor.B) <- Cold 
      assign("Bold", Cold, envir=myenv.ABC) 
     } 
     if(Cnew==svalue(insert.response)){ 
      Cold <- get("Cold", envir=myenv.ABC) 
      svalue(insert.response) <- Cold 
      assign("Yold", Cold, envir=myenv.ABC) 
     } 
     assign("Cold", Cnew, envir=myenv.ABC) 
     }) 
    addHandlerChanged(insert.response, handler <- function(h,...) { 
     Ynew <- svalue(h$obj) 
     if(Ynew==svalue(insert.factor.A)){ 
      Yold <- get("Yold", envir=myenv.ABC) 
      svalue(insert.factor.A) <- Yold 
      assign("Aold", Yold, envir=myenv.ABC) 
     } 
     if(Ynew==svalue(insert.factor.B)){ 
      Yold <- get("Yold", envir=myenv.ABC) 
      svalue(insert.factor.B) <- Yold 
      assign("Bold", Yold, envir=myenv.ABC) 
     } 
     if(Ynew==svalue(insert.factor.C)){ 
      Yold <- get("Yold", envir=myenv.ABC) 
      svalue(insert.factor.C) <- Yold 
      assign("Cold", Yold, envir=myenv.ABC) 
     } 
     assign("Yold", Ynew, envir=myenv.ABC) 
     }) 
    } 
) 

@jverzani 내 코드에 좋은 대안을 주신

업데이트. 그러나 위 코드에서 "열 선택"위젯은 gbutton() 위젯의 handler() 함수에 정의되어 있습니다. 왜냐하면 "데이터로드"위젯을 클릭 한 후에 만 ​​열 선택이 나타나기를 원하기 때문에 " 일단 데이터가로드되면 데이터로드 위젯. 따라서 "열 선택"위젯을 @ jverzani의 제안으로 바꾸면 추가 수정 없이는 작동하지 않습니다 (아래 코드 참조). 로컬 할당 대신 전역 할당을 사용하여 작동하도록 만들지 못했습니다. 어쩌면 다른 위젯의 handler() 함수에 위젯을 삽입하는 것은 나쁜 습관입니까? 그러나 나는 아직 다른 해결책을 모른다.

... 
## WIDGET: SELECT COLUMNS ## 
grp.load.data <- gbutton(text="Load data", container = DataGroup, 
    handler = function(h, ...) { 
    enabled(grp.load.data) <- FALSE 
    RR_data(svalue(browse.file)) 
    # 
    dat0 <- get("dat0", envir=myenv.data) 
    SelectGroup <<- gframe("Select columns ", container = DataGroup, horizontal=FALSE) 
    grp.select <<- ggroup(horizontal=FALSE, container = SelectGroup) 
    dat.columns <- colnames(dat0) 
    # 
    labels <- c("Factor A (fixed)", "Factor B", "Factor C", "Response") 
    Insert.columns <- lapply(1:length(labels), function(i) { 
     glabel(labels[i], container = grp.select) 
     gcombobox(dat.columns, selected=i, container=grp.select) 
    }) 
    ## make exclusive 
    sapply(1:length(Insert.columns), function(i) { 
     addHandlerChanged(Insert.columns[[i]], handler=function(h,...) { 
     all_selected <- sapply(Insert.columns, svalue) 
     selected <- svalue(h$obj)  
     ind <- which(selected == all_selected)  
     if(length(ind) > 1) { 
      j <- setdiff(ind, i) 
      remaining <- setdiff(fac_levels, all_selected) 
      tmp <- Insert.columns[[j]] 
      svalue(tmp) <- remaining[1] 
     } 
     }) 
    }) 
    insert.factor.A <<- Insert.columns[[1]] 
    insert.factor.B <<- Insert.columns[[2]] 
    insert.factor.C <<- Insert.columns[[3]] 
    insert.response <<- Insert.columns[[4]] 
    } 
) 

Answer 1

원하는대로 되나요?

library(gWidgets) 
options("guiToolkit"="RGtk2") 
library(MASS) 



x <- Cars93 
fac_levels <- levels(x$Type) 
n_levels <- length(fac_levels) 

## create a GUI with mutually exclusive comboboxes 
w <- gwindow() 
g <- ggroup(horizontal=FALSE, cont=w) 

widgets <- lapply(1:4, function(i) { 
    gcombobox(fac_levels, selected=i, cont=g) 
}) 


## make exclusive 
sapply(1:length(widgets), function(i) { 
    addHandlerChanged(widgets[[i]], handler=function(h,...) { 
    all_selected <- sapply(widgets, svalue) 
    selected <- svalue(h$obj) 

    ind <- which(selected == all_selected) 

    if(length(ind) > 1) { 
     j <- setdiff(ind, i) 
     remaining <- setdiff(fac_levels, all_selected) 
     tmp <- widgets[[j]] 
     svalue(tmp) <- remaining[1] 
    } 
    }) 
}) 

Answer 2

이전 버전을 편집하는 대신 참조 클래스에 통합하는 새로운 답변을 추가하겠습니다. 다행히도 이것으로 충분할 것입니다. 기본적으로 하나의 답변을 참조 클래스로 래핑 한 다음이를 사용하는 방법을 보여줍니다.

library(gWidgets) 
options("guiToolkit"="RGtk2") 
library(MASS) 





varSelector <- NULL 

## create a GUI with mutually exclusive comboboxes 
w <- gwindow() 
g <- ggroup(horizontal=FALSE, cont=w) 
select_file <- gfilebrowse("Select a file", cont=g, quote=FALSE) 
g1 <- ggroup(horizontal=FALSE, cont=g) 
b <- gbutton("List selected", cont=g, handler=function(h,...) { 
    if (!is.null(varSelector)) 
    print(varSelector$get_values()) 
}) 


addHandlerChanged(select_file, handler=function(h,...) { 
    csvfile <- svalue(h$obj) 
    x <- read.csv(csvfile) 
    fac_levels <- Filter(function(nm) is.factor(x[[nm]]), names(x)) 
    if (length(fac_levels) > 4) { 
    varSelector <<- VarSelect$new(fac_levels, g1) 
    } 
}) 

## 


VarSelect <- setRefClass("VarSelect", 
         fields=list(
          widgets="list", 
          fac_levels="character", 
          flag="logical" 
          ), 
         methods=list(
          initialize=function(levels=character(), cont=gwindow(), ...) { 
          g <- ggroup(horizontal=FALSE, cont=cont, ...) 
          initFields(
           fac_levels=levels, 
           flag=FALSE 
           ) 
          widgets <<- lapply(1:4, function(i) { 
           gcombobox(fac_levels, selected=i, cont=g) 
          }) 
          if(length(fac_levels) > 4) 
           make_exclusive() 
          .self 

          }, 
          set_levels=function(levels) { 
          fac_levels <<- levels 
          lapply(widgets, blockHandler) 
          lapply(widgets, function(widget) widget[] <- fac_levels) 
          if (!flag) { 
           make_exclusive() 
           flag <<- TRUE 
          } 
          lapply(widgets, unblockHandler) 
          }, 
          make_exclusive=function() { 
          sapply(1:length(widgets), function(i) { 
           addHandlerChanged(widgets[[i]], handler=function(h,...) { 
           all_selected <- sapply(widgets, svalue) 
           selected <- svalue(h$obj) 

           ind <- which(selected == all_selected) 

           if(length(ind) > 1) { 
            j <- setdiff(ind, i) 
            remaining <- setdiff(fac_levels, all_selected) 
            tmp <- widgets[[j]] 
            svalue(tmp) <- remaining[1] 
           } 
           }) 
          }) 
          }, 
          get_values = function() lapply(widgets, svalue) 
         ))