sjewo

# Author: Joona Lehtomäki <[email protected]>
# Updated: 13.11.2011
# Version: 0.0.1

if (!require("rgdal")) {
	install.packages("rgdal")
}

if (!require("raster")) {
	install.packages("raster")

sjewo

<?php
// escape \r,\f,\n in latex code in square brackets \[ \]
$REX_ACTION['VALUE']['1']=preg_replace_callback(
    '#\\[(.+?)\\]#s',
    function ($matches) {
        $search = array('\\n','\\r','\\f');
        $replace = array('\\\\n','\\\\r','\\\\f');
        return str_replace($search, $replace, $matches[0]);
    },
        $REX_ACTION['VALUE']['1']);

sjewo

# based on plot.nn, from the neuralnet R package by Stefan Fritsch, Frauke Guenther 
# plotting function for neuralnet objects 
# 
# additional arguments:
# varwidth=FALSE    FALSE: equal lwd for vertices, TRUE: lwd proportional to weights
# lwd.max=5         max lwd for vertices
# col.pos='black'   default color for positive weights
# col.neg='grey'    default color for negative weights
# col.text='black'  default color for vertex label
# all.in=TRUE       TRUE: display all input variables, replace with variable names to display only selected variables

sjewo

plot.nnet<-function(mod.in,nid=T,all.out=T,all.in=T,wts.only=F,rel.rsc=5,circle.cex=5,node.labs=T,
  line.stag=NULL,cex.val=1,alpha.val=1,circle.col='lightgrey',pos.col='black',neg.col='grey',...){

  require(scales)
	
  #gets weights for neural network, output is list
  #if rescaled argument is true, weights are returned but rescaled based on abs value
  nnet.vals<-function(mod.in,nid,rel.rsc){

    library(scales)

sjewo

# Funktion um zwei Vektoren zeilenweise zusammenzufassen
# Argumente:
# A,B   = Vektor
# Quelle: http://stackoverflow.com/a/12512327

process <- function(A,B) {
  x <- cbind(A,B)
  apply(x,1,function(x) {
    if(sum(is.na(x))==1) {na.omit(x)} else   # ein fehlender Wert
    if(all(is.na(x))) {NA} else              # beide fehlend

sjewo

ping <- function(x,stderr=FALSE,stdout=FALSE,...){
    ping <- system(paste("ping -c1", x, "> /dev/null"), 
                      intern=F, 
                      ignore.stdout=stdout, 
                      ignore.stderr=stderr)
    return(if (ping == 0) TRUE else FALSE)
}

sjewo

# Funktion um Zeilenumbrüche nach m Zeichen einfügen
# Argumente:
# txt   = Vektor mit Zeichenketten
# m     = Anzahl an Zeichen nach denen ein Zeilenumbruch eingefügt werden soll (default: 10)
# bchar = Trennzeichen (default: \n)

breaking <- function(txt, m, bchar) {
    out <- ""
    for (i in 1:length(txt)) {
        if (nchar(gsub(paste('^.*',