r,Code片段,代码实例,代码示例,代码片段库

r 华沙地区的地图以房地产价格着色

华沙地区的地图以房地产价格着色

map_by_prices_colored.r



#https://www.stat.auckland.ac.nz/~paul/R/grImport/import.pdf

#http://cran.r-project.org/web/packages/grImport/index.html

require(grImport)
 
#vector file is: http://pl.wikipedia.org/wiki/Plik:Warszawa_podzial_administracyjny_2002.svg converted with Inkscape to PostScript. You should be able to make such convertion with pythonic pycairo
 

download.file("http://www.users.pjwstk.edu.pl/~s8361/r/dane/geo/dzielnice.ps","dzielnice.ps")
PostScriptTrace("dzielnice.ps")
DZIELNICE_WAW <- readPicture("dzielnice.ps.xml")
 
 
 
grid.picture(DZIELNICE_WAW)
Sys.sleep(4)
brokenDZIELNICE_WAW <- explodePaths(DZIELNICE_WAW)
#picturePaths(brokenDZIELNICE_WAW, nr=3, nc=6,
#label=FALSE, freeScales=TRUE)
 
 
DZIELNICE_WAWmanipulate <- function(foo) {
xscale <- DZIELNICE_WAW@summary@xscale
yscale <- DZIELNICE_WAW@summary@yscale
grid.picture(brokenDZIELNICE_WAW[foo],use.gc=FALSE, gp=gpar(fill=dane[dane$dzielnica==d[[foo]],]$col),
xscale=xscale, yscale=yscale)
}

d<-c('Białołęka','Bielany','Bemowo','Ursus','Włochy','Praga Północ','Śródmieście','Targówek','Żoliborz','Wola','Ochota','Rembertów','Wesoła','Praga Południe','Wawer','Mokotów','Wilanów','Ursynów')

names(d)<-c(1:18)

dane<-read.csv("http://www.users.pjwstk.edu.pl/~s8361/r/dane/geo/dzielnice_stats.csv", fileEncoding="utf8")
#posortowanie po SREDNIA_CENA_M
dane<-dane[with(dane,order(dane$SREDNIA_CENA_M)),]
#paleta z ktorych stworzymy wektor kolorow od min, max
paletaKolorow<-colorRampPalette(c('green','red'))
dane$col <- paletaKolorow(18)[as.numeric(cut(dane$SREDNIA_CENA_M,breaks=18))]
#s<-barplot(dane$SREDNIA_CENA_M,col=dane$col,names=dane$dzielnica,las=2)




for (i in 1:18){
print(d[i])
DZIELNICE_WAWmanipulate(i)
Sys.sleep(0.5)
}

grid.picture(brokenDZIELNICE_WAW[19:58])

r Słabeopensformacja - zręcznympisaniempętliitorującychpoelementach data framuzamiastkorzystaćzbibliotek dedykowanych jak np。 dappl

Słabeopensformacja - zręcznympisaniempętliitorującychpoelementach data framuzamiastkorzystaćzbibliotek dedykowanych jak np。 dapply

fb_graph_poor.R

setwd("~/Desktop/10c_R/fb")
ludzie<-read.csv("osoby.csv", header=FALSE,skip=1)
relacje<-read.csv("relacje.csv", header=FALSE,skip=1)
 
for (i in 1:nrow(ludzie)){ ludzie$V1[i] <-format(ludzie$V1[i], scientific=FALSE)}
for (i in 1:nrow(relacje)){ relacje$V1[i]<-format(relacje$V1[i], scientific=FALSE); relacje$V2[i]<-format(relacje$V2[i], scientific=FALSE);}
ludzie$inicjaly<-0
for (i in 1:nrow(ludzie)) {
    ludzie$inicjaly[i] <- paste(
     
    (strsplit(as.character(ludzie$V2[i]), ' ')[[1]])[1] ,
    substring(((strsplit(as.character(ludzie$V2[i]), ' ')[[1]])[2]),1,3)
     
    ,sep="")}    
ludzie$short<-0          
for (i in 1:nrow(ludzie)) {ludzie$short[i]=i}   
 
 
getShort <-function(long) {
     
    short<-0
    L<- 1
    R<- nrow(ludzie)
    M<- floor((L+R)/2)
     
    #for (i in L:R){
    while (L<=R){    
    if(ludzie$V1[M]==long){
        short<-ludzie$short[M]
        break
    }   else
    if(long < ludzie$V1[M] ){# szukany element < od wyznaczonego przez M
        R<-(M-1)
        M<-floor((L+R)/2) 
    }   else { #szukany element > od wyznaczonego przez M
        L<-(M+1)
        M<-floor((L+R)/2) 
    }
         
    }
 
    return (short)
     
}
 
 
getShort <-function(long) {
     
    short<-0
    short<-ludzie$V1[long]
 
    return (short)
     
}
 
 
 
getShort <-function(long) {
    short<-0
short<-ludzie$short[ludzie$V1 == long]
return (short)
}
 
rl<-relacje
 
for (i in 1:nrow(rl)){
    rl$V1[i]<-getShort(rl$V1[i]); rl$V2[i]<-getShort(rl$V2[i]);
}
 
getList<-function(){
l <-vector()
for (i in 1:nrow(rl)){
l<-c(l,rl$V1[i])
l<-c(l,rl$V2[i]) 
     
}
return(l)   
}
 
 
v<-getList()
 
library(igraph)
g<-graph(v, directed=FALSE)
V(g)$label <- ludzie$inicjaly
 
 
p2<-png(filename="plocik.png",width=6500,height=6500,unit="px")
p2<-plot(g, vertex.size=1, edge.color="red")

r R：从Web下载文件，使用XLConnect读取整个XLS工作簿，访问电子表格

R：从Web下载文件，使用XLConnect读取整个XLS工作簿，访问电子表格

xls.r

#windows user should run x64 version of R because of problems with rJava package
require(XLConnect)
require(rJava)
path="http://www.users.pjwstk.edu.pl/~s8361/dane.xlsx"
download.file(path,paste(getwd(),basename(path),sep="/"),mode="wb")

workbook <- loadWorkbook(basename(path))
sheet_names <- getSheets(workbook)
print(sheet_names)

names(sheet_names) <- sheet_names
sheet_list <- lapply(sheet_names, function(.sheet){
readWorksheet(object=workbook, .sheet)})

class(sheet_list)
#[1] "list"
class(sheet_list[[1]])
#[1] "data.frame"

r R：rad CSV，图

R：rad CSV，图

csv-plot.r

#wczytanie plikow z danymi ocen workerow
message("Wskaz plik z wynikami z systemu MACE")
mace=read.csv(file.choose(),header=FALSE,sep="")
message("Wskaz plik z wynikami z systemu TROIA v. mincost")
troia=read.csv(file.choose(),header=FALSE,sep="\t")
 
 
 
#wyliczenie względnej oceny dla workerów. 1=najlepszy worker
mace$relaive_score<-mace$V1/max(mace$V1)
troia$relaive_score<-troia$V2/max(troia$V2)
 
 
#wyświetlenie wykresów z ocenami jakości dla platform
plot(sort(mace$V1),type="l",col="red", ylab="Quality in different platforms",xlab=paste("Correlation bettwen troia minCost and mace scores=",cor(mace$V1,troia$V2)))
lines(sort(troia$V2),col="green")
legend("topleft", legend = c("troia","mace"), pch=1, col=c("green","red"))

r R：决策树

R：决策树

decision_tree.r

required_lib =c("party","ctree","modeltools","coin","mvtnorm","zoo","sandwich","strucchange","vcd","colorspace")


install_required_libs<-function(){
for(i in 1:length(required_lib)){
    if(required_lib[i] %in% rownames(installed.packages()) == FALSE)
        {install.packages(required_lib[i])}
}
}

install_required_libs()
#################################


library("party")
head(iris)
summary(iris)


iris_ctree <- ctree(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width, data=iris)

print(iris_ctree)

plot(iris_ctree)

r R：K-表示基本的例子

R：K-表示基本的例子

k-means.r

library("party")
head(iris)
summary(iris)


ird<-matrix(c(iris$Sepal.Length,iris$Sepal.Width, iris$Petal.Length,iris$Petal.Width), ncol=4)
plot(ird)
rezultaty<-kmeans(ird,3)
rezultaty
plot(ird, col=rezultaty$cluster)
points(rezultaty$centers, col=6,pch=10,cex=3)
table(rezultaty$cluster)

r R地理空间介绍，使用矢量图形

R地理空间介绍，使用矢量图形

waw_map.r

require(grImport)
 
#vector file is: http://pl.wikipedia.org/wiki/Plik:Warszawa_podzial_administracyjny_2002.svg converted with Inkscape to PostScript. You should be able to make such convertion with pythonic pycairo
 
#UNIX USERS
download.file("http://www.users.pjwstk.edu.pl/~s8361/r/dane/geo/dzielnice.ps","dzielnice.ps")
PostScriptTrace("dzielnice.ps")
DZIELNICE_WAW <- readPicture("dzielnice.ps.xml")

#WINDOWS USERS
#DZIELNICE_WAW <- readPicture("http://www.users.pjwstk.edu.pl/~s8361/r/dane/geo/dzielnice.ps.xml") 
 
 
grid.picture(DZIELNICE_WAW)
Sys.sleep(4)
brokenDZIELNICE_WAW <- explodePaths(DZIELNICE_WAW)
picturePaths(brokenDZIELNICE_WAW, nr=3, nc=6,
label=FALSE, freeScales=TRUE)
 
 
DZIELNICE_WAWmanipulate <- function(foo) {
xscale <- DZIELNICE_WAW@summary@xscale
yscale <- DZIELNICE_WAW@summary@yscale
grid.picture(brokenDZIELNICE_WAW[foo],use.gc=FALSE, gp=gpar(fill=dane[dane$dzielnica==d[[foo]],]$color),
xscale=xscale, yscale=yscale)
}

r R：将数据帧写入MySQL数据库，并将数据从数据库查询到R.

R：将数据帧写入MySQL数据库，并将数据从数据库查询到R.

db_mysql.r

install.packages("RMySQL")
library(RMySQL)
NAZWA_TABELI = "andi"
#połączenie
mydb = dbConnect(MySQL(), user='andi_10c',password='########',dbname='andi_10c',host='##################')
#tworzymy w bazie nowa tabele o nazwie iris_table, zapisujac do niej data frame iris (defaultowo dostępny w R)
dbWriteTable(mydb, name=NAZWA_TABELI, value=iris)
#listujemy tabele w bazie
dbListTables(mydb)
#listujemy pola tabeli iris_table
dbListFields(mydb, NAZWA_TABELI)
#zapuszczamy sobie dowolne pożądane queries
rs=dbSendQuery(mydb, paste('select * from ',NAZWA_TABELI,' iris where Species = "setosa"'))
#przechwytujemy z querysetu dane do data framu
dane<-fetch(rs, n=-1)

r R使用标准输入的参数将批处理模式条形图生成为PNG

R使用标准输入的参数将批处理模式条形图生成为PNG

batch.r

# run from Terminal with e.g:
# RScript batch.R "Jakis tytul" 1 2 3 424 242 323 2.33 323 > output.log
argv <- commandArgs(TRUE)
title <-  as.character(argv[1])
vars <- c(as.numeric(argv[2:length(argv)]))

cat("title =", title, "\n")
for (i in 1:length(vars)){ cat (i,"\n")}

today <-format(Sys.Date(), format="%d-%m-%Y")
png(paste("raport-",today,".png",sep=""))
barplot(vars,main=paste(title,today))

r R表，频率为百分比

R表，频率为百分比

frequency_table_percentage.R

prop.table(table(iris$Species))*100