Kolejne pokłady szuflady - REGON

Był PESEL był NIP, teraz czas na REGON:

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)
}

Created by Pretty R at inside-R.org

admin | niedziela, 11 grudzień 2011 - 12:47 am | | Blog-R

Grzebania w szufladzie ciąg dalszy - NIP

Funkcja sprawdza poprawność numeru NIP - operuje na wektrorach:

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)
 }

Created by Pretty R at inside-R.org

admin | niedziela, 11 grudzień 2011 - 12:46 am | | Blog-R

Wektory numeryczne i znakowe, a ramki danych

Umieszczanie zmiennych typu znakowego i numerycznego w pojedynczej ramce danych powoduje, że wszystkie wektory traktowane są jako czynniki. Jest to bardzo irytujące jeśli później z takiej ramki danych chce się uzyskać wartości numeryczne. Można oczywiście za każdym razem korzystać z funkcji:

as.numeric(as.character(ramka$liczbaCzynnik))

Jednak o wiele lepiej uzyskać ramkę danych, która posiada odpowiednio sformatowane kolumny.

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)

Created by Pretty R at inside-R.org

Przykład zaczerpnięty ze strony: http://www.nomad.priv.at/researchblog/?p=911

admin | niedziela, 11 grudzień 2011 - 12:11 am | | Blog-R

Z szuflady - test numeru pesel

Jakiś czas temu, napisałem kilka prostych funkcji sprawdzających poprawność numerów. Jedną z takich funkcji jest funkcja sprawdzająca poprawność numeru PESEL.

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)
}

Created by Pretty R at inside-R.org

Poniższa implementacja przyjmuje jako argument wektor numerów pesel i zwraca wektor wartości logicznych TRUE, gdy prawidłowy i FALSE, gdy błędny.

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)
}

Created by Pretty R at inside-R.org

admin | sobota, 10 grudzień 2011 - 11:03 pm | | Blog-R

Sloty klasy S4 jako lista

Przedstawiam bardzo prostą funkcję, która przekształca prosty (bez slotów zagnieżdżonych w slotach) obiekt klasy S4 do listy, przy czym zwraca jednynie nie puste sloty:

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)
}

Created by Pretty R at inside-R.org

*Wymaga funkcji is.empty. Usunięcie warunku spowoduje, że funkcja zwróci także puste sloty i nie będzie wymagała wymienionej funkcji.

admin | środa, 07 grudzień 2011 - 5:48 pm | | Blog-R

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

Pakiet RInside zapewnia klasy C++, które ułatwiają osadzanie kodu R'a w kodzie C++ --- zarówno w systemach Linux, OS X, Windows.

Źródło: R-bloggers

admin | sobota, 03 grudzień 2011 - 11:55 pm | | Blog-R | Brak komentarzy

Wysyłanie maili z R'a z wykorzystaniem GUI

Ciekawa propozycja dla chcących całe swoje życie spędzić w eRze;)

A tak na poważnie to wysyłanie maili lub sms'ów (mam gdzieś opracowane takie rozwiązanie, ale jeszcze nie nadszedł odpowiedni czas), przydaje się, kiedy nasze analizy zajmują sporo czasu. W końcu miło jest wyjść na dwór lub pole w zależności od rejonu kraju i otrzymać sms'a lub jak w tym przypadku maila "Wykonało się".

Artykuł znajduje się na R-bloggers.

Tutaj zaś można pobrać kod.

lub wpisać:

source(“http://sendemail-gui-r.googlecode.com/files/GUI_sendEmail.R”)

Created by Pretty R at inside-R.org

admin | czwartek, 01 grudzień 2011 - 12:25 pm | | Blog-R | Brak komentarzy

Było nolast jest nofirst

admin | wtorek, 22 listopad 2011 - 10:16 pm | | Blog-R | Brak komentarzy
« poprzednia strona | Wyświetlanie wpisów 57-64 z 84 | następna strona »