R-VAR laajennuksia

[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:
[ei vastauksia]

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!

Etusivu  |  Keskustelu
Copyright © Survo Systems 2001-2013. All rights reserved.
Updated 2013-06-15.