[viesti Survo-keskustelupalstalla (2001-2013)]
| Kirjoittaja: | Petri Palmu |
|---|---|
| Sähköposti: | - |
| Päiväys: | 17.12.2006 16:07 |
Taannoin ("VAR R-funktioilla" 2.3.2006) kirjoittelin
VAR "laajennuksista", jossa VAR operaatio suoritetaan
hyödyntäen R:n funktioita.
Olen lisännyt joitakin ominaisuuksia mm:
- R-skriptit mahdollisesti useammalla rivillä
- R:n kirjastojen hyödyntäminen LIB=
- output myös string (laskee automaattisesti tarvittavan tilan S:x
kentässä :) )
Jatkoa ajatellen lisää laajennuksia:
(näihin ehdotukset tervetulleet)
- osa-aineistorajoitteet SELECT,IND (FILE SELECT?)
- osa-aineistoittaiset luupit
(R:ssä esim. by, tapply funktiot)
- (s)apply tyyppiset usean outputmuuttujan funktiot
Tällä tavoin voi välttää sen, että R:n monia mukavia toimintoja
käyttääkseen ei tarvitse lukea koko dataa R:n workspaceen.
(ainakin omassa koneessani on 1Gb muistirajoitus).
Mm. datan muokkaaminen näyttää tulevan R:ssä todella
hitaaksi suurilla aineistoilla.
En takaa sukron toimivuutta vielä kaikissa olosuhteissa, mutta
ainakin esimerkit näyttäisivät skulaavan.
t. Petri
.......................
DATA _KOE1
HOBBY Y ID TIME X1
auto 1 _0001 10000 50
koira;kissa 1 _0001 10300 22
juoksu 1 _0002 10444 55
kissa 1 _0002 10400 12
kirjat 1 _0002 10220 10
survo;auto 1 _0002 11000 22
sienet 1 _0003 13000 45
R;survo 1 _0003 10550 56
srvo 1 _0003 10009 1
metsästys 1 _0003 10010 0
monta_asiaa:_R;mus;srvo;kisat 1 _0005 10333 -.000009
monta_asiaa:_survo;musa;kissa 1 _0003 12050 1000.56
...............
FILE COPY _KOE1 TO NEW KOE
FILE SHOW KOE
......................
Muunnoksia
/ACTIVATE +
/R_VAR SURVO=(f.agrep("survo",KOE$HOBBY)* # kirjoitusvirheet
f.agrep("musa",KOE$HOBBY)) TO KOE
huom. f.agrep on oma R-funktio ks. alkuperäinen viesti 2.3.2006
/R_VAR T1=gsub(".*survo.*", "SURVO",
as.character(KOE$HOBBY)) TO KOE
Indikaattorimuuttuja:
/R_VAR C1=as.numeric((KOE$X1 > 10) & (KOE$X1 <= 40)) TO KOE
/R_VAR dX1=c(NA,diff(KOE$X1)) TO KOE
/R_VAR date=paste(date()) TO KOE # KOE$Y huom.
................
pvm muokkausta + R-kirjastofkt + scripti useammalla rivillä
/R_VAR ID_DATE=paste(substr(as.character(KOE$ID), start=2, stop=5) ,
"-",
dates(KOE$TIME, format="Y-m-d"),
sep="") TO KOE / LIB=library(chron)
..................
FILE LOAD KOE,CUR+2 / VARS=ID_DATE,SURVO,T1,C1,dX1
DATA KOE*,A,B,C
ID_DATE SURVO T1 C1
0001-97-05-19 0.000 auto 0.000
0001-98-03-15 0.000 koira;kissa 1.000
0002-98-08-06 0.000 juoksu 0.000
0002-98-06-23 0.000 kissa 1.000
0002-97-12-25 0.000 kirjat 0.000
0002-00-02-13 0.000 SURVO 1.000
0003-05-08-05 0.000 sienet 0.000
0003-98-11-20 0.000 SURVO 0.000
0003-97-05-28 0.000 srvo 0.000
0003-97-05-29 0.000 metsästys 0.000
0005-98-04-17 1.000 monta_asiaa:_R;mus;srvo;kisat 0.000
0003-02-12-29 1.000 SURVO 0.000
.................
*
*Tässä sukron listaus:
*TUTSAVE R_VAR
/ P.Palmu 2006-12-17
/ /R_VAR <NEWVAR>=<R-function of <data>$<OLDVAR>'s> TO <data> /
/
/ VAR transformation via R functions
/
/
/
*{init}{u}{ins line}
- if W1 '=' RETURN then goto E2
/
/ def Wvar=W10 Wrfunc=W3 Wfile=W5 Wargs=W7 Wtmp=W9
/ def Wdatapath=W11 Wtempdisk=W12 Wline=W13 Wvfrm=W14 Wvtype=W15
/ def Wvlen=W16
/ def Wx1=W21 Wx2=W22 Wx3=W23 Wx4=W24 Wdata2=W25 Wi=W26 Wj=W27
/ def Wdatapath2=W31 Wsystempath=W32 Wversion=W33 Wapu=W34 Wlib=W35
/
*{tempo 0}
/ Finding the end line of the script
*{line start}{ref set 1}{save spec LIB Wlib}
*FIND ") TO "{act}{R}{save cursor Wi,Wj}{ref jump 1}
*{line start}{erase}SAVEP CUR+1,{print Wi},_rcode.txt{act}{del line}
*{line start}
*{line start}{save line Wline}
*
/ Going to temp folder
*{save stack}{W1=VAR}{call SUR-SAVE}{del stack}{load stack}
/
/ if Wfile '=' {} then goto ERR1
/
*{jump 1,1,1,1}SCRATCH {act}{line start}
/
*{form}/R_VAR RETURN / to current application
/
*{R}
*REDIM 2000,200{act}{R}
*RESIZE 54,90{act}{R}
/ printing the script
/LOADP _rcode.txt{act}{jump end-3,end+4,1}
*LOADP _rcode.txt{act}{line start}{erase}
/
/{tempo +1}
*{ref set 1}{R}
/{print Wline}
*{ref jump 1}{line start}
*REPLACE "="," ",C{act}{line start}{erase}
*REPLACE "$"," $ ",C{act}{line start}{erase}
*REPLACE "(","( ",C{act}{line start}{erase}
*REPLACE ")"," )",C{act}{line start}{erase}
*REPLACE ","," , ",C{act}{line start}{erase}
*REPLACE "-"," - ",C / LINES=CUR+1,END{act}{line start}{erase}
*REPLACE "+"," + ",C / LINES=CUR+1,END{act}{line start}{erase}
*REPLACE "*"," * ",C / LINES=CUR+1,END{act}{line start}{erase}
*REPLACE " "," ",C / LINES=CUR+1,END{act}{line start}{erase}
*REPLACE " "," ",C / LINES=CUR+1,END{act}{line start}{erase}
*
/
*{R}{next word}{save word Wvar}{line start}{u2}{ins line}{ref set 1}
/ Find Survo data name
*FIND ") TO "{act}{R}{next word}{next word}{save word Wfile}{ref jump 1}
*{line start}
*{ins line}{print Wfile}{sp}{print Wvar} / data{R}
*{tempo +1}
/{goto END}
/
*{ins line}{line start}{ref set 2}{u}{line start}{ref set 1}
/ VARS lista tulee olemaan FIND rivin alapuolella
+ GetVars: {ref jump 1}{line start}{erase}
*FIND "{print Wfile} "{act}{R}{del}{next word}{save word Wtmp}
- if Wtmp '=' {sp} then goto EndGvar
- if Wtmp '<>' $ then goto GetVars
*{next word}{save word Wx1}
/ if Wx1 '=' {} then goto EndGvar
*{ref jump 2}{line end}{print Wx1},
*{goto GetVars}
+ EndGvar: {R}{line end}{l}{del}{line start}{save line Wx1}{R}
/
/{jump end+1,end+2,1}{print Wx1}
/{goto END}
*{save datapath Wdatapath}{save tempdisk Wtempdisk}
*{print Wdatapath}{R}
*{R}
*..................{R}{R}
*CHECK {print Wfile}.SVO{act}{r}{save char W2}
- if W2 '<>' O then goto ERR2
*{R}
/{goto END}
*.............{R}
*VARS={print Wx1}{R}
/{goto END}
*>DEL {print Wtempdisk}_tmp1.txt{act}{R}
*FILE LOAD {print Wfile} TO {print Wtempdisk}_tmp1.txt /{sp}
*DELIMITER=TAB NAMES=8{act}{R}
/ Copy r script
*>COPY _rcode.txt {print Wtempdisk}_rcode.txt{act}{R}
*...............{R}
/{goto END}
*CD {print Wtempdisk}{act}{R}
*{ins line}
*{print Wline}
*{u}{line start}{erase}
*FIND "="{act}{R}{del}{save line Wline}{line start}{erase}
*{print Wline}
*{u}{line start}{erase}
*FIND " TO "{act}{R}{erase}{line start}{save line Wline}{R}
*...............{R}
/{tempo +1}
/{goto END}
*>DEL _{print Wvar}.txt{act}{R}
*>DEL _r.r{act}{R}
*..............{R}
/{tempo +1}
*{ref set 1}{R}
*{print Wfile} <- read.table("_tmp1.txt", header=T, sep="\t",
* strip.white=T){R}
*#{R}
/ libraries
*{print Wlib}{R}
*{print Wfile}${print Wvar} <- {R}
/ <- {print Wline}{R}
/ print the r script
*LOADP _rcode.txt{act}{line start}{erase}
*REPLACE " TO {print Wfile} "," ",C{act}{line start}{erase}
*REPLACE "/ ","/ ",C{act}{line start}{erase}
*REPLACE "/ LIB","# LIB",C{act}{del line}{line start}
+ RemoveVar: {save char Wapu}
- if Wapu '=' = then goto Lastrm
*{del}{goto RemoveVar}
+ Lastrm: {del}{goto ContinueScript}
/
+ ContinueScript:
*{jump end-10,end+1,1}
*tmp1 <- {print Wfile}[, "{print Wvar}"]{R}
*# for variable type{R}
*if(!is.numeric(tmp1)) {(}v_format <-
* paste(":S" ,max(nchar(tmp1)), sep=""); {R}
* v_create <- paste("S ", max(nchar(tmp1)), sep="") {)}
* else {(}; {R}
* v_format <- c(":4"); v_create <- c("N 4"){)}{R}
*writeLines(v_format, "_v_fr"){R}
*writeLines(v_create, "_v_cr"){R}
*#{R}
*# names(tmp1) <- "{print Wvar}"{R}
*# write vector {R}
*write.table(tmp1, file="_{print Wvar}.txt", col.names=FALSE ,{R}
*quote=F, sep="\t", row.names=FALSE){R}
*#{R}
*{ref jump 1}
*SAVEP CUR+1,END,_r.r{act}{jump end+1,end+1,1}{R}
/
*{save datapath Wdatapath2}{save systempath Wsystempath}
/
*PUTENV R_PROFILE={write Wsystempath}SYS\SURVO.R{act}{R}
/
*{print Wdatapath2}{R}
*{line start}{erase}{pre}F{ref}
/{goto END}
/
*{save system R_path W6}>{print W6}\bin\RTERM.EXE
* HOME={write Wdatapath2}
* &{R}
* --save -q
/ --no-restore --no-save -q
/{goto END}
+ A: <_r.r >R.LIS 2>&1{ref}{ref}{act}
/{del line}{del line}
/{del line}
*{R}
*{R}
*.............{R}
/{tempo +1}
/ variable type parameters
*LOADP _v_fr{act}{R}{save word Wvfrm}{R}
*LOADP _v_cr{act}{R}{save word Wvtype}{next word}
*{save word Wvlen}{R}
*..............{R}
*FILE DEL {print Wdatapath}__TMP{act}{R}
*FILE CREATE {print Wdatapath}__TMP{ref set 1}{R}
* Output vector from R script{R}
*FIELDS: (active){R}
* 1 {print Wvtype}A_ {print Wvlen}{sp}{print Wvar}{R}
* 2 {print Wvtype}A_ {print Wvlen}{sp}X1{R}
*END{ref set 2}{ref jump 1}{act}{ref jump 2}{R}
*{R}
*.................{R}
*DELIMITER=TAB FIRST=1 LAST=99999999999 / (max survon sallima){R}
*FILE SAVE _{print Wvar}.txt TO {print Wdatapath}__TMP{act}{R}
*>DEL *.RData{act}{R}
/{goto END}
*CD {print Wdatapath}{act}{R}
*..................{R}
/VAR {print Wvar}{print Wvfrm}=MISSING TO __TMP{act}{R}
/...........{R}
- if Wvtype '=' N then goto Numeric
*VAR str({print Wvar})=str(X1) TO __TMP{act}{R}
*{goto FileCopy}
+ Numeric:
*VAR {print Wvar}=X1 TO __TMP{act}{R}
+ FileCopy:
*..............{R}
/ Remove outvar if exits...
/ how to check the outvar not existing
/FILE COPY {print Wfile} TO NEW TEMP1 / VARS=ALL,-{print Wvar}{act}{R}
/.................{R}
/FILE COPY TEMP1 TO NEW {print Wfile}{act}{R}
/FILE DEL TEMP1{act}{R}
*..................{R}
/{tempo 0}
/Using FILE COPY and MATCH
*FILE EXPAND {print Wfile},1,40{act}{R}
/Using FILE COPY and MATCH
*VAR {print Wvar}{print Wvfrm}=MISSING TO {print Wfile}{act}{R}
*............{R}
*MATCH=# VARS={print Wvar}{R}
*FILE COPY __TMP TO {print Wfile}{act}{R}
*..................{R}
/FILE?
/
/{goto END}
*{W1=VAR}{call SUR-RESTORE}{goto END}
/
+ ERR1: {message} Usage: /R_VAR Y=f(DATA$X) TO DATA!@
*{goto E1}
+ ERR2: {message} Data file not found!@{goto E1}
/
+ E1:
- on key
- key _: continue
- wait 300
+ E2: {message}@{W1=VAR}{call SUR-RESTORE}
+ END: {end}
*.....................
*
| Vastaukset: |
|---|
Survo-keskustelupalstan (2001-2013) viestit arkistoitiin aika ajoin sukrolla, joka automaattisesti rakensi viesteistä (yli 1600 kpl) HTML-muotoisen sivukokonaisuuden. Vuoden 2013 alusta Survo-keskustelua on jatkettu entistäkin aktiivisemmin osoitteessa forum.survo.fi. Tervetuloa mukaan!