Projekt:Ökogramme für Commons/Scripts R

Aus Wikiversity

Diese Scripts berechnen gewichtete mittlere Zeigerwerte aus CSV-Dateien für Vegetationsaufnahmen und Lexikon der Zeigerwerte.

Installation der Statistik-Scriptsprache GNU R ist erforderlich.

Es handelt sich lediglich um eine vorläufige Version mit einer Testanwendung. Das Tool ist in der Entwicklung und soll später Diagramme sowie Dateiausgaben zur weiteren Auswertung erzeugen.

Die Anleitung zum Erstellen von Ökogrammen gibt nähere Informationen zur weiteren Verwendung der Ergebnisse sowie Quellen für die nötigen Daten.

Installation[Bearbeiten]

  • Installiere GNU R
  • Lege ein Verzeichnis deiner Wahl für Daten und R-Scripts an, z.B. C:/oekogramme/
  • Erzeuge die Dateien test.r, calc.r, settings.r und io.r.
  • Kopiere die Quelltexte im Abschnitt Quellcodes in diese Dateien (entspr. Name des Script), speiche die Dateien. Nutze hierzu entweder einen Text-Editor oder R
  • Speichere die Daten im Abschnitt Testdaten in den Dateien lex.csv und Yio-Blaium.csv.
  • Öffne R
  • Öffne in R die Datei test.r
  • Ersetze in der Zeile
script_path <- "Script- und Datenverzeichnis" # Endend mit "/" !
den Teil Script- und Datenverzeichnis durch das angelegte Verzeichnis, also bspw. C:/oekogramme/
  • Kopiere den gesamten Inhalt der Datei in die Konsole, drück evtl. Enter.

Das Script sollte ein Diagramm ähnlich Abbildung 1 in der Anleitung öffnen sowie als EPS, PDF und PNG speichern. Mittels Inkscape kann die PDF-Datei vor dem Hochladen geöffnet und als SVG gespeichert werden.

Ferner wird die Datei results_wiki.txt erzeugt, welche die mittleren Zeigerwerte aller ausgewerteten Vegetationsaufnahmen in Wiki-Syntax enthält.

Quellcodes[Bearbeiten]

Skript: test.r

script_path <- "Script- und Datenverzeichnis" # Endend mit "/" !
lex_file <- "lex.csv"
 
#####  Liste der Eingabedateien für Vegetationsaufnahmen. 
#####  Größte Datei möglichst zuerst. Komma-getrennt
data_files <- c(
"Yio-Blaium.csv"
)
 
 
colors <- c(
"Xio-Blaium" = "green",
"Yio-Blaium" = "blue",
"Xio-Blubbium" = "red"
)
symbols <- c(
"Xio-Blaium" = "+",
"Yio-Blaium" = "+",
"Xio-Blubbium" = "+"
)


##################### READ SOURCE FILES ##############
source(paste(script_path,"settings.r",sep=""))
source(paste(script_path,"io.r",sep=""))
source(paste(script_path,"calc.r",sep=""))

######################  READ DATA   #########################
print(paste("Reading ",data_files[1]))
data <- csv.read(paste(script_path,data_files[1],sep=""))

######################  APPEND MORE DATA   #######################
for(i in 2:length(data_files)) {
	print(paste("Appending",data_files[i]))
	data <- append_data(data, csv.read(paste(script_path,data_files[i],sep="")))
}

######################  WRITE COMPLETE TABLE TO FILE  ############
write.csv(data, paste(script_path,"out.csv",sep="") )

######################  PREPARE DATA  #######################
keys <- t(data[data[,1]=="key",2:ncol(data)])[,1]
specieslist <- data[data[,1]!="key",1]
data <- data[data[,1]!="key",2:ncol(data)]
rownames(data) <- 1:nrow(data)

######################  CREATE LEX  #######################
lex <- csv.read(paste(script_path,lex_file,sep=""))
rownames(lex) <- lex[,lex_cols$species]

###################  CALCULATE WEIGHTS, SAVE TO FILE ########
weights <- get_weights(data)
write.table(weights, sep=";", file=paste(script_path,"weights.csv",sep=""))

###################  CALCULATE WEIGHTED MEAN INDICATORS  ###########
mean_vals <- c();
results <- data.frame(row.names = colnames(data))
for(c in calculate_columns) {
	print(paste("Lex column",c))
	vals <- get_available_numeric(lex, as.character(lex_cols[c]))
	for(sample in 1:ncol(data)) {
		weights_col <- weights[,sample]
		mean_val <- calc_weighted_means(specieslist, weights_col, vals )
		mean_vals[colnames(data)[sample]] <- mean_val
	}
	results[c] <- mean_vals
}
results$key <- keys
################ WRITE RESULTS TO FILE
write.table(results, sep=";", file=paste(script_path,"results.csv",sep=""))

########################  END OF CALCULATIONS  #######################

################# LOAD EXISTING RESULATS; IF NEEDED  ################
# results <- csv.read(paste(script_path,"results.csv",sep="")) 

#######  SET COLORS  #######
cols <- keys
cols[] <- "black"
for(c in names(colors)) {
	cols[keys==c] <- colors[c]
}
#######  SET SYMBOLS  #######
pch <- keys
pch[] <- "+"
for(c in names(symbols)) {
	pch[keys==c] <- symbols[c]
}

##############  SCATTERPLOT MATRIX ###############
windows(7,7)
pairs(
	results[,calculate_columns], 
	#xlim=c(1,9), 
	#ylim=c(1,9), 
	pch=pch, 
	col=cols
)

###############  SAVE PLOT TO FILE (see io.r)  ######
save_plot(paste(script_path,"plot",sep=""))

###############  DRAW LEGEND  #######################
windows(5,2)
par(oma=c(0,0,0,0)); par(mai = c(0,0,0,0))
plot(0,cex=0,xlim=c(0,1),ylim=c(0,1))
legend(0,1, legend=names(colors),col=colors, pch=symbols, cex=0.8, ncol=2)
###############  SAVE LEGEND TO FILE  ######
save_plot(paste(script_path,"plot_keys",sep=""))



############  3D SCATTERPLOT  ################
require(lattice)
windows(5, 5)
p <- cloud(results[,calculate_columns[3]] ~ results[,calculate_columns[1]] * results[,calculate_columns[2]],
      screen = list(z = -30, x = -70), distance = .4, zoom = .6,
	col = cols, type = c("p", "h"),
	#xlim=c(1,9), 
	#ylim=c(1,9), 
	#zlim=c(1,9),
	zlab=calculate_columns[3],
	xlab=calculate_columns[1],
	ylab=calculate_columns[2] 
)
print(p)
###############  SAVE PLOT TO FILE (see io.r)
save_plot(paste(script_path,"plot3d",sep=""))


###############  WRITE RESULTS AS WIKI TABLE  ###################
write_FloraWeb_wikitable(results, paste(script_path,"results_wiki.txt",sep="") )


Skript: settings.r

lex_cols <- list(
species="Art",
L="Licht",
T="Temp",
F="Feu",
K="Kont",
R="Reakt",
N="Stick"
)


calculate_columns <- c("F","R","T","N","L","K")

############  Mögliche Ausprägungen der Zeigerwerte
numericvalues <- 1:9

############  Mögliche Ausprägungen der Artmächtigkeiten mit Gewichten
weights_keys=c(
"." = 0.0,
"+" = 0.2,
"r" = 0.2,
"m" = 0.2,
"1" = 0.2,
"2" = 0.4,
"2a" = 0.4,
"2b" = 0.4,
"2m" = 0.4,
"3" = 0.6,
"4" = 0.8,
"5" = 1.0)


Skript: calc.r

#################  Verfügbare Zeigerwerte aus Lexikon, Spalte datacol ##############################
get_available_numeric <- function(df, datacol) {
	col <- as.factor(df[,datacol])
	lev <- levels(col)
	names(lev) <- lev	
	ret <- array(dim=0)
	#print(lev)
	# f ... index of factor in lev
	for(f in rownames(df)) {
		if(is_usable_numeric(as.character(df[f,datacol]))) {
			ret[f] <- as.numeric(as.character(df[f,datacol]))
		}
	}
	ret
}



#################  Gewichte aus Artmächtigkeiten ##############################
get_weights <- function(df) {
	ret <- mapply(replace_code_col, df)
	rownames(ret) <- rownames(df)
	ret
}
replace_code_col <- function(col) {
	ret <- mapply(replace_code, col)
	ret
}
replace_code <- function(val) {
	#print(val)
	w <- weights_keys[as.character(val)]
	if(is.na(w)) 0.0
	else w
}



#################  Gew. mittlere Zeigerwerte berechnen. lex_values ... ausgabe get_available_numeric
calc_weighted_means <- function (spec_names, weights, lex_values) {
	sum <- 0.0
	w_sum <- 0.0
	for(spec in 1:length(spec_names)) {
		sname <- as.character(spec_names[spec])
		v <- lex_values[sname]
		w <- weights[spec]
		#print(sname)
		#print(paste(spec, w, v))
		if( !is.nan(v) && !is.na(v) ) {
			sum <- sum + v * w
			w_sum <- w_sum + w
			#print(paste(v , w))
		}
	}
	sum <- sum / w_sum
	names(sum) <- c("weighted mean")
	sum
}

is_usable_numeric <- function(f) {
	!is.na(f) && length(numericvalues[numericvalues==f])>0
}

is_usable_weight <- function(f) {
	!is.na(weights_keys[f])
}

append_data <- function(data, app) {
	species_old <- as.character(data[,1])
	species <- as.character(app[,1])
	app <- app[,2:ncol(app)]
	for(newcol in 1:ncol(app)) {
		data[,colnames(app[newcol])] <- factor(rep(".",nrow(data)), levels=c(as.character(app[1,newcol]),names(weights_keys)))
		#print( c(as.character(app[1,newcol]),names(weights_keys)) )
		for(row in 1:nrow(app)) {
			if( length(species_old[species_old==species[row]])>0 ) {
			} else {
				levels(data[,1]) <- append(levels(data[,1]),species[row])
				data <- rbind(data, c(species[row], rep(".", ncol(data)-1)) )
				species_old <- append(species_old, species[row])
				#data[nrow(data),1] <- species_old[length(species_old)]
			}
			data[species_old==species[row],colnames(app[newcol])] <- as.character(app[row,newcol])
		}
	}
	data
}


Script io.r



csv.read <- function(f, head = TRUE) {
	sep <- ","
	if( tolower(substr(f, nchar(f)-3, nchar(f))) == ".csv" ) sep=";"
	#print( tolower(substr(f, nchar(f)-3, nchar(f))) )
	read.csv(f, 
                header = head , sep = sep, quote="\"", dec=".",
                fill = TRUE, comment.char="")
}



save_plot <- function(file, type = c("eps","pdf","png")) {
	for(t in type) {
		savePlot(file,
         		type = t,
         		device = dev.cur(),
         		restoreConsole = FALSE)
	}
}



write_FloraWeb_wikitable <- function (results, file) {
	
	lines <- c()
	lines <- append(lines, "{| class=\"prettytable\" |")
	### Write column names
	lines <- append(lines, "!ID")
	lines <- append(lines, "!key")
	for(n in colnames(results)) {
		if(n != "key") lines <- append(lines, paste("! ", n, sep=""))
	}
	for(row in 1:nrow(results)) {
		lines <- append(lines, "|-")
		lines <- append(lines, paste("!", rownames(results)[row]))
		lines <- append(lines, paste("!", results[row,"key"]))
		for(col in 1:ncol(results)) {
			s <- "|"
			if(colnames(results)[col] == "key") {
			} else {
				val <- round(as.numeric(results[row,col]),2)
				#if(is.nan(val)) {
				#	lines <- append(lines, "| style=\"color:red;\" |")
				#	lines <- append(lines, val)
				#} else {
					lines <- append(lines, paste(s, val))
				#}
			}
		}
	}
	lines <- append(lines, "|}")
	write(lines, file);
}

Testdaten[Bearbeiten]

Die Lexikondaten wurden willkürlich erzeugt.

Bei den Vegetationsaufnahmen handelt es sich um die FloraWeb-Aufnahmen 499, 515, 519, 520, 1687. Alle Arten der Baum-, Strauch- und Moosschicht wurden entfernt. Um den Umfang der Daten gering zu halten, wurden zudem alle Pflanzen mit nur einem Auftreten entfernt.

Lexikon lex.csv

ArtNr;Art;Licht;Temp;Kont;Feu;Reakt;Stick
1;Aegopodium podagraria;3;2;4;6;6;3
2;Anemone nemorosa;9;6; ;6;6;3
3;Dentaria bulbifera;;8;5;7;x;
4;Glechoma hederacea;8;6;5;7;3;1
5;Lamium galeobdolon ag.;5;4;4;x; ;2
6;Milium effusum;9;2; ;5;5;
7;Oxalis acetosella;3;5;4;5;3;8
8;Lamium maculatum;8;3; ;6;3;3
9;Stellaria nemorum L. s. l.;x;6; ;6;8;2
10;Athyrium filix-femina;3;2;4; ;9;6
11;Impatiens noli-tangere;2;9; ;7;3;6
12;Senecio ovatus;2;6;4;5;4;8
13;Stachys sylvatica;1;x;5;7;6;x
14;Urtica dioica;6;5;5;6;9;7

Vegetationsaufnahmen Yio-Blaion.csv

Nr;499;515;519;520;1687
key;Yio-Blaium;Yio-Blaium;Yio-Blaium;Yio-Blaium;Yio-Blaium
Aegopodium podagraria;.;.;.;2;2m
Anemone nemorosa;.;2m;.;+;.
Dentaria bulbifera;.;+;+;.;.
Glechoma hederacea;.;.;.;+;2b
Lamium galeobdolon ag.;.;2a;3;.;.
Milium effusum;2;1;.;.;.
Oxalis acetosella;.;2m;2;.;.
Lamium maculatum;.;3;.;3;+
Stellaria nemorum L. s. l.;1;3;3;.;.
Athyrium filix-femina;2;+;1;+;.
Impatiens noli-tangere;.;2a;2;3;+
Senecio ovatus;1;+;+;1;.
Stachys sylvatica;.;2a;+;+;+
Urtica dioica;2;1;.;3;4