28 Nov 2012

So, What Are You? ..A Plant? ..An Animal? -- Nope, I'm a Fungus!


Lately I had a list of about 1000 species names and I wanted to filter out only the plants as that is where I come from. I knew that Scott Chamberlain has put together the ritis package which obviously can do such things. However, I knew of ITIS before and was keen to give it a shot..

Here's what I've come up with (using the ITIS API, updated on 11. Dec 2012, previous version had a flaw with indefinite matches.. Should be ok now. However, there are of course species that are not covered by the database, i.e. Ixodes, see below):



library(XML)
get_tsn <- function(sp_name) {
           require(XML)
           units <- tolower(unlist(strsplit(sp_name, " ")))

           # valid string?
           if (length(units) > 2) { stop("...No valid search string submitted (two words seperated by one space)!") }

           itis_xml <- htmlParse(paste("http://www.itis.gov/ITISWebService/services/ITISService/searchByScientificName?srchKey=", 
                                       sp_name, sep=""))
           tsn <- xpathSApply(itis_xml, "//tsn", xmlValue)
           unitname1 <- tolower(gsub("\\s+", "", xpathSApply(itis_xml, "//unitname1", xmlValue)))
           unitname2 <- tolower(gsub("\\s+", "", xpathSApply(itis_xml, "//unitname2", xmlValue)))
           unitname3 <- tolower(gsub("\\s+", "", xpathSApply(itis_xml, "//unitname3", xmlValue)))

           # sp_name = only Genus, get tsn were sp_name matches perfectly and unitname2 (lower level taxon) is absent 
           if (length(units) == 1) {
               return(tsn[tolower(sub("\\s+", "", unitname1)) == tolower(sp_name) & unitname2 == ""]) }

           # sp_name = Genus and Epitheton, get tsn where both match perfectly and unitname3 (lower level taxon) is absent 
           if (length(units) == 2) {
               return(tsn[unitname1 == units[1] & 
                          unitname2 == units[2] &
                          nchar(unitname3) == 0]) }
           }

get_kngdm <- function(tsn) {
                   kngdm <- xpathSApply(htmlParse(paste("http://www.itis.gov/ITISWebService/services/ITISService/getKingdomNameFromTSN?tsn=", 
                                                       tsn, sep="")), 
                                                  "//kingdomname", xmlValue)
           return(kngdm)
           }

get_tsn_kngdm <- function(x) {y = get_tsn(x)
                              z = get_kngdm(y)
                              return(list(Name = x, TSN = y, Kingdom = z))
                              }

# I had some API-related errors (I guess it was mysteriously not answering in 
# some cases). I couldn't resolve this and thus implemented tryCatch
get_tsn_kngdm_try <- function(x) tryCatch(get_tsn_kngdm(x), error = function(e) NULL)

sp_names <- c("Clostridium", "Physcia", "Ixodes", "LYNX", "Homo sapiens", "Canis lupus")

system.time(result <- data.frame(do.call(rbind, lapply(sp_names, FUN = get_tsn_kngdm_try))))
result

system.time(result <- data.frame(do.call(rbind, lapply(sp_names, FUN = get_tsn_kngdm_try))))
#
# result
#        User      System verstrichen 
#        1.54        0.01       33.66 
#           Name    TSN  Kingdom
# 1  Clostridium 555645   Monera
# 2      Physcia  14024    Fungi
# 3        Viola  22030  Plantae
# 4       Ixodes                
# 5         LYNX 180581 Animalia
# 6 Homo sapiens 180092 Animalia
# 7  Canis lupus 180596 Animalia
#

20 Nov 2012

Add Comments in MS-Word using VBA

This VBA procedure (1) Searches words ("Str1", "Str2",..) and adds commentboxes to it and (2) changes the initials used in the box:

Sub CommentBox()

    Dim range As range
    Dim i As Long
    Dim TargetList
    Dim cm As Comment
    
    TargetList = Array("Str1", "Str2")
    
    For i = 0 To UBound(TargetList)
    
    Set range = ActiveDocument.range
    
    With range.Find
    .Text = TargetList(i)
    .Format = True
    .MatchCase = False
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
        
    Do While .Execute(Forward:=True) = True

        Set cm = range.Comments.Add(range:=range, Text:="Hallo")
        cm.Author = "InternalName"
        cm.Initial = "Initials"
        
        Loop
    
    End With

    Next

With ActiveDocument.Styles("Kommentartext").Font
        .Size = 12
        .Bold = True
        .Italic = True
        .Color = wdColorBlue
End With

End Sub

12 Nov 2012

WIKI Search in Excel with VBA

Here's a VBA code snippet for searching a string in a cell in WIKIPEDIA:

Sub wiki()

Dim searchstr As String
Dim searchsadd As String

searchstr = ActiveCell.Value
searchadd = "http://en.wikipedia.org/w/index.php?title=Special%3ASearch&profile=default&search=" & searchstr & "&fulltext=Search"
  
  If Len(searchstr) = 0 Then
    MsgBox "The active cell is empty.. Nothing to search for..", vbOKOnly, "WIKIPEDIA"

  Else:
    ActiveWorkbook.FollowHyperlink searchadd, NewWindow:=True
    Application.StatusBar = "WIKI search for: " & searchstr
  End If
  
End Sub

6 Nov 2012

Calculate Single Contour-Line from DEM with QGIS / GDAL

In QGIS:

- from menu: Raster / Extraction / Contour

- define output name path/to/output.shp

- alter GDAL call for single contour line at 900 m asl:

gdal_contour -fl 900 "path/to/dem_raster.asc" "path/to/output.shp"


- for removing small poplygons or lines add area or length field (attr table / field calc or vector / geometry / add geometry)

- query by length or area to deselect unwanted iso-lines


Finally, you can export the contours as KML and check it in Google Earth: