(** This module is a very simple parsing library for S-expressions. *)
(* Copyright (C) 2009  Florent Monnier, released under MIT license. *)

type sexpr = Atom of string | Expr of sexpr list
(** the type of S-expressions *)

val parse_string : string -> sexpr list
(** parse from a string *)

val parse_ic : in_channel -> sexpr list
(** parse from an input channel *)

val parse_file : string -> sexpr list
(** parse from a file *)

val parse : (unit -> char option) -> sexpr list
(** parse from a custom function, [None] indicates the end of the flux *)

val print_sexpr : sexpr list -> unit
(** a dump function for the type [sexpr] *)

val print_sexpr_indent : sexpr list -> unit
(** same than [print_sexpr] but with indentation *)

val string_of_sexpr : sexpr list -> string
(** convert an expression of type [sexpr] into a string *)

val string_of_sexpr_indent : sexpr list -> string
(** same than [string_of_sexpr] but with indentation *)


require random.fs
: d6 ( -- roll ) 6 random 1 + ;

variable smallest
: genstat ( -- stat )
   d6 dup smallest !
   3 0 do
     d6 dup smallest @ < if dup smallest ! then +
   loop
   smallest @ -
;

variable strong
variable total
: genstats ( -- cha wis int con dex str )
   0 strong !
   0 total !
   6 0 do
      genstat
      dup 15 >= if strong @ 1 + strong ! then
      dup total @ + total !
   loop
   total @ 75 < strong @ 2 < or if
     drop drop drop drop drop drop
     recurse
   then
;

: roll ( -- )
  genstats
  ." str:" .  ." dex:" .  ." con:" .
  ." int:" .  ." wis:" .  ." cha:" .
  ." (total:" total @ . 8 emit ." )"
;

utime drop seed !


package main

import (
    "fmt"
    "math/rand"
    "sort"
    "time"
)

func main() {
    s := rand.NewSource(time.Now().UnixNano())
    r := rand.New(s)
    for {
        var values [6]int
        vsum := 0
        for i := range values {
            var numbers [4]int
            for j := range numbers {
                numbers[j] = 1 + r.Intn(6)
            }
            sort.Ints(numbers[:])
            nsum := 0
            for _, n := range numbers[1:] {
                nsum += n
            }
            values[i] = nsum
            vsum += values[i]
        }
        if vsum < 75 {
            continue
        }
        vcount := 0
        for _, v := range values {
            if v >= 15 {
                vcount++
            }
        }
        if vcount < 2 {
            continue
        }
        fmt.Println("The 6 random numbers generated are:")
        fmt.Println(values)
        fmt.Println("\nTheir sum is", vsum, "and", vcount, "of them are >= 15")
        break
    }
}


using System.Collections.Generic;
using System.Linq;
using static System.Console;
using static System.Linq.Enumerable;

namespace RunLengthEncoding
{
    static class Program
    {
          public static string Encode(string input) => input.Length ==0 ? "" : input.Skip(1)
            .Aggregate((t:input[0].ToString(),o:Empty<string>()),
               (a,c)=>a.t[0]==c ? (a.t+c,a.o) : (c.ToString(),a.o.Append(a.t)),
               a=>a.o.Append(a.t).Select(p => (key: p.Length, chr: p[0])))
            .Select(p=> $"{p.key}{p.chr}")
            .StringConcat();

        public static string Decode(string input) => input
            .Aggregate((t: "", o: Empty<string>()), (a, c) => !char.IsDigit(c) ? ("", a.o.Append(a.t+c)) : (a.t + c,a.o)).o
            .Select(p => new string(p.Last(), int.Parse(string.Concat(p.Where(char.IsDigit)))))
            .StringConcat();

        private static string StringConcat(this IEnumerable<string> seq) => string.Concat(seq);

        public static void Main(string[] args)
        {
            const string  raw = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
            const string encoded = "12W1B12W3B24W1B14W";

            WriteLine($"raw = {raw}");
            WriteLine($"encoded = {encoded}");
            WriteLine($"Encode(raw) = encoded = {Encode(raw)}");
            WriteLine($"Decode(encode) = {Decode(encoded)}");
            WriteLine($"Decode(Encode(raw)) = {Decode(Encode(raw)) == raw}");
            ReadLine();
        }
    }
}


#!/usr/bin/perl -w
use strict;
use warnings;

sub sexpr
{
	my @stack = ([]);
	local $_ = $_[0];

	while (m{
		\G    # start match right at the end of the previous one
		\s*+  # skip whitespaces
		# now try to match any of possible tokens in THIS order:
		(?<lparen>\() |
		(?<rparen>\)) |
		(?<FLOAT>[0-9]*+\.[0-9]*+) |
		(?<INT>[0-9]++) |
		(?:"(?<STRING>([^\"\\]|\\.)*+)") |
		(?<IDENTIFIER>[^\s()]++)
		# Flags:
		#  g = match the same string repeatedly
		#  m = ^ and $ match at \n
		#  s = dot and \s matches \n
		#  x = allow comments within regex
		}gmsx)
	{
		die "match error" if 0+(keys %+) != 1;

		my $token = (keys %+)[0];
		my $val = $+{$token};

		if ($token eq 'lparen') {
			my $a = [];
			push @{$stack[$#stack]}, $a;
			push @stack, $a;
		} elsif ($token eq 'rparen') {
			pop @stack;
		} else {
			push @{$stack[$#stack]}, bless \$val, $token;
		}
	}
	return $stack[0]->[0];
}

sub quote
{ (local $_ = $_[0]) =~ /[\s\"\(\)]/s ? do{s/\"/\\\"/gs; qq{"$_"}} : $_; }

sub sexpr2txt
{
	qq{(@{[ map {
		ref($_) eq '' ? quote($_) :
		ref($_) eq 'STRING' ? quote($$_) :
		ref($_) eq 'ARRAY' ? sexpr2txt($_) : $$_
	} @{$_[0]} ]})}
}


import Control.Monad (replicateM)
import System.Random (randomRIO)
import Data.Bool (bool)
import Data.List (sort)

character :: IO [Int]
character =
  discardUntil
    (((&&) . (75 <) . sum) <*> ((2 <=) . length . filter (15 <=)))
    (replicateM 6 $ sum . tail . sort <$> replicateM 4 (randomRIO (1, 6 :: Int)))

discardUntil :: ([Int] -> Bool) -> IO [Int] -> IO [Int]
discardUntil p throw = go
  where
    go = throw >>= (<*>) (bool go . return) p

-------------------------- TEST ---------------------------
main :: IO ()
main = replicateM 10 character >>= mapM_ (print . (sum >>= (,)))


roll=: [: >: 4 6 [email protected]:$ 6:
massage=: +/ - <./
generate_attributes=: [email protected]:roll
accept=: (75 <: +/) *. (2 <: [: +/ 15&<:)
Until=: conjunction def 'u^:(0-:v)^:_'

NB. show displays discarded attribute sets
NB. and since roll ignores arguments, echo would suffice in place of show
show=: [ echo

NB. use: generate_character 'name'
generate_character=: (; (+/ ; ])@:([: [email protected]:show Until accept 0:))&>@:boxopen


#include <algorithm>
#include <array>
#include <iterator>
#include <limits>
#include <tuple>

namespace detail_ {

// For constexpr digit<->number conversions.
constexpr auto digits = std::array{'0','1','2','3','4','5','6','7','8','9'};

// Helper function to encode a run-length.
template <typename OutputIterator>
constexpr auto encode_run_length(std::size_t n, OutputIterator out)
{
    constexpr auto base = digits.size();

    // Determine the number of digits needed.
    auto const num_digits = [base](auto n)
    {
        auto d = std::size_t{1};
        while ((n /= digits.size()))
            ++d;
        return d;
    }(n);

    // Helper lambda to raise the base to an integer power.
    auto base_power = [base](auto n)
    {
        auto res = decltype(base){1};
        for (auto i = decltype(n){1}; i < n; ++i)
            res *= base;
        return res;
    };

    // From the most significant digit to the least, output the digit.
    for (auto i = decltype(num_digits){0}; i < num_digits; ++i)
        *out++ = digits[(n / base_power(num_digits - i)) % base];

    return out;
}

// Helper function to decode a run-length.
// As of C++20, this can be constexpr, because std::find() is constexpr.
// Before C++20, it can be constexpr by emulating std::find().
template <typename InputIterator>
auto decode_run_length(InputIterator first, InputIterator last)
{
    auto count = std::size_t{0};

    while (first != last)
    {
        // If the next input character is not a digit, we're done.
        auto const p = std::find(digits.begin(), digits.end(), *first);
        if (p == digits.end())
            break;

        // Convert the digit to a number, and append it to the size.
        count *= digits.size();
        count += std::distance(digits.begin(), p);

        // Move on to the next input character.
        ++first;
    }

    return std::tuple{count, first};
}

} // namespace detail_

template <typename InputIterator, typename OutputIterator>
constexpr auto encode(InputIterator first, InputIterator last, OutputIterator out)
{
    while (first != last)
    {
        // Read the next value.
        auto const value = *first++;

        // Increase the count as long as the next value is the same.
        auto count = std::size_t{1};
        while (first != last && *first == value)
        {
            ++count;
            ++first;
        }

        // Write the value and its run length.
        out = detail_::encode_run_length(count, out);
        *out++ = value;
    }

    return out;
}

// As of C++20, this can be constexpr, because std::find() and
// std::fill_n() are constexpr (and decode_run_length() can be
// constexpr, too).
// Before C++20, it can be constexpr by emulating std::find() and
// std::fill_n().
template <typename InputIterator, typename OutputIterator>
auto decode(InputIterator first, InputIterator last, OutputIterator out)
{
    while (first != last)
    {
        using detail_::digits;

        // Assume a run-length of 1, then try to decode the actual
        // run-length, if any.
        auto count = std::size_t{1};
        if (std::find(digits.begin(), digits.end(), *first) != digits.end())
            std::tie(count, first) = detail_::decode_run_length(first, last);

        // Write the run.
        out = std::fill_n(out, count, *first++);
    }

    return out;
}

template <typename Range, typename OutputIterator>
constexpr auto encode(Range&& range, OutputIterator out)
{
    using std::begin;
    using std::end;

    return encode(begin(range), end(range), out);
}

template <typename Range, typename OutputIterator>
auto decode(Range&& range, OutputIterator out)
{
    using std::begin;
    using std::end;

    return decode(begin(range), end(range), out);
}

// Sample application and checking ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

#include <iostream>
#include <string_view>

int main()
{
    using namespace std::literals;

    constexpr auto test_string = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"sv;

    std::cout << "Input:  \"" << test_string << "\"\n";
    std::cout << "Output: \"";
    // No need for a temporary string - can encode directly to cout.
    encode(test_string, std::ostreambuf_iterator<char>{std::cout});
    std::cout << "\"\n";

    auto encoded_str = std::string{};
    auto decoded_str = std::string{};
    encode(test_string, std::back_inserter(encoded_str));
    decode(encoded_str, std::back_inserter(decoded_str));

    std::cout.setf(std::cout.boolalpha);
    std::cout << "Round trip works: " << (test_string == decoded_str) << '\n';
}


with javascript_semantics
constant s_expr_str = """
((data "quoted data" 123 4.5)
 (data ([email protected]# (4.5) "(more" "data)")))"""

function skip_spaces(string s, integer sidx)
    while sidx<=length(s) and find(s[sidx],{' ','\t','\r','\n'}) do sidx += 1 end while
    return sidx
end function

function get_term(string s, integer sidx)
-- get a single quoted string, symbol, or number.
    integer ch = s[sidx]
    string res = ""
    if ch='\"' then
        res &= ch
        while 1 do
            sidx += 1
            ch = s[sidx]
            res &= ch
            if ch='\\' then
                sidx += 1
                ch = s[sidx]
                res &= ch
            elsif ch='\"' then
                sidx += 1
                exit
            end if
        end while
    else
        integer asnumber = (ch>='0' and ch<='9')
        while not find(ch,{')',' ','\t','\r','\n'}) do
            res &= ch
            sidx += 1
            if sidx>length(s) then exit end if
            ch = s[sidx]
        end while
        if asnumber then
            sequence scanres = scanf(res,"%f")
            if length(scanres)=1 then return {scanres[1][1],sidx} end if
            -- error? (failed to parse number)
        end if
    end if
    return {res,sidx}
end function

function parse_s_expr(string s, integer sidx)
    integer ch = s[sidx]
    sequence res = {}
    object element
    if ch!='(' then ?9/0 end if
    sidx += 1
    while 1 do
        sidx = skip_spaces(s,sidx)
        -- error? (if past end of string/missing ')')
        ch = s[sidx]
        if ch=')' then exit end if
        if ch='(' then
            {element,sidx} = parse_s_expr(s,sidx)
        else
            {element,sidx} = get_term(s,sidx)
        end if
        res = append(res,element)
    end while
    sidx = skip_spaces(s,sidx+1)
    return {res,sidx}
end function

sequence s_expr
integer sidx
{s_expr,sidx} = parse_s_expr(s_expr_str,1)
if sidx<=length(s_expr_str) then
    printf(1,"incomplete parse(\"%s\")\n",{s_expr_str[sidx..$]})
end if

puts(1,"\nThe string:\n")
?s_expr_str

puts(1,"\nDefault pretty printing:\n")
--?s_expr
pp(s_expr)

puts(1,"\nBespoke pretty printing:\n")
--ppEx(s_expr,{pp_Nest,1,pp_StrFmt,-1,pp_IntCh,false,pp_Brkt,"()"})
ppEx(s_expr,{pp_Nest,4,pp_StrFmt,-1,pp_IntCh,false,pp_Brkt,"()"})


import java.util.List;
import java.util.Random;
import java.util.stream.Stream;

import static java.util.stream.Collectors.toList;

public class Rpg {

    private static final Random random = new Random();

    public static int genAttribute() {
        return random.ints(1, 6 + 1) // Throw dices between 1 and 6
            .limit(4) // Do 5 throws
            .sorted() // Sort them
            .limit(3) // Take the top 3
            .sum();   // Sum them
    }

    public static void main(String[] args) {
        while (true) {
            List<Integer> stats =
                Stream.generate(Rpg::genAttribute) // Generate some stats
                    .limit(6) // Take 6
                    .collect(toList()); // Save them in an array
            int sum = stats.stream().mapToInt(Integer::intValue).sum();
            long count = stats.stream().filter(v -> v >= 15).count();
            if (count >= 2 && sum >= 75) {
                System.out.printf("The 6 random numbers generated are: %s\n", stats);
                System.out.printf("Their sum is %s and %s of them are >= 15\n", sum, count);
                return;
            }
        }
    }
}


shared void run() {

    "Takes a string such as aaaabbbbbbcc and returns 4a6b2c"
    String compress(String string) {
        if (exists firstChar = string.first) {
            if (exists index = string.firstIndexWhere((char) => char != firstChar)) {
                return "``index````firstChar````compress(string[index...])``";
            }
            else {
                return "``string.size````firstChar``";
            }
        }
        else {
            return "";
        }
    }

    "Takes a string such as 4a6b2c and returns aaaabbbbbbcc"
    String decompress(String string) =>
            let (runs = string.split(Character.letter, false).paired)
    		"".join {
        		for ([length, char] in runs)
        		if (is Integer int = Integer.parse(length))
        		char.repeat(int)
        	};

    assert (compress("aaaabbbbbaa") == "4a5b2a");
    assert (decompress("4a6b2c") == "aaaabbbbbbcc");
    assert (compress("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") == "12W1B12W3B24W1B14W");
    assert (decompress("24a") == "aaaaaaaaaaaaaaaaaaaaaaaa");
}


(defn compress [s]
  (->> (partition-by identity s) (mapcat (juxt count first)) (apply str)))

(defn extract [s]
  (->> (re-seq #"(\d+)([A-Z])" s)
       (mapcat (fn [[_ n ch]] (repeat (Integer/parseInt n) ch)))
       (apply str)))


class Symbol(string name)
{
    string _sprintf(int type)
    {
        switch(type)
        {
            case 's': return name;
            case 'O': return sprintf("(Symbol: %s)", name||"");
            case 'q': return name;
            case 't': return "Symbol";
            default:  return sprintf("%"+int2char(type), name);
        }
    }

    mixed cast(string type)
    {
        switch(type)
        {
            case "string": return name;
            default: throw(sprintf("can not cast 'Symbol' to '%s'", type));
        }
    }
}

mixed value(string token)
{
    if ((string)(int)token==token)
        return (int)token;
    array result = array_sscanf(token, "%f%s");
    if (sizeof(result) && floatp(result[0]) && ! sizeof(result[1]))
        return result[0];
    else
        return Symbol(token);
}

array tokenizer(string input)
{
    array output = ({});
    for(int i=0; i<sizeof(input); i++)
    {
        switch(input[i])
        {
            case '(': output+= ({"("}); break;
            case ')': output += ({")"}); break;
            case '"': //"
                      output+=array_sscanf(input[++i..], "%s\"%[ \t\n]")[0..0];
                      i+=sizeof(output[-1]);
                      break;
            case ' ':
            case '\t':
            case '\n': break;
            default: string token = array_sscanf(input[i..], "%s%[) \t\n]")[0];
                     output+=({ value(token) });
                     i+=sizeof(token)-1;
                     break;
        }
    }
    return output;
}

// this function is based on the logic in Parser.C.group() in the pike library;
array group(array tokens)
{
    ADT.Stack stack=ADT.Stack();
    array ret =({});

    foreach(tokens;; string token)
    {
        switch(token)
        {
            case "(": stack->push(ret); ret=({}); break;
            case ")":
                    if (!sizeof(ret) || !stack->ptr)
                    {
                      // Mismatch
                        werror ("unmatched close parenthesis\n");
                        return ret;
                    }
                    ret=stack->pop()+({ ret });
                    break;
            default: ret+=({token}); break;
        }
    }
    return ret;
}

string sexp(array input)
{
    array output = ({});
    foreach(input;; mixed item)
    {
        if (arrayp(item))
            output += ({ sexp(item) });
        else if (intp(item))
            output += ({ sprintf("%d", item) });
        else if (floatp(item))
            output += ({ sprintf("%f", item) });
        else
            output += ({ sprintf("%q", item) });
    }
    return "("+output*" "+")";
}

string input = "((data \"quoted data\" 123 4.5)\n (data ([email protected]# (4.5) \"(more\" \"data)\")))";
array data = group(tokenizer(input))[0];
string output = sexp(data);


function roll() {
  const stats = {
    total: 0,
    rolls: []
  }
  let count = 0;

  for(let i=0;i<=5;i++) {
    let d6s = [];

    for(let j=0;j<=3;j++) {
      d6s.push(Math.ceil(Math.random() * 6))
    }

    d6s.sort().splice(0, 1);
    rollTotal = d6s.reduce((a, b) => a+b, 0);

    stats.rolls.push(rollTotal);
    stats.total += rollTotal;
  }

  return stats;
}

let rolledCharacter = roll();

while(rolledCharacter.total < 75 || rolledCharacter.rolls.filter(a => a >= 15).length < 2){
  rolledCharacter = roll();
}

console.log(`The 6 random numbers generated are:
${rolledCharacter.rolls.join(', ')}

Their sum is ${rolledCharacter.total} and ${rolledCharacter.rolls.filter(a => a >= 15).length} of them are >= 15`);


roll_skip_lowest(dice, sides) = (r = rand(collect(1:sides), dice); sum(r) - minimum(r))

function rollRPGtoon()
    attributes = zeros(Int, 6)
    attsum = 0
    gte15 = 0

    while attsum < 75 || gte15 < 2
        for i in 1:6
            attributes[i] = roll_skip_lowest(4, 6)
        end
        attsum = sum(attributes)
        gte15 = mapreduce(x -> x >= 15, +, attributes)
    end

    println("New RPG character roll: $attributes. Sum is $attsum, and $gte15 are >= 15.")
end

rollRPGtoon()
rollRPGtoon()
rollRPGtoon()


       >>SOURCE FREE
IDENTIFICATION DIVISION.
PROGRAM-ID. run-length-encoding.

ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
REPOSITORY.
    FUNCTION encode
    FUNCTION decode
    .
DATA DIVISION.
WORKING-STORAGE SECTION.
01  input-str                           PIC A(100).
01  encoded                             PIC X(200).
01  decoded                             PIC X(200).

PROCEDURE DIVISION.
    ACCEPT input-str
    MOVE encode(FUNCTION TRIM(input-str)) TO encoded
    DISPLAY "Encoded: " FUNCTION TRIM(encoded)
    DISPLAY "Decoded: " FUNCTION TRIM(decode(encoded))
    .
END PROGRAM run-length-encoding.

IDENTIFICATION DIVISION.
FUNCTION-ID. encode.

DATA DIVISION.
LOCAL-STORAGE SECTION.
01  str-len                             PIC 9(3) COMP.

01  i                                   PIC 9(3) COMP.

01  current-char                        PIC A.

01  num-chars                           PIC 9(3) COMP.
01  num-chars-disp                      PIC Z(3).

01  encoded-pos                         PIC 9(3) COMP VALUE 1.

LINKAGE SECTION.
01  str                                 PIC X ANY LENGTH.

01  encoded                             PIC X(200).

PROCEDURE DIVISION USING str RETURNING encoded.
    MOVE FUNCTION LENGTH(str) TO str-len
    MOVE str (1:1) TO current-char
    MOVE 1 TO num-chars
    PERFORM VARYING i FROM 2 BY 1 UNTIL i > str-len
        IF str (i:1) <> current-char
            CALL "add-num-chars" USING encoded, encoded-pos,
                CONTENT current-char, num-chars

            MOVE str (i:1) TO current-char
            MOVE 1 TO num-chars
        ELSE
            ADD 1 TO num-chars
        END-IF
    END-PERFORM

    CALL "add-num-chars" USING encoded, encoded-pos, CONTENT current-char,
        num-chars
    .
END FUNCTION encode.

IDENTIFICATION DIVISION.
PROGRAM-ID. add-num-chars.

DATA DIVISION.
WORKING-STORAGE SECTION.
01  num-chars-disp                      PIC Z(3).

LINKAGE SECTION.
01  str                                 PIC X(200).

01  current-pos                         PIC 9(3) COMP.

01  char-to-encode                      PIC X.

01  num-chars                           PIC 9(3) COMP.

PROCEDURE DIVISION USING str, current-pos, char-to-encode, num-chars.
    MOVE num-chars TO num-chars-disp
    MOVE FUNCTION TRIM(num-chars-disp) TO str (current-pos:3)
    ADD FUNCTION LENGTH(FUNCTION TRIM(num-chars-disp)) TO current-pos
    MOVE char-to-encode TO str (current-pos:1)
    ADD 1 TO current-pos
    .
END PROGRAM add-num-chars.

IDENTIFICATION DIVISION.
FUNCTION-ID. decode.

DATA DIVISION.
LOCAL-STORAGE SECTION.
01  encoded-pos                         PIC 9(3) COMP VALUE 1.
01  decoded-pos                         PIC 9(3) COMP VALUE 1.

01  num-of-char                         PIC 9(3) COMP VALUE 0.

LINKAGE SECTION.
01  encoded                             PIC X(200).

01  decoded                             PIC X(100).

PROCEDURE DIVISION USING encoded RETURNING decoded.
    PERFORM VARYING encoded-pos FROM 1 BY 1
            UNTIL encoded (encoded-pos:2) = SPACES OR encoded-pos > 200
        IF encoded (encoded-pos:1) IS NUMERIC
            COMPUTE num-of-char = num-of-char * 10
                + FUNCTION NUMVAL(encoded (encoded-pos:1))
        ELSE
            PERFORM UNTIL num-of-char = 0
                MOVE encoded (encoded-pos:1) TO decoded (decoded-pos:1)
                ADD 1 TO decoded-pos
                SUBTRACT 1 FROM num-of-char
            END-PERFORM
        END-IF
    END-PERFORM
    .
END FUNCTION decode.


isdigit = (c): 47 < c ord and c ord < 58.
iswhitespace = (c): c ord == 10 or c ord == 13 or c == " ".

# str: a string of the form "...<nondigit>[{<symb>}]..."
# i: index to start at (must be the index of <nondigit>)
# => returns (<the symbol as a string>, <index after the last char>)
parsesymbol = (str, i) :
   datum = ()
   while (str(i) != "(" and str(i) != ")" and not iswhitespace(str(i)) and str(i) != "\"") :
      datum append(str(i++))
   .
   (datum join, i)
.

# str: a string of the form "...[<minus>]{<digit>}[<dot>{<digit>}]..."
# i: index to start at (must be the index of the first token)
# => returns (<float or int>, <index after the last digit>)
parsenumber = (str, i) :
   datum = ()
   dot = false
   while (str(i) != "(" and str(i) != ")" and not iswhitespace(str(i)) and str(i) != "\"") :
      if (str(i) == "."): dot = true.
      datum append(str(i++))
   .
   if (dot): (datum join number, i).
   else: (datum join number integer, i).
.

# str: a string of the form "...\"....\"..."
# i: index to start at (must be the index of the first quote)
# => returns (<the string>, <index after the last quote>)
parsestring = (str, i) :
   datum = ("\"")
   while (str(++i) != "\"") :
      datum append(str(i))
   .
   datum append("\"")
   (datum join, ++i)
.

# str: a string of the form "...(...)..."
# i: index to start at
# => returns (<tuple/list>, <index after the last paren>)
parselist = (str, i) :
   lst = ()
   data = ()
   while (str(i) != "("): i++.
   i++
   while (str(i) != ")") :
      if (not iswhitespace(str(i))) :
         if (isdigit(str(i)) or (str(i) == "-" and isdigit(str(i + 1)))): data = parsenumber(str, i).
         elsif (str(i) == "\""): data = parsestring(str, i).
         elsif (str(i) == "("): data = parselist(str, i).
         else: data = parsesymbol(str, i).
         lst append(data(0))
         i = data(1)
      . else :
         ++i
      .
   .
   (lst, ++i)
.

parsesexpr = (str) :
   parselist(str, 0)(0)
.

parsesexpr("(define (factorial x) \"compute factorial\" (version 2.0) (apply * (range 1 x)))") string print
"\n" print
parsesexpr("((data \"quoted data\" 123 4.5)
 (data ([email protected]# (4.5) \"(more\" \"data)\")))") string print
"\n" print


import re

dbg = False

term_regex = r'''(?mx)
    \s*(?:
        (?P<brackl>\()|
        (?P<brackr>\))|
        (?P<num>\-?\d+\.\d+|\-?\d+)|
        (?P<sq>"[^"]*")|
        (?P<s>[^(^)\s]+)
       )'''

def parse_sexp(sexp):
    stack = []
    out = []
    if dbg: print("%-6s %-14s %-44s %-s" % tuple("term value out stack".split()))
    for termtypes in re.finditer(term_regex, sexp):
        term, value = [(t,v) for t,v in termtypes.groupdict().items() if v][0]
        if dbg: print("%-7s %-14s %-44r %-r" % (term, value, out, stack))
        if   term == 'brackl':
            stack.append(out)
            out = []
        elif term == 'brackr':
            assert stack, "Trouble with nesting of brackets"
            tmpout, out = out, stack.pop(-1)
            out.append(tmpout)
        elif term == 'num':
            v = float(value)
            if v.is_integer(): v = int(v)
            out.append(v)
        elif term == 'sq':
            out.append(value[1:-1])
        elif term == 's':
            out.append(value)
        else:
            raise NotImplementedError("Error: %r" % (term, value))
    assert not stack, "Trouble with nesting of brackets"
    return out[0]

def print_sexp(exp):
    out = ''
    if type(exp) == type([]):
        out += '(' + ' '.join(print_sexp(x) for x in exp) + ')'
    elif type(exp) == type('') and re.search(r'[\s()]', exp):
        out += '"%s"' % repr(exp)[1:-1].replace('"', '\"')
    else:
        out += '%s' % exp
    return out

if __name__ == '__main__':
    sexp = ''' ( ( data "quoted data" 123 4.5)
         (data (123 (4.5) "(more" "data)")))'''

    print('Input S-expression: %r' % (sexp, ))
    parsed = parse_sexp(sexp)
    print("\nParsed to Python:", parsed)

    print("\nThen back to: '%s'" % print_sexp(parsed))


import kotlin.random.Random

fun main() {
    while (true) {
        val values = List(6) {
            val rolls = generateSequence { 1 + Random.nextInt(6) }.take(4)
            rolls.sorted().take(3).sum()
        }
        val vsum = values.sum()
        val vcount = values.count { it >= 15 }
        if (vsum < 75 || vcount < 2) continue
        println("The 6 random numbers generated are: $values")
        println("Their sum is $vsum and $vcount of them are >= 15")
        break
    }
}


#!/bin/ksh

# RPG attributes generator

#	# Variables:
#
typeset -a attribs=( strength dexterity constitution intelligence wisdom charisma )
integer MINTOT=75 MIN15S=2

#	# Functions:
#
#   # Function _diceroll(sides, number, reportAs) - roll number of side-sided
#   # dice, report (s)sum or (a)array (pseudo) of results
#
function _diceroll {
  typeset _sides    ; integer _sides=$1         # Number of sides of dice
  typeset _numDice  ; integer _numDice=$2       # Number of dice to roll
  typeset _rep      ; typeset -l -L1 _rep="$3"  # Report type: (sum || array)

  typeset _seed    ; (( _seed = SECONDS / $$ )) ; _seed=${_seed#*\.}
  typeset _i _sum  ; integer _i _sum=0
  typeset _arr     ; typeset -a _arr

  RANDOM=${_seed}
  for (( _i=0; _i<_numDice; _i++ )); do
      (( _arr[_i] = (RANDOM % _sides) + 1 ))
      [[ ${_rep} == s ]] && (( _sum += _arr[_i] ))
  done

    if [[ ${_rep} == s ]]; then
      echo ${_sum}
    else
      echo "${_arr[@]}"
    fi
}

#	# Function _sumarr(n arr) - Return the sum of the first n arr elements
#
function _sumarr {
	typeset _n ; integer _n=$1
	typeset _arr ; nameref _arr="$2"
	typeset _i _sum ; integer _i _sum

	for ((_i=0; _i<_n; _i++)); do
		(( _sum+=_arr[_i] ))
	done
	echo ${_sum}
}

 ######
# main #
 ######

until (( total >= MINTOT )) && (( cnt15 >= MIN15S )); do
	integer total=0 cnt15=0
	unset attrval ; typeset -A attrval
	for attr in ${attribs[*]}; do
		unset darr ; typeset -a darr=( $(_diceroll 6 4 a) )
		set -sK:nr -A darr
		attrval[${attr}]=$(_sumarr 3 darr)
		(( total += attrval[${attr}] ))
		(( attrval[${attr}] > 14 )) && (( cnt15++ ))
	done
done

for attr in ${attribs[*]}; do
	printf "%12s: %2d\n" ${attr} ${attrval[${attr}]}
done
print "Attribute value total: ${total}"
print "Attribule count >= 15:  ${cnt15}"


valid = False;
While[! valid,
 try = Map[Total[TakeLargest[#, 3]] &,
   RandomInteger[{1, 6}, {6, 4}]];
 If[Total[try] > 75 && Count[try, _?(GreaterEqualThan[15])] >= 2,
  valid = True;
  ]
 ]
{Total[try], try}


encode = (str) ->
    str.replace /(.)\1*/g, (w) ->
        w[0] + w.length

decode = (str) ->
    str.replace /(.)(\d+)/g, (m,w,n) ->
        new Array(+n+1).join(w)

console.log s = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
console.log encode s
console.log decode encode s


(defun group-similar (sequence &key (test 'eql))
  (loop for x in (rest sequence)
        with temp = (subseq sequence 0 1)
        if (funcall test (first temp) x)
          do (push x temp)
        else
          collect temp
          and do (setf temp (list x))))

(defun run-length-encode (sequence)
  (mapcar (lambda (group) (list (first group) (length group)))
          (group-similar (coerce sequence 'list))))

(defun run-length-decode (sequence)
  (reduce (lambda (s1 s2) (concatenate 'simple-string s1 s2))
          (mapcar (lambda (elem)
                    (make-string (second elem)
                                 :initial-element
                                 (first elem)))
                  sequence)))

(run-length-encode "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
(run-length-decode '((#\W 12) (#\B 1) (#\W 12) (#\B 3) (#\W 24) (#\B 1)))


#lang racket
(define input
#<<---
((data "quoted data" 123 4.5)
 (data ([email protected]# (4.5) "(more" "data)")))
---
  )

(read (open-input-string input))


grammar S-Exp {
  rule TOP    {^ <s-list> $};

  token s-list { '(' ~ ')' [ <in_list>+ % [\s+] | '' ] }
  token in_list { <s-token> | <s-list> }

  proto token s-token {*}
  token s-token:sym<Num>    {\d*\.?\d+}
  token s-token:sym<String> {'"' ['\"' |<-[\\"]>]*? '"'} #'
  token s-token:sym<Atom>   {<-[()\s]>+}

}

# The Actions class, for each syntactic rule there is a method
# that stores some data in the abstract syntax tree with make
class S-Exp::ACTIONS {
  method TOP ($/) {make $<s-list>.ast}
  method s-list ($/) {make [$<in_list>».ast]}
  method in_list ($/) {make $/.values[0].ast}

  method s-token:sym<Num> ($/){make +$/}
  method s-token:sym<String> ($/){make ~$/.substr(1,*-1)}
  method s-token:sym<Atom> ($/){make ~$/}
}

multi s-exp_writer (Positional $ary) {'(' ~ $ary.map(&s-exp_writer).join(' ') ~ ')'}
multi s-exp_writer (Numeric    $num) {~$num}
multi s-exp_writer (Str        $str) {
  return $str unless $str ~~ /<[(")]>|\s/;
  return '()' if $str eq '()';
  '"' ~ $str.subst('"', '\"' ) ~ '"';
}

my $s-exp = '((data "quoted data" 123 4.5)
 (data ([email protected]# (4.5) "(more" "data)")))';

my $actions = S-Exp::ACTIONS.new();
my $raku_array = (S-Exp.parse($s-exp, :$actions)).ast;

say "the expression:\n$s-exp\n";
say "the Raku expression:\n{$raku_array.raku}\n";
say "and back:\n{s-exp_writer($raku_array)}";


randomize   ; Seed the rng with current timestamp.

; Implement some general operators we'll need that aren't in the library.
(() 0 shorten) :new
((new (over -> swons)) dip times nip) :replicate
(('' '' '') => spread if) :if?
((1 0 if?) concat map sum) :count

(5 random succ) :d6                                  ; Roll a 1d6.
('d6 4 replicate '< sort 3 take sum) :attr           ; Roll an attribute.
('attr 6 replicate) :attrs                           ; Roll 6 attributes.
(sum 75 >=) :big?                                    ; Is a set of attributes "big?"
(attrs (dup big?) () (pop attrs) () linrec) :big     ; Roll a set of big attributes.
((15 >=) count 2 >=) :special?                       ; Is a set of atributes "special?"
(big (dup special?) () (pop big) () linrec) :stats   ; Roll a set of big and special attributes.

stats puts "Total: " print! sum puts!


roll = function()
    results = []
    for i in range(0,3)
        results.push ceil(rnd * 6)
    end for
    results.sort
    results.remove 0
    return results.sum
end function

while true
    attributes = []
    gt15 = 0    // (how many attributes > 15)
    for i in range(0,5)
        attributes.push roll
        if attributes[i] > 15 then gt15 = gt15 + 1
    end for

    print "Attribute values: " + attributes.join(", ")
    print "Attributes total:  " + attributes.sum

    if attributes.sum >= 75 and gt15 >= 2 then break
    print "Attributes failed, rerolling"
    print
end while
print "Success!"


# Import "random" to get random numbers and "algorithm" to get sorting functions for arrays.
import random, algorithm

randomize()

proc diceFourRolls(): array[4, int] =
  ## Generates 4 random values between 1 and 6.
  for i in 0 .. 3:
    result[i] = rand(1..6)

proc sumRolls(rolls: array[4, int]): int =
  ## Save the sum of the 3 highest values rolled.
  var sorted = rolls
  sorted.sort()
  # By sorting first and then starting the iteration on 1 instead of 0, the lowest number is discarded even if it is repeated.
  for i in 1 .. 3:
    result += sorted[i]

func twoFifteens(attr: var array[6, int]): bool =
  attr.sort()
  # Sorting implies than the second to last number is lesser than or equal to the last.
  if attr[4] < 15: false else: true

var sixAttr: array[6, int]

while true:
  var sumAttr = 0
  for i in 0 .. 5:
    sixAttr[i] = sumRolls(diceFourRolls())
    sumAttr += sixAttr[i]
  echo "The roll sums are, in order: ", sixAttr, ", which adds to ", sumAttr
  if not twoFifteens(sixAttr) or sumAttr < 75: echo "Not good enough. Rerolling..."
  else: break


import std.algorithm, std.array;

alias encode = group;

auto decode(Group!("a == b", string) enc) {
    return enc.map!(t => [t[0]].replicate(t[1])).join;
}

void main() {
    immutable s = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWW" ~
                  "WWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
    assert(s.encode.decode.equal(s));
}


rle:
	if not dup:
		drop
		return []

	swap ]

	local :source chars
	pop-from source
	1
	for c in source:
		if = c over:
			++
		else:
			1 c &
	&
	return [

rld:
	)
	for pair in swap:
		repeat &< pair:
			&> pair
	concat(

rle "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
!. dup
!. rld


/*REXX program  parses  an   S-expression   and  displays the results to the terminal.  */
input= '((data "quoted data" 123 4.5) (data ([email protected]# (4.5) "(more" "data)")))'
say center('input', length(input), "═")          /*display the header title to terminal.*/
say         input                                /*   "     "  input data    "    "     */
say copies('═',     length(input) )              /*   "     "  header sep    "    "     */
grpO.=;      grpO.1 = '{'   ;    grpC.1 = "}"    /*pair of grouping symbol: braces      */
             grpO.2 = '['   ;    grpC.2 = "]"    /*  "   "    "       "     brackets    */
             grpO.3 = '('   ;    grpC.3 = ")"    /*  "   "    "       "     parentheses */
             grpO.4 = '«'   ;    grpC.4 = "»"    /*  "   "    "       "     guillemets  */
q.=;            q.1 = "'"   ;       q.2 = '"'    /*1st and 2nd literal string delimiter.*/
#        = 0                                     /*the number of tokens found (so far). */
tabs     = 10                                    /*used for the indenting of the levels.*/
seps     = ',;'                                  /*characters used for separation.      */
atoms    = ' 'seps                               /*     "       "  to  separate atoms.  */
level    = 0                                     /*the current level being processed.   */
quoted   = 0                                     /*quotation level  (for nested quotes).*/
grpU     =                                       /*used to go   up  an expression level.*/
grpD     =                                       /*  "   "  "  down  "     "       "    */
@.=;        do n=1  while grpO.n\==''
            atoms = atoms || grpO.n || grpC.n    /*add Open and Closed groups to  ATOMS.*/
            grpU  = grpU  || grpO.n              /*add Open            groups to  GRPU, */
            grpD  = grpD  || grpC.n              /*add          Closed groups to  GRPD, */
            end   /*n*/                          /* [↑]  handle a bunch of grouping syms*/
literals=
            do k=1  while q.k\=='';  literals= literals || q.k  /*add literal delimiters*/
            end   /*k*/
!=;                                      literalStart=
      do j=1  to length(input);          $= substr(input, j, 1)                              /* ◄■■■■■text parsing*/
                                                                                /* ◄■■■■■text parsing*/
      if quoted                then do;  !=! || $;    if $==literalStart  then quoted= 0     /* ◄■■■■■text parsing*/
                                         iterate                                             /* ◄■■■■■text parsing*/
                                    end          /* [↑]  handle running  quoted string. */   /* ◄■■■■■text parsing*/
                                                                                /* ◄■■■■■text parsing*/
      if pos($, literals)\==0  then do;  literalStart= $;      != ! || $;        quoted= 1   /* ◄■■■■■text parsing*/
                                         iterate                                             /* ◄■■■■■text parsing*/
                                    end          /* [↑]  handle start of quoted strring.*/   /* ◄■■■■■text parsing*/
                                                                                /* ◄■■■■■text parsing*/
      if pos($, atoms)==0      then do;  != ! || $;   iterate;   end    /*is    an atom?*/   /* ◄■■■■■text parsing*/
                               else do;  call add!;   != $;      end    /*isn't  "   " ?*/   /* ◄■■■■■text parsing*/
                                                                                /* ◄■■■■■text parsing*/
      if pos($, literals)==0   then do;  if pos($, grpU)\==0  then level= level + 1          /* ◄■■■■■text parsing*/
                                         call add!                                           /* ◄■■■■■text parsing*/
                                         if pos($, grpD)\==0  then level= level - 1          /* ◄■■■■■text parsing*/
                                         if level<0  then say  'error, mismatched'   $       /* ◄■■■■■text parsing*/
                                    end                                                      /* ◄■■■■■text parsing*/
      end   /*j*/                                                                            /* ◄■■■■■text parsing*/
                                                                                /* ◄■■■■■text parsing*/
call add!                                        /*process any residual tokens.         */   /* ◄■■■■■text parsing*/
if level\==0  then say  'error, mismatched grouping symbol'                                  /* ◄■■■■■text parsing*/
if quoted     then say  'error, no end of quoted literal'      literalStart                  /* ◄■■■■■text parsing*/

      do m=1  for #;   say @.m                   /*display the tokens  ───►  terminal.  */
      end   /*m*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
add!: if !=''  then return;   #=#+1;  @.#=left("", max(0, tabs*(level-1)))!;  !=;   return


(* Task : RPG_attributes_generator *)

(*
	A programmatic solution to generating character attributes for an RPG
*)

(* Generates random whole values between 1 and 6. *)
let rand_die () : int = Random.int 6

(* Generates 4 random values and saves the sum of the 3 largest *)
let rand_attr () : int =
	let four_rolls = [rand_die (); rand_die (); rand_die (); rand_die ()]
		|> List.sort compare in
	let three_best = List.tl four_rolls in
	List.fold_left (+) 0 three_best

(* Generates a total of 6 values this way. *)
let rand_set () : int list=
	[rand_attr (); rand_attr (); rand_attr ();
	rand_attr (); rand_attr (); rand_attr ()]

(* Verifies conditions: total >= 75, at least 2 >= 15 *)
let rec valid_set () : int list=
	let s = rand_set () in
	let above_15 = List.fold_left (fun acc el -> if el >= 15 then acc + 1 else acc) 0 s in
	let total = List.fold_left (+) 0 s in
	if above_15 >= 2 && total >= 75
	then s
	else valid_set ()

(*** Output ***)

let _ =
	let s = valid_set () in
	List.iter (fun i -> print_int i; print_string ", ") s


program attributes;

var
   total, roll,score, count: integer;
   atribs : array [1..6] of integer;

begin
    randomize; {Initalise the random number genertor}
    repeat
        count:=0;
        total:=0;
        for score :=1 to 6 do begin
           {roll:=random(18)+1;   produce a number up to 18, pretty much the same results}
           for diceroll:=1 to 4 do dice[diceroll]:=random(6)+1; {roll 4 six sided die}

           {find lowest rolled dice. If we roll two or more equal low rolls then we
	    eliminate the first of them, change '<' to '<=' to eliminate last low die}
           lowroll:=7;
	   lowdie:=0;
	   for diceroll:=1 to 4 do if (dice[diceroll] < lowroll) then begin
	       lowroll := dice[diceroll];
	       lowdie := diceroll;
	   end;
           {add up higest three dice}
	   roll:=0;
	   for diceroll:=1 to 4 do if (diceroll <> lowdie) then roll := roll + dice[diceroll];
           atribs[score]:=roll;
           total := total + roll;
           if (roll>15) then count:=count+1;
        end;
   until ((total>74) and (count>1)); {this evens out different rolling methods }
   { Prettily print the attributes out }
   writeln('Attributes :');
   for count:=1 to 6 do
      writeln(count,'.......',atribs[count]:2);
   writeln('       ---');
   writeln('Total  ',total:3);
   writeln('       ---');
end.


program RunLengthTest;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

type
  TRLEPair = record
    count: Integer;
    letter: Char;
  end;

  TRLEncoded = TArray<TRLEPair>;

  TRLEncodedHelper = record helper for TRLEncoded
  public
    procedure Clear;
    function Add(c: Char): Integer;
    procedure Encode(Data: string);
    function Decode: string;
    function ToString: string;
  end;

{ TRLEncodedHelper }

function TRLEncodedHelper.Add(c: Char): Integer;
begin
  SetLength(self, length(self) + 1);
  Result := length(self) - 1;
  with self[Result] do
  begin
    count := 1;
    letter := c;
  end;
end;

procedure TRLEncodedHelper.Clear;
begin
  SetLength(self, 0);
end;

function TRLEncodedHelper.Decode: string;
var
  p: TRLEPair;
begin
  Result := '';
  for p in Self do
    Result := Result + string.Create(p.letter, p.count);
end;

procedure TRLEncodedHelper.Encode(Data: string);
var
  pivot: Char;
  i, index: Integer;
begin
  Clear;
  if Data.Length = 0 then
    exit;

  pivot := Data[1];
  index := Add(pivot);

  for i := 2 to Data.Length do
  begin
    if pivot = Data[i] then
      inc(self[index].count)
    else
    begin
      pivot := Data[i];
      index := Add(pivot);
    end;
  end;
end;

function TRLEncodedHelper.ToString: string;
var
  p: TRLEPair;
begin
  Result := '';
  for p in Self do
    Result := Result + p.count.ToString + p.letter;
end;

const
  Input = 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW';

var
  Data: TRLEncoded;

begin
  Data.Encode(Input);
  Writeln(Data.ToString);
  writeln(Data.Decode);
  Readln;
end.


class SExpr
  def initialize(str)
    @original = str
    @data = parse_sexpr(str)
  end
  attr_reader :data, :original

  def to_sexpr
    @data.to_sexpr
  end

  private

  def parse_sexpr(str)
    state = :token_start
    tokens = []
    word = ""
    str.each_char do |char|
      case state

      when :token_start
        case char
        when "("
          tokens << :lbr
        when ")"
          tokens << :rbr
        when /\s/
          # do nothing, just consume the whitespace
        when  '"'
          state = :read_quoted_string
          word = ""
        else
          state = :read_string_or_number
          word = char
        end

      when :read_quoted_string
        case char
        when '"'
          tokens << word
          state = :token_start
        else
          word << char
        end

      when :read_string_or_number
        case char
        when /\s/
          tokens << symbol_or_number(word)
          state = :token_start
        when ')'
          tokens << symbol_or_number(word)
          tokens << :rbr
          state = :token_start
        else
          word << char
        end
      end
    end

    sexpr_tokens_to_array(tokens)
  end

  def symbol_or_number(word)
    Integer(word)
  rescue ArgumentError
    begin
      Float(word)
    rescue ArgumentError
      word.to_sym
    end
  end

  def sexpr_tokens_to_array(tokens, idx = 0)
    result = []
    while idx < tokens.length
      case tokens[idx]
      when :lbr
        tmp, idx = sexpr_tokens_to_array(tokens, idx + 1)
        result << tmp
      when :rbr
        return [result, idx]
      else
        result << tokens[idx]
      end
      idx += 1
    end
    result[0]
  end
end

class Object
  def to_sexpr
    self
  end
end

class String
  def to_sexpr
    self.match(/[\s()]/) ? self.inspect : self
  end
end

class Symbol
  alias :to_sexpr :to_s
end

class Array
  def to_sexpr
    "(%s)" % inject([]) {|a, elem| a << elem.to_sexpr}.join(" ")
  end
end

sexpr = SExpr.new <<END
((data "quoted data" 123 4.5)
 (data ([email protected]# (4.5) "(more" "data)")))
END

puts "original sexpr:\n#{sexpr.original}"
puts "\nruby data structure:\n#{sexpr.data}"
puts "\nand back to S-Expr:\n#{sexpr.to_sexpr}"


use strict;
use List::Util 'sum';

my ($min_sum, $hero_attr_min, $hero_count_min) = <75 15 3>;
my @attr_names = <Str Int Wis Dex Con Cha>;

sub heroic { scalar grep { $_ >= $hero_attr_min } @_ }

sub roll_skip_lowest {
    my($dice, $sides) = @_;
    sum( (sort map { 1 + int rand($sides) } 1..$dice)[1..$dice-1] );
}

my @attr;
do {
    @attr = map { roll_skip_lowest(6,4) } @attr_names;
} until sum(@attr) >= $min_sum and heroic(@attr) >= $hero_count_min;

printf "%s = %2d\n", $attr_names[$_], $attr[$_] for 0..$#attr;
printf "Sum = %d, with %d attributes >= $hero_attr_min\n", sum(@attr), heroic(@attr);


with javascript_semantics
sequence numbers = repeat(0,6)
integer t,n
while true do
    for i=1 to length(numbers) do
        sequence ni = sq_rand(repeat(6,4))
        numbers[i] = sum(ni)-min(ni)
    end for
    t = sum(numbers)
    n = sum(sq_ge(numbers,15))
    if t>=75 and n>=2 then exit end if
    ?"re-rolling..."  -- (occasionally >20)
end while
printf(1,"The 6 attributes generated are:\n")
printf(1,"strength %d, dexterity %d, constitution %d, "&
         "intelligence %d, wisdom %d, and charisma %d.\n",
         numbers)
printf(1,"\nTheir sum is %d and %d of them are >=15\n",{t,n})


def rle(string) {
  var seen := null
  var count := 0
  var result := []
  def put() {
    if (seen != null) {
      result with= [count, seen]
    }
  }
  for ch in string {
    if (ch != seen) {
      put()
      seen := ch
      count := 0
    }
    count += 1
  }
  put()
  return result
}

def unrle(coded) {
  var result := ""
  for [count, ch] in coded {
    result += E.toString(ch) * count
  }
  return result
}


import system'text;
import system'routines;
import extensions;
import extensions'text;

singleton compressor
{
    string compress(string s)
    {
        auto  tb := new TextBuilder();
        int count := 0;
        char current := s[0];
        s.forEach:(ch)
        {
            if (ch == current)
            {
                count += 1
            }
            else
            {
                tb.writeFormatted("{0}{1}",count,current);
                count := 1;
                current := ch
            }
        };

        tb.writeFormatted("{0}{1}",count,current);

        ^ tb
    }

    string decompress(string s)
    {
        auto tb := new TextBuilder();
        char current := $0;
        var a := new StringWriter();
        s.forEach:(ch)
        {
            current := ch;
            if (current.isDigit())
            {
                a.append(ch)
            }
            else
            {
                int count := a.toInt();
                a.clear();

                tb.fill(current,count)
            }
        };

        ^ tb
    }
}

public program()
{
    var s := "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";

    s := compressor.compress(s);
    console.printLine(s);

    s := compressor.decompress(s);
    console.printLine(s)
}


//! This implementation isn't based on anything in particular, although it's probably informed by a
//! lot of Rust's JSON encoding code.  It should be very fast (both encoding and decoding the toy
//! example here takes under a microsecond on my machine) and tries to avoid unnecessary allocation.
//!
//! In a real implementation, most of this would be private, with only a few visible functions, and
//! there would be somewhat nicer signatures (in particular, the fact that `ParseContext` has to be
//! mutable would get annoying in real code pretty quickly, so it would probably be split out).
//!
//! It supports the ability to read individual atoms, not just lists, although whether this is
//! useful is questionable.
//!
//! Caveats: Does not support symbols vs. non-symbols (it wouldn't be hard, but it would greatly
//! complicate setting up our test structure since we'd have to force it to go through functions
//! that checked to make sure `Symbol`s couldn't have spaces, or slow down our parser by checking
//! for this information each time, which is obnoxious).  Does not support string escaping, because
//! the decoding technique doesn't allocate extra space for strings.  Does support numbers, but
//! only float types (supporting more types is possible but would complicate the code
//! significantly).

extern crate typed_arena;

use typed_arena::Arena;

use self::Error::*;
use self::SExp::*;
use self::Token::*;
use std::io;
use std::num::FpCategory;
use std::str::FromStr;

/// The actual `SExp` structure.  Supports `f64`s, lists, and string literals.  Note that it takes
/// everything by reference, rather than owning it--this is mostly done just so we can allocate
/// `SExp`s statically (since we don't have to call `Vec`).  It does complicate the code a bit,
/// requiring us to have a `ParseContext` that holds an arena where lists are actually allocated.
#[derive(PartialEq, Debug)]
pub enum SExp<'a> {
    /// Float literal: 0.5
    F64(f64),

    /// List of SExps: ( a b c)
    List(&'a [SExp<'a>]),

    /// Plain old string literal: "abc"
    Str(&'a str),
}

/// Errors that can be thrown by the parser.
#[derive(PartialEq, Debug)]
pub enum Error {
    /// If the float is `NaN`, `Infinity`, etc.
    NoReprForFloat,

    /// Missing an end double quote during string parsing
    UnterminatedStringLiteral,

    /// Some other kind of I/O error
    Io,

    /// ) appeared where it shouldn't (usually as the first token)
    IncorrectCloseDelimiter,

    /// Usually means a missing ), but could also mean there were no tokens at all.
    UnexpectedEOF,

    /// More tokens after the list is finished, or after a literal if there is no list.
    ExpectedEOF,
}

impl From<io::Error> for Error {
    fn from(_err: io::Error) -> Error {
        Error::Io
    }
}

/// Tokens returned from the token stream.
#[derive(PartialEq, Debug)]
enum Token<'a> {
    /// Left parenthesis
    ListStart,

    /// Right parenthesis
    ListEnd,

    /// String or float literal, quotes removed.
    Literal(SExp<'a>),

    /// Stream is out of tokens.
    Eof,
}

/// An iterator over a string that yields a stream of Tokens.
///
/// Implementation note: it probably seems weird to store first, rest, AND string, since they should
/// all be derivable from string.  But see below.
#[derive(Copy, Clone, Debug)]
struct Tokens<'a> {
    /// The part of the string that still needs to be parsed
    string: &'a str,

    /// The first character to parse
    first: Option<char>,

    /// The rest of the string after the first character
    rest: &'a str,
}

impl<'a> Tokens<'a> {
    /// Initialize a token stream for a given string.
    fn new(string: &str) -> Tokens {
        let mut chars = string.chars();

        match chars.next() {
            Some(ch) => Tokens {
                string,
                first: Some(ch),
                rest: chars.as_str(),
            },
            None => Tokens {
                string,
                first: None,
                rest: string,
            },
        }
    }

    /// Utility function to update information in the iterator.  It might not be performant to keep
    /// rest cached, but there are times where we don't know exactly what string is (at least, not
    /// in a way that we can *safely* reconstruct it without allocating), so we keep both here.
    /// With some unsafe code we could probably get rid of one of them (and maybe first, too).
    fn update(&mut self, string: &'a str) {
        self.string = string;
        let mut chars = self.string.chars();

        if let Some(ch) = chars.next() {
            self.first = Some(ch);
            self.rest = chars.as_str();
        } else {
            self.first = None;
        };
    }

    /// This is where the lexing happens.  Note that it does not handle string escaping.
    fn next_token(&mut self) -> Result<Token<'a>, Error> {
        loop {
            match self.first {
                // List start
                Some('(') => {
                    self.update(self.rest);
                    return Ok(ListStart);
                }
                // List end
                Some(')') => {
                    self.update(self.rest);
                    return Ok(ListEnd);
                }
                // Quoted literal start
                Some('"') => {
                    // Split the string at most once.  This lets us get a
                    // reference to the next piece of the string without having
                    // to loop through the string again.
                    let mut iter = self.rest.splitn(2, '"');
                    // The first time splitn is run it will never return None, so this is safe.
                    let str = iter.next().unwrap();
                    match iter.next() {
                        // Extract the interior of the string without allocating.  If we want to
                        // handle string escaping, we would have to allocate at some point though.
                        Some(s) => {
                            self.update(s);
                            return Ok(Literal(Str(str)));
                        }
                        None => return Err(UnterminatedStringLiteral),
                    }
                }
                // Plain old literal start
                Some(c) => {
                    // Skip whitespace.  This could probably be made more efficient.
                    if c.is_whitespace() {
                        self.update(self.rest);
                        continue;
                    }
                    // Since we've exhausted all other possibilities, this must be a real literal.
                    // Unlike the quoted case, it's not an error to encounter EOF before whitespace.
                    let mut end_ch = None;
                    let str = {
                        let mut iter = self.string.splitn(2, |ch: char| {
                            let term = ch == ')' || ch == '(';
                            if term {
                                end_ch = Some(ch)
                            }
                            term || ch.is_whitespace()
                        });
                        // The first time splitn is run it will never return None, so this is safe.
                        let str = iter.next().unwrap();
                        self.rest = iter.next().unwrap_or("");
                        str
                    };
                    match end_ch {
                        // self.string will be incorrect in the Some(_) case.  The only reason it's
                        // okay is because the next time next() is called in this case, we know it
                        // will be '(' or ')', so it will never reach any code that actually looks
                        // at self.string.  In a real implementation this would be enforced by
                        // visibility rules.
                        Some(_) => self.first = end_ch,
                        None => self.update(self.rest),
                    }
                    return Ok(Literal(parse_literal(str)));
                }
                None => return Ok(Eof),
            }
        }
    }
}

/// This is not the most efficient way to do this, because we end up going over numeric literals
/// twice, but it avoids having to write our own number parsing logic.
fn parse_literal(literal: &str) -> SExp {
    match literal.bytes().next() {
        Some(b'0'..=b'9') | Some(b'-') => match f64::from_str(literal) {
            Ok(f) => F64(f),
            Err(_) => Str(literal),
        },
        _ => Str(literal),
    }
}

/// Parse context, holds information required by the parser (and owns any allocations it makes)
pub struct ParseContext<'a> {
    /// The string being parsed.  Not required, but convenient.
    string: &'a str,

    /// Arena holding any allocations made by the parser.
    arena: Option<Arena<Vec<SExp<'a>>>>,

    /// Stored in the parse context so it can be reused once allocated.
    stack: Vec<Vec<SExp<'a>>>,
}

impl<'a> ParseContext<'a> {
    /// Create a new parse context from a given string
    pub fn new(string: &'a str) -> ParseContext<'a> {
        ParseContext {
            string,
            arena: None,
            stack: Vec::new(),
        }
    }
}

impl<'a> SExp<'a> {
    /// Serialize a SExp.
    fn encode<T: io::Write>(&self, writer: &mut T) -> Result<(), Error> {
        match *self {
            F64(f) => {
                match f.classify() {
                    // We don't want to identify NaN, Infinity, etc. as floats.
                    FpCategory::Normal | FpCategory::Zero => {
                        write!(writer, "{}", f)?;
                        Ok(())
                    }
                    _ => Err(Error::NoReprForFloat),
                }
            }
            List(l) => {
                // Writing a list is very straightforward--write a left parenthesis, then
                // recursively call encode on each member, and then write a right parenthesis.  The
                // only reason the logic is as long as it is is to make sure we don't write
                // unnecessary spaces between parentheses in the zero or one element cases.
                write!(writer, "(")?;
                let mut iter = l.iter();
                if let Some(sexp) = iter.next() {
                    sexp.encode(writer)?;
                    for sexp in iter {
                        write!(writer, " ")?;
                        sexp.encode(writer)?;
                    }
                }
                write!(writer, ")")?;
                Ok(())
            }
            Str(s) => {
                write!(writer, "\"{}\"", s)?;
                Ok(())
            }
        }
    }

    /// Deserialize a SExp.
    pub fn parse(ctx: &'a mut ParseContext<'a>) -> Result<SExp<'a>, Error> {
        ctx.arena = Some(Arena::new());
        // Hopefully this unreachable! gets optimized out, because it should literally be
        // unreachable.
        let arena = match ctx.arena {
            Some(ref mut arena) => arena,
            None => unreachable!(),
        };
        let ParseContext {
            string,
            ref mut stack,
            ..
        } = *ctx;
        // Make sure the stack is cleared--we keep it in the context to avoid unnecessary
        // reallocation between parses (if you need to remember old parse information for a new
        // list, you can pass in a new context).
        stack.clear();
        let mut tokens = Tokens::new(string);
        // First, we check the very first token to see if we're parsing a full list.  It
        // simplifies parsing a lot in the subsequent code if we can assume that.
        let next = tokens.next_token();
        let mut list = match next? {
            ListStart => Vec::new(),
            Literal(s) => {
                return if tokens.next_token()? == Eof {
                    Ok(s)
                } else {
                    Err(ExpectedEOF)
                };
            }
            ListEnd => return Err(IncorrectCloseDelimiter),
            Eof => return Err(UnexpectedEOF),
        };

        // We know we're in a list if we got this far.
        loop {
            let tok = tokens.next_token();
            match tok? {
                ListStart => {
                    // We push the previous context onto our stack when we start reading a new list.
                    stack.push(list);
                    list = Vec::new()
                }
                Literal(s) => list.push(s), // Plain old literal, push it onto the current list
                ListEnd => {
                    match stack.pop() {
                        // Pop the old context off the stack on list end.
                        Some(mut l) => {
                            // We allocate a slot for the current list in our parse context (needed
                            // for safety) before pushing it onto its parent list.
                            l.push(List(&*arena.alloc(list)));
                            // Now reset the current list to the parent list
                            list = l;
                        }
                        // There was nothing on the stack, so we're at the end of the topmost list.
                        // The check to make sure there are no more tokens is required for
                        // correctness.
                        None => {
                            return match tokens.next_token()? {
                                Eof => Ok(List(&*arena.alloc(list))),
                                _ => Err(ExpectedEOF),
                            };
                        }
                    }
                }
                // We encountered an EOF before the list ended--that's an error.
                Eof => return Err(UnexpectedEOF),
            }
        }
    }

    /// Convenience method for the common case where you just want to encode a SExp as a String.
    pub fn buffer_encode(&self) -> Result<String, Error> {
        let mut m = Vec::new();
        self.encode(&mut m)?;
        // Because encode() only ever writes valid UTF-8, we can safely skip the secondary check we
        // normally have to do when converting from Vec<u8> to String.  If we didn't know that the
        // buffer was already UTF-8, we'd want to call container_as_str() here.
        unsafe { Ok(String::from_utf8_unchecked(m)) }
    }
}

pub const SEXP_STRUCT: SExp<'static> = List(&[
    List(&[Str("data"), Str("quoted data"), F64(123.), F64(4.5)]),
    List(&[
        Str("data"),
        List(&[Str("[email protected]#"), List(&[F64(4.5)]), Str("(more"), Str("data)")]),
    ]),
]);

pub const SEXP_STRING_IN: &str = r#"((data "quoted data" 123 4.5)
(data ([email protected]# (4.5) "(more" "data)")))"#;

and main.rs:

use s_expressions::{ParseContext, SExp, SEXP_STRING_IN, SEXP_STRUCT};

fn main() {
    println!("{:?}", SEXP_STRUCT.buffer_encode());
    let ctx = &mut ParseContext::new(SEXP_STRING_IN);
    println!("{:?}", SExp::parse(ctx));
}


(define (sexpr-read port)
  (define (help port)
    (let ((char (read-char port)))
      (cond
       ((or (eof-object? char) (eq? char #\) )) '())
       ((eq? char #\( ) (cons (help port) (help port)))
       ((char-whitespace? char) (help port))
       ((eq? char #\"") (cons (quote-read port) (help port)))
       (#t (unread-char char port) (cons (string-read port) (help port))))))
  ; This is needed because the function conses all parsed sexprs onto something,
  ; so the top expression is one level too deep.
  (car (help port)))

(define (quote-read port)
  (define (help port)
    (let ((char (read-char port)))
      (if
       (or (eof-object? char) (eq? char #\""))
       '()
       (cons char (help port)))))
  (list->string (help port)))

(define (string-read port)
  (define (help port)
    (let ((char (read-char port)))
      (cond
       ((or (eof-object? char) (char-whitespace? char)) '())
       ((eq? char #\) ) (unread-char char port) '())
       (#t (cons char (help port))))))
  (list->string (help port)))

(define (format-sexpr expr)
  (define (help expr pad)
    (if
     (list? expr)
     (begin
      (format #t "~a(~%" (make-string pad #\tab))
      (for-each (lambda (x) (help x (1+ pad))) expr)
      (format #t "~a)~%" (make-string pad #\tab)))
     (format #t "~a~a~%" (make-string pad #\tab) expr)))
  (help expr 0))

(format-sexpr (sexpr-read
 (open-input-string "((data \"quoted data\" 123 4.5) (data ([email protected]# (4.5) \"(more\" \"data)\")))")))


<?php

$attributesTotal = 0;
$count = 0;

while($attributesTotal < 75 || $count < 2) {
    $attributes = [];

    foreach(range(0, 5) as $attribute) {
        $rolls = [];

        foreach(range(0, 3) as $roll) {
            $rolls[] = rand(1, 6);
        }

        sort($rolls);
        array_shift($rolls);

        $total = array_sum($rolls);

        if($total >= 15) {
            $count += 1;
        }

        $attributes[] = $total;
    }

    $attributesTotal = array_sum($attributes);
}

print_r($attributes);


To add an attribute to some stats:
Allocate memory for an entry.
Put the attribute into the entry's attribute.
Append the entry to the stats.

An attribute is a number.

An entry is a thing with an attribute.

To find a count of attributes greater than fourteen in some stats:
Put 0 into the count.
Get an entry from the stats.
Loop.
If the entry is nil, exit.
If the entry's attribute is greater than 14, bump the count.
Put the entry's next into the entry.
Repeat.

To find a sum of some stats:
Put 0 into the sum.
Get an entry from the stats.
Loop.
If the entry is nil, exit.
Add the entry's attribute to the sum.
Put the entry's next into the entry.
Repeat.

To generate an attribute:
Put 0 into the attribute.
Put 6 into a minimum number.
Loop.
If a counter is past 4, break.
Pick a number between 1 and 6.
Add the number to the attribute.
If the number is less than the minimum, put the number into the minimum.
Repeat.
Subtract the minimum from the attribute.

To generate some stats (raw):
If a counter is past 6, exit.
Generate an attribute.
Add the attribute to the stats.
Repeat.

To generate some stats (valid):
Generate some raw stats (raw).
Find a sum of the raw stats.
If the sum is less than 75, destroy the raw stats; repeat.
Find a count of attributes greater than fourteen in the raw stats.
If the count is less than 2, destroy the raw stats; repeat.
Put the raw stats into the stats.

To run:
Start up.
Show some RPG attributes.
Wait for the escape key.
Shut down.

To show some RPG attributes:
Generate some stats (valid).
Find a sum of the stats.
Find a count of attributes greater than fourteen in the stats.
Write the stats on the console.
Destroy the stats.
Write "Total: " then the sum on the console.
Write "Number of stats greater than fourteen: " then the count on the console.

Some stats are some entries.

A sum is a number.

To write some stats on the console:
Get an entry from the stats.
Loop.
If the entry is nil, write "" on the console; exit.
Convert the entry's attribute to a string.
Write the string on the console without advancing.
If the entry's next is not nil, write ", " on the console without advancing.
Put the entry's next into the entry.
Repeat.


defmodule Run_length do
  def encode(str) when is_bitstring(str) do
    to_char_list(str) |> encode |> to_string
  end
  def encode(list) when is_list(list) do
    Enum.chunk_by(list, &(&1))
    |> Enum.flat_map(fn chars -> to_char_list(length(chars)) ++ [hd(chars)] end)
  end

  def decode(str) when is_bitstring(str) do
    Regex.scan(~r/(\d+)(.)/, str)
    |> Enum.map_join(fn [_,n,c] -> String.duplicate(c, String.to_integer(n)) end)
  end
  def decode(list) when is_list(list) do
    to_string(list) |> decode |> to_char_list
  end
end

text = [ string:    "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",
         char_list: 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' ]

Enum.each(text, fn {type, txt} ->
  IO.puts type
  txt                  |> IO.inspect
  |> Run_length.encode |> IO.inspect
  |> Run_length.decode |> IO.inspect
end)


(defun run-length-encode (str)
  (let (output)
    (with-temp-buffer
      (insert str)
      (goto-char (point-min))
      (while (not (eobp))
        (let* ((char (char-after (point)))
               (count (skip-chars-forward (string char))))
          (push (format "%d%c" count char) output))))
    (mapconcat #'identity (nreverse output) "")))


func sexpr(txt) {
    txt.trim!

    if (txt.match(/^\((.*)\)$/s)) {|m|
        txt = m[0]
    }
    else {
        die "Invalid: <<#{txt}>>"
    }

    var w
    var ret = []

    while (!txt.is_empty) {
        given (txt.first) {
            when('(') {
                (w, txt) = txt.extract_bracketed('()');
                w = sexpr(w)
            }
            when ('"') {
                (w, txt) = txt.extract_delimited('"')
                w.sub!(/^"(.*)"/, {|s1| s1 })
            }
            else {
                txt.sub!(/^(\S+)/, {|s1| w = s1; '' })
            }
        }
        ret << w
        txt.trim_beg!
    }
    return ret
}

func sexpr2txt(String e) {
    e ~~ /[\s"\(\)]/ ? do { e.gsub!('"', '\\"'); %Q("#{e}") } : e
}

func sexpr2txt(expr) {
    '(' + expr.map {|e| sexpr2txt(e) }.join(' ') + ')'
}

var s = sexpr(%q{

((data "quoted data" 123 4.5)
 (data ([email protected]# (4.5) "(more" "data)")))

})

say s               # dump structure
say sexpr2txt(s)    # convert back


#heroicAttributeMinimum = 15
#heroicAttributeCountMinimum = 2
#attributeSumMinimum = 75
#attributeCount = 6

Procedure roll_attribute()
  Protected i, sum
  Dim rolls(3)

  For i = 0 To 3
    rolls(i) = Random(6, 1)
  Next i

  ;sum the highest three rolls
  SortArray(rolls(), #PB_Sort_Descending)
  For i = 0 To 2
    sum + rolls(i)
  Next
  ProcedureReturn sum
EndProcedure

Procedure displayAttributes(List attributes(), sum, heroicCount)
  Protected output$

  output$ = "Attributes generated: ["
  ForEach attributes()
    output$ + attributes()
    If ListIndex(attributes()) <> #attributeCount - 1: output$ + ", ": EndIf
  Next
  output$ + "]"
  PrintN(output$)
  PrintN("Total: " + sum + ", Values " + #heroicAttributeMinimum + " or above: " + heroicCount)
EndProcedure

Procedure Gen_attributes()
  Protected i, attributesSum, heroicAttributesCount

  NewList attributes()
  Repeat
    ClearList(attributes())
    attributesSum = 0: heroicAttributesCount = 0
    For i = 1 To #attributeCount
      AddElement(attributes())
      attributes() = roll_attribute()
      attributesSum + attributes()
      heroicAttributesCount + Bool(attributes() >= #heroicAttributeMinimum)
    Next
  Until attributesSum >= #attributeSumMinimum And heroicAttributesCount >= #heroicAttributeCountMinimum

  displayAttributes(attributes(), attributesSum, heroicAttributesCount)
EndProcedure

If OpenConsole("RPG Attributes Generator")
  Gen_attributes()
  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf


import random
random.seed()
attributes_total = 0
count = 0

while attributes_total < 75 or count < 2:
    attributes = []

    for attribute in range(0, 6):
        rolls = []

        for roll in range(0, 4):
            result = random.randint(1, 6)
            rolls.append(result)

        sorted_rolls = sorted(rolls)
        largest_3 = sorted_rolls[1:]
        rolls_total = sum(largest_3)

        if rolls_total >= 15:
            count += 1

        attributes.append(rolls_total)

    attributes_total = sum(attributes)

print(attributes_total, attributes)


-module(rle).

-export([encode/1,decode/1]).

-include_lib("eunit/include/eunit.hrl").

encode(S) ->
    doEncode(string:substr(S, 2), string:substr(S, 1, 1), 1, []).

doEncode([], CurrChar, Count, R) ->
    R ++ integer_to_list(Count) ++ CurrChar;
doEncode(S, CurrChar, Count, R) ->
    NextChar = string:substr(S, 1, 1),
    if
        NextChar == CurrChar ->
            doEncode(string:substr(S, 2), CurrChar, Count + 1, R);
        true ->
            doEncode(string:substr(S, 2), NextChar, 1,
                R ++ integer_to_list(Count) ++ CurrChar)
    end.

decode(S) ->
    doDecode(string:substr(S, 2), string:substr(S, 1, 1), []).

doDecode([], _, R) ->
    R;
doDecode(S, CurrString, R) ->
    NextChar = string:substr(S, 1, 1),
    IsInt = erlang:is_integer(catch(erlang:list_to_integer(NextChar))),
    if
        IsInt ->
            doDecode(string:substr(S, 2), CurrString ++ NextChar, R);
        true ->
            doDecode(string:substr(S, 2), [],
                R ++ string:copies(NextChar, list_to_integer(CurrString)))
    end.

rle_test_() ->
    PreEncoded =
        "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",
    Expected = "12W1B12W3B24W1B14W",
    [
        ?_assert(encode(PreEncoded) =:= Expected),
        ?_assert(decode(Expected) =:= PreEncoded),
        ?_assert(decode(encode(PreEncoded)) =:= PreEncoded)
    ].


package require Tcl 8.5

proc fromSexp {str} {
    set tokenizer {[()]|"(?:[^\\""]|\\.)*"|(?:[^()""\s\\]|\\.)+|[""]}
    set stack {}
    set accum {}
    foreach token [regexp -inline -all $tokenizer $str] {
	if {$token eq "("} {
	    lappend stack $accum
	    set accum {}
	} elseif {$token eq ")"} {
	    if {![llength $stack]} {error "unbalanced"}
	    set accum [list {*}[lindex $stack end] [list list {*}$accum]]
	    set stack [lrange $stack 0 end-1]
	} elseif {$token eq "\""} {
	    error "bad quote"
	} elseif {[string match {"*"} $token]} {
	    set token [string range $token 1 end-1]
	    lappend accum [list string [regsub -all {\\(.)} $token {\1}]]
	} else {
	    if {[string is integer -strict $token]} {
		set type int
	    } elseif {[string is double -strict $token]} {
		set type real
	    } else {
		set type atom
	    }
	    lappend accum [list $type [regsub -all {\\(.)} $token {\1}]]
	}
    }
    if {[llength $stack]} {error "unbalanced"}
    return [lindex $accum 0]
}
proc toSexp {tokList} {
    set content [lassign $tokList type]
    if {$type eq "list"} {
	set s "("
	set sep ""
	foreach bit $content {
	    append s $sep [toSexp $bit]
	    set sep " "
	}
	return [append s ")"]
    } elseif {$type eq "string"} {
	return "\"[regsub -all {[\\""]} [lindex $content 0] {\\\0}]\""
    } else {
	return [lindex $content 0]
    }
}


package main

import (
    "fmt"
    "io/ioutil"
    "net/http"
    "regexp"
    "sort"
    "strconv"
)

type Result struct {
    lang  string
    users int
}

func main() {
    const minimum = 25
    ex := `"Category:(.+?)( User)?"(\}|,"categoryinfo":\{"size":(\d+),)`
    re := regexp.MustCompile(ex)
    page := "http://rosettacode.org/mw/api.php?"
    action := "action=query"
    format := "format=json"
    fversion := "formatversion=2"
    generator := "generator=categorymembers"
    gcmTitle := "gcmtitle=Category:Language%20users"
    gcmLimit := "gcmlimit=500"
    prop := "prop=categoryinfo"
    rawContinue := "rawcontinue="
    page += fmt.Sprintf("%s&%s&%s&%s&%s&%s&%s&%s", action, format, fversion,
        generator, gcmTitle, gcmLimit, prop, rawContinue)
    resp, _ := http.Get(page)
    body, _ := ioutil.ReadAll(resp.Body)
    matches := re.FindAllStringSubmatch(string(body), -1)
    resp.Body.Close()
    var results []Result
    for _, match := range matches {
        if len(match) == 5 {
            users, _ := strconv.Atoi(match[4])
            if users >= minimum {
                result := Result{match[1], users}
                results = append(results, result)
            }
        }
    }
    sort.Slice(results, func(i, j int) bool {
        return results[j].users < results[i].users
    })

    fmt.Println("Rank  Users  Language")
    fmt.Println("----  -----  --------")
    rank := 0
    lastUsers := 0
    lastRank := 0
    for i, result := range results {
        eq := " "
        rank = i + 1
        if lastUsers == result.users {
            eq = "="
            rank = lastRank
        } else {
            lastUsers = result.users
            lastRank = rank
        }
        fmt.Printf(" %-2d%s   %3d    %s\n", rank, eq, result.users, result.lang)
    }
}


[ 0 swap witheach + ]             is sum       ( [ --> n )

[ 0 ]'[ rot witheach
    [ over do swap dip + ] drop ] is count     ( [ --> n )

[ [] 4 times
    [ 6 random 1+ join ]
  sort behead drop sum ]          is attribute (   --> n )

[ [] 6 times
    [ attribute join ] ]          is raw       (   --> [ )

[ dup sum 74 > not iff
    [ drop false ] done
   count [ 14 > ] 1 > ]           is valid     ( [ --> b )

[ raw dup valid if
    done
  drop again ]                    is stats     (   --> [ )

randomise
stats dup echo cr cr
say 'Sum: ' dup sum echo cr
say '# of attributes > 14: '
count [ 14 > ] echo


#lang racket

(define (d6 . _)
  (+ (random 6) 1))

(define (best-3-of-4d6 . _)
  (apply + (rest (sort (build-list 4 d6) <))))

(define (generate-character)
  (let* ((rolls (build-list 6 best-3-of-4d6))
         (total (apply + rolls)))
    (if (or (< total 75) (< (length (filter (curryr >= 15) rolls)) 2))
        (generate-character)
        (values rolls total))))

(module+ main
  (define-values (rolled-stats total) (generate-character))
  (printf "Rolls:\t~a~%Total:\t~a" rolled-stats total))


genStats <- function()
{
  stats <- c(STR = 0, DEX = 0, CON = 0, INT = 0, WIS = 0, CHA = 0)
  for(i in seq_along(stats))
  {
    results <- sample(6, 4, replace = TRUE)
    stats[i] <- sum(results[-which.min(results)])
  }
  if(sum(stats >= 15) <  2 || (stats["TOT"] <- sum(stats)) < 75) Recall() else stats
}
print(genStats())


include misc.e

function encode(sequence s)
    sequence out
    integer prev_char,count
    if length(s) = 0 then
        return {}
    end if
    out = {}
    prev_char = s[1]
    count = 1
    for i = 2 to length(s) do
        if s[i] != prev_char then
            out &= {count,prev_char}
            prev_char = s[i]
            count = 1
        else
            count += 1
        end if
    end for
    out &= {count,prev_char}
    return out
end function

function decode(sequence s)
    sequence out
    out = {}
    for i = 1 to length(s) by 2 do
        out &= repeat(s[i+1],s[i])
    end for
    return out
end function

sequence s
s = encode("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
pretty_print(1,s,{3})
puts(1,'\n')
puts(1,decode(s))


$ txr -p '(read)'
((data "quoted data" 123 4.5)
 (data ([email protected]# (4.5) "(more" "data)")))
[Ctrl-D][Enter]
((data "quoted data" 123 4.5) (data (! (sys:var #(4.5)) "(more" "data)")))


import "/pattern" for Pattern
import "/fmt" for Fmt

var INDENT = 2

var parseSExpr = Fn.new { |str|
    var ipat = " \t\n\f\v\r()\""
    var p = Pattern.new("""+0/s["+0^""|(|)|"|+1/I]""", Pattern.within, ipat)
    var t = p.findAll(str).map { |m| m.text }.toList
    if (t.count == 0) return null
    var o = false
    var c = 0
    for (i in t.count-1..0) {
        var ti = t[i].trim()
        var nd = Num.fromString(ti)
        if (ti == "\"") return null
        if (ti == "(") {
            t[i] = "["
            c = c + 1
        } else if (ti == ")") {
            t[i] = "]"
            c = c - 1
        } else if (nd) {
            var ni = Num.fromString(ti)
            t[i] = ni ? ni.toString : nd.toString
        } else if (ti.startsWith("\"")) { // escape embedded double quotes
            var temp = ti[1...-1]
            t[i] = "\"" + temp.replace("\"", "\\\"") + "\""
        }
        if (i > 0 && t[i] != "]" && t[i - 1].trim() != "(") t.insert(i, ", ")
        if (c == 0) {
            if (!o) o = true else return null
        }
    }
    return (c != 0) ? null : t
}

var toSExpr = Fn.new { |tokens|
    for (i in 0...tokens.count) {
        if (tokens[i] == "[") {
            tokens[i] = "("
        } else if (tokens[i] == "]") {
            tokens[i] = ")"
        } else if (tokens[i] == ", ") {
            tokens[i] = " "
        } else if (tokens[i].startsWith("\"")) { // unescape embedded quotes
            var temp = tokens[i][1...-1]
            tokens[i] = "\"" + temp.replace("\\\"", "\"") + "\""
        }
    }
    return tokens.join()
}

var prettyPrint = Fn.new { |tokens|
    var level = 0
    for (t in tokens) {
        var n
        if (t == ", " || t == " ") {
            continue
        } else if (t == "[" || t == "(") {
            n = level * INDENT + 1
            level = level + 1
        } else if (t == "]" || t == ")") {
            level = level - 1
            n = level * INDENT + 1
        } else {
            n = level * INDENT + t.count
        }
        Fmt.print("$*s", n, t)
    }
}

var str = """((data "quoted data" 123 4.5)""" + "\n" +
          """ (data ([email protected]# (4.5) "(more" "data)")))"""
var tokens = parseSExpr.call(str)
if (!tokens) {
    System.print("Invalid s-expr!")
} else {
    System.print("Native data structure:")
    System.print(tokens.join())
    System.print("\nNative data structure (pretty print):")
    prettyPrint.call(tokens)

    System.print("\nRecovered S-Expression:")
    System.print(toSExpr.call(tokens))
    System.print("\nRecovered S-Expression (pretty print):")
    prettyPrint.call(tokens)
}


""" Rank languages on Rosetta Code's site by number of users."""

using HTTP
using JSON3

const URI = "http://rosettacode.org/mw"
const PARAMS = [
    "action" => "query",
    "format" => "json",
    "formatversion" => "2",
    "generator" => "categorymembers",
    "gcmtitle" => "Category:Language users",
    "gcmlimit" => "999",
    "prop" => "categoryinfo",
    "rawcontinue" => "",
]

function mediawikiquery(site = URI, params = PARAMS, mintoshow = 100)
    langusers = Dict{String, Int}()
    url = site * "/api.php?" * join(map(x -> x[1] * "=" * x[2], params), "&")
    r = HTTP.get(url)
    data = JSON3.read(String(r.body))
    for page in data["query"]["pages"]
        lang = occursin("User", page["title"]) ? split(page["title"], r"\:|\sUser")[2] :
            page["title"]
        if haskey(page, "categoryinfo")
            langusers[lang] = page["categoryinfo"]["size"]
        else
            langusers[lang] = 0
        end
    end
    for (i, p) in enumerate(sort!([lp for lp in langusers], lt = (x, y) -> x[2] > y[2]))
        last(p) >= mintoshow && println(lpad(i, 2), "   ", rpad(first(p), 30), last(p))
    end
end

mediawikiquery()


import algorithm, httpclient, json, strformat, strscans, strutils

const
  Action = "action=query"
  Format = "format=json"
  FormatVersion = "formatversion=2"
  Generator = "generator=categorymembers"
  GcmTitle = "gcmtitle=Category:Language%20users"
  GcmLimit = "gcmlimit=500"
  Prop = "prop=categoryinfo"

  Page = "http://rosettacode.org/mw/api.php?"  &
         [Action, Format, Formatversion, Generator, GcmTitle, GcmLimit, Prop].join("&")

type Counts = tuple[lang: string, count: int]

proc cmp(a, b: Counts): int =
  ## Compare two count tuples. Place the one with greater count field first and when
  ## count fields are equal, place the one with the first name in alphabetic order.
  result = cmp(b.count, a.count)
  if result == 0: result = cmp(a.lang, b.lang)

var client = newHttpClient()
var counts: seq[Counts]
var url = Page

while true:

  # Access to the page and load the JSON representation.
  let response = client.get(url)
  if response.status != $Http200: break
  let root = response.body.parseJson()

  # Extract language names and number of users.
  for node in root{"query", "pages"}:
    var lang: string
    if node["title"].getStr().scanf("Category:$+ User", lang):
      let count = node{"categoryinfo", "size"}.getInt()
      counts.add (lang, count)
  if "continue" notin root: break

  # Load continuation page.
  let gcmcont = root{"continue", "gcmcontinue"}.getStr()
  let cont = root{"continue", "continue"}.getStr()
  url = Page & fmt"&gcmcontinue={gcmcont}&continue={cont}"

# Sort and display.
counts.sort(cmp)
var rank, lastCount = 0
for i, (lang, count) in counts:
  if count != lastCount:
    rank = i + 1
    lastCount = count
  echo &"{rank:3} {count:4} - {lang}"


use strict;
use warnings;
use JSON;
use URI::Escape;
use LWP::UserAgent;

my $client = LWP::UserAgent->new;
$client->agent("Rosettacode Perl task solver");
my $url = 'http://rosettacode.org/mw';
my $minimum = 100;

sub uri_query_string {
    my(%fields) = @_;
    'action=query&format=json&formatversion=2&' .
    join '&', map { $_ . '=' . uri_escape($fields{$_}) } keys %fields
}

sub mediawiki_query {
    my($site, $type, %query) = @_;
    my $url = "$site/api.php?" . uri_query_string(%query);
    my %languages = ();

    my $req = HTTP::Request->new( GET => $url );
    my $response = $client->request($req);
    $response->is_success or die "Failed to GET '$url': ", $response->status_line;
    my $data = decode_json($response->content);
    for my $row ( @{${$data}{query}{pages}} ) {
        next unless defined $$row{categoryinfo} && $$row{title} =~ /User/;
        my($title) = $$row{title} =~ /Category:(.*?) User/;
        my($count) = $$row{categoryinfo}{pages};
        $languages{$title} = $count;
    }
    %languages;
}

my %table = mediawiki_query(
    $url, 'pages',
    ( generator   => 'categorymembers',
      gcmtitle    => 'Category:Language users',
      gcmlimit    => '999',
      prop        => 'categoryinfo',
      rawcontinue => '',
    )
);

for my $k (sort { $table{$b} <=> $table{$a} } keys %table) {
    printf "%4d %s\n", $table{$k}, $k if $table{$k} > $minimum;
}


my ( $min_sum, $hero_attr_min, $hero_count_min ) = 75, 15, 2;
my @attr-names = <Str Int Wis Dex Con Cha>;

sub heroic { + @^a.grep: * >= $hero_attr_min }

my @attr;
repeat until @attr.sum     >= $min_sum
         and heroic(@attr) >= $hero_count_min {

    @attr = @attr-names.map: { (1..6).roll(4).sort(+*).skip(1).sum };
}

say @attr-names Z=> @attr;
say "Sum: {@attr.sum}, with {heroic(@attr)} attributes >= $hero_attr_min";


Red ["RPG attributes generator"]

raw-attribute: does [
    sum next sort collect [
        loop 4 [keep random/only 6]
    ]
]

raw-attributes: does [
    collect [
        loop 6 [keep raw-attribute]
    ]
]

valid-attributes?: func [b][
    n: 0
    foreach attr b [
        if attr > 14 [n: n + 1]
    ]
    all [
        n > 1
        greater? sum b 74
    ]
]

attributes: does [
    until [
        valid-attributes? a: raw-attributes
    ]
    a
]

show-attributes: function [a][
    i: 1
    foreach stat-name [
        "Strength"
        "Dexterity"
        "Constitution"
        "Intelligence"
        "Wisdom"
        "Charisma"
    ][
        print [rejoin [stat-name ":"] a/:i]
        i: i + 1
    ]
    print "-----------------"
    print ["Sum:" sum a]
    print [n "attributes > 14"]
]

show-attributes attributes


open System
open System.Text.RegularExpressions

let encode data =
    // encodeData : seq<'T> -> seq<int * 'T> i.e. Takes a sequence of 'T types and return a sequence of tuples containing the run length and an instance of 'T.
    let rec encodeData input =
        seq { if not (Seq.isEmpty input) then
                 let head = Seq.head input
                 let runLength = Seq.length (Seq.takeWhile ((=) head) input)
                 yield runLength, head
                 yield! encodeData (Seq.skip runLength input) }

    encodeData data |> Seq.fold(fun acc (len, d) -> acc + len.ToString() + d.ToString()) ""

let decode str =
    [ for m in Regex.Matches(str, "(\d+)(.)") -> m ]
    |> List.map (fun m -> Int32.Parse(m.Groups.[1].Value), m.Groups.[2].Value)
    |> List.fold (fun acc (len, s) -> acc + String.replicate len s) ""


"""Rank languages by number of users. Requires Python >=3.5"""

import requests

# MediaWiki API URL.
URL = "http://rosettacode.org/mw/api.php"

# Query string parameters
PARAMS = {
    "action": "query",
    "format": "json",
    "formatversion": 2,
    "generator": "categorymembers",
    "gcmtitle": "Category:Language users",
    "gcmlimit": 500,
    "prop": "categoryinfo",
}

def fetch_data():
    counts = {}
    continue_ = {"continue": ""}

    # Keep making HTTP requests to the MediaWiki API if more records are
    # available.
    while continue_:
        resp = requests.get(URL, params={**PARAMS, **continue_})
        resp.raise_for_status()

        data = resp.json()

        # Grab the title (language) and size (count) only.
        counts.update(
            {
                p["title"]: p.get("categoryinfo", {}).get("size", 0)
                for p in data["query"]["pages"]
            }
        )

        continue_ = data.get("continue", {})

    return counts

if __name__ == "__main__":
    # Request data from the MediaWiki API.
    counts = fetch_data()

    # Filter out languages that have less than 100 users.
    at_least_100 = [(lang, count) for lang, count in counts.items() if count >= 100]

    # Sort languages by number of users
    top_languages = sorted(at_least_100, key=lambda x: x[1], reverse=True)

    # Pretty print
    for i, lang in enumerate(top_languages):
        print(f"{i+1:<5}{lang[0][9:][:-5]:<20}{lang[1]}")


#lang racket

(require racket/hash
         net/url
         json)

(define limit 64)
(define (replacer cat) (regexp-replace #rx"^Category:(.*?) User$" cat "\\1"))
(define category "Category:Language users")
(define entries "users")

(define api-url (string->url "http://rosettacode.org/mw/api.php"))
(define (make-complete-url gcmcontinue)
  (struct-copy url api-url
               [query `([format . "json"]
                        [action . "query"]
                        [generator . "categorymembers"]
                        [gcmtitle . ,category]
                        [gcmlimit . "200"]
                        [gcmcontinue . ,gcmcontinue]
                        [continue . ""]
                        [prop . "categoryinfo"])]))

(define @ hash-ref)

(define table (make-hash))

(let loop ([gcmcontinue ""])
  (define resp (read-json (get-pure-port (make-complete-url gcmcontinue))))
  (hash-union! table
               (for/hash ([(k v) (in-hash (@ (@ resp 'query) 'pages))])
                 (values (@ v 'title #f) (@ (@ v 'categoryinfo (hash)) 'size 0))))
  (cond [(@ resp 'continue #f) => (λ (c) (loop (@ c 'gcmcontinue)))]))

(for/fold ([prev #f] [rank #f] #:result (void))
          ([item (in-list (sort (hash->list table) > #:key cdr))] [i (in-range limit)])
  (match-define (cons cat size) item)
  (define this-rank (if (equal? prev size) rank (add1 i)))
  (printf "Rank: ~a ~a ~a\n"
          (~a this-rank #:align 'right #:min-width 2)
          (~a (format "(~a ~a)" size entries) #:align 'right #:min-width 14)
          (replacer cat))
  (values size this-rank))


use HTTP::UserAgent;
use URI::Escape;
use JSON::Fast;

my $client = HTTP::UserAgent.new;

my $url = 'http://rosettacode.org/mw';

my $start-time = now;

say "========= Generated: { DateTime.new(time) } =========";

my $lang = 1;
my $rank = 0;
my $last = 0;
my $tie = ' ';
my $minimum = 25;

.say for
    mediawiki-query(
        $url, 'pages',
        :generator<categorymembers>,
        :gcmtitle<Category:Language users>,
        :gcmlimit<350>,
        :rawcontinue(),
        :prop<categoryinfo>
    )

    .map({ %( count => .<categoryinfo><pages> || 0,
              lang  => .<title>.subst(/^'Category:' (.+) ' User'/, ->$/ {$0}) ) })

    .sort( { -.<count>, .<lang> } )

    .map( { last if .<count> < $minimum; display(.<count>, .<lang>) } );

say "========= elapsed: {(now - $start-time).round(.01)} seconds =========";

sub display ($count, $which) {
    if $last != $count { $last = $count; $rank = $lang; $tie = ' ' } else { $tie = 'T' };
    sprintf "#%3d  Rank: %2d %s  with %-4s users:  %s", $lang++, $rank, $tie, $count, $which;
}

sub mediawiki-query ($site, $type, *%query) {
    my $url = "$site/api.php?" ~ uri-query-string(
        :action<query>, :format<json>, :formatversion<2>, |%query);
    my $continue = '';

    gather loop {
        my $response = $client.get("$url&$continue");
        my $data = from-json($response.content);
        take $_ for $data.<query>.{$type}.values;
        $continue = uri-query-string |($data.<query-continue>{*}».hash.hash or last);
    }
}

sub uri-query-string (*%fields) {
    join '&', %fields.map: { "{.key}={uri-escape .value}" }
}


/* REXX
Generates 4 random, whole values between 1 and 6.
Saves the sum of the 3 largest values.
Generates a total of 6 values this way.
Displays the total, and all 6 values once finished.
*/
Do try=1 By 1
  ge15=0
  sum=0
  ol=''
  Do i=1 To 6
    rl=''
    Do j=1 To 4
      rl=rl (random(5)+1)
      End
    rl=wordsort(rl)
    rsum.i=maxsum()
    If rsum.i>=15 Then ge15=ge15+1
    sum=sum+rsum.i
    ol=ol right(rsum.i,2)
    End
  Say ol '->' ge15 sum
  If ge15>=2 & sum>=75 Then Leave
  End
Say try 'iterations'
Say ol '=>' sum
Exit

maxsum: procedure Expose rl
/**********************************************************************
* Comute the sum of the 3 largest values
**********************************************************************/
  m=0
  Do i=2 To 4
    m=m+word(rl,i)
    End
  Return m

wordsort: Procedure
/**********************************************************************
* Sort the list of words supplied as argument. Return the sorted list
**********************************************************************/
  Parse Arg wl
  wa.=''
  wa.0=0
  Do While wl<>''
    Parse Var wl w wl
    Do i=1 To wa.0
      If wa.i>w Then Leave
      End
    If i<=wa.0 Then Do
      Do j=wa.0 To i By -1
        ii=j+1
        wa.ii=wa.j
        End
      End
    wa.i=w
    wa.0=wa.0+1
    End
  swl=''
  Do i=1 To wa.0
    swl=swl wa.i
    End
  Return strip(swl)


# Project  : RPG Attributes Generator

load "stdlib.ring"
attributestotal = 0
count = 0
while attributestotal < 75 or count < 2
        attributes = []
        for attribute = 0 to 6
             rolls = []
             largest3 = []
             for roll = 0 to 4
                  result = random(5)+1
                  add(rolls,result)
             next
             sortedrolls = sort(rolls)
             sortedrolls = reverse(sortedrolls)
             for n = 1 to 3
                  add(largest3,sortedrolls[n])
             next
             rollstotal = sum(largest3)
             if rollstotal >= 15
                count = count + 1
             ok
             add(attributes,rollstotal)
        next
        attributestotal = sum(attributes)
end
showline()

func sum(aList)
       num = 0
       for n = 1 to len(aList)
            num = num + aList[n]
       next
       return num

func showline()
        line = "(" + attributestotal + ", ["
        for n = 1 to len(attributes)
             line = line + attributes[n] + ", "
        next
        line = left(line,len(line)-2)
        line = line + "])"
        see line + nl


USING: io kernel literals math.parser math.ranges sequences
sequences.extras sequences.repeating splitting.extras
splitting.monotonic strings ;
IN: rosetta-code.run-length-encoding

CONSTANT: alpha $[ CHAR: A CHAR: Z [a,b] >string ]

: encode ( str -- str )
    [ = ] monotonic-split [ [ length number>string ] [ first ]
    bi suffix ] map concat ;

: decode ( str -- str )
    alpha split* [ odd-indices ] [ even-indices
    [ string>number ] map ] bi [ repeat ] 2map concat ;

"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
"12W1B12W3B24W1B14W"
[ encode ] [ decode ] bi* [ print ] [email protected]