*LIST OF REACTIVE OBJECTS*
Data()
Groupings()
Table()
Data2()
Test() (incomplete implementation)
Data3()
minedAttributes()
Hypotheses()
Adjustment.Model()
What.if()
Settings()




This is a piece of coding documentation/text dump/code dump

<li><a href=https://github.com/tohweizhong/redhyte target=_blank>Source code on Github</a></li>
        

Table(): first column in the data.frame will be the rows,
second column will be column of table

#=============================================#
#=============================================#
#=============================================#

tags$br(),tags$br(),tags$br(),tags$br(),tags$br(),
tags$br(),tags$br(),tags$br(),tags$br(),tags$br(),

Data() has stringsAsFactors=F, because if use TRUE,
generated tables will consist of all classes on Atgt and/or Acmp,
instead of just the initial context

***KEYWORDS***

all user-input renderui are tagged with "ctrl"
all options and data file grabbers are indicated by "dat" in their variable names
1. preview
2. viz
3. test
4. ctx.view
5. diag
6. ctx.mine


using sidebarPanels in the tabPanels => the sidebarPanels are fixed and cannot move

#some definitions and explanation
#                tags$h4("It's testing time."),
#                tags$h5("Definitions:"),
#                tags$h5("-> Target attribute: attribute representing the result or desired outcome, e.g. (lowering of) cholesterol levels"),
#                tags$h5("-> Comparing attribute: attribute representing the act of comparison and/or intervention, e.g. statin vs. placebo"),
#                tags$h5("Note that while the target attribute can be either continuous or discrete, the comparing attribute must be discrete (2-class)."),
#                tags$h4("Let's start by indicating target and comparing attributes."),


#                  tags$style(type="text/css", '#leftPanel { width:200px; float:left;}'),
#                  id = "leftPanel",


#=============================================#
#=============================================#
#=============================================#






df.to.tab<-Data2()[[1]][c(i)]
    
    if(Data2()[[4]] == FALSE){ #no starting ctx
    
      df<-Data()[[1]][c(input$targetAttr,input$comparingAttr)]
      
      #is the target attribute continuous or categorical?
      if(Data()[[2]][input$targetAttr] == "Cate")
        return(list(t(table(df)),
                    "Contingency",
                    length(unique(df[,input$comparingAttr])),
                    df))
      
      else{ #target attribute is continuous
        cl<-unique(df[,input$comparingAttr]) #all classes of comparing attribute
        means<-NULL
        for(i in seq(length(cl))){
          #for a given class of the comparing attribute,
          #compute the mean value of the target attribute
          whichones<-which(df[,2] == cl[i]) #2nd column is comparing attribute
          means<-c(means,mean(df[whichones,1])) #1st column is target atrribute
        }
        names(means)<-cl
        tmp<-data.frame(means)
        colnames(tmp)<-paste("means of ",input$targetAttr,sep="")
        return(list(tmp,
                    "Comparison",
                    length(cl),
                    df))
      }
    }
    
    else if(Data2()[[4]] == TRUE){ #there is a starting ctx
      
     







    
#     #assuming no starting ctx yet
#     rowsToUse<-seq(nrow(dfWithCtx))
#     ctxFlag<-FALSE
#     
#     #consider the type of Atgt and Acmp
#     #starting context can only be considered for categorical attributes,
#     #ie. Atgt must be categorical while Acmp is already categorical
#     
#     #both`Atgt and Acmp are categorical
#     if(Data()[[2]][input$targetAttr] == "Cate" && Data()[[2]][input$comparingAttr] == "Cate"){
#       #use all?
#       if(input$whichtgtclasses == "Use all classes" && input$whichcmpclasses == "Use all classes")
#         rowsToUse<-seq(nrow(dfWithCtx)) #all rows
#       else if(input$whichtgtclasses == "Use all classes" && input$whichcmpclasses != "Use all classes"){
#         rowsToUse<-which(dfWithCtx[,input$comparingAttr] %in% input$whichcmpclasses == TRUE) # <------ PROBLEM IS HERE
#         #060914: PROBLEM RESOLVED
#         ctxFlag<-TRUE
#       }
#       else if(input$whichtgtclasses != "Use all classes" && input$whichcmpclasses == "Use all classes"){
#         rowsToUse<-which(dfWithCtx[,input$targetAttr] %in% input$whichtgtclasses == TRUE) # <------ PROBLEM IS HERE
#         ctxFlag<-TRUE
#       }
#       else{
#         rowsToUse<-intersect(which(dfWithCtx[,input$targetAttr] %in% input$whichtgtclasses == TRUE),
#                              which(dfWithCtx[,input$comparingAttr] %in% input$whichcmpclasses ==  TRUE)) # <------ PROBLEM IS HERE
#         ctxFlag<-TRUE
#       }
#     }
#     
#     #Only Atgt is categorical and Acmp is not
#     #(does not comply to Redhyte's algorithm)
#     else if(Data()[[2]][input$targetAttr] == "Cate" && Data()[[2]][input$comparingAttr] != "Cate"){
#       if(input$whichtgtclasses == "Use all classes")
#         rowsToUse<-seq(nrow(dfWithCtx)) #all rows
#       else if(input$whichtgtclasses != "Use all classes"){
#         rowsToUse<-which(dfWithCtx[,input$targetAttr] == input$whichtgtclasses) # <------ PROBLEM IS HERE
#         ctxFlag<-TRUE
#       }
#     }
#     
#     #only Acmp is categorical and Atgt is not
#     else if(Data()[[2]][input$targetAttr] != "Cate" && Data()[[2]][input$comparingAttr] == "Cate"){
#       if(input$whichcmpclasses == "Use all classes")
#         rowsToUse<-seq(nrow(dfWithCtx)) #all rows
#       else if(input$whichcmpclasses != "Use all classes"){
#         rowsToUse<-which(dfWithCtx[,input$comparingAttr] %in% input$whichcmpclasses == TRUE) # <------ PROBLEM IS HERE
#         ctxFlag<-TRUE
#       }
#     }
#     
#     #retrieve the row numbers of the row to be used in subsequent analysis,
#     #forming the starting context
#     dfWithCtx<-dfWithCtx[rowsToUse,]
#     
#     #lastly, add the mean cutoff attribute if Atgt is continuous
#     #this median value based on the data after considering Cinitial
#     if(Data()[[2]][input$targetAttr] == "Cont"){
#       m<-mean(dfWithCtx[,input$targetAttr])
#       #using mean instead of median,
#       #because median cannot handle extremely skewed data
#       
#       #print(unique(dfWithCtx[,input$targetAttr]))
#       
#       dfWithCtx$tgt.class<-sapply(dfWithCtx[,input$targetAttr],
#                                   FUN=function(x){
#                                     if(x>=m) return("High")
#                                     else return("Low")})
#     }
#     
#     #add the attribute type for the cutoff attribute if required
#     attr.type<-Data()[[2]]
#     if(ncol(dfWithCtx) > ncol(Data()[[1]])){ #meaning the cutoff attribute is added
#       attr.type<-c(attr.type,"Cate")
#     }
#     
#     return(list(dfWithCtx,attr.type,Data()[[3]],ctxFlag))
    #Data2()[[3]] is incorrect for now. refer to comments above






line 788 Metrics()
    
    #introduce mean-discretization for the continuous mined Actx
    which.are.cont<-mined.attr[which(Data2()[[2]][mined.attr] == "Cont")]
    
    #function to add mean discretization for one attribute
    mean.discre<-function(a.ctx.attr){
      m<-mean(df[,a.ctx.attr])
      new.col<-sapply(df[,a.ctx.attr],
                      FUN=function(x){
                        if(x>=m) return("High")
                        else return("Low")})
      return(new.col)
    }
    
    for(a.ctx.attr in which.are.cont)
      df[,a.ctx.attr]<-mean.discre(a.ctx.attr)
      
    str(df)





#   Data1.1<-reactive({
#     
#     cur.df<-Data()[[1]]
#     
#     rows.tgt<-NULL
#     print(input$targetAttr)
#     if(!is.null(input$targetAttr)){
#       if(!is.null(input$whichtgtclassesA))
#         rows.tgt<-c(rows.tgt,which(cur.df[,input$targetAttr] %in% input$whichtgtclassesA))
#       if(!is.null(input$whichtgtclassesB))
#         rows.tgt<-c(rows.tgt,which(cur.df[,input$targetAttr] %in% input$whichtgtclassesB))
#     }
#     rows.cmp<-NULL
#     if(!is.null(input$comparingAttr)){
#       if(!is.null(input$whichcmpclassesX))
#         rows.cmp<-c(rows.cmp,which(cur.df[,input$comparingAttr] %in% input$whichcmpclassesX))
#       if(!is.null(input$whichcmpclassesY))
#         rows.cmp<-c(rows.cmp,which(cur.df[,input$comparingAttr] %in% input$whichcmpclassesY))
#     }
#     rows.ctx<-NULL
#     if(!is.null(input$ctxItems)){
#       for(an.item in input$ctxItems){
#         
#         Actx<-unlist(strsplit(an.item,"="))[1]
#         vctx<-unlist(strsplit(an.item,"="))[2]
#         rows.ctx<-c(rows.ctx,which(cur.df[,Actx] %in% vctx))
#       }
#     }
#     rows<-unique(c(rows.tgt,rows.cmp,rows.ctx))
#     
#     str(rows.tgt)
#     str(rows.cmp)
#     str(rows.ctx)
#     str(rows)
#     
#     if(is.null(rows)) return(cur.df)
#     else if(!is.null(rows)) return(cur.df[rows,])
#   })







  #***************REACTIVE**********************#
  
#   Cinitial<-reactive({
#     # retrieve attributes
#     tgt.attr<-input$targetAttr
#     cmp.attr<-input$comparingAttr
#     ctx.attr<-input$ctxAttr
#     
#     # retrieve items
#     tgt.class1<-input$whichtgtclassesA
#     tgt.class2<-input$whichtgtclassesB
#     cmp.class1<-input$whichcmpclassesX
#     cmp.class2<-input$whichcmpclassesY
#     ctx.items <-input$ctxItems
#     
#     # remove support at end of string
#     remove.sup<-function(s){return(unlist(strsplit(s," [()]"))[1])}
#     tgt.class1<-sapply(tgt.class1,FUN=remove.sup)
#     tgt.class2<-sapply(tgt.class2,FUN=remove.sup)
#     cmp.class1<-sapply(cmp.class1,FUN=remove.sup)
#     cmp.class2<-sapply(cmp.class2,FUN=remove.sup)
#     ctx.items <-sapply(ctx.items, FUN=remove.sup)
#     
#     return(list(tgt.attr=tgt.attr,cmp.attr=cmp.attr,ctx.attr=ctx.attr,
#                 tgt.class1=tgt.class1,tgt.class2=tgt.class2,
#                 cmp.class1=cmp.class1,cmp.class2=cmp.class2,
#                 ctx.items=ctx.items))
#   })









