systematicinvestor/SIT — pull request #7 by AndreMikulec (2013-10-13 16:59:31+00:00)
Title: 1. Fixed single column matrix acccidentally being converted down to a vector.  2.  Added feature keepHTMLTITLEtext

TheSystematicInvestor@gmail

[Pull request] SIT File: fundamental.data.r R function: fund.data

Michael Kapler,

The following are the
1. reasons
2. code

supporting
1. fixes
2. enhancement

File: fundamental.data.r
R function: fund.data

PROBLEM #1
----------

The situation exists that

AAOI only has one quarter of information on the web page

When I run

outp <- fund.data31("AAOI", 20)

The following code is (eventually) executed,

# remove empty columns
all.data = all.data[, colSums(nchar(trim(all.data))) > 0]

if( ncol(all.data) > n ) {

Code
all.data[, colSums(nchar(trim(all.data))) > 0]

accidentally converts the single column matrix
( because only one column of information on the web page ) into a vector.

So next

if( ncol(all.data) > n ) {

fails with error

Downloading http://uk.advfn.com/p.php?pid=financials&symbol=AAOI&btn=quarterly_reports
Error in if (ncol(all.data) > n) { : argument is of length zero

This is because, "vectors" do not have a "ncol" attribute

This is the fix

# remove empty columns
all.data = all.data[, colSums(nchar(trim(all.data))) > 0]
# if converted to a vector, then make it a matrix again
if (is.vector(all.data)) {
all.data.temp <- matrix(all.data,nrow=length(all.data))
rownames(all.data.temp) <- names(all.data)
colnames(all.data.temp) <- all.data.temp[1, ]
all.data <- all.data.temp
all.data.temp <- matrix(nrow=0, ncol=0)
}

if( ncol(all.data) > n ) {
all.data <- all.data[, (ncol(all.data) - n + 1):ncol(all.data)]
# if converted to a vector, then make it a matrix again
if (is.vector(all.data)) {
all.data.temp <- matrix(all.data,nrow=length(all.data))
rownames(all.data.temp) <- names(all.data)
colnames(all.data.temp) <- all.data.temp[1, ]
all.data <- all.data.temp
all.data.temp <- matrix(nrow=0, ncol=0)
}

PROBLEM #2 ( RELATED TO PROBLEM #1 )
------------------------------------

The situation exists that

I may only want one quarter of information

When I run

outp <- fund.data31("THM", 1)

When requesting only one quarter of information ( using n=1 )
again,

This Code

all.data = all.data[, colSums(nchar(trim(all.data))) > 0]

accidentally converts the single column matrix into a vector

It is tested by

if( ncol(all.data) > n ) {

Instead it is directly returned from the function by

return(all.data)

as a vector ( but this should be a matrix )

This is the fix

# remove empty columns
all.data = all.data[, colSums(nchar(trim(all.data))) > 0]
# if converted to a vector, then make it a matrix again
if (is.vector(all.data)) {
all.data.temp <- matrix(all.data,nrow=length(all.data))
rownames(all.data.temp) <- names(all.data)
colnames(all.data.temp) <- all.data.temp[1, ]
all.data <- all.data.temp
all.data.temp <- matrix(nrow=0, ncol=0)
}

if( ncol(all.data) > n ) {
all.data <- all.data[, (ncol(all.data) - n + 1):ncol(all.data)]
# if converted to a vector, then make it a matrix again
if (is.vector(all.data)) {
all.data.temp <- matrix(all.data,nrow=length(all.data))
rownames(all.data.temp) <- names(all.data)
colnames(all.data.temp) <- all.data.temp[1, ]
all.data <- all.data.temp
all.data.temp <- matrix(nrow=0, ncol=0)
}

ENHANCEMENT
----------

One may want to capture the page title for reasons of

1. make visually matching symbols to companies easier
2. compare and contrast errors between the page titles and the in-page company names

This is the enhancement

if ( keepHTMLTITLEtext == TRUE ) {
# extract title from this page
HTMLOPENTITLETAGposStart <- regexpr(pattern="

", txt,ignore.case=TRUE)[1]
HTMLCLOSETITLETAGposStart <- regexpr(pattern="

",txt,ignore.case=TRUE)[1]
HTMLOPENTITLETAGlength <- nchar("

")
HTMLTITLEtext <- substr(txt, HTMLOPENTITLETAGposStart + HTMLOPENTITLETAGlength , HTMLCLOSETITLETAGposStart - 1 )
}
...

if ( keepHTMLTITLEtext == TRUE ) {
# add a row of the HTMLTITLEtext values
all.data <- rbind(all.data, rep( HTMLTITLEtext, ncol(all.data) ) )
# to the new 'added row' name it "HTMLTITLEtext"
rownames(all.data)[nrow(all.data)] <- "HTMLTITLEtext"
}
return(all.data)
} else {
if ( keepHTMLTITLEtext == TRUE ) {
# add a row of the HTMLTITLEtext values
all.data <- rbind(all.data, rep( HTMLTITLEtext, ncol(all.data) ) )
# to the new 'added row' name it "HTMLTITLEtext"
rownames(all.data)[nrow(all.data)] <- "HTMLTITLEtext"
}
return(all.data)
}
}

SIMPLE METHOD TO TEST
----------------------

BELOW fund.data41 is actually fund.data function of
https://github.com/AndreMikulec/SIT/blob/hotfix/hotfix-vector_null_HTMLTitle/R/fundamental.data.r
https://github.com/AndreMikulec/SIT/commit/0a14fea6b9cebc59ac698c251b978a8daea56bd8

library(SIT)

fund.data41 <- function
(
Symbol,	# ticker
n=10,	# number of periods
mode=c('quarterly','annual'), # periodicity
max.attempts=5,	# maximum number of attempts to download before exiting
keepHTMLTITLEtext = FALSE	# last row includes HTML TITLE text
)
{
all.data = c()
option.value = -1

start_date = spl('istart_date,start_date')
names(start_date) = spl('quarterly,annual')

repeat {
# download Quarterly Financial Report data
if(option.value >= 0) {
url = paste('http://uk.advfn.com/p.php?pid=financials&symbol=', Symbol, '&btn=', mode[1], '_reports&', start_date[mode[1]], '=', option.value, sep = '')
} else {
url = paste('http://uk.advfn.com/p.php?pid=financials&symbol=', Symbol, '&btn=', mode[1], '_reports', sep = '')
}

cat('Downloading', url, '\n')

#txt = join(readLines(url))
for(iattempt in 1:max.attempts) {
flag = T
tryCatch({
txt = join(readLines(url))
}, interrupt = function(ex) {
flag <<- F
Sys.sleep(0.1)
}, error = function(ex) {
flag <<- F
Sys.sleep(0.1)
}, finally = {
if(flag) break
})
}

if( len(grep('INDICATORS', txt, ignore.case = T)) == 0 ) {
cat('No Data Found for', Symbol, '\n')
return(all.data)
}

if ( keepHTMLTITLEtext == TRUE ) {
# extract title from this page
HTMLOPENTITLETAGposStart <- regexpr(pattern="<title>", txt,ignore.case=TRUE)[1]
HTMLCLOSETITLETAGposStart <- regexpr(pattern="

",txt,ignore.case=TRUE)[1]
HTMLOPENTITLETAGlength <- nchar("

")
HTMLTITLEtext <- substr(txt, HTMLOPENTITLETAGposStart + HTMLOPENTITLETAGlength , HTMLCLOSETITLETAGposStart - 1 )
}

# extract table from this page
data = extract.table.from.webpage(txt, 'INDICATORS', hasHeader = T)
colnames(data) = data[1,]
rownames(data) = data[,1]
data = data[,-1,drop=F]

# only add not already present data
add.index = which( is.na(match( colnames(data), colnames(all.data) )) )
all.data = cbind(data[,add.index,drop=F], all.data)

# check if it is time to stop
if(ncol(all.data) >= n) break
if(option.value == 0) break

# extract option value to go to the next page
temp = gsub(pattern = '<option', replacement = '<tr>', txt, perl = TRUE)
temp = gsub(pattern = '</option>', replacement = '</tr>', temp, perl = TRUE)
temp = extract.table.from.webpage(temp, 'All amounts', hasHeader = T)

temp = apply(temp,1,join)
index.selected = grep('selected', temp)
option.value = 0
if(	len(index.selected) )
option.value = as.double( gsub('.*value=\'([0-9]*).*', '\\1', temp[index.selected]) )

if(option.value > 0) {
# can only get 5 time periods at a time
option.value = option.value - 5
option.value = max(0, option.value)
} else {
break
}
}

# remove empty columns
all.data = all.data[, colSums(nchar(trim(all.data))) > 0]
# if converted to a vector, then make it a matrix again
if (is.vector(all.data)) {
all.data.temp <- matrix(all.data,nrow=length(all.data))
rownames(all.data.temp) <- names(all.data)
colnames(all.data.temp) <- all.data.temp[1, ]
all.data <- all.data.temp
all.data.temp <- matrix(nrow=0, ncol=0)
}

if( ncol(all.data) > n ) {
all.data <- all.data[, (ncol(all.data) - n + 1):ncol(all.data)]
# if converted to a vector, then make it a matrix again
if (is.vector(all.data)) {
all.data.temp <- matrix(all.data,nrow=length(all.data))
rownames(all.data.temp) <- names(all.data)
colnames(all.data.temp) <- all.data.temp[1, ]
all.data <- all.data.temp
all.data.temp <- matrix(nrow=0, ncol=0)
}
if ( keepHTMLTITLEtext == TRUE ) {
# add a row of the HTMLTITLEtext values
all.data <- rbind(all.data, rep( HTMLTITLEtext, ncol(all.data) ) )
# to the new 'added row' name it "HTMLTITLEtext"
rownames(all.data)[nrow(all.data)] <- "HTMLTITLEtext"
}
return(all.data)
} else {
if ( keepHTMLTITLEtext == TRUE ) {
# add a row of the HTMLTITLEtext values
all.data <- rbind(all.data, rep( HTMLTITLEtext, ncol(all.data) ) )
# to the new 'added row' name it "HTMLTITLEtext"
rownames(all.data)[nrow(all.data)] <- "HTMLTITLEtext"
}
return(all.data)
}
}

------------

library(SIT)

# BLUE: CONTROL ( NEVER DID 'NOT WORK' )
outp <- fund.data41("THM", 10 )

> is.matrix(outp)
[1] TRUE
> rownames(outp)[nrow(outp)];outp[nrow(outp),]
[1] "auditors report"
2002/09 2002/12 2003/03 2003/06 2003/09 2003/12 2004/03 2004/06 2004/09
"" "" "" "" "" "" "" "" ""

# RED: A PROBLEM ( FIXED )
outp <- fund.data41("AAOI", 10)

> is.matrix(outp)
[1] TRUE
> rownames(outp)[nrow(outp)];outp[nrow(outp),]
[1] "% of leverage-to-industry"
[1] "0.0"

# NEVER A PROBLEM
outp <- fund.data41("THM", 2)

> is.matrix(outp)
[1] TRUE
> rownames(outp)[nrow(outp)];outp[nrow(outp),]
[1] "auditors report"
2004/06 2004/09
"" ""
# A PROBLEM ( FIXED )
outp <- fund.data41("THM", 1)

> is.matrix(outp)
[1] TRUE
> rownames(outp)[nrow(outp)];outp[nrow(outp),]
[1] "auditors report"
[1] ""
>

-------------------

library(SIT)

# BLUE: CONTROL ( NEVER DID 'NOT WORK' )
outp <- fund.data41("THM", 10, keepHTMLTITLEtext = TRUE)

> is.matrix(outp)
[1] TRUE
> rownames(outp)[nrow(outp)];outp[nrow(outp),]
[1] "HTMLTITLEtext"
2002/09
"Thomas Equipment Company Financial Information"
2002/12
"Thomas Equipment Company Financial Information"
2003/03
"Thomas Equipment Company Financial Information"
2003/06
"Thomas Equipment Company Financial Information"
2003/09
"Thomas Equipment Company Financial Information"
2003/12
"Thomas Equipment Company Financial Information"
2004/03
"Thomas Equipment Company Financial Information"
2004/06
"Thomas Equipment Company Financial Information"
2004/09
"Thomas Equipment Company Financial Information"
>

# RED: A PROBLEM ( FIXED )
outp <- fund.data41("AAOI", 10, keepHTMLTITLEtext = TRUE)

> is.matrix(outp)
[1] TRUE
> rownames(outp)[nrow(outp)];outp[nrow(outp),]
[1] "HTMLTITLEtext"
[1] "APPLIED OPTOELECTRONICS, INC. Company Financial Information"

# NEVER A PROBLEM
outp <- fund.data41("THM", 2, keepHTMLTITLEtext = TRUE)

> is.matrix(outp)
[1] TRUE
> rownames(outp)[nrow(outp)];outp[nrow(outp),]
[1] "HTMLTITLEtext"
2004/06
"Thomas Equipment Company Financial Information"
2004/09
"Thomas Equipment Company Financial Information"
>

# A PROBLEM ( FIXED )
outp <- fund.data41("THM", 1, keepHTMLTITLEtext = TRUE)

> is.matrix(outp)
[1] TRUE
> rownames(outp)[nrow(outp)];outp[nrow(outp),]
[1] "HTMLTITLEtext"
[1] "Thomas Equipment Company Financial Information"
>