Sukro avuksi erilaisiin luuppauksiin

[viesti Survo-keskustelupalstalla (2001-2013)]

Kirjoittaja: Petri Palmu
Sähköposti:    -
Päiväys: 11.12.2007 0:13

Moi,

Olen toisinaan törmännyt tilanteisiin, jossa
esim. aineiston käsittely, kuva tai statistiikka on vaatinut
jos jonkinmoista luuppaamista. Olen näissä
tilanteissa päätynyt joko sukroon, FILE LOAD + FORMAT tietynlaiseen
käyttöön tai sitten esim. R tai Python ohjelman tarjoamiin
mahdollisuuksiin. Osan luuppauksista voi myös kiertää kikkailemalla
esim. VAR-operaatiossa.

Halusin kokeilla, josko onnistuisi tekemään jonkilaisen yleiskäyttöisen
luupitussukron. Ja mielellään sillä olisi (visuaalista) vastaavuutta
ohjelmointikielien for/while-rakenteille. Ohessa oleva REP-sukro on
tulos siitä, mitä olen alustavasti ehtinyt pakertaa homman kanssa.

Kaikki Survon ominaisuudet ovat mukana, tavallaan tämän voi
ajatella yleistettynä ACTIVATE-sukrona, joka vain toistaa aktivoitavia
komentorivejä n-kertaa. Erikoistapauksessa n=1 sukro on
olennaisesti ACTIVATE (jos ei tuota vuorovaikutteisuutta lasketa).
Luuppi-indeksimuuttujilla (tavallisesti i,j,k) on usein oma
tärkeä käyttö, mm. rajata aineistoja IND=X,i ja kirjoittaa tiedostonimiä
tyyliin file_i.txt (i=1,2,...n). Tämä ominaisuus täytyy siis myös
olla mukana (ks. sukrossa TXTCONV). Lisäksi esim. iterointityyppiset
tilanteet saattavat vaatia jonkinlaisen break option (hyppää pois
silmukasta) tai ehkä muuttaa luuppi-indeksimuuttujan arvoa pienemmäksi
tai suuremmaksi. Sinänsä toimituskentässä voi hypellä tuttuun
Survo-sirkka tyyliin... Koska luuppeja joutuu monesti sisäkkäistämään,
/REPiä on mahdollista käyttää 7 kertaa sisäkkäin. Se riittänee
useimpiin sovelluksiin ;)

/REP sukrossa annetaan parametrit:
 komentoriviargumentit:
 <luupissa aktivoitava merkki kontrollisarakessa>,
 <aloitusrivi>, (tämä on oikeastaan tarpeeton)
 <merkki kontrollisarakessa, johon aktivointi päättyy> 
 täsmennykset:
 NREP = <toistojen lkm> 
 FORI = luuppi-indeksointimuuttujan nimi luuppikaaviossa ($i, $j,...)
   (huom. nimi oltava sellainen, ettei se esiinny toimituskentässä
    edes osana muita merkkijonoja)
 LEVEL = <1,2,..> (oletus = 1)

 Sitten varsinaisen suoritusosan sisällä voi käyttää
 (luupin mahdollinen lopetus)
 BREAK = {tyhjä,1}
 (luuppi-indeksimuuttujan arvon muuttaminen)
 MOVEI = {kokonaisluku tai tyhjä}

Sukroa pitää vielä kehittää. Varmaan kehitystarpeet huomaa parhaiten,
kun sitä koklaa käytännössä erilaisissa tilanteissa.

Mikäli tulee mieleen ajatuksia homman kehittämiseen tai muuten vaan
kommentteja, niin :)

t. Petri

Pari simppeliä esimerkkiä (nämä pitää olla eri toimituskentässä
 kontrollimerkkien samuuden vuoksi).

*.......................
*  ESIM 1:
*  3-tasoisen ryhmittelyn indeksointi
*
*  eka taso (uloin):
*/REP A,CUR+1,B / NREP=1 FORI=$i LEVEL=1 { sulku kuriositeettina :)
*
*.............................
*  toka taso:
A /REP C,CUR+1,D / NREP=2 FORI=$j LEVEL=2 {
*
*.................
*  kolmas taso (sisin):
C  /REP E,CUR+1,F / NREP=6 FORI=$k LEVEL=3 {
*
*................
ESAVEP CUR+1,CUr+1,_tmp1
* X$i.$j.$k
ELOADP _tmp1,END+1
*...............
*
* Jos ao. BREAKilla olisi joku arvo, niin luuppi hyppäisi
* ulos kolmannelta tasolta.
*
*MOVEI=1    / 3-tason luuppissa joka toinen k:n arvo
*BREAK=
E
*....................
F   --- k --- }
D  --- j --- }
B --- i --- }
*.................
*
*
*........................
*
*Tulos:
* X1.1.1
* X1.1.3
* X1.1.5
* X1.2.1
* X1.2.3
* X1.2.5
*
*
*
*
*.......................
* ESIM2: Gibbs-sampler, kaksiulotteinen normaalijakauma N(0,S)
*  (kopsattu Gelman: Bayesian Data Analysis)
*
*  Full conditionals  (theta1 and theta2)
*  [Theta1 | Theta2 = theta2] ~ N(  , )
*  [Theta2 | Theta1 = theta1] ~ N(  , )
*   N( , ) sisällä ao. ehdollisen jakauman parametrit
*
*
*  Kokeillaan 3 eri theta1 ja theta2 korrelaatioiden r
*  välistä vaikutusta yhteisjakauman simulointiin Gibbs-samplerilla
*  Kaksitasoinen luuppi, jossa sisempi muodostuu
*  varsinaisesta Gibbs-samplerista ja ulompi
*  korrelaatioparametritasosta.
*
*  Vain tämä komento aktivoidaan
*  (mutta talleta eka toimkentän matriisit alla)
*/REP A,CUR+1,B / NREP=3 FORI=$i LEVEL=1
*
*.....................
*  Vain 10 havainnon otos (sisempi luuppi)
A/REP C,CUR+1,D / NREP=10 FORI=$j LEVEL=2
*
*MATRIX M  / Means
*///  M
*T1    0
*T2    0
*
*MATRIX SD / Standard deviations
*///  SD
*T1    1
*T2    1
*
*MATRIX R     / Correlations of Theta1 and Theta2
*///  R
*1    -.5
*2    0
*3    .99
*
*Siis yo. tiedot tunnetaan
*
* Talleta tämä kaikki ensin (F2+Esc) ennen /REP komentoa
*MAT SAVE M TO M
*MAT SAVE SD TO SD
*MAT SAVE R TO R
*MAT S(1,1)=SD(1,1)^2
*MAT S(2,2)=SD(2,1)^2
*MAT S(1,2)=R(1,1)*SD(1,1)*SD(2,1)
*MAT S(2,1)=S(1,2)
*MAT OUT=ZER(Ki,2)   /   Ki=NREP+1
*MAT CLABELS X TO OUT
*MAT APU2=ZER(2,1)
*MAT APU=ZER(1,1)      / initialize theta2
*MAT #TRANSFORM APU BY N.G(0,10^2,rnd(0))   / ~ from normal
*MAT OUT(1,2)=APU  / voisi koklata suoraan jotain arvoa esim -8
*
*..............................
*
* j=$j
*
* Draw theta1 given current value of theta2
CMAT APU2(1,1)=M(1,1)+R($i,1)*SD(1,1)*INV(SD(2,1))*OUT(j,2)
CMAT APU2(2,1)=(1-R($i,1)^2)*SD(1,1)^2
CMAT #TRANSFORM APU BY probit(rnd(0))  /  ~ N(0,1)
CMAT APU=APU2(1,1)+APU2(2,1)*APU
CMAT OUT(j,1)=APU  / update theta1
* Draw theta2 given current value of theta1
CMAT APU2(1,1)=M(2,1)+R($i,1)*SD(2,1)*INV(SD(1,1))*OUT(j,1)
CMAT APU2(2,1)=(1-R($i,1)^2)*SD(2,1)^2
CMAT #TRANSFORM APU BY probit(rnd(0))   /
CMAT APU=APU2(1,1)+APU2(2,1)*APU
CMAT OUT(j+1,2)=APU  / update theta2
*
D --- end j level ---
*
*.......................
* Tiedostojen talletus eri korrelaatiotasoilla
*
AMAT CLABELS X TO OUT
AFILE DEL OUT$i
AFILE SAVE MAT OUT TO OUT$i
AVAR SIMORD:2=ORDER TO OUT$i
*...................
ASAVEP CUr+1,CUR+1,_plot
*GPLOT OUT$i,X1,X2 / TREND=0 IND=ORDER,1,10 POINT=[Times(12)],SIMORD
ALOADP _plot,END+1
*.........................
B --- end i level ---
*.................................
*
*FILE SHOW OUT1
*FILE SHOW OUT3
*.......................
*  Tulos:
* Tsekataan eri korrelaatiotason vaikutuksia simulointiin
*PEN=[Times(10)][BLACK][line_type(0)][line_width(1)][rot(0)][move(0,0)]
* XSCALE=-10,10 YSCALE=-10,10
*MODE=PS LINE=1
*GPLOT OUT1,X1,X2 / TREND=0 IND=ORDER,1,10 POINT=[Times(12)],SIMORD
*GPLOT OUT2,X1,X2 / TREND=0 IND=ORDER,1,10 POINT=[Times(12)],SIMORD
*GPLOT OUT3,X1,X2 / TREND=0 IND=ORDER,1,10 POINT=[Times(12)],SIMORD
*
*

.......................
 Ja sitten itse sukro...

*TUTSAVE REP             / REPeat
/ 2007-12-09 / PP
/
/ Vastaa for($i in 1:n) {...} luuppirakennetta
/
/ /REP sukrossa annetaan parametrit:
/  argumentit:
/  <luupissa aktivoitava merkki kontrollisarakessa>,
/  <aloitusrivi>, (tämä on oikeastaan tarpeeton)
/  <merkki kontrollisarakessa, johon aktivointi päättyy> 
/  täsmennykset:
/  NREP = <toistojen lkm> 
/  FORI = luuppi-indeksointimuuttujan nimi luuppikaaviossa ($i, $j,...)
/    (huom. nimi oltava sellainen, ettei se esiinny toimituskentässä
/     edes osana muita merkkijonoja)
/  LEVEL = <1,2,..> (oletus = 1)
/
/  Sitten varsinaisen suoritusosan sisällä voi käyttää
/  (luupin mahdollinen lopetus)
/  BREAK = {tyhjä,1}
/  (luuppi-indeksimuuttujan arvon muuttaminen)
/  MOVEI = {kokonaisluku tai tyhjä}
/
/ *********************************************************
/
/ def Wact=W1 Wcur1=W2 Wend=W3
/ def Wact=W10 Wnrep=W11 Wr1=W12 Wc1=W13 Wfori=W14 Wlevel=W15
/ def Wi=W20 Wc=W21 Wbreak=W22 Wmovei=W23
/ def Wrcmd=W30 Wccmd=W31 Wrtxtc=W32 Wctxtc=W33
/
/ *********************************************************
*{init}{tempo -1}
/ Täsmennykset
*{save spec NREP Wnrep}
*{save spec LEVEL Wlevel}
*{save spec FORI Wfori}
/
+ Checks1:
- if Wlevel '=' {} then goto Level else goto LevelOk
+ Level: {Wlevel=1}
+ LevelOk:
/ mahdollisia täsmennyksiä joilla luuppaamista voidaan ohjata
/ esim hypätään silmukasta ulos kesken (esim. konvergenssikrit täyt)
*{Wmovei=0}
*{Wbreak=}
/{R}{print Wlevel}{goto End}
/ Talletetaan sukrokomennon paikka toimkentässä
*{save cursor Wrcmd,Wccmd}
/
+ Edit1:
*{jump cur+1,cur+1,1}{u5}{d5}
*{save cursor Wr1,Wc1}{u}{ins line}
*{ins line}{ins line}{ins line}{ins line}{u4}
/ Mahdollista luuppausindeksimuuttujaa varten
+ ReplFormat:
*SAVEP CUR+5,{print Wend},_tmploop{print Wact}{act}
*{line start}{erase}
*LOADP _tmploop{print Wact}2,CUR+5{R}
/
*TXTCONV _tmploop{print Wact},_tmploop{print Wact}2{R}
*CONVERSIONS:{R}
*T "{print Wfori}"   "{save cursor Wrtxtc,Wctxtc}{R}
*END
/
/  Then Activate all the commands with specified control char ACT
/  and repeat it nrep times
/
*{jump Wr1,Wr1,1}{u5}{d5}
*{Wi=0}
/ Luuppi alkaa
+ Loop: {Wi=Wi+1}{Wi=Wi+Wmovei}
- if Wi > Wnrep then goto E
/ Korvataan luuppi-indeksimuuttuja asianmukaisella arvolla 1,2,..
+ Txtconv: {jump Wrtxtc,Wrtxtc,Wctxtc}
*{erase}{print Wi}"{u2}{line start}{act}
*{u}{act}{d5}
/ Etsitään kontrollisarakkeesta merkkiä
+ Activate: {}
*{pre}Lc
*{line start}{l4}{save char Wc}{r}
*{save spec BREAK Wbreak}
- if Wbreak '<>' {} then goto E
+ CtrlCheck:
- if Wc '=' Wend then goto Loop
- if Wc '=' Wact then goto Act else goto NewRow
+ Act:
/ Siirretäänkö luuppi-indeksiä johonkin?
*{save spec MOVEI Wmovei}
- if Wmovei '=' {} then goto Move0 else goto Switch
+ Move0: {Wmovei=0}
+ Switch:
/ Talleta sukromuisti tiedostoksi luupin tason mukaan
- switch Wlevel
-  case 1: goto R1
-  case 2: goto R2
-  case 3: goto R3
-  case 4: goto R4
-  case 5: goto R5
-  case 6: goto R6
-  case 7: goto R7
-  case 8: goto R8
-  default: goto E
/
+ R1: {save stack SUR_REP1}{act}{load stack SUR_REP1}{R}{goto Activate}
+ R2: {save stack SUR_REP2}{act}{load stack SUR_REP2}{R}{goto Activate}
+ R3: {save stack SUR_REP3}{act}{load stack SUR_REP3}{R}{goto Activate}
+ R4: {save stack SUR_REP4}{act}{load stack SUR_REP4}{R}{goto Activate}
+ R5: {save stack SUR_REP5}{act}{load stack SUR_REP5}{R}{goto Activate}
+ R6: {save stack SUR_REP6}{act}{load stack SUR_REP6}{R}{goto Activate}
+ R7: {save stack SUR_REP7}{act}{load stack SUR_REP7}{R}{goto Activate}
+ R8: {save stack SUR_REP8}{act}{load stack SUR_REP8}{R}{goto Activate}
/ Ja jollei aktivoida niin uusi rivi ja paluu Activateen
+ NewRow: {R}{goto Activate}
/ Viimeistelyt
+ E: {jump Wrcmd,Wrcmd,Wccmd}{d2}
*{del line}{del line}{del line}{del line}
*{u}{line start}{erase}
*LOADP _tmploop{print Wact},CUR+1{act}{del line}
*{jump Wrcmd,Wrcmd,Wccmd}{u2}{d2}
+ 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!

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