
#---------------------------------------------------------------#
## utilización de los objetos RC para gestión pila mutable         ##z

rm(list =ls()) # esta instrucción vacía el entorno

#---------------------------------------------------------------#
## un contenedor para los data y el puntero                   ##
Frame <- setRefClass("Frame",
                    fields = list (
                      data_  = "ANY", # data
                      last_  = "ANY"  # Frame o NULL
                      )
                    ) 

#---------------------------------------------------------------#
## la pila                                                     ##

Stack <- setRefClass("Stack",
                     fields = list (
                       head_  = "ANY",      # Frame o NULL
                       size_  = "numeric",  # integer 
                                            # un poco limitante
                       
                       # propio de mi implementaciçon
                       # variables "globales" de la stack
                       memo_     = "ANY",      # data o NULL
                       head_new  = "ANY"       # Frame o NULL
                       )
                     ) 
#---------------------------------------------------------------#
## método initialización de la pila                           ##

Stack$methods( initialize =
                function (...){   # ... : param super clase
                  callSuper(...)  # llamada param super clase
                  head_  <<- NULL
                  size_  <<- 0L
                  memo_  <<- NULL
                  .self           # hecho
                  }
              )

#---------------------------------------------------------------#
## meter un objeto en la pila                                 ##

Stack$methods( put =
                 function (x){   # put data
                   
                   head_new       <<- Frame$new()
                   head_new$data_ <<- x
                   head_new$last_ <<- head_                
                   head_          <<- head_new
                   head_new       <<- NULL
                   size_          <<- size_ + 1L
                   }
              )

#---------------------------------------------------------------#
## leer el objeto en la parte superior de la pila (sin desapilar)                ##

Stack$methods( peek =
                 function (){
                   return(.self$head_$data_)
                 }
             )

#---------------------------------------------------------------#
## obtener el tamaño de la pila                                ##

Stack$methods( size =
                 function (){
                   return(.self$size_)
                 }
             )

#---------------------------------------------------------------#
## desapila y obtiene el objeto en la parte superior de la pila                ##

Stack$methods( pop =
                 function (){
                   if (size_ == 0) {
                     memo_  <<- NULL
                     return(NULL)
                     }
                     
                   memo_          <<- head_$data_
                   head_          <<- head_$last_
                   size_          <<- size_ - 1L
                   return(memo_)
                 }
              )

#---------------------------------------------------------------#
## desapila una lista de objetos                                    ##
## por defecto todos los objetos, o el num deseado                  ##

Stack$methods( pop_list =
                 function (n = -1){
                   i <- .self$size_
                   if (n >= 0){ m <- n} else {m <- i}
                   l <- list()
                   while (  (m > 0) && !is.null(.self$pop()) ){
                     l[[m]] <- .self$memo_
                     m <- m- 1           
                     }
                  return(l)
                  }
              )

#---------------------------------------------------------------#
## apila el contenido de una lista (inversa de desapilar)          ##

Stack$methods( put_list =
                 function (l){   # put data
                   n <- length(l)
                   for (i in 1:n) {.self$put(l[[i]])}
                 }
             )

#---------------------------------------------------------------#
## prueba de nuestros métodos                                      ##

#---------------------------------------------------------------#
## pruebas básicas                                               ##

s <- Stack$new()         # s es una nueva pila
s$put("primer")         # en la parte inferior de la pila
s$peek()                 # es la
s$put("segundo")
s$put("tercer")
s$size()                 # pila de 3 ítems

s$pop()                  # desapila el último y el primero
s$pop()
s$pop()
s$peek()                 # no hay nada más
s$pop()                  # no hay problema si se desapila demasiado
s$peek()
s$size()                 # es una pila vacía

#---------------------------------------------------------------#
## BONUS                                                       ##
#---------------------------------------------------------------#

s$put("primer")        # podemos alternar put y pop
s$put("segundo")
s$pop()
s$size()                 # 1 = 2 put - 1 pop

#---------------------------------------------------------------#
## pruebas más finas                                             ##

## una clase para las pruebas sobre apilado de objetos
Objet <- setRefClass("Objet",
                     fields = list (
                       contenido  = "ANY"
                      )
                     ) 

## un objeto del que veremos variar los valores
dummy           <- Objet$new()
dummy$contenido   <- 666

## una matriz 3 X 3
una_matriz     <- matrix(seq(1:9),3,3)

## tres objetos de prueba de + en + complejos
primer         <- Objet$new()
primer$contenido <- "primer"

segundo          <- Objet$new()
segundo$contenido  <- dummy

tercer         <- Objet$new()
tercer$contenido <- list(dummy,"tercer",una_matriz)

## tests mutate
s <- Stack$new()
s$put(primer)
s$put(segundo)
s$put(tercer)

dummy$contenido    <- 999
o1 <- s$pop()            # vuelve a copiar el objeto top de la pila
o1$contenido               # la mutación funciona

s$put(tercer)
una_matriz[1,1] <- 777  # test mutación matriz
o1 <- s$pop()            
o1$contenido               # matriz: no mutable

#---------------------------------------------------------------#
## tests pop_list                                              ##
s <- Stack$new()
s$put(primer)
s$put(segundo)
s$put(tercer)

lista_contenidos <- s$pop_list() # vacía todo en una lista
length(lista_contenidos)         # 3 elementos en la lista

lista_contenidos[[2]]
dummy$contenido   <- 222         
lista_contenidos[[2]]            # la mutación función

s$peek()                       # la pila está vacía
s$put_list(lista_contenidos)    # put de los datos
s$size()                       # 
s$peek()                       # todo vuelve a estar en orden

#---------------------------------------------------------------#
## test pop_list parciales                                    ##
s <- Stack$new()
s$put(list("primer",dummy))
s$put("segundo")
s$put("tercer")

lista_contenidos <- s$pop_list(2)# devuelve 2 slots superiores
                               # de lista
length(lista_contenidos)         # 2 ítem en la lista
s$size()                       # solo falta uno en la pila
lista_contenidos[[2]]            # ex superior de la pila
lista_contenidos[[1]]            # ex n-1 superior de la pila
dummy$contenido   <- 444
s$put_list(lista_contenidos)    # recargamos los 2 
s$size()                       # lo que da 3        
s$pop()
s$pop()
s$pop()                        # la mutación funciona

#---------------------------------------------------------------#
