Minsky Kayıt Cihazını Simüle Etme (I)


26

Pek çok formalizm var, bu yüzden diğer kaynakları faydalı bulabilirken, gerekli olmadıklarını açıkça belirtmeyi umuyorum.

Bir RM, sonlu durumlu bir makineden ve her biri negatif olmayan bir tamsayıya sahip olan sınırlı sayıda adlandırılmış kayıttan oluşur. Metin girişi kolaylığı için bu görev, durumların da adlandırılmasını gerektirir.

Üç tür durum vardır: her ikisi de belirli bir sicile başvuru yapan artma ve azalış; ve sonlandırın. Bir artış durumu kayıt defterini arttırır ve kontrolü bir halefine geçirir. Bir azalma durumunun iki halefi vardır: Eğer kayıt sıfırı sıfır değilse, o zaman onu azaltır ve kontrolü ilk halefiye geçirir; Aksi halde (yani sicil sıfırdır) sadece ikinci ardılıya kontrolü geçer.

Bir programlama dili olarak "nezaket" için, sonlandırma durumları yazdırmak için kodlanmış bir dize alır (böylece olağanüstü sonlandırmayı belirtebilirsiniz).

Giriş stdin'den. Giriş formatı, durum başına bir satır ve ardından ilk kayıt içeriğinden oluşur. İlk satır ilk durumdur. Durum çizgileri için BNF:

line       ::= inc_line
             | dec_line
inc_line   ::= label ' : ' reg_name ' + ' state_name
dec_line   ::= label ' : ' reg_name ' - ' state_name ' ' state_name
state_name ::= label
             | '"' message '"'
label      ::= identifier
reg_name   ::= identifier

Tanımlayıcı ve mesaj tanımında bazı esneklikler var. Programınız gerekir bir tanıtıcı olarak boş olmayan bir alfanümerik dize kabul ama olabilir isterseniz daha genel dizeleri kabul (örneğin eğer dil destekleri alt çizgilerle tanımlayıcılar ve bununla işe sizin için daha kolay). Benzer şekilde, mesaj için boş olmayan bir alfanümerik ve boşluk dizesini kabul etmelisiniz , ancak isterseniz kaçan yeni satırlara ve çift alıntı karakterlerine izin veren daha karmaşık dizeleri kabul edebilirsiniz .

İlk kayıt değerlerini veren son girdi satırı, boş olmayan bir boşlukla ayrılmış tanımlayıcı = int atama listesidir. Programda belirtilen tüm kayıtları başlatması gerekli değildir: başlatılmayanların 0 olduğu varsayılır.

Programınız girişi okumalı ve RM'yi simüle etmelidir. Bir sonlandırma durumuna ulaştığında, mesajı, yeni bir satırı ve ardından tüm kayıtların değerlerini (herhangi bir uygun, insan tarafından okunabilen, format ve herhangi bir sırayla) yayacaktır.

Not: resmi olarak kayıtlar sınırsız tamsayıları tutmalıdır. Ancak, hiçbir kaydın değerinin asla 2 ^ 30 değerini aşmayacağını varsaymak isterseniz.

Bazı basit örnekler

a + = b, a = 0
s0 : a - s1 "Ok"
s1 : b + s0
a=3 b=4

Beklenen sonuçlar:

Ok
a=0 b=7
b + = a, t = 0
init : t - init d0
d0 : a - d1 a0
d1 : b + d2
d2 : t + d0
a0 : t - a1 "Ok"
a1 : a + a0
a=3 b=4

Beklenen sonuçlar:

Ok
a=3 b=7 t=0
Trickier-to-pars makineleri için test kutuları
s0 : t - s0 s1
s1 : t + "t is 1"
t=17

Beklenen sonuçlar:

t is 1
t=1

ve

s0 : t - "t is nonzero" "t is zero"
t=1

Beklenen sonuçlar:

t is nonzero
t=0

Daha karmaşık bir örnek

DailyWTF'den Josephus'un problem kodu mücadelesinden alınmıştır. Girdi n (asker sayısı) ve k (avans) ve r cinsinden çıktı, hayatta kalan kişinin (sıfır indeksli) pozisyonudur.

init0 : k - init1 init3
init1 : r + init2
init2 : t + init0
init3 : t - init4 init5
init4 : k + init3
init5 : r - init6 "ERROR k is 0"
init6 : i + init7
init7 : n - loop0 "ERROR n is 0"
loop0 : n - loop1 "Ok"
loop1 : i + loop2
loop2 : k - loop3 loop5
loop3 : r + loop4
loop4 : t + loop2
loop5 : t - loop6 loop7
loop6 : k + loop5
loop7 : i - loop8 loopa
loop8 : r - loop9 loopc
loop9 : t + loop7
loopa : t - loopb loop7
loopb : i + loopa
loopc : t - loopd loopf
loopd : i + loope
loope : r + loopc
loopf : i + loop0
n=40 k=3

Beklenen sonuçlar:

Ok
i=40 k=3 n=0 r=27 t=0

Resim olarak bu program, görsel düşünen ve sözdizimini kavramada yararlı olacağını düşünenler için: Josephus problem RM

Eğer bu golftan hoşlanıyorsanız, devam filmine bir göz atın .


Giriş, stdin'den, bir dosyadan veya başka bir yerden mı geliyor?
Kevin Brown

@Bass, stdin'den.
Peter Taylor

Sorunları ele alması zor olan bazı test senaryoları eklemelisiniz: 1) boşluklu mesajlar, 2) eşit işaretli mesajlar, 3) inc_line mesajlar, 4) dec_line ilk durumda mesajlar, 5) boşluklarda mesajlar 3 ve 4. davalar
MtnViewMark

Dilbilgisinde hata var: dec_line içindeki iki durum_adı girişi arasında değişmez bir boşluk olması gerekiyor. Ayrıca, girişteki belirteçler arasında birden fazla boşluk kabul etmelerini istemenizin gerekip gerekmediği de belli değildir.
MtnViewMark

2
@Peter: Özellikleri ve dengesi iyi manevra kabiliyeti olan gerçekten etli bir koda sahip golf için +1! Buradaki çoğu soru çok zayıf.
MtnViewMark

Yanıtlar:


10

Perl, 166

@p=<>;/=/,$_{$`}=$' for split$",pop@p;$o='\w+';(map{($r
,$o,$,,$b)=$'=~/".*?"|\S+/g if/^$o :/}@p),$_=$o=($_{$r}
+=','cmp$o)<0?do{$_{$r}=0;$b}:$,until/"/;say for eval,%_

İle koş perl -M5.010 file.

Çılgınca farklı başladı, ama korkarım ki Ruby çözümü ile birçok alanda sona yaklaşıyor. Ruby'nin avantajı "sigil yok" ve Perl'in "daha iyi regex entegrasyonu" gibi görünüyor.

Perl'i okumazsan, masumlardan bir parça detay:

  • @p=<>: tüm makine açıklamasını okuyun @p
  • /=/,$_{$`}=$' for split$",pop@p: son makine açıklama satırındaki ( ) her bir ( for) atama ( split$") için, @peşit işareti ( /=/) bulun, ardından $'hask %_anahtarına değer atayın$`
  • $o='\w+': ilk durum, Perl regex "word karakterleri" ile eşleşen ilk isim olacaktır.
  • until/"/: sonlandırma durumuna ulaşana kadar döngü:
    • map{($r,$o,$,,$b)=$'=~/".*?"|\S+/g if/^$o :/}@p: makine açıklamasında döngü @p: mevcut durumla ( if/^$o :/) eşleşen satırdayken /".*?"|\S+/g, satırın geri kalanını $'değişkenlerle tokenize ( ) ($r,$o,$,,$b). Hile: $obaşlangıçta etiket adı için ve daha sonra operatör için kullanılırsa aynı değişken . Etiket eşleştiğinde, operatör geçersiz kılar ve bir etiket + veya - olarak adlandırılamadığında (bir kez daha eşleşmez).
    • $_=$o=($_{$r}+=','cmp$o)<0?do{$_{$r}=0;$b}:$,:
      - hedef kaydı $_{$r}yukarı veya aşağı ayarla (ASCII büyü: ','cmp'+'1 iken 1; ','cmp'-'-1);
      - sonuç negatifse ( <0?, yalnızca - için olabilir)
      - o zaman 0 ( $_{$r}=0) 'da kalır ve ikinci etiketi döndürür $b;
      - başka ilk (muhtemelen tek) etiketi döndür$,
    • BTW, bunun $,yerine, aralarında boşluk kalmadan bir $asonraki jetona yapıştırılabilir until.
  • say for eval,%_: döküm raporu ( eval) ve içindeki kayıtların içeriği%_

Kolona gerçekten ihtiyacın yok /^$o :/. Yalnız şapka, sadece etiketlere bakmak için yeterli.
Lowjacker

@Lowjacker Doğru etiketin üzerinde olduğumu belirlemeye ihtiyacım yok, ama bunun dışında tutulmam gerekiyor $'. Regex'te bir karakter var $c,, dışarıdan hesaba katılacak üç tane olurdu . Alternatif olarak bazı daha büyük ancak tokenizing regex'te değişiklik yapın.
JB

10

Python + C, 466 karakter

Sadece eğlence için, RM programını C'ye derleyen, sonra C'yi derleyen ve çalıştıran bir python programı.

import sys,os,shlex
G=shlex.shlex(sys.stdin).get_token
A=B=''
C='_:'
V={}
J=lambda x:'goto '+x+';'if'"'!=x[0]else'{puts('+x+');goto _;}'
while 1:
 L,c=G(),G()
 if''==c:break
 if':'==c:
  v,d=G(),G()
  V[v]=1;B+=L+c+v+d+d+';'
  if'+'==d:B+=J(G())
  else:B+='if('+v+'>=0)'+J(G())+'else{'+v+'=0;'+J(G())+'}'
 else:A+=L+c+G()+';'
for v in V:C+='printf("'+v+'=%d\\n",'+v+');'
open('C.c','w').write('int '+','.join(V)+';main(){'+A+B+C+'}')
os.system('gcc -w C.c;./a.out')

3
Kayıtları 'gibi adlara varsa, bu işe yaramaz main', ' ifvb'
Nabb

1
@Nabb: Buzzkill. Doğru yerlerde alt çizgi önekleri eklemeyi okuyucuya bırakıyorum.
Keith Randall

6

Haskell, 444 karakter

(w%f)(u@(s,v):z)|s==w=(s,f+v):z|t=u:(w%f)z
(w%f)[]=[(w,f)]
p#(a:z)|j==a=w p++[j]&z|t=(p++[a])#z;p#[]=w p
p&(a:z)|j==a=p:""#z|t=(p++[a])&z
c x=q(m!!0)$map((\(s,_:n)->(s,read n)).break(=='=')).w$last x where
 m=map(""#)$init x
 q[_,_,r,"+",s]d=n s$r%1$d
 q[_,_,r,_,s,z]d|maybe t(==0)(lookup r d)=n z d|t=n s$r%(-1)$d
 n('"':s)d=unlines[s,d>>=(\(r,v)->r++'=':shows v" ")]
 n s d=q(filter((==s).head)m!!0)d
main=interact$c.lines
t=1<3;j='"';w=words

Dostum, bu zordu! Mesajların içinde boşluk bulunan doğru kullanım, 70 karakterden fazladır. Çıktı biçimlendirmesi daha "insan tarafından okunabilir" olmak ve örnekleri eşleştirmek için başka 25 maliyet.


  • Düzenleme: (498 -> 482) çeşitli küçük iç kaplamalar ve @ FUZxxl'ın bazı önerileri
  • Düzenleme: (482 -> 453) kayıtlar için gerçek sayıları kullanarak geri döner; uygulanan birçok golf hileci
  • Düzenleme: (453 -> 444) inline çıktı formatlama ve başlangıç ​​değer ayrıştırma

Haskell'i tanımıyorum, bu yüzden tüm sözdizimini deşifre edemiyorum, ancak kayıt içerikleri için listeleri kullandığınızı görecek kadar deşifre edebilirim. Şunu söylemeliyim ki, ints kullanmaktan daha kısa.
Peter Taylor

Yerel bağlantıları where, noktalı virgüllerle ayrılmış tek bir satıra koymak, 6 karakterden tasarruf etmenizi sağlayabilir. Ve sanırım tanımında bazı karakterleri kurtarabilirseniz q, eğer varsa o zaman başka bir kalıp koruyucuyu değiştirebilirsin.
FUZxxl

Ve ayrıca: Sadece kör olarak, üçüncü değerin bunun yerine bir alt çizgi "-"tanımında olduğunu qve kullandığını varsayalım .
FUZxxl

Sanırım, 8 satırını değiştirerek başka bir karakter kaydedebilirsin q[_,_,r,_,s,z]d|maybe t(==0)$lookup r d=n z d|t=n s$r%(-1)$d. Ama yine de, bu program son derece iyi golf oynuyor.
FUZxxl

lexPrelude'dan faydalanarak ayrıştırma kodunu önemli ölçüde kısaltabilirsiniz . Örneğin f[]=[];f s=lex s>>= \(t,r)->t:f r, alıntı yapılan dizeleri doğru tutarken bir şey çizgileri tokenlere böler.
Hammar

6

Ruby 1.9, 214 212 211 198 195 192 181 175 173 175

*s,k=*$<
a,=s
b=Hash.new 0
eval k.gsub /(\w+)=/,';b["\1"]='
loop{x,y,r,o,t,f=a.scan /".*?"|\S+/
l=(b[r]-=o<=>?,)<0?(b[r]=0;f):t
l[?"]&&puts(eval(l),b)&exit
a,=s.grep /^#{l} /}

Bunun birbirlerinin etiket öneklerinde başarısız olmasını bekliyorum. Düşünceler?
JB

Örneklerden başka bir olayla çalışmasını sağlayamıyorum. Bunda yanlış olan
JB

Sanırım şimdi düzeltildi.
Lowjacker

Ah, çok daha iyi. Teşekkür ederim.
JB

3

Delphi, 646

Delphi dizeleri ve diğer şeyleri ayırma konusunda pek bir şey sunmuyor. Neyse ki, biraz yardımcı olan genel koleksiyonlarımız var, ancak bu hala oldukça büyük bir çözüm:

uses SysUtils,Generics.Collections;type P=array[0..99]of string;Y=TDictionary<string,P>;Z=TDictionary<string,Int32>;var t:Y;l,i:string;j,k:Int32;q:P;u:Z;v:TPair<string,Int32>;begin t:=Y.Create;repeat if i=''then i:=q[0];t.Add(q[0],q);ReadLn(l);for j:=0to 6do begin k:=Pos(' ',l+' ');q[j]:=Copy(l,1,k-1);Delete(l,1,k)end;until q[1]<>':';u:=Z.Create;j:=0;repeat k:=Pos('=',q[j]);u.Add(Copy(q[j],1,k-1),StrToInt(Copy(q[j],k+1,99)));Inc(j)until q[j]='';repeat q:=t[i];i:=q[4];u.TryGetValue(q[2],j);if q[3]='+'then Inc(j)else if j=0then i:=q[5]else Dec(j);u.AddOrSetValue(q[2],j)until i[1]='"';WriteLn(i);for v in u do Write(v.Key,'=',v.Value,' ')end.

İşte girintili ve yorumlanmış versiyon:

uses SysUtils,Generics.Collections;
type
  // P is a declaration line, offsets:
  // 0 = label
  // 1 = ':'
  // 2 = register
  // 3 = operation ('-' or '+')
  // 4 = 1st state (or message)
  // 5 = 2nd state (or message)
  P=array[0..99]of string;
  // T is a dictionary of all state lines :
  Y=TDictionary<string,P>;
  // Z is a dictionary of all registers :
  Z=TDictionary<string,Int32>;
var
  t:Y;
  l,
  i:string;
  j,
  k:Int32;
  q:P;
  u:Z;
  v:TPair<string,Int32>;
begin
  // Read all input lines :
  t:=Y.Create;
  repeat
    // Put all lines into a record
    if i=''then i:=q[0];
    t.Add(q[0],q);
    // Split up each input line on spaces :
    ReadLn(l);
    for j:=0to 6do
    begin
      k:=Pos(' ',l+' ');
      q[j]:=Copy(l,1,k-1);
      Delete(l,1,k)
    end;
    // Stop when there are no more state transitions :
  until q[1]<>':';
  // Scan initial registers :
  u:=Z.Create;
  j:=0;
  repeat
    k:=Pos('=',q[j]);
    // Add each name=value pair to a dictionary :
    u.Add(Copy(q[j],1,k-1),StrToInt(Copy(q[j],k+1,99)));
    Inc(j)
  until q[j]='';
  // Execute the state machine :
  repeat
    q:=t[i];
    i:=q[4];
    u.TryGetValue(q[2],j);
    if q[3]='+'then
      Inc(j)
    else
      if j=0then
        i:=q[5]
      else
        Dec(j);
    u.AddOrSetValue(q[2],j)
  until i[1]='"';
  WriteLn(i);
  for v in u do
    Write(v.Key,'=',v.Value,' ')
end.

1

PHP, 446 441 402 398 395 389 371 370 366 karakter

<?$t=trim;$e=explode;while($l=$t(fgets(STDIN))){if(strpos($l,"=")){foreach($e(" ",$l)as$b){list($k,$c)=$e("=",$b);$v[$k]=$c;}break;}list($k,$d)=$e(":",$l);$r[$z=$t($k)]=$t($d);$c=$c?:$z;}while($d=$e(" ",$r[$c],4)){$c=$v[$a=$d[0]]||!$d[3]?$d[2]:$d[3];if(!$r[$c]){eval("echo $c.'\n';");foreach($v as$k=>$c)echo$k."=".$c." ";die;}if(!$d[3]&&++$v[$a]||$v[$a]&&--$v[$a]);}

Ungolfed


<?php

$register = array();
$values = array();

while($line = trim(fgets(STDIN))){

    if(strpos($line, "=")){

        // Set each value and then continue to the calculations

        foreach(explode(" ", $line) as $var){
            list($key, $val) = explode("=", $var);

            $values[$key] = $val;
        }

        break;
    }

    list($key, $data) = explode(":", $line);

    // Add data to the register

    $register[$z = trim($key)] = trim($data);

    // Set the first register

    $current = $current?:$z;
}

while($data = explode(" ", $register[$current], 4)){

    // Determine next register and current register

    $current = $values[$target = $data[0]] || !$data[3]? $data[2] : $data[3];

    // Will return true if the register does not exist (Messages wont have a register)

    if(!$register[$current]){

        // No need to strip the quotes this way

        eval("echo$current.'\n';");

        // Print all values in the right formatting

        foreach($values as $key => $val)
            echo $key."=".$val." ";

        die();
    }

    // Only subtraction has a third index
    // Only positive values return true

    // If there is no third index, then increase the value
    // If there is a third index, increment the decrease the value if it is positive

    // Uses PHP's short-circuit operators

    if(!$data[3] && ++$values[$target] || $values[$target] && --$values[$target]);
}

Değişiklikler


446 -> 441 : İlk durum için dizeleri ve biraz hafif sıkıştırmayı destekler
441 -> 402 : Mümkünse sıkıştırılmış / atama ve atama ifadeleri mümkün olduğunca
402 -> 398 : İşlev isimleri, dizge olarak kullanılabilecek sabitler olarak kullanılabilir.
398 -> 395 : kısa devre operatörleri kullanır
395 -> 389 : her bir kısmı için gerek
389 -> 371 : kullanımı array_key_exists gerek yok ()
371 -> 370 : kaldırıldı gereksiz alanı
370 -> 366 : iki gereksiz boşluklar içinde kaldırıldı foreach


1

Harika, 338

m={s=r=[:];z=[:]
it.eachLine{e->((e==~/\w+=.*/)?{(e=~/((\w+)=(\d+))+/).each{r[it[2]]=it[3] as int}}:{f=(e=~/(\w+) : (.*)/)[0];s=s?:f[1];z[f[1]]=f[2];})()}
while(s[0]!='"'){p=(z[s]=~/(\w+) (.) (\w+|(?:".*?")) ?(.*)?/)[0];s=p[3];a=r[p[1]]?:0;r[p[1]]=p[2]=='-'?a?a-1:{s=p[4];0}():a+1}
println s[1..-2]+"\n"+r.collect{k,v->"$k=$v"}.join(' ')}


['''s0 : a - s1 "Ok"
s1 : b + s0
a=3 b=4''':'''Ok
a=0 b=7''',
'''init : t - init d0
d0 : a - d1 a0
d1 : b + d2
d2 : t + d0
a0 : t - a1 "Ok"
a1 : a + a0
a=3 b=4''':'''Ok
a=3 b=7 t=0''',
'''s0 : t - s0 s1
s1 : t + "t is 1"
t=17''':'''t is 1
t=1''',
'''s0 : t - "t is nonzero" "t is zero"
t=1''':'''t is nonzero
t=0''',
'''init0 : k - init1 init3
init1 : r + init2
init2 : t + init0
init3 : t - init4 init5
init4 : k + init3
init5 : r - init6 "ERROR k is 0"
init6 : i + init7
init7 : n - loop0 "ERROR n is 0"
loop0 : n - loop1 "Ok"
loop1 : i + loop2
loop2 : k - loop3 loop5
loop3 : r + loop4
loop4 : t + loop2
loop5 : t - loop6 loop7
loop6 : k + loop5
loop7 : i - loop8 loopa
loop8 : r - loop9 loopc
loop9 : t + loop7
loopa : t - loopb loop7
loopb : i + loopa
loopc : t - loopd loopf
loopd : i + loope
loope : r + loopc
loopf : i + loop0
n=40 k=3''':'''Ok
i=40 k=3 n=0 r=27 t=0'''].collect {input,expectedOutput->
    def actualOutput = m(input)
    actualOutput == expectedOutput
}

1
Bunu test ettim ama stdout'a hiçbir şey çıkmadı gibi görünüyor . Sonuçları görmek için neye ihtiyacım var? (PS, teknik özellik, çıktıdaki kayıtların sırasının önemsiz olduğunu söylüyor, bu nedenle 7 karakter kaydedebilirsiniz .sort())
Peter Taylor

@Peter, bahşiş için teşekkürler - 8 karakter eklemek zorunda kalacağım println- ah peki!
Armand

1

Clojure (344 karakter)

"Okunabilirlik" için birkaç satır aralığı ile:

(let[i(apply str(butlast(slurp *in*)))]
(loop[s(read-string i)p(->> i(replace(zipmap":\n=""[] "))(apply str)(format"{%s}")read-string)]
(let[c(p s)](cond(string? s)(println s"\n"(filter #(number?(% 1))p))
(=(c 1)'-)(let[z(=(get p(c 0)0)0)](recur(c(if z 3 2))(if z p(update-in p[(c 0)]dec))))
1(recur(c 2)(update-in p[(c 0)]#(if %(inc %)1)))))))

1

Postscript () () (852) (718)

Bu sefer gerçekler için. Tüm test durumlarını yürütür. Yine de RM programının program akışında hemen takip edilmesini gerektirir.

Düzenleme: Daha fazla faktoring, azaltılmış prosedür adları.

errordict/undefined{& " * 34 eq{.()= !{& " .(=). load " .( ).}forall ^()=
stop}{^ ^ " 0 @ : 0}ifelse}put<</^{pop}/&{dup}/:{def}/#{exch}/*{& 0
get}/.{print}/~{1 index}/"{=string cvs}/`{cvn # ^ #}/+={~ load add :}/++{1
~ length 1 sub getinterval}/S{/I where{^}{/I ~ cvx :}ifelse}/D{/? # :/_ #
cvlit :}/+{D S({//_ 1 +=//?})$ ^ :}/-{/| # : D S({//_ load 0 ne{//_ -1
+=//?}{//|}ifelse})$ ^ :}/![]/@{~/! #[# cvn ! aload length & 1 add #
roll]:}/;{(=)search ^ # ^ # cvi @ :}/${* 32 eq{++}if * 34 eq{& ++(")search
^ length 2 add 4 3 roll # 0 # getinterval cvx `}{token ^
#}ifelse}>>begin{currentfile =string readline ^( : )search{`( + )search{`
$ ^ +}{( - )search ^ ` $ $ ^ -}ifelse}{( ){search{;}{; I}ifelse}loop}ifelse}loop

Eklenmiş program ile girintili ve yorumlanmış.

%!
%Minsky Register Machine Simulation
errordict/undefined{ %replace the handler for the /undefined error
    & " * 34 eq{ % if, after conversion to string, it begins with '"',
        .()= !{ % print it, print newline, iterate through the register list
            & " .(=). load " .( ). % print regname=value
        }forall ^()= stop % print newline, END PROGRAM
    }{ % if it doesn't begin with '"', it's an uninitialized register
        ^ ^ " 0 @ : 0 %initialize register to zero, return zero
    }ifelse
}put
<<
/^{pop}
/&{dup}
/:{def} % cf FORTH
/#{exch}
/*{& 0 get} % cf C
/.{print} % cf BF

% these fragments were repeated several times
/~{1 index}
/"{=string cvs} % convert to string
/`{cvn # ^ #} % convert to name, exch, pop, exch
/+={~ load add :} % add a value to a variable
/++{1 ~ length 1 sub getinterval} % increment a "string pointer"

/S{/I where{^}{/I ~ cvx :}ifelse} %setINIT define initial state unless already done
/D{/? # :/_ # cvlit :} %sr define state and register for generated procedure
/+{D S({//_ 1 +=//?})$ ^ :} % generate an increment state and define
/-{/| # : D S({//_ load 0 ne{//_ -1 +=//?}{//|}ifelse})$ ^ :} % decrement state
/![] %REGS list of registers
/@{~/! #[# cvn ! aload length & 1 add # roll]:} %addreg append to REGS
/;{(=)search ^ # ^ # cvi @ :} %regline process a register assignment
/${ %tpe extract the next token or "string"
    * 32 eq{++}if %skip ahead if space
    * 34 eq{ %if quote, find the end-quote and snag both
        & ++(")search ^ length 2 add 4 3 roll # 0 # getinterval cvx `
    }{
        token ^ # %not a quote: pull a token, exch, pop
    }ifelse
}
>>begin

{
    currentfile =string readline ^
    ( : )search{ % if it's a state line
        `( + )search{ % if it's an increment
            ` $ ^ + %parse it
        }{
            ( - )search ^ ` $ $ ^ - %it's a decrement. Parse it
        }ifelse
    }{ % not a state, do register assignments, and call initial state
        ( ){search{;}{; I}ifelse}loop %Look Ma, no `exit`!
    }ifelse
}loop
init0 : k - init1 init3
init1 : r + init2
init2 : t + init0
init3 : t - init4 init5
init4 : k + init3
init5 : r - init6 "ERROR k is 0"
init6 : i + init7
init7 : n - loop0 "ERROR n is 0"
loop0 : n - loop1 "Ok"
loop1 : i + loop2
loop2 : k - loop3 loop5
loop3 : r + loop4
loop4 : t + loop2
loop5 : t - loop6 loop7
loop6 : k + loop5
loop7 : i - loop8 loopa
loop8 : r - loop9 loopc
loop9 : t + loop7
loopa : t - loopb loop7
loopb : i + loopa
loopc : t - loopd loopf
loopd : i + loope
loope : r + loopc
loopf : i + loop0
n=40 k=3

PostScript yazdığımdan bu yana bir süre var ama isimleri gibi isimlerle tanımlıyor reglinemusunuz? Onlara şöyle şeyler diyerek çok tasarruf edemez misin R?
Peter Taylor

Evet kesinlikle. Ancak tüm bu tanımlar devletle bir arada bulunduğundan ve isimleri aynı sözlükte kaydettirdiğinden de potansiyel bir problem var. Bu yüzden noktalama işaretlerini bazı anımsatıcı değerlerle bulmaya çalışıyorum (bu yüzden hala okuyabilirim :). Daha fazla algoritmik redüksiyon bulmayı da umuyorum, bu yüzden taze gözlerle bakmadan önce çok fazla enerji harcamak istemedim.
kullanıcı

1

AWK - 447

BEGIN{FS=":"}NF<2{split($1,x," ");for(y in x){split(x[y],q,"=");
g[q[1]]=int(q[2])}}NF>1{w=$1;l=$2;gsub(/ /,"",w);if(!a)a=w;for(i=0;;)
{sub(/^ +/,"",l);if(l=="")break;if(substr(l,1,1)=="\""){l=substr(l,2);
z=index(l,"\"")}else{z=index(l," ");z||z=length(l)+1}d[w,i++]=
substr(l,1,z-1);l=substr(l,z+1)}}END{for(;;){if(!((a,0)in d))break;h=d[a,0];
if(d[a,1]~/+/){g[h]++;a=d[a,2]}else{a=g[h]?d[a,2]:d[a,3];g[h]&&g[h]--}}
print a;for(r in g)print r"="g[r]}

Bu ilk testin çıktısıdır:

% cat | awk -f mrm1.awk
s0 : a - s1 "Ok"
s1 : b + s0
a=3 b=4
^D
Ok
a=0
b=7

1

Stax , 115 100 bayt

╥áípßNtP~£G±☼ΩtHô⌐╒╡~·7╝su9êq7h50Z`╩ë&ñ╝←j╞.½5└∩√I|ù┤╧Åτ╘8┼ç╕╒Æ►^█₧♫÷?²H½$IG☺S╚]«♀_≥å∩A+∩╣Δ└▐♫!}♥swα

Koş ve hata ayıkla

Sitemizi kullandığınızda şunları okuyup anladığınızı kabul etmiş olursunuz: Çerez Politikası ve Gizlilik Politikası.
Licensed under cc by-sa 3.0 with attribution required.