Bagaimana cara menentukan dengan elegan bidang loop histeresis (masalah dalam / luar)?

8

Saya telah mengukur dua parameter (Karbon organik DOC terlarut = y, dan debit = x). Ketika dua variabel ini diplot terhadap satu sama lain, kita mendapatkan loop histeresis (lihat contoh kode dan gambar).

Sekarang, untuk analisis lebih lanjut, saya ingin menentukan area loop histeretik ini. Saya menemukan bahwa ini dapat dilakukan dengan menggunakan metode darting Monte Carlo. Metode ini mengatakan bahwa luas area yang tidak diketahui sebanding dengan luas area yang dikenal dengan luas empat kali klik di bidang dalam (loop).

Masalah saya sekarang adalah, bagaimana menyelesaikan masalah dalam / luar menggunakan R. Bagaimana saya bisa menggambar persegi panjang dengan area yang diketahui dan bagaimana saya bisa unggul dari hit acak di dalam dan di luar loop histeretik?

Harap dicatat, bahwa saya terbuka untuk metode lain ...

Saya mencari di Google, dan mencari di berbagai situs statistik tetapi tidak dapat menemukan jawaban. Bantuan atau tautan langsung ke situs web / posting lain sangat dihargai.

Lingkaran histeresis saya

Data <- read.table("http://dl.dropbox.com/u/2108381/DOC_Q_hystersis.txt", sep = ";",
               header = T)

head(Data)
plot(Data$Q, Data$DOC, type = "o", xlab = "Discharge (m3 s-1)", ylab = "DOC (mg C l-1)",
 main = "Hystersis loop of the C/Q relationship")
Strohmi
sumber

Jawaban:

6

Cara yang sama sekali berbeda adalah dengan langsung menghitung luas poligon Anda:

library(geometry)
polyarea(x=Data$Q, y=Data$DOC)

Ini menghasilkan 0,606.

Stephan Kolassa
sumber
+1. Selain itu, area (tidak seperti panjang, misalnya) sangat kuat untuk kesalahan independen dalam koordinat titik. Perhatikan bahwa solusi ini tidak berasumsi banyak tentang poligon; khususnya, ia menghormati kurangnya manifestasinya.
whuber
1

Satu kemungkinan adalah ini: bagi saya sepertinya lingkaran histeresis seharusnya cembung, bukan? Jadi seseorang dapat menghasilkan poin dan menguji untuk setiap titik apakah itu merupakan bagian dari cembung gabungan dari kumpulan data Anda dan titik acak - jika ya, itu terletak di luar dataset asli. Untuk mempercepat, kita dapat bekerja dengan subset dari dataset asli, yaitu poin yang terdiri dari cembung cembung itu sendiri.

Data.subset <- Data[chull(Data$Q, Data$DOC),c("Q","DOC")]

x.min <- min(Data.subset$Q)
x.max <- max(Data.subset$Q)
y.min <- min(Data.subset$DOC)
y.max <- max(Data.subset$DOC)

n.sims <- 1000
random.points <- data.frame(Q=runif(n=n.sims,x.min,x.max),
  DOC=runif(n=n.sims,y.min,y.max))
hit <- rep(NA,n.sims)
for ( ii in 1:n.sims ) {
  hit[ii] <- !((nrow(Data.subset)+1) %in%
    chull(c(Data.subset$Q,random.points$Q[ii]),
      c(Data.subset$DOC,random.points$DOC[ii])))
}

points(random.points$Q[hit],random.points$DOC[hit],pch=21,bg="black",cex=0.6)
points(random.points$Q[!hit],random.points$DOC[!hit],pch=21,bg="red",col="red",cex=0.6)

estimated.area <- (y.max-y.min)*(x.max-x.min)*sum(hit)/n.sims

lambung cembung

Tentu saja, cara R dalam melakukan sesuatu tidak akan menggunakan forloop saya , tetapi ini mudah dimengerti dan tidak terlalu lambat. Saya mendapatkan perkiraan area 0,703.

EDIT: tentu saja, ini bergantung pada dugaan kecemburuan hubungan. Sebagai contoh, tampaknya ada bagian nonconvex di kanan bawah. Pada prinsipnya, kita bisa memperkirakan estimasi area seperti itu dengan cara yang sama dan mengurangi ini dari estimasi area asli.

Stephan Kolassa
sumber
Akan jauh lebih cepat dan lebih akurat hanya dengan meraster poligon dan memperkirakan luasnya dengan menghitung sel-sel yang dikandungnya.
whuber