################################################################
#
# ce fichier contient quelques fonctions pour Rstat
# dont read.dbf
################################################################


################################################################
#
# fonction copiée avec l'autorisation de son auteur
#
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Shapefile Format - Read/Write shapefile format within R
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Ben Stabler benjamin.stabler@odot.state.or.us
# Copyright (C) 2003  Oregon Department of Transportation
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Read DBF format
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#
################################################################

read.dbf <- function(dbf.name) {

        infile<-file(dbf.name,"rb")

        # Header

        file.version <- readBin(infile,integer(), 1, size=1, endian="little")
        file.year <- readBin(infile,integer(), 1, size=1, endian="little")
        file.month <- readBin(infile,integer(), 1, size=1, endian="little")
        file.day <- readBin(infile,integer(), 1, size=1, endian="little")
        num.records <- readBin(infile,integer(), 1, size=4, endian="little")
        header.length <- readBin(infile,integer(), 1, size=2, endian="little")
        record.length <- readBin(infile,integer(), 1, size=2, endian="little")
        file.temp <- readBin(infile,integer(), 20, size=1, endian="little")
        header <- list(file.version,file.year, file.month, file.day,
                     num.records, header.length, record.length)
        names(header) <- c("file.version","file.year","file.month","file.day",
                    "num.records","header.length","record.length")
        rm(file.version,file.year, file.month, file.day, num.records, header.length, record.length)

        # Calculate the number of fields

        num.fields <- (header$header.length-32-1)/32
        field.name <- NULL
        field.type <- NULL
        field.length <- NULL
        field.decimal <- NULL

        # Field Descriptions (32 bytes each)

        for (i in 1:num.fields) {
                field.name.test <- readBin(infile,character(), 1, size=10, endian="little")
                field.name <- c(field.name,field.name.test)
                if (nchar(field.name.test)!=10) {
                   file.temp <- readBin(infile,integer(), 10-(nchar(field.name.test)),
                                   1, endian="little")
                } # fin de si
                field.type <- c(field.type,readChar(infile, 1))
                file.temp <- readBin(infile,integer(), 4, 1, endian="little")
                field.length <- c(field.length,readBin(infile,integer(), 1, 1, endian="little"))
                field.decimal <- c(field.decimal, readBin(infile,integer(), 1, 1, endian="little"))
                file.temp <- readBin(infile,integer(), 14, 1, endian="little")
        } # fin de pour i

        # Create a table of the field info

        fields <- data.frame(NAME=field.name,TYPE=field.type,LENGTH=field.length,DECIMAL=field.decimal)

        # Set all fields with length<0 equal to correct number of characters

        fields$LENGTH[fields$LENGTH<0]<-(256+fields$LENGTH[fields$LENGTH<0])

        # Read in end of attribute descriptions terminator - should be integer value 13

        file.temp <- readBin(infile,integer(), 1, 1, endian="little")

        # Increase the length of field 1 by one to account for the space at the beginning of each record

        fields$LENGTH[1]<-fields$LENGTH[1]+1

        # Add fields to the header list

        header <- c(header,fields=NULL)
        header$fields <- fields

        # Read in each record to a list element

        all.records <- list()
        for (i in 1:header$num.records) {
                all.records <- c(all.records, list(readChar(infile, header$record.length)))
        } # fin de pour i

        # Close the dbf file connection

        close(infile)

        #Function to split the strings and replace all " " with "" at the end of string

        format.record <- function(record) {
                record <- substring(record, c(1,cumsum(fields$LENGTH)
                           [1:length(cumsum(fields$LENGTH))-1]+1),cumsum(fields$LENGTH))
                record <- gsub(" +$","", record)
                record
        } # fin de fonction format.record

        # Split each record into columns and save as data.frame

        dbf <- data.frame(t(data.frame(lapply(all.records, format.record))))
        rm(all.records)
        dimnames(dbf) <- list(1:header$num.records, header$fields$NAME)

        # Set the numeric fields to numeric

        for (i in 1:ncol(dbf)) {
                if(fields$TYPE[i]=="C") { dbf[[i]] <- as.character(dbf[[i]]) }
                if(fields$TYPE[i]=="N") { dbf[[i]] <- as.numeric(as.character(dbf[[i]])) }
                if(fields$TYPE[i]=="F") { d
                    bf[[i]] <- as.numeric(as.character(dbf[[i]]))
                    warning("Possible trouble converting numeric field in the DBF\n")
                } # fin de si type F
        } # fin de pour i

        # If the first field is of type character then remove the first
        # character of each record since the DBF stores a space for a
        # valid record and an * for a deleted record.
        # If the field is numeric then R removes the white space

        if(fields[1,2]=="C") { dbf[[1]] <- gsub("^[ *]", "", as.character(dbf[[1]])) }

        colnames(dbf) <- as.character(fields$NAME)
        colnames(dbf) <- gsub("_",".",colnames(dbf))

        # Return the dbf as a list with a data.frame and a header list

        list(dbf=dbf, header=header)

} # fin de fonction read.dbf

################################################################

skku <- function( x ) {

################################################################

    cnt_x <- length(x)
    moy_x <- sum(x)/cnt_x
    med_x <- median(x)
    mct_x <- sum(x*x)/cnt_x
    var_x <- mct_x - moy_x**2
    ect_x <- sqrt( var_x)
    dix   <- (x-moy_x)/ect_x
    sk    <- sum(dix**3)/cnt_x
    ku    <- sum(dix**4)/cnt_x
    cat(" pour ",cnt_x," valeurs \n")
    cat("   moyenne    ",moy_x,"\n")
    cat("   médiane    ",med_x,"\n")
    cat("   écart-type ",ect_x,"\n")
    cat("   skewness   ",sk   ,"\n")
    cat("   kurtosis   ",ku   ,"\n")

} ; # fin de fonction skku

################################################################