*

Postez ici vos questions, réponses, commentaires ou suggestions - Les sujets seront ultérieurement répartis dans les archives par les modérateurs

Modérateur : Groupe des modérateurs

Elsa Nario
Messages : 83
Enregistré le : 22 Mar 2019, 09:06

*

Messagepar Elsa Nario » 22 Mar 2019, 14:07

*

Mickael Canouil
Messages : 1315
Enregistré le : 04 Avr 2011, 08:53
Contact :

Re: Créer une variable date à partir d'autres variables

Messagepar Mickael Canouil » 22 Mar 2019, 15:30

Bonjour,

pour faire court: Qu'est-ce qu'un code reproductible ?

Code : Tout sélectionner

data$date3[!is.na(data$date1) & !is.na(data$date2) & data$date1>data$date2] <- data$date1
#> Error in data$date1: object of type 'closure' is not subsettable
data
#> function (..., list = character(), package = NULL, lib.loc = NULL,
#>     verbose = getOption("verbose"), envir = .GlobalEnv)
#> {
#>     fileExt <- function(x) {
#>         db <- grepl("\\.[^.]+\\.(gz|bz2|xz)$", x)
#>         ans <- sub(".*\\.", "", x)
#>         ans[db] <- sub(".*\\.([^.]+\\.)(gz|bz2|xz)$", "\\1\\2",
#>             x[db])
#>         ans
#>     }
#>     names <- c(as.character(substitute(list(...))[-1L]), list)
#>     if (!is.null(package)) {
#>         if (!is.character(package))
#>             stop("'package' must be a character string or NULL")
#>         if (any(package %in% "base"))
#>             warning("datasets have been moved from package 'base' to package 'datasets'")
#>         if (any(package %in% "stats"))
#>             warning("datasets have been moved from package 'stats' to package 'datasets'")
#>         package[package %in% c("base", "stats")] <- "datasets"
#>     }
#>     paths <- find.package(package, lib.loc, verbose = verbose)
#>     if (is.null(lib.loc))
#>         paths <- c(path.package(package, TRUE), if (!length(package)) getwd(),
#>             paths)
#>     paths <- unique(normalizePath(paths[file.exists(paths)]))
#>     paths <- paths[dir.exists(file.path(paths, "data"))]
#>     dataExts <- tools:::.make_file_exts("data")
#>     if (length(names) == 0L) {
#>         db <- matrix(character(), nrow = 0L, ncol = 4L)
#>         for (path in paths) {
#>             entries <- NULL
#>             packageName <- if (file_test("-f", file.path(path,
#>                 "DESCRIPTION")))
#>                 basename(path)
#>             else "."
#>             if (file_test("-f", INDEX <- file.path(path, "Meta",
#>                 "data.rds"))) {
#>                 entries <- readRDS(INDEX)
#>             }
#>             else {
#>                 dataDir <- file.path(path, "data")
#>                 entries <- tools::list_files_with_type(dataDir,
#>                   "data")
#>                 if (length(entries)) {
#>                   entries <- unique(tools::file_path_sans_ext(basename(entries)))
#>                   entries <- cbind(entries, "")
#>                 }
#>             }
#>             if (NROW(entries)) {
#>                 if (is.matrix(entries) && ncol(entries) == 2L)
#>                   db <- rbind(db, cbind(packageName, dirname(path),
#>                     entries))
#>                 else warning(gettextf("data index for package %s is invalid and will be ignored",
#>                   sQuote(packageName)), domain = NA, call. = FALSE)
#>             }
#>         }
#>         colnames(db) <- c("Package", "LibPath", "Item", "Title")
#>         footer <- if (missing(package))
#>             paste0("Use ", sQuote(paste("data(package =", ".packages(all.available = TRUE))")),
#>                 "\n", "to list the data sets in all *available* packages.")
#>         else NULL
#>         y <- list(title = "Data sets", header = NULL, results = db,
#>             footer = footer)
#>         class(y) <- "packageIQR"
#>         return(y)
#>     }
#>     paths <- file.path(paths, "data")
#>     for (name in names) {
#>         found <- FALSE
#>         for (p in paths) {
#>             if (file_test("-f", file.path(p, "Rdata.rds"))) {
#>                 rds <- readRDS(file.path(p, "Rdata.rds"))
#>                 if (name %in% names(rds)) {
#>                   found <- TRUE
#>                   if (verbose)
#>                     message(sprintf("name=%s:\t found in Rdata.rds",
#>                       name), domain = NA)
#>                   thispkg <- sub(".*/([^/]*)/data$", "\\1", p)
#>                   thispkg <- sub("_.*$", "", thispkg)
#>                   thispkg <- paste0("package:", thispkg)
#>                   objs <- rds[[name]]
#>                   lazyLoad(file.path(p, "Rdata"), envir = envir,
#>                     filter = function(x) x %in% objs)
#>                   break
#>                 }
#>                 else if (verbose)
#>                   message(sprintf("name=%s:\t NOT found in names() of Rdata.rds, i.e.,\n\t%s\n",
#>                     name, paste(names(rds), collapse = ",")),
#>                     domain = NA)
#>             }
#>             if (file_test("-f", file.path(p, "Rdata.zip"))) {
#>                 warning("zipped data found for package ", sQuote(basename(dirname(p))),
#>                   ".\nThat is defunct, so please re-install the package.",
#>                   domain = NA)
#>                 if (file_test("-f", fp <- file.path(p, "filelist")))
#>                   files <- file.path(p, scan(fp, what = "", quiet = TRUE))
#>                 else {
#>                   warning(gettextf("file 'filelist' is missing for directory %s",
#>                     sQuote(p)), domain = NA)
#>                   next
#>                 }
#>             }
#>             else {
#>                 files <- list.files(p, full.names = TRUE)
#>             }
#>             files <- files[grep(name, files, fixed = TRUE)]
#>             if (length(files) > 1L) {
#>                 o <- match(fileExt(files), dataExts, nomatch = 100L)
#>                 paths0 <- dirname(files)
#>                 paths0 <- factor(paths0, levels = unique(paths0))
#>                 files <- files[order(paths0, o)]
#>             }
#>             if (length(files)) {
#>                 for (file in files) {
#>                   if (verbose)
#>                     message("name=", name, ":\t file= ...", .Platform$file.sep,
#>                       basename(file), "::\t", appendLF = FALSE,
#>                       domain = NA)
#>                   ext <- fileExt(file)
#>                   if (basename(file) != paste0(name, ".", ext))
#>                     found <- FALSE
#>                   else {
#>                     found <- TRUE
#>                     zfile <- file
#>                     zipname <- file.path(dirname(file), "Rdata.zip")
#>                     if (file.exists(zipname)) {
#>                       Rdatadir <- tempfile("Rdata")
#>                       dir.create(Rdatadir, showWarnings = FALSE)
#>                       topic <- basename(file)
#>                       rc <- .External(C_unzip, zipname, topic,
#>                         Rdatadir, FALSE, TRUE, FALSE, FALSE)
#>                       if (rc == 0L)
#>                         zfile <- file.path(Rdatadir, topic)
#>                     }
#>                     if (zfile != file)
#>                       on.exit(unlink(zfile))
#>                     switch(ext, R = , r = {
#>                       library("utils")
#>                       sys.source(zfile, chdir = TRUE, envir = envir)
#>                     }, RData = , rdata = , rda = load(zfile,
#>                       envir = envir), TXT = , txt = , tab = ,
#>                       tab.gz = , tab.bz2 = , tab.xz = , txt.gz = ,
#>                       txt.bz2 = , txt.xz = assign(name, read.table(zfile,
#>                         header = TRUE, as.is = FALSE), envir = envir),
#>                       CSV = , csv = , csv.gz = , csv.bz2 = ,
#>                       csv.xz = assign(name, read.table(zfile,
#>                         header = TRUE, sep = ";", as.is = FALSE),
#>                         envir = envir), found <- FALSE)
#>                   }
#>                   if (found)
#>                     break
#>                 }
#>                 if (verbose)
#>                   message(if (!found)
#>                     "*NOT* ", "found", domain = NA)
#>             }
#>             if (found)
#>                 break
#>         }
#>         if (!found)
#>             warning(gettextf("data set %s not found", sQuote(name)),
#>                 domain = NA)
#>     }
#>     invisible(names)
#> }
#> <bytecode: 0x56062adfc590>
#> <environment: namespace:utils>


A vu de nez, "data" est une fonction ...

Si on admet que data est un data.frame (un tableau):

Code : Tout sélectionner

data[!is.na(data$date1) & !is.na(data$date2) & data$date1>data$date2, "date3"] <- data$date1


Cordialement,
Mickaël
mickael.canouil.fr | rlille.fr

Elsa Nario
Messages : 83
Enregistré le : 22 Mar 2019, 09:06

*

Messagepar Elsa Nario » 25 Mar 2019, 10:06

*

Mickael Canouil
Messages : 1315
Enregistré le : 04 Avr 2011, 08:53
Contact :

Re: Créer une variable date à partir d'autres variables

Messagepar Mickael Canouil » 26 Mar 2019, 10:41

Bonjour,

dans votre exemple vous avez votre test qui ne renvoie qu'un seul TRUE

Code : Tout sélectionner

!is.na(tableau$datexec) & !is.na(tableau$dateclotur) & tableau$datexec > tableau$dateclotur
#> [1] FALSE FALSE FALSE  TRUE


Code : Tout sélectionner

tableau[!is.na(tableau$datexec) & !is.na(tableau$dateclotur) & tableau$datexec > tableau$dateclotur, "daterr"]
#> NULL


Or vous souhaitez remplir 1 valeur avec 4... ça ne rentre pas...

Code : Tout sélectionner

tableau <- data.frame(
  datexec = c("2019-01-02", "2019-01-20", "", "2019-02-28"),
  dateclotur = c("2019-01-15", "", "2019-02-12", "2019-02-22"),
  row.names = c("titi", "toto", "tata", "tutu")
)

tableau$datexec <- as.Date(tableau$datexec, format = "%Y-%m-%d")
tableau$dateclotur <- as.Date(tableau$dateclotur, format = "%Y-%m-%d")

str(tableau)
#> 'data.frame':    4 obs. of  2 variables:
#>  $ datexec   : Date, format: "2019-01-02" "2019-01-20" ...
#>  $ dateclotur: Date, format: "2019-01-15" NA ...

# Votre solution :
tableau[!is.na(tableau$datexec) & !is.na(tableau$dateclotur) & tableau$datexec > tableau$dateclotur, "daterr"] <-
  tableau$datexec
#> Error in `[<-.data.frame`(`*tmp*`, !is.na(tableau$datexec) & !is.na(tableau$dateclotur) & : replacement has 4 rows, data has 1

# Solution :
tableau[!is.na(tableau$datexec) & !is.na(tableau$dateclotur) & tableau$datexec > tableau$dateclotur, "daterr"] <-
  tableau$datexec[!is.na(tableau$datexec) & !is.na(tableau$dateclotur) & tableau$datexec > tableau$dateclotur]

tableau
#>         datexec dateclotur     daterr
#> titi 2019-01-02 2019-01-15       <NA>
#> toto 2019-01-20       <NA>       <NA>
#> tata       <NA> 2019-02-12       <NA>
#> tutu 2019-02-28 2019-02-22 2019-02-28

Cordialement,
Mickaël
mickael.canouil.fr | rlille.fr

Elsa Nario
Messages : 83
Enregistré le : 22 Mar 2019, 09:06

*

Messagepar Elsa Nario » 05 Avr 2019, 07:38

*

Elsa Nario
Messages : 83
Enregistré le : 22 Mar 2019, 09:06

*

Messagepar Elsa Nario » 15 Avr 2019, 13:27

*

Mickael Canouil
Messages : 1315
Enregistré le : 04 Avr 2011, 08:53
Contact :

Re: Créer une variable date à partir d'autres variables

Messagepar Mickael Canouil » 15 Avr 2019, 13:36

Bonjour,

l'erreur est plutôt explicite.
Vous n'avez pas spécifié "origin" pour la méthode "as.Date.numeric"
Toutes les réponses sont dans l'aide:

Code : Tout sélectionner

?as.Date


Un exemple reproductible:

Code : Tout sélectionner

as.Date.numeric(18001)
#> Error in as.Date.numeric(18001): 'origin' must be supplied
as.Date(18001)
#> Error in as.Date.numeric(18001): 'origin' must be supplied

as.Date.numeric(18001, origin = "1970-01-01")
#> [1] "2019-04-15"
as.Date(18001, origin = "1970-01-01")
#> [1] "2019-04-15"


PS: "origin" étant système dépendant, copier-coller n'est pas une bonne idée.

Cordialement,
Mickaël
mickael.canouil.fr | rlille.fr

Elsa Nario
Messages : 83
Enregistré le : 22 Mar 2019, 09:06

*

Messagepar Elsa Nario » 16 Avr 2019, 15:59

*


Retourner vers « Questions en cours »

Qui est en ligne

Utilisateurs parcourant ce forum : Aucun utilisateur enregistré et 1 invité