AA 折れ線グラフクイズ ５

hirofummy さんの Haskell 版を直訳気味に。なお、Squeak の Smalltalk では、ブロックを再帰できるようにするために ClosureCompiler を必要とします。ClosureCompiler のインストール方法については、id:sumim:20060210:p1 などを参考にしてください。

| blank acc graph main |

blank := [:xs | xs collect: [:each | ' ', each]].

acc := nil.
acc := [:cc :xxs :yys |
   (cc = $R and: [yys notEmpty]) ifTrue: [
      {{'/', yys first}, (blank value: xxs). blank value: yys allButFirst}] ifFalse: [
   (cc = $F and: [xxs notEmpty]) ifTrue: [
      {blank value: xxs allButFirst. {'\', xxs first}, (blank value: yys)}] ifFalse: [
   (cc = $C and: [xxs notEmpty]) ifTrue: [
      {{'_', xxs first}, (blank value: xxs allButFirst). blank value: yys}] ifFalse: [

   cc = $R ifTrue: [acc valueWithArguments: {cc. xxs. #(''), yys}] ifFalse: [
   acc valueWithArguments: {cc. #(''), xxs. yys}]]]]].

graph := [:str |
   | xsys |
   xsys := str reversed
      inject: #(() ()) into: [:rr :each | acc valueWithArguments: {each. rr first. rr last}].
   xsys first reversed, xsys last].

main := [:series | (graph value: series) do: [:each | Transcript cr; show: each]].

World findATranscript: nil.
main value: 'RCRFCRFFCCRFFRRCRRCCFRFRFF'

再帰しない版（ClosureCompiler 不要。以下も同じ）

| blank acc graph main |

blank := [:xs | xs collect: [:each | ' ', each]].

acc := [:cc :xxs :yys |
   cc = $R ifTrue: [
      yys isEmpty ifTrue: [yys := #(''), yys].
      {{'/', yys first}, (blank value: xxs). blank value: yys allButFirst}] ifFalse: [

   xxs isEmpty ifTrue: [xxs := #(''), xxs].
   cc = $F ifTrue: [
      {blank value: xxs allButFirst. {'\', xxs first}, (blank value: yys)}] ifFalse: [
   cc = $C ifTrue: [
      {{'_', xxs first}, (blank value: xxs allButFirst). blank value: yys}]]]].

graph := [:str |
   | xsys |
   xsys := str reversed
      inject: #(() ()) into: [:rr :each | acc valueWithArguments: {each. rr first. rr last}].
   xsys first reversed, xsys last].

main := [:series | (graph value: series) do: [:each | Transcript cr; show: each]].

World findATranscript: nil.
main value: 'RCRFCRFFCCRFFRRCRRCCFRFRFF'

同じ内容で、心持ち読み下しやすくした版

| addsp acc graph main |

addsp := [:lines | lines collect: [:line | ' ', line]].

acc := [:chr :upps :lows |
   chr caseOf: {
      [$R] -> [
         lows isEmpty ifTrue: [lows := #(''), lows].
         {{'/', lows first}, (addsp value: upps). addsp value: lows allButFirst}]} otherwise: [

   upps isEmpty ifTrue: [upps := #(''), upps].
   chr caseOf: {
      [$F] -> [{addsp value: upps allButFirst. {'\', upps first}, (addsp value: lows)}].
      [$C] -> [{{'_', upps first}, (addsp value: upps allButFirst). addsp value: lows}]}]].

graph := [:str |
   | results |
   results := str reversed 
      inject: #(() ()) into: [:rr :chr | acc valueWithArguments: {chr. rr first. rr last}].
   results first reversed, results last].

main := [:series | (graph value: series) do: [:each | Transcript cr; show: each]].

World findATranscript: nil.
main value: 'RCRFCRFFCCRFFRRCRRCCFRFRFF'

もう少しかみ砕いた版

| series upps lows addsp |

series := 'RCRFCRFFCCRFFRRCRRCCFRFRFF'.

upps := OrderedCollection new.
lows := OrderedCollection new.

addsp := [:lines | lines collect: [:line | ' ', line]].

series reversed do: [:chr |
   chr caseOf: {
      [$R] -> [
         lows isEmpty ifTrue: [lows add: String new].
         upps := addsp value: upps.
         upps addLast: '/', lows removeFirst.
         lows := addsp value: lows].
      [$F] -> [
         upps isEmpty ifTrue: [upps add: String new].
         lows := addsp value: lows.
         lows addFirst: '\', upps removeLast.
         upps := addsp value: upps].
      [$C] -> [
         upps isEmpty ifTrue: [upps add: String new].
         lows := addsp value: lows.
         upps := upps collectWithIndex: [:line :idx |
            (idx = upps size ifTrue: ['_'] ifFalse: [' ']), line]]}].

World findATranscript: nil.
upps, lows do: [:line | Transcript cr; show: line]

さらにクタった版

| series lines curr add newln |

series := 'RCRFCRFFCCRFFRRCRRCCFRFRFF'.

lines := OrderedCollection new.
newln := OrderedCollection new.
curr := 0.

add := [:chr | lines doWithIndex: [:line :idx |
   line addFirst: (idx = curr ifTrue: [chr] ifFalse: [Character space])]].

series reverseDo: [:code |
   code == $R
      ifTrue: [
         (curr := curr + 1) > lines size ifTrue: [lines addLast: newln copy].
         add value: $/]
      ifFalse: [
         curr = 0 ifTrue: [lines addFirst: newln copy. curr := 1].
         code caseOf: {
            [$F] -> [add value: $\. curr := curr - 1].
            [$C] -> [add value: $_]}]].

World findATranscript: nil.
lines do: [:line | Transcript cr; show: (line as: String)]

id:sumim:20060407:p1 に続く。