28. July 2011
Nove podatke o ameriških patentih 1976-2006 je mogoče najti na http://elsa.berkeley.edu/~bhhall/NBER06.html . Za predelavo v Pajkove in R-jeve datoteteke sem (27. september 2010) moral uporabiti 64-bitni računalnik. Šlo je brez težav, le kar nekaj časa potrebuje.
> memory.size()
[1] 10.58383
> memory.limit()
[1] 3583.875
> getwd()
[1] "C:/Users/batagelj.FMF1/work/R/nber"
> library(foreign)
> a <- read.dta("cite76_06.dta")
> save(a,file="nberCite.Rdata")
> names(a)
[1] "citing" "cited" "ncites7606"
> b <- as.matrix(a)
> dim(b)
[1] 23650891 3
> b[1:10,]
citing cited ncites7606
1 5135226 3930271 6
2 5592695 3930271 6
3 5621918 3930271 6
4 5624296 3930271 6
5 5675839 3930271 6
6 6725465 3930271 6
7 4084277 3930273 20
8 4206525 3930273 20
9 4509217 3930273 20
10 4985946 3930273 20
> nrow(b)
[1] 23650891
> max(b[,1])
[1] 7155745
> max(b[,2])
[1] 7118895
> n <- max(b[,1])
> net <- file("nber.net","w")
> cat('% NBER Patent data for 1976-2006\n% transformed in Pajek format,',date(),'\n',file=net)
> cat('*vertices',n,'\n*arcs\n',file=net)
> for(i in 1:nrow(b)) cat(b[i,1],b[i,2],'\n',file=net)
> close(net)
>
> remove(a)
> remove(b)
> d <- read.dta("patsic06_mar09_ipc.dta")
> names(d)
[1] "appyear" "assignee" "cat" "gyear" "icl" "icl_class"
[7] "icl_maingroup" "iclnum" "nclass" "patent" "pdpass" "subcat"
[13] "subclass"
> length(d$cat)
[1] 4855982
> save(d,file="nberData.Rdata")
Podatke sem shranil v R-jevski obliki Rdata
Naložimo jih preprosto z ukazom load(file).
Ker tretji stolpec v podatkih nberCite ni potreben, sem podatke že predelal v Pajkovo omrežje in pozipal. Drugi zip vsebuje pozipano datoteko nberData.
Za lažje delo s podatki sem vsak stolpec izpisal na svojo datoteko:
> setwd("C:/Users/batagelj.FMF1/work/R/nber")
> load(file="nberData.Rdata")
> objects()
[1] "d"
> names(d)
[1] "appyear" "assignee" "cat" "gyear" "icl" "icl_class" "icl_maingroup"
[8] "iclnum" "nclass" "patent" "pdpass" "subcat" "subclass"
> for(n in names(d)) {txt <- file(paste(n,".txt",sep=''),"w");
cat(d[[n]],sep='\n',file=txt); close(txt)}
in spravil v zip:
Potem sem predelal še omrežje sklicevanj v Pajkovo omrežje
> setwd("C:/Users/batagelj.FMF1/work/R/nber")
> library(foreign)
> pati <- function(p) {
+ q <- as.character(p)
+ if(exists(q,env=patents,inherits=FALSE)) return(get(q,env=patents,inherits=FALSE)) else {
+ np <<- np+1; cat(np,' "',p,'"\n',sep='',file=vtx); assign(q,np,env=patents); return(np)
+ }
+ }
> pat <- readLines(con<-file("./Cols/patent.txt","r")); close(con)
> vtx <- file("nber.vtx","w")
> patents <- new.env(hash=TRUE,parent=emptyenv(),size=4000000)
> np <- 0
> for(p in pat) if(!exists(p,env=patents,inherits=FALSE)){
+ np <- np+1; cat(np,' "',p,'"\n',sep='',file=vtx); assign(p,np,env=patents)}
> a <- as.matrix(read.dta("cite76_06.dta"))
> edg <- file("nber.edg","w")
> for(i in 1:nrow(a)) cat(pati(a[i,1]),pati(a[i,2]),'\n',file=edg)
> close(edg)
> close(vtx)
Na datoteki nber.vtx sem najprej zbral vse patente iz stolpca patent iz podatkov. Spočetka sem
nameraval to narediti tako, da bi točke imele kar zaporedno številko, ki ustreza podatku patent v stolpcih. Nastopile so težave
> pat <- readLines(con<-file("./Cols/patent.txt","r")); close(con)
> length(pat)
[1] 4855982
> pat[1:5]
[1] "3930271" "3930272" "3930273" "3930273" "3930274"
> ass <- readLines(con<-file("./Cols/assignee.txt","r")); close(con)
> ass[1:5]
[1] "251415" "246000" "10490" "10490" "0"
Zgleda, da se lahko ista patentna številka nahaja v več vrsticah - npr. “3930273”. Nekaj o tem piše tudi na http://elsa.berkeley.edu/~bhhall/NBER06.html . Nekje bi bilo dobro izvedeti, kaj je mišljeno z “observation”. Zato sem se odločil, da upoštevam samo različne. Teh je 3209376. Izkaže pa se, da so v omrežju sklicevanj patenti, ki nimajo nobenega opisa v podatkih. Te sem dodal na konec datoteke, ki ima tako skupaj 3210774 točk. Povezave omrežja sem izpisal na datoteko nber.edg .
Obe datoteki sem nato ročno dopolnil do ustreznih Pajkovih datotek nber60.nam (izpopolnjena nber.vtx - vsebuje imena točk; dodamo jih po potrebi izpeljanim omrežjem z ukazom Net/Transform/Add/Vertex Labels from File) in nber60Cite.net (izpopolnjena nber.edg - omrežje sklicevanj brez imen v Pajkovi obliki).
Ker R naravna števila, ki se končajo z vsaj 5 ničlami izpiše v eksponentni obliki (ostale izpiše v pričakovani obliki), je bilo pri predelavi obeh datotek potrebno zamenjati vse e+05 z 00000 in vse e+06 z 000000. Lahko bi sicer popravljal ukaze in izpisoval s funkcijo format, a ker obdelava teče več kot 2 uri, sem se odločil kar za ročni popravek.
Datoteki sta shranjeni v zip
Ostane še vprašanje: kako do podatkov o posameznem patentu?
library(foreign)
# construct .CLU files (from additional variables, nberCols)
# construct file to help all others (which line in nberCols files to leave)
pat <- readLines(con<-file("../nberCols/patent.txt","r")); close(con)
f <- file("line_to_leave.txt","w")
patents <- new.env(hash=TRUE,parent=emptyenv(),size=4000000)
np <- 0
for(p in pat){
if(!exists(p,env=patents,inherits=FALSE)){
np <- np+1
cat('1\n',sep='',file=f)
assign(p,np,env=patents)
}else{
cat('0\n',sep='',file=f)
}
}
close(f)
const <- 1398
files <- list.files(path="../nberCols/")
for (i in 1:length(files)){
g <- file("line_to_leave.txt","r")
old <- file(paste("../nberCols/",files[i],sep=""),"r")
temp <- strsplit(files[i],split=".txt")
new <- file(paste("../nberCols/",temp[[1]],".clu",sep=""),"w")
x <- readLines(n=1,g)
while (!(length(x)==0)){
if (x=="1"){
cat(readLines(n=1,old),"\n",sep="",file=new)}
else{
readLines(n=1,old)} #only read line - to get to new line
x <- readLines(n=1,g)
}
close(old)
close(g)
for (i in 1:const){ # add the ones without additional data
cat("0\n",sep="",file=new)}
close(new)
}
S pomočjo zgornje kode skonstruiramo vse ”.clu” datoteke. Za pravilno delovanje je potrebno stvari še malce počistiti (NA → 9999998). Vrednosti zadnjih 1398 patentov (tistih, ki nimajo dodatnih podatkov), so vedno 0.
Podobno skonstruiramo tudi datoteko “described.clu”. Opisi datotek:
CLUSTERS (3210774 patents, 3209376 have additional information)
---
described.clu (1 for those with additional information - first 3209376, others 0)
appyear.clu (application year)
assignee.clu (assignee id)
gyear.clu (grant year)
cat.clu (HJT category - 1-6)
subcat.clu (HJT subcategory - 2-digit)
--- not cleaned! - will not be used for the book
icl_class.clu (Main 4-char IPC)
icl_maingroup.clu (Main group within 4char IPC)
iclnum.clu (clas/icl seq. number (imc))
nclass.clu (3-digit US patent class (10=D))
subclass.clu (numerical subclass)
--- not everything included (see constructed 2-mode networks), not cleaned!
icl.clu (clas/ international classification)
pdpass.clu (unique assignee number for match in CompuStat)
Zadnji 2 datoteki pretvorimo v 2-vrstna omrežja (podobno - s hranjenjem vrednosti v 2 “environment”-a).
2-MODE (3210774 patents + second mode)
----
icl_simple.net (second mode: 170548)
icl.nam
pdpass_simple.net (second mode: 223943)
pdpass.nam
Datoteke:
Naslednji program v R-ju zbira dodatne podatke o patentih: naslov patenta in avtorje (kraj, država). Številke patentov pobira iz pajkovega seznama 'imen' patentov z datoteke nber06.nam.
# Collecting title + inventors info from US patent Office
# http://patft.uspto.gov/netahtml/PTO/srchnum.htm
# Vladimir Batagelj, July 22, 2011
readURL <- function(page,repo,save){
e<-NULL
for(a in 1:10){
stran <- tryCatch(readLines(con<-url(page),warn=FALSE,n=100),
error = function(e) e,finally=close(con))
ok <- class(stran)=="character"
if(ok) return(stran)
if (a<6) cat('\n*** class = ',class(stran),'\nretry',a,':',date(),'\n',file=repo)
if (a<10) {
cat('\n*** class = ',class(stran),'\nretry',a,':',date(),'\n')
flush.console()}
Sys.sleep(60)
}
cat("Problems on the Internet ...\nClosing",date(),'\n',file=repo)
cat("Problems on the Internet ...\nClosing",date(),'\n')
close(repo); close(save); stop("Too many retries")
}
setwd("D:/Data/nber/titles")
repo <- file("report-400Mc.txt","w")
save <- file("titles-400Mc.dat","w")
nums <- read.csv("nber06.nam",sep=' ',header=FALSE,skip=1,stringsAsFactors=FALSE)$V2
url1 <- 'http://patft.uspto.gov/netacgi/nph-Parser?Sect2=PTO1&Sect2=HITOFF&p=1'+
'&u=%2Fnetahtml%2FPTO%2Fsearch-bool.html&r=1&f=G&l=50&d=PALL&RefSrch=yes&Query=PN%2F'
k <- 281387; K <- 400000
cat('% NBER - patent titles\n% started at,',k,'-',K,':',date(),'\n\n',file=repo)
while(k < K){
if(k %% 100==0) {
if(k %% 5000==0) {cat('\n',k,' ',date(),' ',sep=''); flush.console()
cat(k,' ',date(),'\n',sep='',file=repo)
}
cat('.'); flush.console()
}
k <- k+1; patNum <- nums[k]
stran <- readURL(paste(url1,patNum,sep=''),repo,save)
it <- grep('<font size=\"+1\">',stran,fixed=TRUE)
if (length(it)>0){
ti <- it[1]; str <- stran[ti]; lt <- nchar(str)
jt <- regexpr('> ',str); tit <- substr(str,jt+2,lt)
cat(k,'=',patNum,'="',tit,'"\n',sep='',file=save)
} else {
cat(k,patNum,' - missing title\n',file=repo)
}
ii <- grep('>Inventors:',stran,fixed=TRUE)
if (length(ii)>0){
ti <- ii[1]; str <- stran[ti+1]; lt <- nchar(str)
jt <- regexpr('</TD>',str); inv <- substr(str,1,jt-1)
cat(inv,'\n',sep='',file=save)
} else {
cat(k,patNum,' - missing inventors\n',file=repo)
}
}
close(repo); close(save)
Pozor, pri branju preberemo le prvih 100 vrstic: readLines(con←url(page),warn=FALSE,n=100)
Zbiranje poteka precej počasi - okrog 2500 patentov na uro. Zato stvar pohitrimo z izvajanjem večih izvodov programa na različnih delih (k,K) seznama patentov.
Iz zbranih podatkov ustvarimo Pajkovo datoteko z dolgimi imeni (naslovi patentov) v načrtu pa so še dvovrstna omrežja patents X keywords (pridobljeni iz naslovov), patents X authors in patents X states.
import re
import sys; wdir = r'd:\data\nber\titles'; sys.path.append(wdir)
titFile=wdir+'\\data\\titles-200Mc.dat'
namFile=wdir+'\\data\\long.nam'
pauFile=wdir+'\\data\\nber06.PA'
dat = open(titFile,'r')
nam = open(namFile,'w')
pau = open(pauFile,'w')
bb = "Fletcher; James C.</B> (National Aeronautics and Space, US)"
k = 0
while True:
a = dat.readline()
if not a: break
b = dat.readline()
if not b: break
k = k+1
A = a.strip().split('=')
nam.write(A[0]+' '+A[2]+'\n')
B = b.strip()[3:]
if B.startswith('Fletcher; James C. '):
D = re.split(r"<B>,|</B> |</B>$",B)
B = bb
for i in range((len(D)-3) // 2):
B += '<B>,'+D[2*i+4]+'</B> '+D[2*i+3]
B = B.replace('(N/A)','(**, **)').split('<B>, ')
names = [x.split('</B>')[0] for x in B]
try:
C = [x.split('(',1)[1] for x in B]
except:
print "*** Error: C\n",A[0],A[2],'\n',b,'\n',B,'\n',C
C =[x if x.rfind(',')>0 else
x[:-1]+', **)' if len(x)>3 else '**, '+x for x in C]
try:
places = [y.rsplit(',',1)[0] for y in C]
except:
print "*** Error: places\n",A[0],A[2],'\n',b,'\n',B,'\n',C
try:
cntries = [z[3:-4] if z.startswith('<B>') else 'US-'+z
if len(z)==2 else '**-'+z for z in [
y.rsplit(', ',1)[1][:-1] for y in C]]
for (i,x) in enumerate(names):
pau.write(A[0]+'|'+str(i+1)+'|'+x+'|'+places[i]+'|'+
(cntries[i] if len(cntries[i])>0 else '**')+'\n')
except:
print "*** Error: cntries\n",A[0],A[2],'\n',b,'\n',B,'\n',C
dat.close(); nam.close(); pau.close()
Datoteka pyr.zip vsebuje datoteko nber06.nam in oba programa; datoteka pyrp.zip pa zadnji različici obeh programov.