2014-04-10 64 views
2

我收集了關於船舶對海鳥造成干擾的數據。我在船上配有測距望遠鏡和角板。對於我所調查的每隻鳥,我都有一個相對於船舶航向的起始距離和方位。我也有鳥的反應距離和方位(或在某些情況下沒有)。繪圖距離和方位在R

我想做一個兩個面板的情節顯示一個起始距離和軸承位置,另一個終止距離和軸承。理想情況下,第二個小區將進行彩色編碼(或pch編碼)以顯示不同的反應類型。

我的數據是這種格式

 date_id dist bear act 
550 40711_027 200 30 f 
551 40711_028 500 45 n 
552 40711_028 450 60 n 
553 40711_028 400 75 n 
554 40711_028 371 80 f 
555 40711_029 200 5 f 
556 40711_030 200 10 d 
557 40711_031 400 30 n 
558 40711_031 350 30 d 

這裏是一個格式的數據,你可以玩弄

id <- c(1,2,2,2,2,3,4,5,5) 
dist <- c(200,500,450,400,371,200,200,400,350) 
bear <- c(30,45,60,75,80,5,10,30,30) 
act <- c("f","n","n","n","f","f","d","n","d") 

dat <- data.frame(id, dist, bear, act) 

正如你可以看到有一些ID的,即重複和一些有隻有一行。我想繪製第一個dist,並在另一個情節上承擔一個情節和最後一個dist並承擔(每個id)。對於只有一次觀察的鳥類,這些可能是相同的。根據「行爲」列對第二個圖中的點進行顏色編碼會很好。也沒有左或右的軸承名稱,所以我可以把所有的點都放在中間線的另一側,但是如果你知道將它們隨機放置在中線的左側還是右側將會很酷。理想情況下,情節會看起來像這樣。

Dist Bear Plot

UPDATE:從@jbaums使用他的代碼從另一個問題的建議之後發現here

get.coords <- function(a, d, x0, y0) { 
    a <- ifelse(a <= 90, 90 - a, 450 - a) 
    data.frame(x = x0 + d * cos(a/180 * pi), 
      y = y0+ d * sin(a/180 * pi)) 
} 

rotatedAxis <- function(x0, y0, a, d, symmetrical=FALSE, tickdist, ticklen, ...) { 
    if(isTRUE(symmetrical)) { 
    axends <- get.coords(c(a, a + 180), d, x0, y0)  
    tick.d <- c(seq(0, d, tickdist), seq(-tickdist, -d, -tickdist))  
    } else { 
    axends <- rbind(get.coords(a, d, x0, y0), c(x0, y0)) 
    tick.d <- seq(0, d, tickdist) 
    } 
    invisible(lapply(apply(get.coords(a, d=tick.d, x0, y0), 1, function(x) { 
    get.coords(a + 90, c(-ticklen, ticklen), x[1], x[2]) 
    }), function(x) lines(x$x, x$y, ...))) 
    lines(axends$x, axends$y, ...) 
} 

plot.new() 
plot.window(xlim=c(-1000,1000),ylim=c(-1000, 1000), asp=1) 
polygon(get.coords(seq(0,180, length.out=1000),1000,0,0),lwd=2) 
polygon(get.coords(seq(0,180, length.out=750),750,0,0),lwd=2) 
polygon(get.coords(seq(0,180, length.out=500),500,0,0),lwd=2) 
polygon(get.coords(seq(0,180, length.out=250),250,0,0),lwd=2) 

rotatedAxis(0, 0, a=90, d=1000, tickdist=100, ticklen=1) 
rotatedAxis(0, 0, a=45, d=1000, tickdist=100, ticklen=1) 
rotatedAxis(0, 0, a=135, d=1000, tickdist=100, ticklen=1) 

obs <- with(dat, get.coords(bear, dist, 0, 0)) 
points(obs) 

這給了我這個越來越接近我的目標的陰謀!謝謝@jbaums。

closer

我的問題是,我無法弄清楚如何做到繪製從0 90楔到90(因爲這是我的數據收集。

我也還是需要一些指導只有當一個以上的觀察已經收集,選擇第一(後來最後)觀察

+0

將兩張圖組合成一張,使用不同的顏色作爲同一只鳥的起點和終點,並用直線連接起點和終點,會更好嗎? – jinlong

+0

我可能會做的第一件事就是計算每次觀察的X和Y距離。像'calcXY < - 函數(tdat)dist < - as.numeric(tdat [2]) bear < - as.numeric(tdat [3]) bear.rad < - bear * pi/180 Y < - cos(bear.rad)* dist X < - sin(bear.rad)* dist return(c(X,Y)) } XYPos < - apply(dat,1,calcXY)'Sorry about代碼全部在一行上。應該清楚間距應該在哪裏。我不認爲這是合理的回答你的問題 – Adrian

+0

@Adrian:使用分號分隔註釋中的代碼行。 :) – jbaums

回答

1

如果你想更仔細地重新創建示例圖,請嘗試以下,使用您的datget.coords功能最初發布here

# Define function to calculate coordinates given distance and bearing 
get.coords <- function(a, d, x0, y0) { 
    a <- ifelse(a <= 90, 90 - a, 450 - a) 
    data.frame(x = x0 + d * cos(a/180 * pi), 
      y = y0+ d * sin(a/180 * pi)) 
} 

# Set up plotting device 
plot.new() 
par(mar=c(2, 0, 0, 0), oma=rep(0, 4)) 
plot.window(xlim=c(-1100, 1100), ylim=c(-100, 1100), asp=1) 

# Semicircles with radii = 100 through 1000 
sapply(seq(100, 1000, 100), function(x) { 
    lines(get.coords(seq(270, 450, length.out=1000), x, 0, 0)) 
}) 

# Horizontal line 
segments(-1000, 0, 1000, 0) 

# 45-degree lines 
apply(get.coords(c(360-45, 45), 1000, 0, 0), 1, 
     function(x) lines(rbind(x, c(0, 0)), lwd=2)) 

# Plot white curves over black curves and add text 
sapply(seq(100, 1000, 100), function(x) { 
    txt <- paste0(x, 'm') 
    w <- strwidth(txt, cex=0.9)/2 
    a <- atan(w/x)/pi*180 
    lines(get.coords(seq(-a, a, length=100), x, 0, 0), 
     lwd=2.5, col='white') 
    text(0, x, txt, cex=0.8) 
}) 

# Add points 
points(with(dat, get.coords(-bear, dist, 0, 0)), pch=20) 

# Add triangle 
polygon(c(0, -30, 30), c(-5, -55, -55), col='black') 

dist & bearing

請注意,我已經通過了由於您的示例圖表明您正在從正Y軸逆時針計算軸承,因此您的指向get.coords的點的角度爲-bear。函數get.coords函數期望從正x軸順時針計算角度,負角度(如將出現在-bear中)將被解釋爲360減去角度。

+1

非常感謝。我用jinlong提供的代碼修改了一些代碼,並且非常接近你在這裏完成的代碼,但是肯定會包含一些你的代碼。由於我有超過4000點的陰謀,我選擇沿着X軸放置儀表標記,因爲它們將被點覆蓋。再次感謝。 – marcellt

1

不知道如果我理解您的所有要求,但下面是我對「出發點」的情節的解決方案:

#install.packages("plotrix") 
library("plotrix") 

id <- c(1,2,2,2,2,3,4,5,5) 
dist <- c(200,500,450,400,371,200,200,400,350) 
bear <- c(30,45,60,75,80,5,10,30,30) 
act <- c("f","n","n","n","f","f","d","n","d") 

dat <- data.frame(id, dist, bear, act) 

##Define a function that converts degrees to radians 
#NOTE: Authored by Fabio Marroni 
#URL: http://fabiomarroni.wordpress.com/2010/12/23/r-function-to-convert-degrees-to-radians/ 
degrees.to.radians<-function(degrees=45,minutes=30) 
{ 
    if(!is.numeric(minutes)) stop("Please enter a numeric value for minutes!\n") 
    if(!is.numeric(degrees)) stop("Please enter a numeric value for degrees!\n") 
    decimal<-minutes/60 
    c.num<-degrees+decimal 
    radians<-c.num*pi/180 
    return(radians) 
} 

#Plot the canvas 
plot(0, 0, type = "n", xaxt = "n", yaxt = "n", asp=1, 
    xlim = c(0, max(dat$dist)), ylim = c(0, max(dist)), 
    bty="n", xlab = "", ylab = "", 
    main = "Whatever observations (starting points only)") 

#Plot x/y axes 
segments(0, 0, max(dat$dist), 0) 
segments(0, 0, 0, max(dat$dist)) 

#Plot axes labels 
axis(1, at = seq(0, max(dat$dist), 100), labels = seq(0, max(dat$dist), 100)) 

#Plot the equal-distance arcs 
dist = 100 
while(dist < max(dat$dist)){ 
    draw.arc(0, 0, radius = dist, deg1 = 0, deg2 = 90, n = 100, col = "blue") 
    dist <- dist + 100 
} 

#Plot the 1st point (cause it's always an starting point) 
x <- dat[1, ]$dist*sin(degrees.to.radians(dat[1, ]$bear)) 
y <- dat[1, ]$dist*cos(degrees.to.radians(dat[1, ]$bear)) 
points(x, y, pch = 21) 

for(i in 2:nrow(dat)){ 
    #Only plot starting points 
    if(dat[i, ]$id != dat[i-1, ]$id){ 
    #Determin the x and y for each point 
    x <- dat[i, ]$dist*sin(degrees.to.radians(dat[i, ]$bear)) 
    y <- dat[i, ]$dist*cos(degrees.to.radians(dat[i, ]$bear)) 

    #Adding starting points 
    points(x, y, pch = 21) 
    } 
} 

如果這是你想要的,你可以適應它的「終點」情節。你可以添加一個col參數給point()函數,並使用「act」對點進行顏色編碼。

+0

感謝@jinlong,該代碼爲我想要的完美工作。我很感謝幫助。 – marcellt

+1

@jbaums我會留下來自你以前的文章的代碼,因爲它讓我獲得了2/3的目標,我認爲它可以幫助其他人。 – marcellt