R - Programmierung

library(tcltk)


# Öffnet Dateidialog und gibt eine Liste zurück.
funcReadCSVFile <- function(){
	datei <- tk_choose.files(
		caption = "Bitte CSV oder TXT auswählen",
		filters = matrix(
			c(
			"CSV und TXT", ".csv .txt",
			"CSV", ".csv",
			"TXT", ".txt"
			),
		ncol = 2,
		byrow = TRUE
		)
	)
	if (length(datei) == 0 || datei == "") {		
		return(list(
			success = FALSE,
			file = NULL))
	}
	return(list(
		success = TRUE,
		file = datei))
}

# Lädt Daten aus csv Datei in die lokale Variable "daten" und gibt diese zurück
funcLoadData <- function() {
	ok <- funcReadCSVFile()
	if(!ok$success){
		cat("\nDateidialog beendet - keine Datei geladen\n")
		return(invisible(NULL))
	}
	cat("\nLese Datei:\t", ok$file, "\n")

 	# Header erkennen (einfach & robust)
	first_line <- readLines(ok$file, n = 1)
	fields <- strsplit(first_line, ";")[[1]]

	test <- suppressWarnings(as.numeric(gsub("\\.", "", fields[1])))
	hat_header <- is.na(test)

	# CSV einlesen
	daten <- read.csv(
	  ok$file,
	  sep = ";",
	  dec = ",",
	  stringsAsFactors = FALSE,
	  header = hat_header
	)
	cat("Datei erfolgreich eingelesen.\n")
	#str(daten)
	#names(daten)

	# Wenn nur 1 Spalte → sauber extrahieren
	if (ncol(daten) == 1) {
	    daten <- daten[[1]]
	}
	return(daten)
}

funcAnalyzeData <- function(x) {

  x <- as.numeric(x)
  x <- x[!is.na(x)]   # NA entfernen

  n <- length(x)

  # Basis
  min_x <- min(x)
  max_x <- max(x)
  range_x <- max_x - min_x
  sum_x <- sum(x)

  mean_x <- mean(x)
  median_x <- median(x)

  # Quartile / IQR
  q1 <- quantile(x, 0.25, na.rm = TRUE)
  q3 <- quantile(x, 0.75, na.rm = TRUE)
  iqr <- IQR(x, na.rm = TRUE)

  lower <- q1 - 1.5 * iqr
  upper <- q3 + 1.5 * iqr

  outliers <- x[x < lower | x > upper]

  # Standardabweichung
  sd_sample <- sd(x)                 # n-1 (Stichprobe)
  sd_pop <- sqrt(mean((x - mean_x)^2))  # n (Population)

  # Standardfehler des Mittelwerts
  se_mean <- sd_sample / sqrt(n)

  # Variationskoeffizient
  cv <- sd_sample / mean_x

  # Median absolute deviation (MAD)
  mad_val <- mad(x, constant = 1)  # ohne Skalierung auf Normalverteilung

  # Schiefe (Momentkoeffizient)
  skewness <- mean((x - mean_x)^3) / (sd_pop^3)

  result <- list(

    n = n,

    Min = min_x,
    Max = max_x,
    Spannweite = range_x,
    Summe = sum_x,

    Mittelwert = mean_x,
    Median = median_x,
    Median_MAD = mad_val,

    Q1 = q1,
    Q3 = q3,
    IQR = iqr,

    Untere_Grenze = lower,
    Obere_Grenze = upper,


    Stdabwg_Stichprobe = sd_sample,
    Stdabwg_Gesamt = sd_pop,
    Stdfehler_Mittelwert = se_mean,
    Variationskoeffizient = cv,

    Schiefe = skewness,
    Ausreisser = outliers
  )

  return(result)
}


funcPrintResults <- function(res) {

  cat("\n============ AUSWERTUNG ===========\n\n")

  for (name in names(res)) {

    value <- res[[name]]

    if (is.numeric(value)) {
	cat(sprintf("%-20s \t%12.2f\n", name, value))
    } 
	else if (is.vector(value)) {
	      cat(sprintf("%-20s \t%s Werte\n", name, length(value)))
	}
  }

  cat("\n===================================\n")
}



funcPrintStatistics <- function(res){

  # Deutsche Zahlenformatierung
  fmt_de <- function(x, digits = 2){

    format(
      round(x, digits),
      big.mark = ".",
      decimal.mark = ",",
      nsmall = digits,
      scientific = FALSE,
      trim = TRUE
    )
  }

  cat("\n")
  cat("=========================================================\n")
  cat("DESKRIPTIVE STATISTIK\n")
  cat("=========================================================\n\n")

 cat(sprintf("%-35s %20s\n", "Anzahl der Stichprobe", res$n))
 cat(sprintf("%-35s %20s\n", "Minimum", fmt_de(res$Min)))
 cat(sprintf("%-35s %20s\n", "Maximum", fmt_de(res$Max)))
 cat(sprintf("%-35s %20s\n", "Spannweite", fmt_de(res$Spannweite)))
 cat(sprintf("%-35s %20s\n", "Summe", fmt_de(res$Summe)))
 cat("\n")
 cat(sprintf("%-35s %20s\n", "Median", fmt_de(res$Median)))
 cat(sprintf("%-35s %20s\n", "Median abs. Abweichung", fmt_de(res$Median_MAD)))
 cat("\n")
 cat(sprintf("%-35s %20s\n", "arithm. Mittel", fmt_de(res$Mittelwert)))
 cat(sprintf("%-35s %20s\n", "Stdabw. Stichprobe (n-1)", fmt_de(res$Stdabwg_Stichprobe)))
 cat(sprintf("%-35s %20s\n", "Stdabw. Gesamtheit (n)", fmt_de(res$Stdabwg_Gesamt)))
 cat(sprintf("%-35s %20s\n", "Standardfehler Mittelwert", fmt_de(res$Stdfehler_Mittelwert)))
 cat(sprintf("%-35s %20s\n", "Variationskoeffizient", fmt_de(res$Variationskoeffizient, 4)))
 cat(sprintf("%-35s %20s\n", "Schiefe", fmt_de(res$Schiefe, 4)))
 cat("\n")
 cat(sprintf("%-35s %20s\n", "1. Quartil (Q1)", fmt_de(res$Q1)))
 cat(sprintf("%-35s %20s\n", "3. Quartil (Q3)", fmt_de(res$Q3)))
 cat(sprintf("%-35s %20s\n", "Interquartilsabstand", fmt_de(res$IQR)))
 cat("\n")
 cat(sprintf("%-35s %21s\n", "Untere Ausreißergrenze", fmt_de(res$Untere_Grenze)))
 cat(sprintf("%-35s %21s\n", "Obere Ausreißergrenze", fmt_de(res$Obere_Grenze)))
 cat("\n")
 cat(sprintf("%-35s %21s\n", "Anzahl Ausreißer", length(res$Ausreisser)))
if(length(res$Ausreisser) > 0){

  antwort <- readline(
    prompt = "\nENTER = Ausreißer anzeigen, X = Ende: "
  )

  if(toupper(trimws(antwort)) != "X"){

    cat("\nAusreißer:\n")

    for(v in sort(res$Ausreisser)){
      cat(sprintf("   %20s\n", fmt_de(v)))
    }
  }
}
 cat("\n=========================================================\n")
}

funcPrintStatistics_disabled01 <- function(res){
  cat("\n")
  cat("=========================================================\n")
  cat("DESKRIPTIVE STATISTIK\n")
  cat("=========================================================\n\n")
  cat(sprintf("%-35s %15d\n", "Anzahl der Stichprobe", res$n))
  cat(sprintf("%-35s %15.2f\n", "Minimum", res$Min))
  cat(sprintf("%-35s %15.2f\n", "Maximum", res$Max))
  cat(sprintf("%-35s %15.2f\n", "Spannweite", res$Spannweite))
  cat(sprintf("%-35s %15.2f\n", "Summe", res$Summe))
  cat("\n")
  cat(sprintf("%-35s %15.2f\n", "Median", res$Median))
  cat(sprintf("%-35s %15.2f\n", "Median abs. Abweichung", res$Median_MAD))
  cat("\n")
  cat(sprintf("%-35s %15.2f\n", "arithm. Mittel", res$Mittelwert))
  cat(sprintf("%-35s %15.2f\n", "Stdabw. Stichprobe (n-1)", res$Stdabwg_Stichprobe))
  cat(sprintf("%-35s %15.2f\n", "Stdabw. Gesamtheit (n)", res$Stdabwg_Gesamt))
  cat(sprintf("%-35s %15.2f\n", "Standardfehler Mittelwert", res$Stdfehler_Mittelwert))
  cat(sprintf("%-35s %15.4f\n", "Variationskoeffizient", res$Variationskoeffizient))
  cat(sprintf("%-35s %15.4f\n", "Schiefe", res$Schiefe))
  cat("\n")
  cat(sprintf("%-35s %15.2f\n", "1. Quartil (Q1)", res$Q1))
  cat(sprintf("%-35s %15.2f\n", "3. Quartil (Q3)", res$Q3))
  cat(sprintf("%-35s %15.2f\n", "Interquartilsabstand", res$IQR))
  cat("\n")
  cat(sprintf("%-35s %15.2f\n", "Untere Ausreißergrenze", res$Untere_Grenze))
  cat(sprintf("%-35s %15.2f\n", "Obere Ausreißergrenze", res$Obere_Grenze))
  cat("\n")
  cat(sprintf("%-35s %15d\n", "Anzahl Ausreißer", length(res$Ausreisser))) 
  if(length(res$Ausreisser) > 0){
    cat("\nAusreißer:\n")
    for(v in res$Ausreisser){
      cat(sprintf("   %.2f\n", v))
    }
  }
  cat("\n=========================================================\n")
}


# Formatiert die Zahlenausgabe auf deutsch mit Punkt als Tausenderzeichen und Komma als Nachkommazeichen
fmtde <- function(x, digits = 2) {

  format(
    round(x, digits),
    big.mark = ".",
    decimal.mark = ",",
    nsmall = digits,
    scientific = FALSE,
    trim = TRUE
  )
}

main <- function(){

  cat("\n===================================\n\n")
  cat("   Statistik-Tool gestartet\n")
  cat("\n===================================\n\n")
  x <- funcLoadData()

  if (is.null(x)) {
    cat("Programm beendet. Keine Daten vorhanden.\n")
    return(invisible(NULL))
  }

  res <- funcAnalyzeData(x)

  #funcPrintResults(res)
  funcPrintStatistics(res)

  # optional: in Workspace verfügbar machen
  cat("Deine Daten sind aufrufbar mit:\n")
  cat("\tdata_raw\t\t - Datenreihe\n")
  cat("\tdata_result\t\t - Ergebnis insgesamt\n")
  cat("\tdata_result$[name]\t - Ergebnis speziell\n")
  assign("data_raw", x, envir = .GlobalEnv)
  assign("data_result", res, envir = .GlobalEnv)

  return(invisible(res))
}

main()