## objets S4 avec validation plus explicite et gestion de l'affichage

setClass(
  Class="VSv3",
  representation=representation(
    titre="character",
    ref="character",
    valeurs="numeric"
  )  ,
  prototype=prototype(
     titre="",
     ref="",
     valeurs=numeric(0)
  )  ,
  validity=function(object) {
       (nchar(object@titre)>0) &&
       (nchar(object@ref)>0)
  } # fin de validity

) # fin de définition de la classe VSv3

setValidity(
  Class="VSv3",
  method= function(object) {
     ok <- TRUE
     if (nchar(object@titre)==0) {
       cat("Erreur : il manque le titre \n")
       ok <- FALSE
     } # finsi
     if (nchar(object@ref)==0) {
       cat("Erreur : il manque la référence \n")
       ok <- FALSE
     } # finsi
     return( ok )
  } # fin de méthode
) # fin de fonction de validation pour VSv3

setMethod(
  signature="VSv3",
  f="show",
  definition=function(object) {
    cat("Variable statistique : ",object@titre," références : ",object@ref,"\n")
    nbval  <- length(object@valeurs)
    nbvaldis <- length(unique(object@valeurs))
    cat(" avec",nbval,"valeurs")
    if (nbval==nbvaldis) {
      cat(" uniques")
    } else {
      cat(" dont ",nbvaldis,"uniques")
    } # fin si
    nbna <- sum(is.na(object@valeurs))
    if (nbna>0) {
      cat(" et",nbna,"valeur(s) manquante(s)")
    } # fin si
    cat(".\n")
  } # fin de définition
) # fin de setMethod show pour VSv3

## not run :
#  var3a <- new(Class="VSv3",titre="ages",ref="gh DEMO",valeurs=c(30,40,50,60))
#  show(var3a)
#  print(var3a)
#
#  var3b <- new(Class="VSv3",titre="ages",ref="gh DEMO",valeurs=c(30,40,50,NA,60,30,60,30))
#  show(var3b)
#  print(var3b)

## also not run :
#   badVar3a <- new("VSv3",titre="ages",valeurs="30 40 50 60")
#   badVar3b <- new("VSv3",titre="ages",valeurs=c(30,40,50,60))

##
## objets S4 : sous-classes VSqt (quantitatives) et VSql (qualitatives)
## de la classe VS (variables statistiques)
##

setClass(

  Class="VSqt",
  contains="VSv3",

  representation=representation(
    unite="character"
  )
  ,
  prototype=prototype(
    unite="???"
  )

) # fin de définition de la classe VSqt

setClass(

  Class="VSql",

  representation=representation(
    modalites="character",
    donnees="factor"
  )
  ,
  contains="VSv3"

) # fin de définition de la classe VSqt

## not run :
#
#  var4qt <- new(Class="VSqt",titre="ages",ref="gh DEMO",valeurs=c(30,40,50,NA,60,30),unite="ans")
#
#  print(var4qt)
#
#  print( slotNames(var4qt) )
#  print( getSlots( class(var4qt)) )
#  print( getClass( class(var4qt)) )

# ajout d'une fonction du même nom que la classe

VSqt <- function(sonTitre,saRef,sesValeurs=numeric(0),sonUnite="???") {

  if (missing(sonTitre)) {
     stop("pour créer un objet VSqt, il faut impérativement donner son titre\n")
  } # finsi

  if (missing(saRef)) {
     stop("pour créer un objet VSqt, il faut impérativement donner sa référence\n")
  return()
  } # finsi

  return( new(Class="VSqt",titre=sonTitre,ref=saRef,valeurs=sesValeurs,unite=sonUnite) )

} # finsi

## not run :
#
#  v6a <- VSqt(sonTitre="poids",saRef="dossier HER (gh)",sesValeurs=c(8,12,15),sonUnite="kg")
#  print( v6a )
#
#  v6b <- VSqt("taille"," exemple GH")
#  print( v6b )

## also  not run : v6c <- VSqt()
##
# Error in VSqt() :
##   pour créer un objet VSqt, il faut impérativement donner son titre
##

##########################################
#
# fonctions pour accéder aux slots
#
##########################################

setGeneric("getTitre",
  function(object) { standardGeneric("getTitre") }
) # fin de setGeneric pour getTitre

setGeneric("getRef",
  function(object) { standardGeneric("getRef") }
) # fin de setGeneric pour getTitre

setGeneric("getValeurs",
  function(object) { standardGeneric("getValeurs") }
) # fin de setGeneric pour getValeurs

setGeneric("getUnite",
  function(object) { standardGeneric("getUnite") }
) # fin de setGeneric pour getUnite

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

setMethod("getTitre","VSqt",
  function(object) { return( object@titre ) }
) # fin de setMethod pour getTitre

setMethod("getRef","VSqt",
  function(object) { return( object@ref ) }
) # fin de setMethod pour getRef

setMethod("getValeurs","VSqt",
  function(object) { return( object@valeurs ) }
) # fin de setMethod pour getValeurs

setMethod("getUnite","VSqt",
  function(object) { return( object@unite ) }
) # fin de setMethod pour getUnite

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

setGeneric("setTitre<-",
  function(object,...) { standardGeneric("setTitre<-") }
) # fin de setGeneric pour setTitre

setGeneric("setRef<-",
  function(object,...) { standardGeneric("setRef<-") }
) # fin de setGeneric pour setTitre

setGeneric("setValeurs<-",
  function(object,...) { standardGeneric("setValeurs<-") }
) # fin de setGeneric pour setValeurs

setGeneric("setUnite<-",
  function(object,...) { standardGeneric("setUnite<-") }
) # fin de setGeneric pour setUnite

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

setReplaceMethod(
  f="setTitre",
  signature="VSqt",
  definition=function(object,value) {
    object@titre <- value
    return(object)
  }
) # fin de setReplaceMethod pour setTitre

setReplaceMethod(
  f="setRef",
  signature="VSqt",
  definition=function(object,value) {
    object@ref <- value
    return(object)
  }
) # fin de setReplaceMethod pour setRef

setReplaceMethod(
  f="setValeurs",
  signature="VSqt",
  definition=function(object,value) {
    object@valeurs <- value
    return(object)
  }
) # fin de setReplaceMethod pour setValeurs

setReplaceMethod(
  f="setUnite",
  signature="VSqt",
  definition=function(object,value) {
    object@unite <- value
    return(object)
  }
) # fin de setReplaceMethod pour setUnite

setGeneric("decrit",
  function(object,...) { summary(object@valeurs ) }
) # fin de setGeneric pour decrit