vignettes/CulturalDistance/cul_dist_kde_xxxxxxx.r

In CRC1266-A2/moin: Modelling Interactions

# kde nur für die Knoten

#inputs for tests
features_csv = "shkr-weapons.csv"
features = read.csv(features_csv, sep = ";")
nodes_csv = "fs_ag.csv"
nodes = read.csv(nodes, sep = ";")

#use of create_type_generator does not need to be changed, so therefore can go in wrapper
typelist = create_type_generator(nodes, "type", 1)

# # support function to use dist with coordinates of nodes and features and returns distance matrix
dist4 <- function(x){
  x_1 <- x[1]
  x_2 <- x[2]
  y_1 <- x[3]
  y_2 <- x[4]
  m <- matrix(c(x_1,x_2,y_1,y_2), nrow=2)
  d <- dist(m)[1]
  return(d)
}

#coordinates of features (x2, y2) are passed for all nodes (x1, x2), density values are normalised and returned as vector
dens_samp <- function(x1,y1,x2,y2,sd) {
    l <- length(x2)
    ts <- x1
    ts[] <- 0

    for (i in 1:length(x1)) {
      xav <- rep(x1[i], l)
      yav <- rep(y1[i], l)
      xy <- cbind(xav,yav,x2,y2)
      d <- apply(xy, 1, dist4)
      d <- dnorm(d, mean=0, sd=sd)
      ts[i] <- sum(d)
    }
    return(ts)
}

#testoutput
test_dens_from_nodes = dens_samp(nodes$x,nodes$y,
                                 features$x,features$y,sd(c(nodes$x,nodes$y,features$x,features$y)))
# TODO function to dens_samp for subs. of types in types of features

subs_by_type <- function(type, df_for_subset){
  ind = which(colnames(df_for_subset) == type)
  df_sub = df_for_subset[df_for_subset[, ind] > 0,]
  return(df_sub)
}

colnames(features) = c("x", "y", "type", "nodes")
tyspec = create_typespectra(features, typelist)

testmerge = merge(features, tyspec, by.x="nodes",by.y="node_id", all.x = TRUE)

testSingleType <- subs_by_type("B411", testmerge) # checked for type; therefore

#TODO: find better way to structure output with changing dens_samp() to full df
test_for_B411 = test_dens_from_nodes = dens_samp(
  nodes$x,nodes$y,testSingleType$x,testSingleType$y,sd(c(nodes$x,nodes$y,testSingleType$x,testSingleType$y)))

# understood approach: types are put in typespectre are checked
# and then the cultural distance should be calculated for the sites.
# TODO write proper function for input check
# TODO wrapper function that uses func from culturalDistance package then implement in external wrapper




#other approach dealing with raster
# idea: for every type calculate raster and then sample with nodes
library(maptools)
library(raster)

pts_fea <- SpatialPointsDataFrame(coords = features[1:2], data = features)
pts_nodes <- SpatialPointsDataFrame(coords = nodes[1:2], data = nodes)

one_site = SpatialPointsDataFrame(coords = nodes[18,1:2], data = nodes[18,])
plot(pts_nodes[pts_nodes[, 3] == 18], pch = 10)
plot(pts_fea, pch = 16, add =T)


rast <- raster()
extent(rast) <- extent(pts) # this might be unnecessary
ncol(rast) <- 20 # this is one way of assigning cell size / resolution
nrow(rast) <- 20 # seems to be enough for testsites; not sure if enough for all. maybe TODO make flex

rast_for_dens_sampling <- rasterize(pts, rast, features$type, fun=mean)