I do subscribe to Economagic, but unfortunately the download method
available with a subscription is not as useful as the method intended in
fImport. The subscription gives me some other advantages so I don't begrudge
it.

 

My solution is to maintain my own method, which I have to change
occasionally. It is derived from the original economagicImport function. One
day it may become impossible to read the HTML; in the meantime it remains a
valuable data source.

 

Here is my current code:

 

economagicImport <- function (query, file = "tempfile", source =
"http://www.economagic.com/em-cgi/data.exe/", 

    frequency = c("quarterly", "monthly", "daily", "weekly"), save = FALSE, 

    colname = "VALUE", try = TRUE) 

{

    freq = match.arg(frequency)

    if (try) {

        z = try(economagicImport(query = query, file = file, 

            source = source, frequency = freq, save = save, colname =
colname, 

            try = FALSE))

        if (inherits(z, "try-error") || inherits(z, "Error")) {

            return("No Internet Access")

        }

        else {

            return(z)

        }

    }

    else {

        n <- switch(freq, quarterly = , monthly = 2, daily = 3, weekly = 4)

        method <- if (is.R()) 

            NULL

        else "lynx"

        url = paste(source, query, sep = "")

        download.file(url = url, destfile = file, method = method)

        SCAN = scan(file, what = "", sep = "\n")

        # this identifies the data lines

        lines = grep("font color=white", SCAN)

        z1 = SCAN[lines]

        z2 = gsub("font", "          ", x = z1)

        z1 = gsub("color=white........", " ", x = z2)

        z2 = gsub(">", " ", x = z1)

        z1 = gsub("<", " ", x = z2)

        z1 = gsub("/", " ", x = z1)

        z1 = gsub("&#149;", ".", x = z1) # MW addition

        n.rows = length(z1)

        z2 = unlist(apply(matrix(z1, ncol = 1), 2, strsplit, 

            split = " "))

        # this triggers warnings. It replaces non-numerics with NA

        options(warn=-1)

        z1 = as.numeric(z2[z2 != ""])

        z1 <- z1[!is.na(z1)] # MW addition

        options(warn=0)

        n.fields = length(z1)

        ncols <- n.fields/n.rows

        z = matrix(z1, byrow = TRUE, ncol = ncols)

        if (n == 2) 

            z = cbind(z[, 1] * 100 + z[, 2], z[, 3])

        if (n == 3){

                                if(ncols == 3){

                                                z = cbind(z[, 1] * 100 + z[,
2], z[, 3])

                                                zlast <- z[nrow(z),2]

                                                dup <- duplicated(z[,1])

                                                z <- z[!dup,]

                                                z[nrow(z),2] <- zlast

                                                freq <- "monthly"

                                } else {

            z = cbind(z[, 1] * 10000 + z[, 2] * 100 + z[, 3], 

                z[, 4])

            }

        }

        if (freq == "quarterly") 

            z[, 1] = 100 * (z[, 1]%/%100) + 3 * z[, 1]%%100

        z = data.frame(cbind(z[, 1], z[, 2]))

        names(z) = c("DATE", colname)

        rowNames = as.character(z[, 1])

        if (freq == "daily" || freq == "weekly") {

            rowNames = paste(substring(rowNames, 1, 4), "-", 

                substring(rowNames, 5, 6), "-", substring(rowNames, 

                  7, 8), sep = "")

        }

        else {

            rowNames = paste(substring(rowNames, 1, 4), "-", 

                substring(rowNames, 5, 6), "-01", sep = "")

        }

        z[, 1] = rowNames

        if (save) {

            write.table(z, file, quote = FALSE, sep = ";", row.names =
FALSE)

        }

        else {

            unlink(file)

        }

        return(list(data=z,freq=freq)) # MW replaces fWEBDATA structure

    }

}

 

Bill Hutchison

hutch@moneyware.com

 


	[[alternative HTML version deleted]]

