Processing Transect Data

Hydrologic Modeling in Oak Woodland Soilscapes

Navigation

Random image

User login

Syndicate

Submitted by dylan on Fri, 2008-03-14 20:12.

Input File Format (see attached CSV file)

   start stop       species transect block transect.length     notes
      0   27          open      t01    b1             344          
     68   93          open      t01    b1             344          
    137  148          open      t01    b1             344          
    160  177          open      t01    b1             344          
    209  219          open      t01    b1             344          
    237  318          open      t01    b1             344          
    332  344          open      t01    b1             344          
     27   68      blue oak      t01    b1             344          
     93  137      blue oak      t01    b1             344          
    148  160      blue oak      t01    b1             344          
    177  209      blue oak      t01    b1             344          
    219  237      blue oak      t01    b1             344          
    318  332      blue oak      t01    b1             344          
[...]

Setup

## load libs

library(lattice)

&nbsp;

## read in the data

## note that this contains multiple blank lines

x.data <- read.csv('sfrec_canopy_coverage.csv')

&nbsp;

## remove a mistake: there is overlap between black oak and open cover types

x.data <- x.data[-125,]

Example visualization (see attached PDF)

dotplot(species ~ start + stop | transect, data=x.data, 

layout=c(3,6), as.table=TRUE\, subscripts=TRUE\, 

xlab='Transect Distance (ft)', ylab='Cover Type',

key=list(columns=2, text=list(c('Measured', 'Estimated')), lines=list(lty=c(1,1), col=c(1,2))),

panel=function(x, y, subscripts, groups, ...) 

{

## plot the points, and setup the graph

panel.dotplot(x, y, subscripts=subscripts, groups=groups, pch=NA\, ...)

## convert factor level to number

y_num <- as.numeric(y) 

## create a table of the distance, factor level, and start/stop flag

d <- data.frame(x=x, y=y_num, groups=groups[subscripts])

## get the start points

xy_i <- subset(d, select=c(x,y), subset=groups=='start') 

## get the stop points

xy_f <- subset(d, select=c(x,y), subset=groups=='stop')

## 

## make a line color, based on the notes field

## first level = black

## second level = red (estimated)

lcol=as.numeric(x.data$notes[subscripts])

## plot the lines

panel.segments(xy_i$x, xy_i$y, xy_f$x, xy_f$y, lwd=2, col=lcol)  

}

)

Convert to matrix representation

d <- list()

for(j in levels(x.data$transect)) 

{

&nbsp;

## work with a subset of the data:

y <- subset(x.data, subset=transect == j)

&nbsp;

## init a matrix to hold the transect data: wide format

## fill with 0's

z <- matrix(0, ncol=length(levels(y$species)), nrow=max(y$stop))

&nbsp;

## for each level of species, populate the corresponding cells of the matrix

for(i in 1:nrow(y)) 

{ 

## increment the start by one (shrinking the number of cells by 1)

y_start <- y$start[i] + 1

y_stop <- y$stop[i] 

&nbsp;

y_col <- as.numeric(y$species[i])

&nbsp;

## encode the canopy type

## using powers of 2

z[y_start:y_stop, y_col] <- 2^y_col

}

&nbsp;

eval(parse(text=paste('d$', j, ' <- z', sep='')))

}

Matrix representation and canopy overlap simplification

## generate an example

cbind(d$t10[300:320,],  rowSums(d$t10[300:320,]))

                            *
      [,1] [,2] [,3] [,4] [,5]
 [1,]    0    0    8    0    8
 [2,]    0    0    8    0    8
 [3,]    0    0    8    0    8
 [4,]    2    0    8    0   10
 [5,]    2    0    8    0   10
 [6,]    2    0    8    0   10
 [7,]    2    0    8    0   10
 [8,]    2    0    8    0   10
 [9,]    2    0    8    0   10
[10,]    2    0    8    0   10
[11,]    0    0    8    0    8
[12,]    0    0    8    0    8
[13,]    0    0    8    0    8
[14,]    0    0    8    0    8
[15,]    0    0    8    0    8
[16,]    0    0    8    0    8
[17,]    0    0    0   16   16
[18,]    0    0    0   16   16
[19,]    0    0    0   16   16
[20,]    0    0    0   16   16
[21,]    0    0    0   16   16

Convert codes

## generate the canopy cover combination table

## using powers of 2

## note that we are leaving out canopy type '5' (open), as there should be no overlap

g <- t(combn(2^(1:3), 2))

g.lookup <- data.frame(apply(g, 2, function(i) levels(x.data$species)[logb(i, base=2)]), code=rowSums(g))

&nbsp;

g.lookup.overlap <-  data.frame( canopy_type=paste(g.lookup$X1, g.lookup$X2, sep=' / '), code=g.lookup$code)

&nbsp;

## now the lookup table to non-overlapping regions

g.lookup.no_overlap <- data.frame(canopy_type=levels(x.data$species), code=2^(1:length(levels(x.data$species))))

&nbsp;

## combine

g.lookup.final <- rbind(g.lookup.no_overlap, g.lookup.overlap)

&nbsp;

## for each transect compute the linear totals for each canopy type, including overlap

t_sums <- lapply(d, function(i) table(rowSums(i))  )

&nbsp;

## re-create the table with the correct canopy type for each transect

t_sums <- lapply(t_sums, function(i) data.frame(canopy=g.lookup.final$canopy_type[match(names(i), g.lookup.final$code)], t_part=as.vector(i)) )

Re-attach transect and block id

## convert to dataframe by "row-binding"

t_sums.df <- do.call('rbind', t_sums)

&nbsp;

## re-add the transect id

t_sums.df$transect <- substr(row.names(t_sums.df), 1, 3)

&nbsp;

## make a lookup table containing transect -> block relationship

t_b.lookup <- unique(subset(x.data, select=c(transect, block, transect.length)))

&nbsp;

## join block data

t_b_sums.df <- merge(x=t_sums.df, y=t_b.lookup)

Compute percent cover by transect

pct_cover_by_transect <- sweep(tapply(t_b_sums.df$t_part, list(t_b_sums.df$canopy, t_b_sums.df$transect), sum, na.rm=TRUE\), 2, t_b.lookup$transect.length, '/') * 100

&nbsp;

write.csv(pct_cover_by_transect, na='', file='pct_cover_by_transect.csv')

print(pct_cover_by_transect, digits=1)

Compute percent cover by block

pct_cover_by_block <- sweep(tapply(t_b_sums.df$t_part, list(t_b_sums.df$canopy, t_b_sums.df$block), sum, na.rm=TRUE\), 2, tapply(t_b.lookup$transect.length, t_b.lookup$block, sum), '/') * 100

&nbsp;

write.csv(pct_cover_by_block, na='', file='pct_cover_by_block.csv')

print(pct_cover_by_block, digits=1)

Compute percent cover across all data

pct_cover <- data.frame(pct_cover=tapply(t_b_sums.df$t_part, list(t_b_sums.df$canopy), sum, na.rm=TRUE\) / sum(sapply(d, function(i) nrow(i))) * 100)

&nbsp;

write.csv(pct_cover, na='', file='pct_cover.csv')

print(pct_cover, digits=1)

Attachment	Size
transect_chart.pdf	33.45 KB
sfrec_canopy_coverage.csv_.txt	5.36 KB

( categories:

)