library(spatstat) # ################################# # Vicerozmerne a kotovane procesy ################################# # ### Priklady data(amacrine) # priklad dvourozmerneho bodoveho vzorku plot(amacrine) amacrine$marks # koty jsou tridy 'factor' - kategoricke, kvalitativni # muzeme se domnivat, ze 'on' a 'off' se vyskytuji nezavisle na sobe? # data(chorley) # jiny dvourozmerny bodovy vzorek plot(chorley,chars=c(19,3),cols=c("blue","red")) summary(chorley) # jsou v ramci zjistenych mist s vyskytem nemoci # pripady rakoviny hrtanu rozmisteny nahodne? # data(lansing) # sestirozmerny vzorek plot(lansing) plot(split(lansing)) # kazdy typ zvlast # jsou zavislosti mezi polohami jednotlivych druhu stromu? # data(finpines) # priklad kotovaneho vzorku plot(unmark(finpines)) # jen polohy bodu - funkce 'unmark' vynecha koty plot(finpines) # i se znazornenymi kotami points(finpines$x,finpines$y,col="red",pch=20) # zvyraznene polohy marks(finpines) # koty jsou spojite - kvantitativni hist(marks(finpines)) # ovlivnuje blizkost stromu u sebe jejich vysku? # ### Operace # pomoci 'cut' jsou koty z numerickych hodnot transformovany na faktorove cf3 <- cut(finpines,breaks=3) # rozdeli body na 3 typy podle velikosti koty plot(cf3) # funkci 'split' lze pouzit pro rozdeleni bodoveho vzorku podle predpisu, # ktery si sami specifikujeme data(nztrees) plot(nztrees) cn <- cut(nndist(nztrees),4) # rozdelime na 4 skupiny podle vzdalenosti nejblizsiho souseda plot(split(nztrees,f=cn)) # f musi byt factor, lze vyuzit funkce factor nebo as.factor # ### Modely kotovani # nahodne kotovani (random labelling) - polohy jsou dany, koty vytvoreny nezavisle na polohach koty <- runif(nztrees$n,2,8) # nezavisle rovnomerne koty markednztrees <- nztrees %mark% koty # pridame koty k existujicimu bodovemu procesu markednztrees <- setmarks(nztrees,koty) # udela totez pp <- rMatClust(30,0.1,5) mpp_rl <- pp %mark% factor(sample(letters[1:4], pp$n, replace=TRUE)) plot(mpp_rl) # diskretni koty => ctyrrozmerny bodovy proces # nahodne slozeni (random superposition) - vicerozmerny bodovy proces vznikne slozenim nezavislych bodovych procesu mpp_rs <- superimpose('a' = rMaternII(30,0.05), 'b' = rMaternII(50,0.05), 'c' = rMaternII(70,0.05)) plot(mpp_rs) # ### Modely kotovanych procesu mppp2 <- rmpoispp(c(3,7),win=square(3),types=c("prvni","druhy")) # dvourozmerny Poissonuv kotovany proces plot(mppp2) # nahodne kotovani a nahodne slozeni splyvaji u Poissonova procesu # vicerozmerny binomicky bodovy proces (pevny pocet bodu daneho typu): f <- function(x,y,m) { ifelse(m=='a',1,x) } mbpp3 <- rmpoint(c(30,20,10),f,types=c('a','b','c')) # 30 bodu typu 'a' rovnomerne rozdelenych # 20 bodu typu 'b' s hustotou umernou x # 10 bodu typu 'c' s hustotou umernou x plot(mbpp3) plot(split(mbpp3)) # ### Nejblizsi sousede bodu jednoho typu od bodu druheho typu v dvourozmernem procesu mppp2prvni <- split(mppp2)$prvni mppp2druhy <- split(mppp2)$druhy N <- nncross(mppp2prvni,mppp2druhy) plot(mppp2,cols=c("blue","red")) arrows(mppp2prvni$x,mppp2prvni$y,mppp2druhy[N$which]$x,mppp2druhy[N$which]$y,length=0.15) # ### Krizova K-funkce: K_{ij}(r) # lambda_j ... intenzita bodoveho procesu s kotami j # lambda_j K_{ij}(r) ... udava stredni pocet bodu s kotou j # v kouli se stredem v bode s kotou i a polomerem r # pro i=j (stejne typy bodu) je K_{ii}(r) K-funkce bodoveho procesu s kotami i # plati: K_{ij}(r) = K_{ji}(r) # nahodne kotovani: vsechny krizove K-funkce splyvaji a jsou rovny K-funkci nekotovaneho procesu # nahodne slozeni: krizova K-funkce pro ruzne typy bodu je rovna K-funkci Poissonova procesu # odhad krizove K-funkce: plot(Kcross(mpp_rl,i='a',j='b')) plot(Kcross(mpp_rs,i='a',j='b')) plot(Kcross(mppp2,i="prvni",j="druhy")) plot(Kcross(mppp2,i="druhy",j="prvni")) # melo by vyjit stejne # vse v jednom obrazku: plot(alltypes(mpp_rl,"K")) plot(alltypes(mpp_rs,"K")) plot(alltypes(mppp2,"K")) plot(alltypes(amacrine,"K")) # podobne lze vykreslit krizove G-funkce nebo J-funkce # ### Korelacni funkce kot - meri zavislost kot bodu v dane vzdalenosti plot(markcorr(finpines)) plot(markcorr(mppp2)) M <- markcorr(amacrine, correction="translate", method="density", kernel="epanechnikov", bw=0.02) plot(M) # dev.off() ### koncime