R Polish Team

oparte na programowaniu GUI

howManyDecimals<-function(x){
	if(!is.numeric(x))
		stop("x must be numeric!")
	return(nchar(unlist(strsplit(as.character(x),'.',fixed=TRUE))[2]))
}
roundStep<-function(x, step, start=0){
	if(missing(x)|missing(step))
		stop("Missing argument")
	return(round((x-start)/step)*step+start)
}
for (i in 1:4) {
      x <- i:4
      print(sample(x))
}
#[1] 4 1 2 3
#[1] 3 2 4
#[1] 4 3
#[1] 3 2 1 4
for (i in 1:4) {
      x <- i:4
      print(x[sample(length(x))])
}
#[1] 4 1 2 3
#[1] 3 2 4
#[1] 3 4
#[1] 4
    library(ggplot2)
 
    # setting a parameter
    year <- 2012
    d <- seq.Date(as.Date(paste(year, "-01-01", sep = "")), as.Date(paste(year, "-12-31", sep = "")), by="days")
    z <- data.frame(Y = format(d, "%Y"), M = as.numeric(format(d, "%m")), D = as.numeric(format(d, "%d")), W = format(d, "%w"))
 
    # creating a image with ggplot2.
    c <- ggplot(z, aes(D, M))
    c + geom_text(aes(label=z$D, colour=factor(W), size = 20)) +
    scale_colour_manual(values = c("magenta", rep("black", 5),"darkturquoise"))+
    scale_y_continuous(trans = "reverse", breaks = 1:12) +
    labs(x="", y="") +
    opts(
    title = paste("CalendaR", year, "\n", sep = " "),
    plot.title = theme_text(colour = "black"),
    legend.position = "none"
    ) 
function(iban){
wynik <- logical(length(iban))
 for (p in 1:length(iban)){
  IBAN <- iban[p]
  IBAN <- gsub(" ","", IBAN)
  IBAN <- gsub("-","",IBAN)
  literki <- LETTERS
  cyferki <- 10:35
  IBAN2 <- paste(substr(IBAN, 5, nchar(IBAN)), substr(IBAN,1,4),sep="")
  for(n in 1:length(literki)){
   gsub(literki[n], cyferki[n], IBAN2) -> IBAN2
  }
  while(nchar(IBAN2)>0){
   if(nchar(IBAN2)>6){
    checktest <- as.numeric(substr(IBAN2,1,6))
    checkrest <- checktest %% 97
    IBAN2 <- paste(checkrest,substr(IBAN2,7,nchar(IBAN2)),sep="")
   }else{
    checktest <- as.numeric(substr(IBAN2,1,nchar(IBAN2)))
    checkrest <- checktest %% 97
    IBAN2 <- ""
   }
  }
  if(checkrest == 1){
   wynik[p] <- TRUE
  }else{wynik[p] <- FALSE}
 }
 return(wynik)
}
function(cardno){
 wynik <- logical(length(cardno))
  for(p in 1:length(cardno)){
   CARDNO <- cardno[p]
   CARDNO <- gsub(" ","",CARDNO)
   CARDNO <- gsub("-","",CARDNO)
   wagi <- rep(c(2,1), length.out=16)
   if(nchar(CARDNO) > 16){
    wynik[p] <- FALSE
   }else{
    roznica = 16 - nchar(CARDNO)
    suma = ""
    for (i in nchar(CARDNO):1){
     suma <- paste(as.numeric(substr(CARDNO,i,i))*wagi[i+roznica],suma, sep="")
    }
    sk = 0
    for(i in 1:nchar(suma)){
     sk <- sk + as.numeric(substr(suma,i,i))
    }
    sk <- sk %% 10
    if (sk == 0){
     wynik[p] <- TRUE
    }else{wynik[p] <- FALSE}
   }
  }
 return(wynik)
}
function(regon){
 wagi7 <- 234567
 wagi9 <- 89234567
 wagi14 <- 2485097361248
 wynik <- logical(length(regon))
 for(p in 1:length(regon)){
  REGON <- regon[p]
  REGON <- gsub(" ","",REGON)
  REGON <- gsub("-","",REGON)
  suma <- 0
  if(nchar(REGON) == 7){
    for(i in 1:6){
     suma <- suma + as.numeric(substr(REGON,i,i))*as.numeric(substr(wagi7,i,i))
    }
    sk <- suma %% 11
    if(sk == as.numeric(substr(REGON,7,7)) | sk == ((as.numeric(substr(REGON,7,7))+10))){
     wynik[p] <- TRUE
    }else{wynik[p] <- FALSE}
  }else{
  if(nchar(REGON) == 9 | nchar(REGON) == 14){
    test9 <- function(regon9){
     sumas <- 0
      for(i in 1:8){
       sumas <- sumas + as.numeric(substr(regon9,i,i))*as.numeric(substr(wagi9,i,i))
      }
      sk <- sumas %% 11
      if(sk == as.numeric(substr(regon9,9,9)) | sk == ((as.numeric(substr(regon9,9,9))+10))){
       return(TRUE)
      }else{return(FALSE)}
    }
   if(nchar(REGON)==9){
    wynik[p]<-test9(REGON)
   }else{
     sk1<-test9(substr(REGON,1,9))
     for (i in 1:13){
      suma <- suma +as.numeric(substr(REGON,i,i))*as.numeric(substr(wagi14,i,i))
     }
     sk <- suma %% 11
     if(sk == as.numeric(substr(REGON,14,14)) | sk == ((as.numeric(substr(REGON,14,14))+10))){
      sk2 <- TRUE
     }else{sk2 <- FALSE}
     if(sk1 & sk2){wynik[p]<-TRUE
     }else{wynik[p]<-FALSE}
     }
  }else{wynik[p]<-FALSE}
 }
}
return(wynik)
}
function(nip){
 wynik <- logical(length(nip))
 for (p in 1:length(nip)){
  NIP <- nip[p]
  wagi <- "657234567"
  suma =0
  if (nchar(NIP) == 10){
   for (i in 1:9){
    suma + as.numeric(substr(NIP,i,i))*as.numeric(substr(wagi,i,i)) -> suma
   }
  sk <- (suma %% 11)
  if(sk == as.numeric(substr(NIP,10,10))){
    wynik[p] <- TRUE
  }else{wynik[p]<-FALSE}
 }else{wynik[p]<-FALSE}
 }
 return(wynik)
 }
as.numeric(as.character(ramka$liczbaCzynnik))
all <- data.frame(cbind(site, year, model, x, y, z))
 
all$x <- as.numeric(x)
all$y <- as.numeric(y)
all$z <- as.numeric(z)
function(pesel){
 if(nchar((pesel))==11){
  cat("Poprawna długość numeru Pesel.\nSprawdzam poprawność numeru:\n")
  wagi <- "1379137913"
  suma=0
  for (i in 1:10){
    suma+as.numeric(substr(pesel,i,i))*as.numeric(substr(wagi,i,i)) -> suma
  }
  sumakontrolna <- 10 - (suma %% 10)
  if (sumakontrolna == as.numeric(substr(pesel,11,11))){
    cat ("NUMER PESEL PRAWIDŁOWY\n")
    return(TRUE)
  } else{
    cat ("Błąd sumy kontrolnej\n")
    return(FALSE)
  }
 }else{
   cat("Pesel ma nieodpowiednia ilość znaków.\n")}
   return(FALSE)
}
function(PESEL){
 wynik <- logical(length(PESEL))
 for (p in 1:length(PESEL)){
  pesel <- PESEL[p]
  if(nchar((pesel))==11){
   wagi <- "1379137913"
   suma=0
   for (i in 1:10){
    suma+as.numeric(substr(pesel,i,i))*as.numeric(substr(wagi,i,i)) -> suma
   }
   sumakontrolna <- 10 - (suma %% 10)
    if (sumakontrolna == as.numeric(substr(pesel,11,11))){
     wynik[p] <- TRUE
    }else{wynik[p]<-FALSE}
  }else{wynik[p]<-FALSE}
 }
 return(wynik)
}
slot.as.list<-function(object){
	sn<-slotNames(object)
	tmp<-list()
	for(i in sn)
		if(!is.empty(slot(object,i))) tmp[[i]]<-slot(object,i)
	return(tmp)
}
source(“http://sendemail-gui-r.googlecode.com/files/GUI_sendEmail.R”)

R Polish Team

Blog poświęcony środowisku R

Życzenia Noworoczne

Jak poprawnie pisać...

Pojawiła się nowa wersja Rcmdr

Ile miejsc po przecinku ?

Funkcja zaokrąglająca "krokowo"

Programistyczne problemy próbkowania

Życzenia

Wykresy w R bez znajomości R...

Interesująca alternatywa dla Sweave...

Bezpieczeństwo wewnętrzne kodu...

Kalendarz na 2012

Frustracje czynnikowe...

Znalezione w sieci - przyspieszanie kodu

Analiza sieci społecznościowych z zastosowaniem R'a i Gephis

LondonR - prezentacje

UseR! 2011 prezentacje i filmy

Skoro były karty kredytowe to czas na IBAN

Szuflada - Karta kredytowa

Kolejne pokłady szuflady - REGON

Grzebania w szufladzie ciąg dalszy - NIP

Wektory numeryczne i znakowe, a ramki danych

Z szuflady - test numeru pesel

Sloty klasy S4 jako lista

Kolejny sposób na rozwijanie interfejsów graficznych w R

Wysyłanie maili z R'a z wykorzystaniem GUI

Znaczniki

Nowe komentarze

Strony

Archiwum

Kategorie

Serwis