1

ループを使用して、サンプル データの長さ頻度分布を比較forする一連のlatticeヒストグラムを作成しています。各ヒストグラムにabline、各分布の平均とtextサンプル数を示す垂直方向のグラフを表示したいと考えています。

次のデータがあります。

> head(hist.data,20)
               Scientific_name Count Length..cm. Method
3  Pristipomoides filamentosus     1          60 BotCam
5           Etelis carbunculus     1          43 BotCam
6             Etelis coruscans     1          40 BotCam
12 Pristipomoides filamentosus     1          55 BotCam
16           Aphareus rutilans     1          67 BotCam
17           Aphareus rutilans     1          77 BotCam
20          Etelis carbunculus     1          46 BotCam
21    Pristipomoides sieboldii     1          35 BotCam
23    Pristipomoides sieboldii     1          33 Fishing
25          Etelis carbunculus     1          53 Fishing
26 Pristipomoides filamentosus     1          45 Fishing
27 Pristipomoides filamentosus     1          43 Fishing
28 Pristipomoides filamentosus     1          58 Fishing
29 Pristipomoides filamentosus     1          55 Fishing
30    Pristipomoides sieboldii     1          29 Fishing

私のコードは次のとおりです。

#create a list of species
sp <- c("Etelis coruscans","Etelis carbunculus","Pristipomoides sieboldii","Pristipomoides filamentosus","Pristipomoides zonatus","Epinephelus quernus","Aphareus rutilans")

#Calculate sample# and mean length by species by method
n <- with(hist.data, tapply(Scientific_name, Method, function(x) count(x)))
mean.length <- aggregate(Length..cm. ~ Scientific_name + Method, data = hist.data, FUN= "mean")

#plot hisotgrams for each spp in 1cm bins
for (i in sp){
    BIN_WIDTH <- 1 #desired bin width
    print(histogram(~ Length..cm. | Method, #create and print histogram
    data = hist.data[hist.data$Scientific_name == i,], 
    nint = (max(hist.data$Length..cm.) - min(hist.data$Length..cm.)+1)/BIN_WIDTH,
    layout = c(1,2),
    type = "density",
    main = substitute(expr = expression(paste("Length-Frequency of ", italic(i), " by Gear")), env = list(i=i)),
    xlab = "Length (cm)",
    panel = function(x, ...){
        #panel.abline(v = 60, col = "red", lty = 2)
        #panel.text(lab = paste("Sample #: ",n$BotCam[1,2]), 90, 100)
        panel.histogram(x,...)
        panel.mathdensity(dmath = dnorm, col = "black",
                      args = list(mean = mean(x), sd= sd(x)), ...)     
    }
    ))


    #save histogram as PDF file
    quartz.save(paste("Length-Frequency of", i, "by method.pdf", sep = " "), type = "pdf")
    dev.off() #close the graphics diver
}

次の配列を作成できます。

n <- with(hist.data, tapply(Scientific_name, Method, function(x) count(x)))
n
$BotCam
                            x freq
1           Aphareus rutilans   16
2          Etelis carbunculus   35
3            Etelis coruscans   20
4 Pristipomoides filamentosus  179
5    Pristipomoides sieboldii  125
6      Pristipomoides zonatus    2

$Fishing
                            x freq
1         Epinephelus quernus    2
2          Etelis carbunculus   68
3            Etelis coruscans   30
4 Pristipomoides filamentosus   24
5    Pristipomoides sieboldii   80
6      Pristipomoides zonatus    5

と

mean.length <- aggregate(Length..cm. ~ Scientific_name + Method, data = hist.data, FUN= "mean")
> mean.length
               Scientific_name  Method Length..cm.
1            Aphareus rutilans  BotCam    58.81250
2           Etelis carbunculus  BotCam    43.65714
3             Etelis coruscans  BotCam    46.55000
4  Pristipomoides filamentosus  BotCam    53.22346
5     Pristipomoides sieboldii  BotCam    35.52000
6       Pristipomoides zonatus  BotCam    35.00000
7          Epinephelus quernus Fishing    74.00000
8           Etelis carbunculus Fishing    42.98529
9             Etelis coruscans Fishing    49.96667
10 Pristipomoides filamentosus Fishing    59.58333
11    Pristipomoides sieboldii Fishing    37.25000
12      Pristipomoides zonatus Fishing    30.80000

交換したい：

#panel.abline(v = 60, col = "red", lty = 2)
#panel.text(lab = paste("Sample #: ",n$BotCam[1,2]), 90, 100)

abline種の分布の平均に基づいてを生成するコードと、 fromおよび "Sample #:" fromtextを生成するコードを使用します。値は、上部と下部のプロット、および の反復ごとに異なります。これを行う方法はありますか？私は結婚していませんが、それは私が経験したことです。このようなものがあれば、私に知らせてください。ablinemean.lengthnlooplatticeggplot

4

2 に答える 2

1

いろいろ調べてみたところ、問題を解決しているように見える次のコードを思いつきました。panel.textここで、軸がループの反復ごとに変化することを考慮して、出力を配置する最良の方法を見つけ出す必要があります。

#plot hisotgrams for each spp in 1cm bins
for (i in sp){
    BIN_WIDTH <- 1 #desired bin width
    print(histogram(~ Length..cm. | Method, #create and print histogram
    data = hist.data[hist.data$Scientific_name == i,], 
    nint = (max(hist.data$Length..cm.) - min(hist.data$Length..cm.)+1)/BIN_WIDTH,
    layout = c(1,2),
    type = "density",
    main = substitute(expr = expression(paste("Length-Frequency of ", italic(i), " by Gear")), env = list(i=i)),
    xlab = "Length (cm)",
    panel = function(x, ...){
        mean.values <- mean(x)
        panel.abline(v=mean.values, col.line="red", lty = 2)
        sample.n <- length(x)
        panel.text(lab = paste("Sample size = ", sample.n), mean.values*1.2, .26)
        panel.text(lab = paste("Mean = ", round(mean.values, 1)), mean.values*1.2, .23)
        panel.histogram(x,...)
        panel.mathdensity(dmath = dnorm, col = "black",
                      args = list(mean = mean(x), sd= sd(x)), ...)     
    }
    ))

    #save histogram to PDF file
    quartz.save(paste("Length-Frequency of", i, "by method.png", sep = " "), type = "png")
    dev.off() #close graphics diver
}
于 2013-05-25T00:09:01.610 に答える
0

コードのコピーをアップロードできますか? (x) を正しく定義していないようです。

于 2013-07-10T03:58:23.643 に答える