"Mandelbrot"

The story headline is "A Non-Interactive Set".

Include Glimmr Drawing Commands by Erik Temple.

[Q20 fixed-point or floating-point: see definitions below]
Use floating-point math.

Finished is a room.

The graphics-window is a graphics g-window spawned by the main-window.
The position is g-placeabove.

When play begins:
	let f10 be 10 as float;
	now min re is ( -20 as float ) fdiv f10;
	now max re is ( 6 as float ) fdiv f10;
	now min im is ( -12 as float ) fdiv f10;
	now max im is ( 12 as float ) fdiv f10;
	now max iterations is 100;
	add color g-Black to the palette;
	add color g-Red to the palette;
	add hex "#FFA500" to the palette;
	add color g-Yellow to the palette;
	add color g-Green to the palette;
	add color g-Blue to the palette;
	add hex "#4B0082" to the palette;
	add hex "#EE82EE" to the palette;
	open up the graphics-window.

Min Re is a number that varies.
Max Re is a number that varies.
Min Im is a number that varies.
Max Im is a number that varies.

Max Iterations is a number that varies.

Min X is a number that varies.
Max X is a number that varies.
Min Y is a number that varies.
Max Y is a number that varies.

The palette is a list of numbers that varies.

[vertically mirrored version]
Window-drawing rule for the graphics-window when max im is fneg min im:
	clear the graphics-window;
	let point be { 0, 0 };
	now min X is 0 as float;
	now min Y is 0 as float;
	let mX be the width of the graphics-window minus 1;
	let mY be the height of the graphics-window minus 1;
	now max X is mX as float;
	now max Y is mY as float;
	let L be the column order with max mX;
	repeat with X running through L:
		now entry 1 in point is X;
		repeat with Y running from 0 to mY / 2:
			now entry 2 in point is Y;
			let the scaled point be the complex number corresponding to the point;
			let V be the Mandelbrot result for the scaled point;
			let C be the color corresponding to V;
			if C is 0, next;
			draw a rectangle (C) in the graphics-window at the point with size 1 by 1;
			now entry 2 in point is mY - Y;
			draw a rectangle (C) in the graphics-window at the point with size 1 by 1;
		yield to VM;
	rule succeeds.

[slower non-mirrored version]
Window-drawing rule for the graphics-window:
	clear the graphics-window;
	let point be { 0, 0 };
	now min X is 0 as float;
	now min Y is 0 as float;
	let mX be the width of the graphics-window minus 1;
	let mY be the height of the graphics-window minus 1;
	now max X is mX as float;
	now max Y is mY as float;
	let L be the column order with max mX;
	repeat with X running through L:
		now entry 1 in point is X;
		repeat with Y running from 0 to mY:
			now entry 2 in point is Y;
			let the scaled point be the complex number corresponding to the point;
			let V be the Mandelbrot result for the scaled point;
			let C be the color corresponding to V;
			if C is 0, next;
			draw a rectangle (C) in the graphics-window at the point with size 1 by 1;
		yield to VM;
	rule succeeds.

To decide which list of numbers is column order with max (N - number):
	let L be a list of numbers;
	let L2 be a list of numbers;
	let D be 64;
	let rev be false;
	while D > 0:
		let X be 0;
		truncate L2 to 0 entries;
		while X <= N:
			if D is 64 or X / D is odd, add X to L2;
			increase X by D;
		if rev is true:
			reverse L2;
			let rev be false;
		otherwise:
			let rev be true;
		add L2 to L;
		let D be D / 2;
	decide on L.

To decide which list of numbers is complex number corresponding to (P - list of numbers):
	let R be a list of numbers;
	extend R to 2 entries;
	let X be entry 1 in P as float;
	let X be (max re fsub min re) fmul (X fdiv max X);
	let X be X fadd min re;
	let Y be entry 2 in P as float;
	let Y be (max im fsub min im) fmul (Y fdiv max Y);
	let Y be Y fadd min im;
	now entry 1 in R is X;
	now entry 2 in R is Y;
	decide on R.

To decide which number is Mandelbrot result for (P - list of numbers):
	let c_re be entry 1 in P;
	let c_im be entry 2 in P;
	let z_re be 0 as float;
	let z_im be z_re;
	let threshold be 4 as float;
	let runs be 0;
	while 1 is 1:
		[ z = z * z ]
		let r2 be z_re fmul z_re;
		let i2 be z_im fmul z_im;
		let ri be z_re fmul z_im;
		let z_re be r2 fsub i2;
		let z_im be ri fadd ri;
		[ z = z + c ]
		let z_re be z_re fadd c_re;
		let z_im be z_im fadd c_im;
		let norm be (z_re fmul z_re) fadd (z_im fmul z_im);
		increase runs by 1;
		if norm is greater than threshold, decide on runs;
		if runs is max iterations, decide on 0.

To decide which number is color corresponding to (V - number):
	let L be the number of entries in the palette;
	let N be the remainder after dividing V by L;
	decide on entry (N + 1) in the palette.

Section - Fractional numbers (for Glulx only)

To decide which number is (N - number) as float: (- (numtof({N})) -).
To decide which number is (N - number) fadd (M - number): (- (fadd({N}, {M})) -).
To decide which number is (N - number) fsub (M - number): (- (fsub({N}, {M})) -).
To decide which number is (N - number) fmul (M - number): (- (fmul({N}, {M})) -).
To decide which number is (N - number) fdiv (M - number): (- (fdiv({N}, {M})) -).
To decide which number is fneg (N - number): (- (fneg({N})) -).
To yield to VM: (- glk_select_poll(gg_event); -).

Use Q20 fixed-point math translates as (- Constant Q20_MATH; -).
Use floating-point math translates as (- Constant FLOAT_MATH; -).

Include (-
#ifdef Q20_MATH;
! Q11.20 format: 1 sign bit, 11 integer bits, 20 fraction bits
[ numtof n r; @shiftl n 20 r; return r; ];
[ fadd n m; return n+m; ];
[ fsub n m; return n-m; ];
[ fmul n m; n = n + $$1000000000; @sshiftr n 10 n; m = m + $$1000000000; @sshiftr m 10 m; return n * m; ];
[ fdiv n m; @sshiftr m 20 m; return n / m; ];
[ fneg n; return -n; ];
#endif;

#ifdef FLOAT_MATH;
[ numtof f; @"S2:400" f f; return f; ];
[ fadd n m; @"S3:416" n m n; return n; ];
[ fsub n m; @"S3:417" n m n; return n; ];
[ fmul n m; @"S3:418" n m n; return n; ];
[ fdiv n m; @"S3:419" n m n; return n; ];
[ fneg n; @bitxor n $80000000 n; return n; ];
#endif;
-).


$ include "seed7_05.s7i";

const proc: main is func
  local
    var string: story is "";
    var string: line is "";
    var integer: pos1 is 0;
    var integer: pos2 is 1;
    var string: field is "";
  begin
    writeln("Enter a story template, terminated by an empty line:");
    repeat
      readln(line);
      if line <> "" then
        story &:= line & "\n";
      end if;
    until line = "";
    pos1 := pos(story, '<');
    while pos1 <> 0 and pos2 <> 0 do
      pos2 := pos(story, '>', pos1);
      if pos2 <> 0 then
        field := story[pos1 .. pos2];
        write("Enter a value for " <& field <& ": ");
        story := replace(story, field, getln(IN));
        pos1 := pos(story, '<', pos1);
      end if;
    end while;
    writeln;
    writeln("The story becomes:");
    write(story);
  end func;


var story = ARGF.slurp;

var blanks = Hash.new;
while (var m = /<(.*?)>/.gmatch(story)) {
    blanks.append(m[0]);
}

blanks.keys.sort.each { |blank|
    var replacement = Sys.scanln("#{blank}: ");
    blanks{blank} = replacement;
}

print story.gsub(/<(.*?)>/, {|s1| blanks{s1} });


SUB BETWEEN$(TXT$, LHS$, RHS$, AFTER)
	LET LHS = POS(TXT$, LHS$, AFTER)
	IF LHS = 0 THEN
		'LHS$ NOT FOUND IN TXT$. RETURN EMPTY STRING
		RETURN ""
		EXIT SUB
	END IF
	LET RHS = POS(TXT$, RHS$, LHS + LEN(LHS$))
	IF RHS = 0 THEN
		'NO RHS$ FOUND IMMEDIATELY AFTER LHS$ IN TXT$. RETURN EMPTY STRING.
		RETURN ""
		EXIT SUB
	END IF
	RETURN SEG$(TXT$, LHS + LEN(LHS$), RHS-1)
END SUB

DECLARE SUB REPLACE$(INTHIS$, FINDTHIS$, WITHTHIS$)
	LET T = POS(INTHIS$, FINDTHIS$)
	RETURN INTHIS$
	IF T <> 0 THEN
		MID$(INTHIS$, T, LEN(FINDTHIS$)) = WITHTHIS$
		RETURN INTHIS$
	END IF
END SUB

LET STORY$ = ""
LET STORYLINE$ = ""
WHILE TRUE
	LINE INPUT "Enter line of story (empty line to stop)"; STORYLINE$
	IF STORYLINE$ = "" THEN
		EXIT WHILE
	END IF
	STORY$ = STORY$ + " " + STORYLINE$
END WHILE

WHILE TRUE
	LET TXT$ = ""
	LET KEY$ = BETWEEN$(STORY$, "<", ">", 0)
	IF KEY$ <> "" THEN
		PRINT "PLEASE ENTER A " + KEY$;
		LINE INPUT TXT$
		LET SRCH$ = "<" + KEY$ + ">"
		STORY$ = REPLACE$(STORY$, SRCH$, TXT$)
	ELSE
		EXIT WHILE
	END IF
END WHILE

PRINT STORY$


package main

import (
	"fmt"
	"log"
	"strings"
)

// Compress a string to a list of output symbols.
func compress(uncompressed string) []int {
	// Build the dictionary.
	dictSize := 256
	// We actually want a map of []byte -> int but
	// slices are not acceptable map key types.
	dictionary := make(map[string]int, dictSize)
	for i := 0; i < dictSize; i++ {
		// Ugly mess to work around not having a []byte key type.
		// Using `string(i)` would do utf8 encoding for i>127.
		dictionary[string([]byte{byte(i)})] = i
	}

	var result []int
	var w []byte
	for i := 0; i < len(uncompressed); i++ {
		c := uncompressed[i]
		wc := append(w, c)
		if _, ok := dictionary[string(wc)]; ok {
			w = wc
		} else {
			result = append(result, dictionary[string(w)])
			// Add wc to the dictionary.
			dictionary[string(wc)] = dictSize
			dictSize++
			//w = []byte{c}, but re-using wc
			wc[0] = c
			w = wc[:1]
		}
	}

	if len(w) > 0 {
		// Output the code for w.
		result = append(result, dictionary[string(w)])
	}
	return result
}

type BadSymbolError int

func (e BadSymbolError) Error() string {
	return fmt.Sprint("Bad compressed symbol ", int(e))
}

// Decompress a list of output symbols to a string.
func decompress(compressed []int) (string, error) {
	// Build the dictionary.
	dictSize := 256
	dictionary := make(map[int][]byte, dictSize)
	for i := 0; i < dictSize; i++ {
		dictionary[i] = []byte{byte(i)}
	}

	var result strings.Builder
	var w []byte
	for _, k := range compressed {
		var entry []byte
		if x, ok := dictionary[k]; ok {
			//entry = x, but ensuring any append will make a copy
			entry = x[:len(x):len(x)]
		} else if k == dictSize && len(w) > 0 {
			entry = append(w, w[0])
		} else {
			return result.String(), BadSymbolError(k)
		}
		result.Write(entry)

		if len(w) > 0 {
			// Add w+entry[0] to the dictionary.
			w = append(w, entry[0])
			dictionary[dictSize] = w
			dictSize++
		}
		w = entry
	}
	return result.String(), nil
}

func main() {
	compressed := compress("TOBEORNOTTOBEORTOBEORNOT")
	fmt.Println(compressed)
	decompressed, err := decompress(compressed)
	if err != nil {
		log.Fatal(err)
	}
	fmt.Println(decompressed)
}


package require Tcl 8.5

# Read the template...
puts [string repeat "-" 70]
puts "Enter the story template, ending with a blank line"
while {[gets stdin line] > 0} {
    append content $line "\n"
}

# Read the mapping...
puts [string repeat "-" 70]
set mapping {}
foreach piece [regexp -all -inline {<[^>]+>} $content] {
    if {[dict exists $mapping $piece]} continue
    puts -nonewline "Give me a $piece: "
    flush stdout
    dict set mapping $piece [gets stdin]
}

# Apply the mapping and print...
puts [string repeat "-" 70]
puts -nonewline [string map $mapping $content]
puts [string repeat "-" 70]


Function mad_libs(s)
    Do
        If InStr(1,s,"<") <> 0 Then
            start_position = InStr(1,s,"<") + 1
            end_position = InStr(1,s,">")
            parse_string = Mid(s,start_position,end_position-start_position)
            WScript.StdOut.Write parse_string & "? "
            input_string = WScript.StdIn.ReadLine
            s = Replace(s,"<" & parse_string & ">",input_string)
        Else
            Exit Do
        End If
    Loop
    mad_libs = s
End Function

WScript.StdOut.Write mad_libs("<name> went for a walk in the park. <he or she> found a <noun>. <name> decided to take it home.")
WScript.StdOut.WriteLine


Imports System.Text

Module Program
    Private Function GetStory() As String
        Dim input As New StringBuilder()
        Do
            Dim nextLine = Console.ReadLine()
            If String.IsNullOrEmpty(nextLine) Then Exit Do
            input.AppendLine(nextLine)
        Loop

        Dim story = input.ToString()
        Return story
    End Function

    Sub Main()
        Dim input As String = GetStory()

        Dim result As New StringBuilder()
        Dim replacements As New Dictionary(Of String, String)

        For i = 0 To input.Length - 1
            Dim curChar = input(i)

            ' For all characters but '<', append it and move on.
            If curChar <> "<"c Then
                result.Append(curChar)
            Else
                ' If the character before was a backslash, then replace the backslash in the result with a '<' and move on.
                If i > 0 AndAlso input(i - 1) = "\"c Then
                    result(result.Length - 1) = "<"c
                    Continue For
                End If

                ' Search for the first '>' that isn't preceded by a backslash.
                Dim closeBracketPos = -1
                For ind = i To input.Length - 1
                    If input(ind) = ">"c AndAlso input(ind - 1) <> "\"c Then
                        closeBracketPos = ind
                        Exit For
                    End If
                Next

                ' The search failed to find a '>'.
                If closeBracketPos < 0 Then
                    Console.WriteLine($"ERROR: Template starting at position {i} is not closed.")
                    Environment.Exit(-1)
                End If

                ' The text between the current character and the found '>' character, with escape sequences simplified.
                Dim key As String = input.Substring(i + 1, closeBracketPos - i - 1).Replace("\>", ">", StringComparison.Ordinal)

                Dim subst As String = Nothing
                ' Ask for and store a replacement value if there isn't already one for the key.
                If Not replacements.TryGetValue(key, subst) Then
                    Console.Write($"Enter a {key}: ")
                    subst = Console.ReadLine()
                    replacements.Add(key, subst)
                End If

                result.Append(subst)
                i = closeBracketPos
            End If
        Next

        Console.WriteLine()
        Console.Write(result)
    End Sub
End Module


def compress = { text ->
    def dictionary = (0..<256).inject([:]) { map, ch -> map."${(char)ch}" = ch; map }
    def w = '', compressed = []
    text.each { ch ->
        def wc = "$w$ch"
        if (dictionary[wc]) {
            w = wc
        } else {
            compressed << dictionary[w]
            dictionary[wc] = dictionary.size()
            w = "$ch"
        }
    }
    if (w) { compressed << dictionary[w] }
    compressed
}

def decompress = { compressed ->
    def dictionary = (0..<256).inject([:])  { map, ch -> map[ch] = "${(char)ch}"; map }
    int dictSize = 128;
    String w = "${(char)compressed[0]}"
    StringBuffer result = new StringBuffer(w)

    compressed.drop(1).each { k ->
        String entry = dictionary[k]
        if (!entry) {
            if (k != dictionary.size()) throw new IllegalArgumentException("Bad compressed k $k")
            entry = "$w${w[0]}"
        }
        result << entry

        dictionary[dictionary.size()] = "$w${entry[0]}"
        w = entry
    }

    result.toString()
}


import java.awt.Graphics;
import java.awt.image.BufferedImage;
import javax.swing.JFrame;

public class Mandelbrot extends JFrame {

    private final int MAX_ITER = 570;
    private final double ZOOM = 150;
    private BufferedImage I;
    private double zx, zy, cX, cY, tmp;

    public Mandelbrot() {
        super("Mandelbrot Set");
        setBounds(100, 100, 800, 600);
        setResizable(false);
        setDefaultCloseOperation(EXIT_ON_CLOSE);
        I = new BufferedImage(getWidth(), getHeight(), BufferedImage.TYPE_INT_RGB);
        for (int y = 0; y < getHeight(); y++) {
            for (int x = 0; x < getWidth(); x++) {
                zx = zy = 0;
                cX = (x - 400) / ZOOM;
                cY = (y - 300) / ZOOM;
                int iter = MAX_ITER;
                while (zx * zx + zy * zy < 4 && iter > 0) {
                    tmp = zx * zx - zy * zy + cX;
                    zy = 2.0 * zx * zy + cY;
                    zx = tmp;
                    iter--;
                }
                I.setRGB(x, y, iter | (iter << 8));
            }
        }
    }

    @Override
    public void paint(Graphics g) {
        g.drawImage(I, 0, 0, this);
    }

    public static void main(String[] args) {
        new Mandelbrot().setVisible(true);
    }
}


import "io" for Stdin, Stdout
import "/pattern" for Pattern
import "/seq" for Lst

System.print("Please enter a multi-line story template terminated by a blank line:\n")
Stdout.flush()
var story = ""
while (true) {
    var line = Stdin.readLine()
    if (line.isEmpty) break
    story = story + line + "\n" // preserve line breaks
}
// identify blanks
var p = Pattern.new("<+0^>>")
var blanks = Lst.distinct(p.findAll(story).map { |m| m.text }.toList)
System.print("Please enter your replacements for the following 'blanks' in the story:")
for (blank in blanks) {
    System.write("  %(blank[1..-2]) : ")
    Stdout.flush()
    var repl = Stdin.readLine()
    story = story.replace(blank, repl)
}
System.print("\n%(story)")


story,line,re:=Data(),"",RegExp("(<[^>]+>)");
do{ line=ask("Story: "); story.write(line,"\n") }while(line);
while(re.search(story,True)){
   z,ml,N:=re.matched,z[1],z[0][1]; // z=( (0,6),"<name>" )
   s:=ask("Text to replace ",ml," with: ");
   while(Void!=(n:=story.find(ml))){ story[n,N]=s } // replace all <names>s
}
println("-----------------");
story.text.print();


import Data.List (elemIndex, tails)
import Data.Maybe (fromJust)

doLZW :: Eq a => [a] -> [a] -> [Int]
doLZW _ [] = []
doLZW as (x:xs) = lzw (return <$> as) [x] xs
  where
    lzw a w [] = [fromJust $ elemIndex w a]
    lzw a w (x:xs)
      | w_ `elem` a = lzw a w_ xs
      | otherwise = fromJust (elemIndex w a) : lzw (a ++ [w_]) [x] xs
      where
        w_ = w ++ [x]

undoLZW :: [a] -> [Int] -> [a]
undoLZW _ [] = []
undoLZW a cs =
  cs >>=
  (!!)
    (foldl
       ((.) <$> (++) <*>
        (\x xs -> return (((++) <$> head <*> take 1 . last) ((x !!) <$> xs))))
       (return <$> a)
       (take2 cs))

take2 :: [a] -> [[a]]
take2 xs = filter ((2 ==) . length) (take 2 <$> tails xs)

main :: IO ()
main = do
  print $ doLZW ['\0' .. '\255'] "TOBEORNOTTOBEORTOBEORNOT"
  print $
    undoLZW
      ['\0' .. '\255']
      [84, 79, 66, 69, 79, 82, 78, 79, 84, 256, 258, 260, 265, 259, 261, 263]
  print $
    ((==) <*> ((.) <$> undoLZW <*> doLZW) ['\NUL' .. '\255'])
      "TOBEORNOTTOBEORTOBEORNOT"


function mandelIter(cx, cy, maxIter) {
  var x = 0.0;
  var y = 0.0;
  var xx = 0;
  var yy = 0;
  var xy = 0;

  var i = maxIter;
  while (i-- && xx + yy <= 4) {
    xy = x * y;
    xx = x * x;
    yy = y * y;
    x = xx - yy + cx;
    y = xy + xy + cy;
  }
  return maxIter - i;
}

function mandelbrot(canvas, xmin, xmax, ymin, ymax, iterations) {
  var width = canvas.width;
  var height = canvas.height;

  var ctx = canvas.getContext('2d');
  var img = ctx.getImageData(0, 0, width, height);
  var pix = img.data;

  for (var ix = 0; ix < width; ++ix) {
    for (var iy = 0; iy < height; ++iy) {
      var x = xmin + (xmax - xmin) * ix / (width - 1);
      var y = ymin + (ymax - ymin) * iy / (height - 1);
      var i = mandelIter(x, y, iterations);
      var ppos = 4 * (width * iy + ix);

      if (i > iterations) {
        pix[ppos] = 0;
        pix[ppos + 1] = 0;
        pix[ppos + 2] = 0;
      } else {
        var c = 3 * Math.log(i) / Math.log(iterations - 1.0);

        if (c < 1) {
          pix[ppos] = 255 * c;
          pix[ppos + 1] = 0;
          pix[ppos + 2] = 0;
        }
        else if ( c < 2 ) {
          pix[ppos] = 255;
          pix[ppos + 1] = 255 * (c - 1);
          pix[ppos + 2] = 0;
        } else {
          pix[ppos] = 255;
          pix[ppos + 1] = 255;
          pix[ppos + 2] = 255 * (c - 2);
        }
      }
      pix[ppos + 3] = 255;
    }
  }

  ctx.putImageData(img, 0, 0);
}

var canvas = document.createElement('canvas');
canvas.width = 900;
canvas.height = 600;

document.body.insertBefore(canvas, document.body.childNodes[0]);

mandelbrot(canvas, -2, 1, -1, 1, 1000);


encodeLZW =: 4 : 0
 d=. ;/x
 r=.0$0
 wc=.w=.{.y
 for_c. }.y do.
   wc=.w,c
   if. d e.~ <wc do. w=.wc else.
     r=. r, d i.<w
     d=.d,<wc
     w=.c
   end.
 end.
 r, d i.<w
)


import java.util.*;

public class LZW {
    /** Compress a string to a list of output symbols. */
    public static List<Integer> compress(String uncompressed) {
        // Build the dictionary.
        int dictSize = 256;
        Map<String,Integer> dictionary = new HashMap<String,Integer>();
        for (int i = 0; i < 256; i++)
            dictionary.put("" + (char)i, i);

        String w = "";
        List<Integer> result = new ArrayList<Integer>();
        for (char c : uncompressed.toCharArray()) {
            String wc = w + c;
            if (dictionary.containsKey(wc))
                w = wc;
            else {
                result.add(dictionary.get(w));
                // Add wc to the dictionary.
                dictionary.put(wc, dictSize++);
                w = "" + c;
            }
        }

        // Output the code for w.
        if (!w.equals(""))
            result.add(dictionary.get(w));
        return result;
    }

    /** Decompress a list of output ks to a string. */
    public static String decompress(List<Integer> compressed) {
        // Build the dictionary.
        int dictSize = 256;
        Map<Integer,String> dictionary = new HashMap<Integer,String>();
        for (int i = 0; i < 256; i++)
            dictionary.put(i, "" + (char)i);

        String w = "" + (char)(int)compressed.remove(0);
        StringBuffer result = new StringBuffer(w);
        for (int k : compressed) {
            String entry;
            if (dictionary.containsKey(k))
                entry = dictionary.get(k);
            else if (k == dictSize)
                entry = w + w.charAt(0);
            else
                throw new IllegalArgumentException("Bad compressed k: " + k);

            result.append(entry);

            // Add w+entry[0] to the dictionary.
            dictionary.put(dictSize++, w + entry.charAt(0));

            w = entry;
        }
        return result.toString();
    }

    public static void main(String[] args) {
        List<Integer> compressed = compress("TOBEORNOTTOBEORTOBEORNOT");
        System.out.println(compressed);
        String decompressed = decompress(compressed);
        System.out.println(decompressed);
    }
}


# SVG STUFF
  def svg(id; width; height):
    "<svg width='\(width // "100%")' height='\(height // "100%") '
        id='\(id)'
        xmlns='http://www.w3.org/2000/svg'>";

  def pixel(x;y;r;g;b;a):
    "<circle cx='\(x)' cy='\(y)' r='1' fill='rgb(\(r|floor),\(g|floor),\(b|floor))' />";

# "UNTIL"
  # As soon as "condition" is true, then emit . and stop:
  def do_until(condition; next):
    def u: if condition then . else (next|u) end;
    u;


//LZW Compression/Decompression for Strings
var LZW = {
    compress: function (uncompressed) {
        "use strict";
        // Build the dictionary.
        var i,
            dictionary = {},
            c,
            wc,
            w = "",
            result = [],
            dictSize = 256;
        for (i = 0; i < 256; i += 1) {
            dictionary[String.fromCharCode(i)] = i;
        }

        for (i = 0; i < uncompressed.length; i += 1) {
            c = uncompressed.charAt(i);
            wc = w + c;
            //Do not use dictionary[wc] because javascript arrays
            //will return values for array['pop'], array['push'] etc
           // if (dictionary[wc]) {
            if (dictionary.hasOwnProperty(wc)) {
                w = wc;
            } else {
                result.push(dictionary[w]);
                // Add wc to the dictionary.
                dictionary[wc] = dictSize++;
                w = String(c);
            }
        }

        // Output the code for w.
        if (w !== "") {
            result.push(dictionary[w]);
        }
        return result;
    },

    decompress: function (compressed) {
        "use strict";
        // Build the dictionary.
        var i,
            dictionary = [],
            w,
            result,
            k,
            entry = "",
            dictSize = 256;
        for (i = 0; i < 256; i += 1) {
            dictionary[i] = String.fromCharCode(i);
        }

        w = String.fromCharCode(compressed[0]);
        result = w;
        for (i = 1; i < compressed.length; i += 1) {
            k = compressed[i];
            if (dictionary[k]) {
                entry = dictionary[k];
            } else {
                if (k === dictSize) {
                    entry = w + w.charAt(0);
                } else {
                    return null;
                }
            }

            result += entry;

            // Add w+entry[0] to the dictionary.
            dictionary[dictSize++] = w + entry.charAt(0);

            w = entry;
        }
        return result;
    }
}, // For Test Purposes
    comp = LZW.compress("TOBEORNOTTOBEORTOBEORNOT"),
    decomp = LZW.decompress(comp);
document.write(comp + '<br>' + decomp);


function mandelbrot(a)
    z = 0
    for i=1:50
        z = z^2 + a
    end
    return z
end

for y=1.0:-0.05:-1.0
    for x=-2.0:0.0315:0.5
        abs(mandelbrot(complex(x, y))) < 2 ? print("*") : print(" ")
    end
    println()
end


# LZW compression/decompression for strings
def lzw_compress:
  def decode: [.] | implode;
  # Build the dictionary:
  256 as $dictSize
  | (reduce range(0; $dictSize) as $i ({}; .[ $i | decode ] = $i)) as $dictionary
  | reduce explode[] as $i
      ( [$dictionary, $dictSize, "", []];        # state: [dictionary, dictSize, w, result]
        .[0] as $dictionary
        | .[1] as $dictSize
        | .[2] as $w
        | ($i | decode) as $c
        | ($w + $c ) as $wc
        | if $dictionary[$wc] then .[2] = $wc
          else
              .[2] =  $c                         # w = c
            | .[3] += [$dictionary[$w]]          # result += dictionary[w]
            | .[0][$wc] = $dictSize              # Add wc to the dictionary
            | .[1] += 1                          # dictSize ++
          end
      )
      # Output the code for w unless w == "":
      | if .[2] == "" then .[3]
        else .[3] + [.[0][.[2]]]
        end
;

def lzw_decompress:
  def decode: [.] | implode;
  # Build the dictionary - an array of strings
  256 as $dictSize
  | (reduce range(0; $dictSize) as $i ([]; .[ $i ] = ($i|decode))) as $dictionary
  | (.[0]|decode) as $w
  | reduce .[1:][] as $k
    ( [ $dictionary, $dictSize, $w, $w];   # state: [dictionary, dictSize, w, result]
      .[0][$k] as $entry
      | (if $entry then $entry
        elif $k == .[1] then .[2] + .[2][0:1]
        else error("lzw_decompress: k=\($k)")
        end) as $entry
      | .[3] += $entry                     # result += entry
      | .[0][.[1]] = .[2] + $entry[0:1]    # dictionary[dictSize] = w + entry.charAt(0);
      | .[1] += 1                          # dictSize++
      | .[2] = $entry                      # w = entry
    ) | .[3]
;


function compressLZW(decompressed::String)
    dictsize = 256
    dict     = Dict{String,Int}(string(Char(i)) => i for i in 0:dictsize)
    result   = Vector{Int}(undef, 0)
    w        = ""
    for c in decompressed
        wc = string(w, c)
        if haskey(dict, wc)
            w = wc
        else
            push!(result, dict[w])
            dict[wc]  = dictsize
            dictsize += 1
            w        = string(c)
        end
    end
    if !isempty(w) push!(result, dict[w]) end
    return result
end

function decompressLZW(compressed::Vector{Int})
    dictsize = 256
    dict     = Dict{Int,String}(i => string('\0' + i) for i in 0:dictsize)
    result   = IOBuffer()
    w        = string(Char(popfirst!(compressed)))
    write(result, w)
    for k in compressed
        if haskey(dict, k)
            entry = dict[k]
        elseif k == dictsize
            entry = string(w, w[1])
        else
            error("bad compressed k: $k")
        end
        write(result, entry)
        dict[dictsize] = string(w, entry[1])
        dictsize += 1
        w = entry
    end
    return String(take!(result))
end

original     = ["0123456789", "TOBEORNOTTOBEORTOBEORNOT", "dudidudidudida"]
compressed   = compressLZW.(original)
decompressed = decompressLZW.(compressed)

for (word, comp, decomp) in zip(original, compressed, decompressed)
    comprate = (length(word) - length(comp)) / length(word) * 100
    println("Original: $word\n-> Compressed: $comp (compr.rate: $(round(comprate, digits=2))%)\n-> Decompressed: $decomp")
end


// version 1.1.2

import java.awt.Graphics
import java.awt.image.BufferedImage
import javax.swing.JFrame

class Mandelbrot: JFrame("Mandelbrot Set") {
    companion object {
        private const val MAX_ITER = 570
        private const val ZOOM = 150.0
    }

    private val img: BufferedImage

    init {
        setBounds(100, 100, 800, 600)
        isResizable = false
        defaultCloseOperation = EXIT_ON_CLOSE
        img = BufferedImage(width, height, BufferedImage.TYPE_INT_RGB)
        for (y in 0 until height) {
            for (x in 0 until width) {
                var zx = 0.0
                var zy = 0.0
                val cX = (x - 400) / ZOOM
                val cY = (y - 300) / ZOOM
                var iter = MAX_ITER
                while (zx * zx + zy * zy < 4.0 && iter > 0) {
                    val tmp = zx * zx - zy * zy + cX
                    zy = 2.0 * zx * zy + cY
                    zx = tmp
                    iter--
                }
                img.setRGB(x, y, iter or (iter shl 7))
            }
        }
    }

    override fun paint(g: Graphics) {
        g.drawImage(img, 0, 0, this)
    }
}

fun main(args: Array<String>) {
    Mandelbrot().isVisible = true
}


// version 1.1.2

object Lzw {
    /** Compress a string to a list of output symbols. */
    fun compress(uncompressed: String): MutableList<Int> {
        // Build the dictionary.
        var dictSize = 256
        val dictionary = mutableMapOf<String, Int>()
        (0 until dictSize).forEach { dictionary.put(it.toChar().toString(), it)}

        var w = ""
        val result = mutableListOf<Int>()
        for (c in uncompressed) {
            val wc = w + c
            if (dictionary.containsKey(wc))
                w = wc
            else {
                result.add(dictionary[w]!!)
                // Add wc to the dictionary.
                dictionary.put(wc, dictSize++)
                w = c.toString()
            }
        }

        // Output the code for w
        if (!w.isEmpty()) result.add(dictionary[w]!!)
        return result
    }

    /** Decompress a list of output symbols to a string. */
    fun decompress(compressed: MutableList<Int>): String {
        // Build the dictionary.
        var dictSize = 256
        val dictionary = mutableMapOf<Int, String>()
        (0 until dictSize).forEach { dictionary.put(it, it.toChar().toString())}

        var w = compressed.removeAt(0).toChar().toString()
        val result = StringBuilder(w)
        for (k in compressed) {
            var entry: String
            if (dictionary.containsKey(k))
                entry = dictionary[k]!!
            else if (k == dictSize)
                entry = w + w[0]
            else
                throw IllegalArgumentException("Bad compressed k: $k")
            result.append(entry)

            // Add w + entry[0] to the dictionary.
            dictionary.put(dictSize++, w + entry[0])
            w = entry
        }
        return result.toString()
    }
}

fun main(args: Array<String>) {
    val compressed = Lzw.compress("TOBEORNOTTOBEORTOBEORNOT")
    println(compressed)
    val decompressed = Lzw.decompress(compressed)
    println(decompressed)
}


: d2c(*,*) 2 compress 'c dress ;        # Make a complex number.

: iterate(c) [0 0](c) "dup * over +" steps reshape execute ;

: print_line(*) "#*+-. " "" split swap subscript "" join . "\n" . ;

75 iota 45 - 20 /                       # x coordinates
29 iota 14 - 10 /                       # y cordinates
'd2c outer                              # Make complex matrix.

10 'steps set                           # How many iterations?

iterate abs int 5 min 'print_line apply # Compute & print


 DIM LZW(1, 1)
 DIM JDlzw(1)
 DIM JDch$(1)
 LET maxBits = 20          ' maximum bit width of the dictionary: minimum=12; maximum=21
 LET resetDictionary = 1   ' flag to reset the dictionary when it gets full: 1=TRUE; 0=FALSE
 LET printDictionary = 0   ' output encoding and decoding dictionaries to files
 LET maxChunkSize = 2 ^ 14 ' maximum size of the data buffer
 LET dSize = 2 ^ maxBits   ' maximum dictionary size
 LET JDext$ = ".lzw"       ' file extension used for created archives
 FILEDIALOG "Select a file to test LZW...", "*.*", inputName$
 IF inputName$ = "" THEN END
 DO ' get fullPath\ and fileName.ext
    P = X
    X = INSTR(inputName$, "\", (X + 1))
 LOOP UNTIL X = 0
 filePath$ = LEFT$(inputName$, P)
 fileName$ = MID$(inputName$, (P + 1))
 DO ' get fileName and .ext
    P = X
    X = INSTR(fileName$, ".", (X + 1))
 LOOP UNTIL X = 0
 fileExt$ = MID$(fileName$, P)
 fileName$ = LEFT$(fileName$, (P - 1))

 GOSUB [lzwEncode]
 GOSUB [lzwDecode]

 END

''''''''''''''''''''''''''''''''''''''''
' Start LZW Encoder ''''''''''''''''''''
[lzwEncode]
 REDIM LZW(dSize, 4)
 LET EMPTY=-1:PREFIX=0:BYTE=1:FIRST=2:LESS=3:MORE=4:bmxCorrect=1
 LET bitsRemain=0:remainIndex=0:tagCount=0:currentBitSize=8:fileTag$=""
 FOR dNext = 0 TO 255                                       ' initialize dictionary for LZW
 '  LZW(dNext, PREFIX) = EMPTY                              ' prefix index of '<index>' <B>
 '  LZW(dNext, BYTE)   = dNext                              ' byte value of <index> '<B>'
    LZW(dNext, FIRST)  = EMPTY                              ' first index to use <index><B> as prefix
 '  LZW(dNext, LESS)   = EMPTY                              ' lesser index of binary search tree for <B>
 '  LZW(dNext, MORE)   = EMPTY                              ' greater index of binary search tree for <B>
 NEXT dNext
 OPEN inputName$ FOR INPUT AS #lzwIN
 IF LOF(#lzwIN) < 2 THEN
    CLOSE #lzwIN
    END
 END IF
 OPEN fileName$ + fileExt$ + JDext$ FOR OUTPUT AS #lzwOUT
 GOSUB [StartFileChunk]
 chnkPoint = 1
 IF maxBits < 12 THEN maxBits = 12
 IF maxBits > 21 THEN maxBits = 21
 settings = maxBits - 12                                    ' setting for dictionary size; 1st decimal +12
 IF resetDictionary THEN settings = settings + 100          ' setting for dictionary type; 2nd decimal even=static, odd=adaptive
 #lzwOUT, CHR$(settings);                                   ' save settings as 1st byte of output
 orgIndex = ASC(LEFT$(fileChunk$, 1))                       ' read 1st byte into <index>
 WHILE fileChunk$ <> ""                                     ' while the buffer is not empty
    DO                                                      ' begin the main encoder loop
        chnkPoint = chnkPoint + 1
        savIndex = FIRST                                    ' initialize the save-to index
        prvIndex = orgIndex                                 ' initialize the previous index in search
        newByte = ASC(MID$(fileChunk$, chnkPoint, 1))       ' read <B>
        dSearch = LZW(orgIndex, FIRST)                      ' first search index for this <index> in the dictionary
        WHILE (dSearch > EMPTY)                             ' while <index> is present in the dictionary
            IF LZW(dSearch, BYTE) = newByte THEN EXIT WHILE ' if <index><B> is found
            IF newByte < LZW(dSearch, BYTE) THEN            ' else if new <B> is less than <index><B>
                savIndex = LESS                             ' follow lesser binary tree
            ELSE
                savIndex = MORE                             ' else follow greater binary tree
            END IF
            prvIndex = dSearch                              ' set previous <index>
            dSearch = LZW(dSearch, savIndex)                ' read next search <index> from binary tree
        WEND
        IF dSearch = EMPTY THEN                             ' if <index><B> was not found in the dictionary
            GOSUB [WriteIndex]                              ' write <index> to the output
            IF dNext < dSize THEN                           ' save <index><B> into the dictionary
                LZW(prvIndex, savIndex) = dNext
                LZW(dNext, PREFIX) = orgIndex
                LZW(dNext, BYTE)   = newByte
                LZW(dNext, FIRST)  = EMPTY
                LZW(dNext, LESS)   = EMPTY
                LZW(dNext, MORE)   = EMPTY
                IF dNext = (2 ^ currentBitSize) THEN currentBitSize = currentBitSize + 1
                dNext = dNext + 1
            ELSE                                            ' else reset the dictionary... or maybe not
                IF resetDictionary THEN
                    GOSUB [PrintEncode]
                    REDIM LZW(dSize, 4)
                    FOR dNext = 0 TO 255
                        LZW(dNext, FIRST)  = EMPTY
                    NEXT dNext
                    currentBitSize = 8
                    bmxCorrect = 0
                END IF
            END IF
            orgIndex = newByte                              ' set <index> = <B>
        ELSE                                                ' if <index><B> was found in the dictionary,
            orgIndex = dSearch                              ' then set <index> = <index><B>
        END IF
    LOOP WHILE chnkPoint < chunk                            ' loop until the chunk has been processed
    GOSUB [GetFileChunk]                                    ' refill the buffer
 WEND                                                       ' loop until the buffer is empty
 GOSUB [WriteIndex]
 IF bitsRemain > 0 THEN #lzwOUT, CHR$(remainIndex);
 CLOSE #lzwOUT
 CLOSE #lzwIN
 IF bmxCorrect THEN ' correct the settings, if needed
    IF (currentBitSize < maxBits) OR resetDictionary THEN
        IF currentBitSize < 12 THEN currentBitSize = 12
        OPEN fileName$ + fileExt$ + JDext$ FOR BINARY AS #lzwOUT
        #lzwOUT, CHR$(currentBitSize - 12);
        CLOSE #lzwOUT
    END IF
 END IF
 GOSUB [PrintEncode]
 REDIM LZW(1, 1)
 RETURN

[WriteIndex]
 X = orgIndex                             ' add remaining bits to input
 IF bitsRemain > 0 THEN X = remainIndex + (X * (2 ^ bitsRemain))
 bitsRemain = bitsRemain + currentBitSize ' add current bit size to output stack
 WHILE bitsRemain > 7                     ' if 8 or more bits are to be written
    #lzwOUT, CHR$(X MOD 256);             ' attatch lower 8 bits to output string
    X = INT(X / 256)                      ' shift input value down by 2^8
    bitsRemain = bitsRemain - 8           ' adjust counters
 WEND
 remainIndex = X                          ' retain trailing bits for next write
 RETURN

' End LZW Encoder ''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''

[StartFileChunk]
 sizeOfFile = LOF(#lzwIN)    ' set EOF marker
 bytesRemaining = sizeOfFile ' set EOF counter
 chunk = maxChunkSize        ' set max buffer size
[GetFileChunk]
 fileChunk$ = ""
 IF bytesRemaining < 1 THEN RETURN
 IF chunk > bytesRemaining THEN chunk = bytesRemaining
 bytesRemaining = bytesRemaining - chunk
 fileChunk$ = INPUT$(#lzwIN, chunk)
 chnkPoint = 0
 RETURN

''''''''''''''''''''''''''''''''''''''''
' Start LZW Decoder ''''''''''''''''''''
[lzwDecode]
 LET EMPTY=-1:bitsRemain=0:tagCount=0:fileTag$=""
 OPEN fileName$ + fileExt$ + JDext$ FOR INPUT AS #lzwIN
 OPEN fileName$ + ".Copy" + fileExt$ FOR OUTPUT AS #lzwOUT
 GOSUB [StartFileChunk]
 chnkPoint = 2
 settings = ASC(fileChunk$)
 maxBits  = VAL(RIGHT$(STR$(settings), 1)) + 12
 dSize = 2 ^ maxBits
 IF settings > 99 THEN resetDictionary = 1
 GOSUB [ResetLZW]
 oldIndex = orgIndex
 WHILE fileChunk$ <> ""
    ' decode current index and write to file
    GOSUB [GetIndex]
    IF JDch$(orgIndex) = "" THEN
        tmpIndex = oldIndex
        tmp$ = JDch$(tmpIndex)
        WHILE JDlzw(tmpIndex) > EMPTY
            tmpIndex = JDlzw(tmpIndex)
            tmp$ = JDch$(tmpIndex) + tmp$
        WEND
        tmp$ = tmp$ + LEFT$(tmp$, 1)
    ELSE
        tmpIndex = orgIndex
        tmp$ = JDch$(tmpIndex)
        WHILE JDlzw(tmpIndex) > EMPTY
            tmpIndex = JDlzw(tmpIndex)
            tmp$ = JDch$(tmpIndex) + tmp$
        WEND
    END IF
    #lzwOUT, tmp$;
    ' add next dictionary entry or reset dictionary
    IF dNext < dSize THEN
        JDlzw(dNext) = oldIndex
        JDch$(dNext) = LEFT$(tmp$, 1)
        dNext = dNext + 1
        IF dNext = (2 ^ currentBitSize) THEN
            IF maxBits > currentBitSize THEN
                currentBitSize = currentBitSize + 1
            ELSE
                IF resetDictionary THEN
                    GOSUB [PrintDecode]
                    GOSUB [ResetLZW]
                END IF
            END IF
        END IF
    END IF
    oldIndex = orgIndex
 WEND
 CLOSE #lzwOUT
 CLOSE #lzwIN
 GOSUB [PrintDecode]
 REDIM JDlzw(1)
 REDIM JDch$(1)
 RETURN

[GetIndex]
 byteCount = 0:orgIndex = 0
 bitsToGrab = currentBitSize - bitsRemain
 IF bitsRemain > 0 THEN
    orgIndex = lastByte
    byteCount = 1
 END IF
 WHILE bitsToGrab > 0
    lastByte = ASC(MID$(fileChunk$, chnkPoint, 1))
    orgIndex = orgIndex + (lastByte * (2 ^ (byteCount * 8)))
    IF chnkPoint = chunk THEN GOSUB [GetFileChunk]
    chnkPoint = chnkPoint + 1
    byteCount = byteCount + 1
    bitsToGrab = bitsToGrab - 8
 WEND
 IF bitsRemain > 0 THEN orgIndex = orgIndex / (2 ^ (8 - bitsRemain))
 orgIndex = orgIndex AND ((2 ^ currentBitSize) - 1)
 bitsRemain = bitsToGrab * (-1)
 RETURN

[ResetLZW]
 REDIM JDlzw(dSize)
 REDIM JDch$(dSize)
 FOR dNext = 0 TO 255
    JDlzw(dNext) = EMPTY       ' Prefix index
    JDch$(dNext) = CHR$(dNext) ' New byte value
 NEXT dNext
 currentBitSize = 8
 GOSUB [GetIndex]
 #lzwOUT, JDch$(orgIndex);
 currentBitSize = 9
 RETURN

' End LZW Decoder ''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''
[PrintEncode]
 IF printDictionary < 1 THEN RETURN
 OPEN "Encode_" + fileTag$ + fileName$ + ".txt" FOR OUTPUT AS #dictOUT
 FOR X = 0 TO 255
    LZW(X, PREFIX) = EMPTY
    LZW(X, BYTE)   = X
 NEXT X
 FOR X = dNext TO 0 STEP -1
    tmpIndex = X
    tmp$ = CHR$(LZW(tmpIndex, BYTE))
    WHILE LZW(tmpIndex, PREFIX) > EMPTY
        tmpIndex = LZW(tmpIndex, PREFIX)
        tmp$ = CHR$(LZW(tmpIndex, BYTE)) + tmp$
    WEND
    #dictOUT, X; ":"; tmp$
 NEXT X
 CLOSE #dictOUT
 tagCount = tagCount + 1
 fileTag$ = STR$(tagCount) + "_"
 RETURN

[PrintDecode]
 IF printDictionary < 1 THEN RETURN
 OPEN "Decode_" + fileTag$ + fileName$ + ".txt" FOR OUTPUT AS #dictOUT
 FOR X = dNext TO 0 STEP -1
    tmpIndex = X
    tmp$ = JDch$(tmpIndex)
    WHILE JDlzw(tmpIndex) > EMPTY
        tmpIndex = JDlzw(tmpIndex)
        tmp$ = JDch$(tmpIndex) + tmp$
    WEND
    #dictOUT, X; ":"; tmp$
 NEXT X
 CLOSE #dictOUT
 tagCount = tagCount + 1
 fileTag$ = STR$(tagCount) + "_"
 RETURN
''''''''''''''''''''''''''''''''''''''''


local function compress(uncompressed) -- string
  local dictionary, result, dictSize, w, c = {}, {}, 255, ""
  for i = 0, 255 do
    dictionary[string.char(i)] = i
  end
  for i = 1, #uncompressed do
    c = string.sub(uncompressed, i, i)
    if dictionary[w .. c] then
      w = w .. c
    else
      table.insert(result, dictionary[w])
      dictSize = dictSize + 1
      dictionary[w .. c] = dictSize
      w = c
    end
  end
  if w ~= "" then
    table.insert(result, dictionary[w])
  end
  return result
end

local function decompress(compressed) -- table
  local dictionary, dictSize, entry, w, k = {}, 256, "", string.char(compressed[1])
  local result = {w}
  for i = 0, 255 do
    dictionary[i] = string.char(i)
  end
  for i = 2, #compressed do
    k = compressed[i]
    if dictionary[k] then
      entry = dictionary[k]
    elseif k == dictSize then
      entry = w .. string.sub(w, 1, 1)
    else
      return nil, i
    end
    table.insert(result, entry)
    dictionary[dictSize] = w .. string.sub(entry, 1, 1)
    dictSize = dictSize + 1
    w = entry
  end
  return table.concat(result)
end

local example = "TOBEORNOTTOBEORTOBEORNOT"
local com = compress(example)
local dec = decompress(com)
print(table.concat(com, ", "))
print(dec)


{def mandel

 {def mandel.r
  {lambda {:iter :cx :cy :norm :x :y :count}
   {if {> :count :iter}                       // then norm < 4
    then o                                    // inside the set
    else {if {> :norm 4}                      // then iter > max
    then .                                    // outside the set
    else {let { {:cx :cx} {:cy :cy} {:iter :iter}
                {:X {+ {* :x :x} -{* :y :y} :cx}}  // compute
                {:Y {+ {* 2 :x :y} :cy}}           // z = z^2+c
                {:count {+ :count 1}}
              } {mandel.r :iter :cx :cy
                          {+ {* :X :X} {* :Y :Y}}  // the norm
                          :X :Y :count} }}}}}

 {lambda {:iter :cx :cy}
  {mandel.r :iter
            {+ {* :cx 0.05} -1.50}       // centering the set
            {+ {* :cy 0.05} -0.75}       // inside the frame
            0 0 0 0} }}
-> mandel

We call mandel directly in the wiki page

{S.map {lambda {:i} {br}     // loop on y
  {S.map {{lambda {:i :j}    // loop on x
    {mandel 20 :i :j}} :i}   // compute
  {S.serie 0 30}}}           // x resolution
{S.serie 0 40}}              // y resolution


Module BBCtrans {
      \\ LZW compression
      plaintext$="TOBEORNOTTOBEORTOBEORNOT"
      Function encodeLZW$(i$) {
                  Def long c, d, i, l, o$, w$
                  DIM dict$(0 to 4095)
                  FOR i = 0 TO 255 : dict$(i) = CHR$(i) : NEXT i
                  l = i
                  i = 1
                  w$ = LEFT$(i$,1)
                  REPEAT{
                          d = 0
                          REPEAT {
                                  c = d
                                  IF i > LEN(i$) THEN EXIT
                                  FOR d = 1 TO l-1
                                    IF w$ = dict$(d) THEN EXIT
                                  NEXT d
                                  IF d < l Then i += 1 : w$ += MID$(i$, i, 1)
                        } UNTIL d >= l
                          dict$(l) = w$ : l += 1 : w$ = RIGHT$(w$, 1)
                          o$ += CHR$(c MOD 256) + CHR$(c DIV 256)
                  } UNTIL i > LEN(i$)
                  = o$
      }
      encodeLZW$ = encodeLZW$(plaintext$)
      FOR i = 1 TO LEN(encodeLZW$) STEP 2
              PRINT ASC(MID$(encodeLZW$,i)) + 256*ASC(MID$(encodeLZW$,i+1));" ";
      NEXT i
      Print
      Function decodeLZW$(i$) {
                  Def c, i, l, o$, t$, w$
                  DIM dict$(0 to 4095)
                  FOR i = 0 TO 255 : dict$(i) = CHR$(i) : NEXT i
                  l = i
                  c = ASC(i$) + 256*ASC(MID$(i$,2))
                  w$ = dict$(c)
                  o$ = w$
                  IF LEN(i$) < 4 THEN = o$
                  FOR i = 3 TO LEN(i$) STEP 2
                    c = ASC(MID$(i$,i)) + 256*ASC(MID$(i$,i+1))
                    IF c < l Then { t$ = dict$(c) } ELSE t$ = w$ + LEFT$(w$,1)
                    o$ += t$
                    dict$(l) = w$ + LEFT$(t$,1)
                    l += 1
                    w$ = t$
                  NEXT i
                  = o$
      }
      Print decodeLZW$(encodeLZW$)
}
BBCtrans


compress[uncompressed_] :=
  Module[{dictsize, dictionary, w, result, wc},
   dictsize = 256;
   dictionary = # -> # & /@ FromCharacterCode /@ [email protected];
   w = "";
   result = {};
   Do[wc = w <> c;
    If[MemberQ[dictionary[[All, 1]], wc],
     w = wc,
     AppendTo[result, w /. dictionary];
     AppendTo[dictionary, wc -> dictsize];
     dictsize++;
     w = c],
    {c, Characters[uncompressed]}];
   AppendTo[result, w /. dictionary];
   result];
decompress::bc = "Bad compressed `1`";
decompress[compressed_] :=
  Module[{dictsize, dictionary, w, result, entry},
   dictsize = 256;
   dictionary = # -> # & /@ FromCharacterCode /@ [email protected];
   w = result = compressed[[1]];
   Do[Which[MemberQ[dictionary[[All, 1]], k],
     entry = k /. dictionary,
     k == dictsize,
     entry = w <> StringTake[w, 1],
     True,
     Message[decompress::bc, k]];
    result = result <> entry;
    AppendTo[dictionary, dictsize -> w <> StringTake[entry, 1]];
    dictsize++;
    w = entry,
    {k, compressed[[2 ;;]]}];
   result];
(*How to use:*)
compress["TOBEORNOTTOBEORTOBEORNOT"]
decompress[%]


define mandelbrotBailout => 16
define mandelbrotMaxIterations => 1000

define mandelbrotIterate(x, y) => {
	local(cr = #y - 0.5,
		ci = #x,
		zi = 0.0,
		zr = 0.0,
		i = 0,
		temp, zr2, zi2)

	{
		++#i;
		#temp = #zr * #zi
		#zr2 = #zr * #zr
		#zi2 = #zi * #zi

		#zi2 + #zr2 > mandelbrotBailout?
			return #i
		#i > mandelbrotMaxIterations?
			return 0

		#zr = #zr2 - #zi2 + #cr
		#zi = #temp + #temp + #ci

		currentCapture->restart
	}()
}

define mandelbrotTest() => {
	local(x, y = -39.0)
	{
		stdout('\n')
		#x = -39.0
		{
			mandelbrotIterate(#x / 40.0, #y / 40.0) == 0?
				stdout('*')
				| stdout(' ');
			++#x
			#x <= 39.0?
				currentCapture->restart
		}();
		++#y

		#y <= 39.0?
			currentCapture->restart
	}()
	stdout('\n')
}

mandelbrotTest


#
# A mandelbrot generator that outputs a PBM file. This can be used to measure
# performance differences between LIL versions and measure performance
# bottlenecks (although keep in mind that LIL is not supposed to be a fast
# language, but a small one which depends on C for the slow parts - in a real
# program where for some reason mandelbrots are required, the code below would
# be written in C). The code is based on the mandelbrot test for the Computer
# Language Benchmarks Game at http://shootout.alioth.debian.org/
#
# In my current computer (Intel Core2Quad Q9550 @ 2.83GHz) running x86 Linux
# the results are (using the default 256x256 size):
#
#  2m3.634s  - commit 1c41cdf89f4c1e039c9b3520c5229817bc6274d0 (Jan 10 2011)
#
# To test call
#
#  time ./lil mandelbrot.lil > mandelbrot.pbm
#
# with an optimized version of lil (compiled with CFLAGS=-O3 make).
#

set width [expr $argv]
if not $width { set width 256 }
set height $width
set bit_num 0
set byte_acc 0
set iter 50
set limit 2.0

write "P4\n${width} ${height}\n"

for {set y 0} {$y < $height} {inc y} {
   for {set x 0} {$x < $width} {inc x} {
       set Zr 0.0 Zi 0.0 Tr 0.0 Ti 0.0
       set Cr [expr 2.0 * $x / $width - 1.5]
       set Ci [expr 2.0 * $y / $height - 1.0]
       for {set i 0} {$i < $iter && $Tr + $Ti <= $limit * $limit} {inc i} {
           set Zi [expr 2.0 * $Zr * $Zi + $Ci]
           set Zr [expr $Tr - $Ti + $Cr]
           set Tr [expr $Zr * $Zr]
           set Ti [expr $Zi * $Zi]
       }

       set byte_acc [expr $byte_acc << 1]
       if [expr $Tr + $Ti <= $limit * $limit] {
           set byte_acc [expr $byte_acc | 1]
       }

       inc bit_num

       if [expr $bit_num == 8] {
           writechar $byte_acc
           set byte_acc 0
           set bit_num 0
       } {if [expr $x == $width - 1] {
           set byte_acc [expr 8 - $width % 8]
           writechar $byte_acc
           set byte_acc 0
           set bit_num 0
       }}
   }
}


import tables

proc compress*(uncompressed: string): seq[int] =

  # Build the dictionary.
  var dictionary: Table[string, int]
  for i in 0..255: dictionary[$chr(i)] = i

  var w = ""
  for c in uncompressed:
    var wc = w & c
    if wc in dictionary:
      w = wc
    else:
      # Writes "w" to output.
      result.add dictionary[w]
      # "wc" is a new sequence: add it to the dictionary.
      dictionary[wc] = dictionary.len
      w = $c

  # Write remaining output if necessary.
  if w.len > 0: result.add dictionary[w]

proc decompress*(compressed: var seq[int]): string =

  # Build the dictionary.
  var dictionary: Table[int, string]
  for i in 0..255: dictionary[i] = $chr(i)

  var w = dictionary[compressed[0]]
  compressed.delete(0)

  result = w
  for k in compressed:
    var entry: string
    if k in dictionary:
      entry = dictionary[k]
    elif k == dictionary.len:
      entry = w & w[0]
    else:
      raise newException(ValueError, "Bad compressed k: " & $k)
    result.add entry
    # New sequence: add it to the dictionary.
    dictionary[dictionary.len] = w & entry[0]
    w = entry

when isMainModule:
  var compressed = compress("TOBEORNOTTOBEORTOBEORNOT")
  echo compressed
  var decompressed = decompress(compressed)
  echo decompressed


use Collection;

class LZW {
  function : Main(args : String[]) ~ Nil {
    compressed := Compress("TOBEORNOTTOBEORTOBEORNOT");
    Show(compressed);
    decompressed := Decompress(compressed);
    decompressed->PrintLine();
  }

  function : native : Compress(uncompressed : String) ~ IntVector {
    # Build the dictionary.
    dictSize := 256;
      dictionary := StringMap->New();
      for (i := 0; i < 256; i+=1;) {
        key := "";
        key->Append(i->As(Char));
        dictionary->Insert(key, IntHolder->New(i));
    };

    w := "";
    result := IntVector->New();

    each (i : uncompressed) {
      c := uncompressed->Get(i);
      wc := String->New(w);
      wc->Append(c);
        if (dictionary->Has(wc)) {
          w := wc;
        }
        else {
          value := dictionary->Find(w)->As(IntHolder);
          result->AddBack(value->Get());
          # Add wc to the dictionary.
          dictionary->Insert(wc, IntHolder->New(dictSize));
          dictSize+=1;
          w := "";
          w->Append(c);
        };
      };

      # Output the code for w.
      if (w->Size() > 0) {
        value := dictionary->Find(w)->As(IntHolder);
        result->AddBack(value->Get());
      };

      return result;
  }

  function : Decompress(compressed : IntVector) ~ String {
    # Build the dictionary.
    dictSize := 256;
    dictionary := IntMap->New();
    for (i := 0; i < 256; i+=1;) {
      value := "";
      value->Append(i->As(Char));
      dictionary->Insert(i, value);
    };

    w := "";
    found := compressed->Remove(0);
    w->Append(found->As(Char));

    result := String->New(w);
    each (i : compressed) {
      k := compressed->Get(i);

      entry : String;
      if (dictionary->Has(k)) {
        entry := dictionary->Find(k);
      }
      else if (k = dictSize) {
        entry := String->New(w);
        entry->Append(w->Get(0));
      }
      else {
        return "";
      };
      result->Append(entry);

      # Add w+entry[0] to the dictionary.
      value := String->New(w);
      value->Append(entry->Get(0));
      dictionary->Insert(dictSize, value);
      dictSize+=1;

      w := entry;
    };

    return result;
  }

  function : Show(results : IntVector) ~ Nil {
    "["->Print();
    each(i : results) {
      results->Get(i)->Print();
      if(i + 1 < results->Size()) {
        ", "->Print();
      };
    };
    "]"->PrintLine();
  }
}


to mandelbrot :left :bottom :side :size
  cs setpensize [1 1]
  make "inc :side/:size
  make "zr :left
  repeat :size [
    make "zr :zr + :inc
    make "zi :bottom
    pu
    setxy repcount - :size/2  minus :size/2
    pd
    repeat :size [
      make "zi :zi + :inc
      setpencolor count.color calc :zr :zi
      fd 1 ] ]
end

to count.color :count
  ;op (list :count :count :count)
  if :count > 256 [op 0]	; black
  if :count > 128 [op 7]	; white
  if :count >  64 [op 5]	; magenta
  if :count >  32 [op 6]	; yellow
  if :count >  16 [op 4]	; red
  if :count >   8 [op 2]	; green
  if :count >   4 [op 1]	; blue
  op 3				; cyan
end

to calc :zr :zi [:count 0] [:az 0] [:bz 0]
  if :az*:az + :bz*:bz > 4 [op :count]
  if :count > 256 [op :count]
  op (calc :zr :zi (:count + 1) (:zr + :az*:az - :bz*:bz) (:zi + 2*:az*:bz))
end

mandelbrot -2 -1.25 2.5 400


#import <Foundation/Foundation.h>
#import <stdio.h>

@interface LZWCompressor : NSObject
{
  @private
    NSMutableArray *iostream;
    NSMutableDictionary *dict;
    NSUInteger codemark;
}

-(instancetype) init;
-(instancetype) initWithArray: (NSMutableArray *) stream;
-(BOOL) compressData: (NSData *) string;
-(void) setArray: (NSMutableArray *) stream;
-(NSArray *) getArray;
@end

@implementation LZWCompressor : NSObject

-(instancetype) init
{
   self = [super init];
   if ( self )
   {
      iostream = nil;
      codemark = 256;
      dict = [[NSMutableDictionary alloc] initWithCapacity: 512];
   }
   return self;
}

-(instancetype) initWithArray: (NSMutableArray *) stream
{
   self = [self init];
   if ( self )
   {
      [self setArray: stream];
   }
   return self;
}

-(void) setArray: (NSMutableArray *) stream
{
   iostream = stream;
}

-(BOOL) compressData: (NSData *) string;
{
    // prepare dict
    for(NSUInteger i=0; i < 256; i++)
    {
       unsigned char j = i;
       NSData *s = [NSData dataWithBytes: &j length: 1];
       dict[s] = @(i);
    }

    NSData *w = [NSData data];

    for(NSUInteger i=0; i < [string length]; i++)
    {
       NSMutableData *wc = [NSMutableData dataWithData: w];
       [wc appendData: [string subdataWithRange: NSMakeRange(i, 1)]];
       if ( dict[wc] != nil )
       {
          w = wc;
       } else {
          [iostream addObject: dict[w]];
          dict[wc] = @(codemark);
          codemark++;
          w = [string subdataWithRange: NSMakeRange(i, 1)];
       }
    }
    if ( [w length] != 0 )
    {
       [iostream addObject: dict[w]];
    }
    return YES;
}

-(NSArray *) getArray
{
  return iostream;
}

@end


local maxIterations = 250
local minX, maxX, minY, maxY = -2.5, 2.5, -2.5, 2.5
local miX, mxX, miY, mxY
function remap( x, t1, t2, s1, s2 )
    local f = ( x - t1 ) / ( t2 - t1 )
    local g = f * ( s2 - s1 ) + s1
    return g;
end
function drawMandelbrot()
    local pts, a, as, za, b, bs, zb, cnt, clr = {}
    for j = 0, hei - 1 do
        for i = 0, wid - 1 do
            a = remap( i, 0, wid, minX, maxX )
            b = remap( j, 0, hei, minY, maxY )
            cnt = 0; za = a; zb = b
            while( cnt < maxIterations ) do
                as = a * a - b * b; bs = 2 * a * b
                a = za + as; b = zb + bs
                if math.abs( a ) + math.abs( b ) > 16 then break end
                cnt = cnt + 1
            end
            if cnt == maxIterations then clr = 0
            else clr = remap( cnt, 0, maxIterations, 0, 255 )
            end
            pts[1] = { i, j, clr, clr, 0, 255 }
            love.graphics.points( pts )
        end
    end
end
function startFractal()
    love.graphics.setCanvas( canvas ); love.graphics.clear()
    love.graphics.setColor( 255, 255, 255 )
    drawMandelbrot(); love.graphics.setCanvas()
end
function love.load()
    wid, hei = love.graphics.getWidth(), love.graphics.getHeight()
    canvas = love.graphics.newCanvas( wid, hei )
    startFractal()
end
function love.mousepressed( x, y, button, istouch )
    if button ==  1 then
        startDrag = true; miX = x; miY = y
    else
        minX = -2.5; maxX = 2.5; minY = minX; maxY = maxX
        startFractal()
        startDrag = false
    end
end
function love.mousereleased( x, y, button, istouch )
    if startDrag then
        local l
        if x > miX then mxX = x
        else l = x; mxX = miX; miX = l
        end
        if y > miY then mxY = y
        else l = y; mxY = miY; miY = l
        end
        miX = remap( miX, 0, wid, minX, maxX )
        mxX = remap( mxX, 0, wid, minX, maxX )
        miY = remap( miY, 0, hei, minY, maxY )
        mxY = remap( mxY, 0, hei, minY, maxY )
        minX = miX; maxX = mxX; minY = miY; maxY = mxY
        startFractal()
    end
end
function love.draw()
    love.graphics.draw( canvas )
end


#directory "+extlib"  (* or maybe "+site-lib/extlib/" *)
#load "extLib.cma"
open ExtString

(** compress a string to a list of output symbols *)
let compress ~uncompressed =
  (* build the dictionary *)
  let dict_size = 256 in
  let dictionary = Hashtbl.create 397 in
  for i=0 to 255 do
    let str = String.make 1 (char_of_int i) in
    Hashtbl.add dictionary str i
  done;

  let f = (fun (w, dict_size, result) c ->
    let c = String.make 1 c in
    let wc = w ^ c in
    if Hashtbl.mem dictionary wc then
      (wc, dict_size, result)
    else
      begin
        (* add wc to the dictionary *)
        Hashtbl.add dictionary wc dict_size;
        let this = Hashtbl.find dictionary w in
        (c, dict_size + 1, this::result)
      end
  ) in
  let w, _, result =
    String.fold_left f ("", dict_size, []) uncompressed
  in

  (* output the code for w *)
  let result =
    if w = ""
    then result
    else (Hashtbl.find dictionary w) :: result
  in

  (List.rev result)
;;

exception ValueError of string

(** decompress a list of output symbols to a string *)
let decompress ~compressed =
  (* build the dictionary *)
  let dict_size = 256 in
  let dictionary = Hashtbl.create 397 in
  for i=0 to pred dict_size do
    let str = String.make 1 (char_of_int i) in
    Hashtbl.add dictionary i str
  done;

  let w, compressed =
    match compressed with
    | hd::tl -> (String.make 1 (char_of_int hd)), tl
    | [] -> failwith "empty input"
  in

  let result = [w] in

  let result, _, _ =
    List.fold_left (fun (result, w, dict_size) k ->
      let entry =
        if Hashtbl.mem dictionary k then
          Hashtbl.find dictionary k
        else if k = Hashtbl.length dictionary then
          w ^ (String.make 1 w.[0])
        else
          raise(ValueError(Printf.sprintf "Bad compressed k: %d" k))
      in
      let result = entry :: result in

      (* add (w ^ entry.[0]) to the dictionary *)
      Hashtbl.add dictionary dict_size (w ^ (String.make 1 entry.[0]));
      (result, entry, dict_size + 1)
    ) (result, w, dict_size) compressed
  in
  (List.rev result)
;;


Module Mandelbrot(x=0&,y=0&,z=1&) {
      If z<1  then z=1
      If z>16 then z=16
      Const iXmax=32*z
      Const iYmax=26*z
      Def single Cx, Cy, CxMin=-2.05, CxMax=0.85, CyMin=-1.2,  CyMax=1.2
      Const PixelWidth=(CxMax-CxMin)/iXmax, iXm=(iXmax-1)*PixelWidth
      Const PixelHeight=(CyMax-CyMin)/iYmax,Ph2=PixelHeight/2
      Const Iteration=25
      Const EscRadious=2.5, ER2=EscRadious**2
      Def single preview
      preview=iXmax*twipsX*(z/16)
      Def long yp, xp, dx, dy, dx1, dy1
      Let dx=twipsx*(16/z), dx1=dx-1
      Let dy=twipsy*(16/z), dy1=dy-1
      yp=y
      For iY=0 to (iYmax-1)*PixelHeight step PixelHeight {
            Cy=CyMin+iY
            xp=x
            if abs(Cy)<Ph2 Then Cy=0
            For iX=0 to iXm Step PixelWidth {
                  Let  Cx=CxMin+iX,Zx=0,Zy=0,Zx2=Zx**2,Zy2=Zy**2
                  For It=Iteration to 1 {Let Zy=2*Zx*Zy+Cy,Zx=Zx2-Zy2+Cx,Zx2=Zx**2,Zy2=Zy**2 :if Zx2+Zy2>ER2 Then exit
                  }
                  if it>13 then {it-=13} else.if it=0 then SetPixel(xp,yp,0): xp+=dx : continue
                  it*=10:SetPixel(xp,yp,color(it, it,255)) :xp+=dx
            } : yp+=dy
      }
      Sub SetPixel()
            move number, number: fill  dx1, dy1, number
      End Sub
}
Cls 1,0
sz=(1,2,4,8,16)
i=each(sz)
While i {
      Mandelbrot 250*twipsx,100*twipsy, array(i)
}


(define (compress str)
(let loop ((dc (fold (lambda (f x) ; dictionary (simplest, not optimized), with reversed codes
                        (cons (list x) (cons x f)))
                  '() (iota 256)))
           (w '()) ; output sequence (reversed)
           (s 256) ; maximal dictionary code value + 1
           (x '()) ; current sequence
           (r (str-iter str))); input stream
   (cond
      ((null? r)
         (reverse (cons (cadr (member x dc)) w)))
      ((pair? r)
         (let ((xy (cons (car r) x)))
            (if (member xy dc)
               (loop dc w s xy (cdr r))
               (loop (cons xy (cons s dc))         ; update dictionary with xy . s
                     (cons (cadr (member x dc)) w) ; add code to output stream
                     (+ s 1) ; increase code
                     (list (car r)) ; new current sequence
                     (cdr r))))) ; next input
      (else
         (loop dc w s x (r)))))
)

(print (compress "TOBEORNOTTOBEORTOBEORNOT")) ; => (84 79 66 69 79 82 78 79 84 256 258 260 265 259 261 263)


ImageTools:-Embed(Fractals[EscapeTime]:-Mandelbrot(500, -2.0-1.35*I, .7+1.35*I, output = layer1));


eTime[c_, maxIter_Integer: 100] := [email protected][#^2 + c &, 0, [email protected]# <= 2 &, 1, maxIter] - 1

DistributeDefinitions[eTime];
mesh = ParallelTable[eTime[x + I*y, 1000], {y, 1.2, -1.2, -0.01}, {x, -1.72, 1, 0.01}];
ReliefPlot[mesh, Frame -> False]


# Compress a string to a list of output symbols.
sub compress {
    my $uncompressed = shift;

    # Build the dictionary.
    my $dict_size = 256;
    my %dictionary = map {chr $_ => chr $_} 0..$dict_size-1;

    my $w = "";
    my @result;
    foreach my $c (split '', $uncompressed) {
        my $wc = $w . $c;
        if (exists $dictionary{$wc}) {
            $w = $wc;
        } else {
            push @result, $dictionary{$w};
            # Add wc to the dictionary.
            $dictionary{$wc} = $dict_size;
            $dict_size++;
            $w = $c;
        }
    }

    # Output the code for w.
    if ($w) {
        push @result, $dictionary{$w};
    }
    return @result;
}

# Decompress a list of output ks to a string.
sub decompress {
    my @compressed = @_;

    # Build the dictionary.
    my $dict_size = 256;
    my %dictionary = map {chr $_ => chr $_} 0..$dict_size-1;

    my $w = shift @compressed;
    my $result = $w;
    foreach my $k (@compressed) {
        my $entry;
        if (exists $dictionary{$k}) {
            $entry = $dictionary{$k};
        } elsif ($k == $dict_size) {
            $entry = $w . substr($w,0,1);
        } else {
            die "Bad compressed k: $k";
        }
        $result .= $entry;

        # Add w+entry[0] to the dictionary.
        $dictionary{$dict_size} = $w . substr($entry,0,1);
        $dict_size++;

        $w = $entry;
    }
    return $result;
}

# How to use:
my @compressed = compress('TOBEORNOTTOBEORTOBEORNOT');
print "@compressed\n";
my $decompressed = decompress(@compressed);
print "$decompressed\n";


filter mandelbrot (gradient coloration)
   c=ri:(xy/xy:[X,X]*1.5-xy:[0.5,0]);
   z=ri:[0,0]; # initial value z0 = 0
   # iteration of z
   iter=0;
   while abs(z)<2 && iter<31
   do
       z=z*z+c;  # z(n+1) = fc(zn)
       iter=iter+1
   end;
   coloration(iter/32) # color of pixel
end


function [theSet,realAxis,imaginaryAxis] = mandelbrotSet(start,gridSpacing,last,maxIteration)

    %Define the escape time algorithm
    function escapeTime = escapeTimeAlgorithm(z0)

        escapeTime = 0;
        z = 0;

        while( (abs(z)<=2) && (escapeTime < maxIteration) )
            z = (z + z0)^2;
            escapeTime = escapeTime + 1;
        end

    end

    %Define the imaginary axis
    imaginaryAxis = (imag(start):imag(gridSpacing):imag(last));

    %Define the real axis
    realAxis = (real(start):real(gridSpacing):real(last));

    %Construct the complex plane from the real and imaginary axes
    complexPlane = meshgrid(realAxis,imaginaryAxis) + meshgrid(imaginaryAxis(end:-1:1),realAxis)'.*i;

    %Apply the escape time algorithm to each point in the complex plane
    theSet = arrayfun(@escapeTimeAlgorithm, complexPlane);

    %Draw the set
    pcolor(realAxis,imaginaryAxis,theSet);
    shading flat;

end


with javascript_semantics
function compress(string uncompressed)
integer dict = new_dict()
sequence result = {}
integer dictSize = 255, c
string word = ""
    for i=0 to 255 do
        setd(""&i,i,dict)
    end for
    for i=1 to length(uncompressed) do
        c = uncompressed[i]
        if getd_index(word&c,dict) then
            word &= c
        else
            result &= getd(word,dict)
            dictSize += 1
            setd(word&c,dictSize,dict)
            word = ""&c
        end if
    end for
    if word!="" then
        result &= getd(word,dict)
    end if
    destroy_dict(dict)
    return result
end function

function decompress(sequence compressed)
integer dict = new_dict()
integer dictSize = 255, k, ki
string dent = "", result = "", word = ""
    for i=0 to 255 do
        setd(i,""&i,dict)
    end for
    for i=1 to length(compressed) do
        k = compressed[i]
        ki = getd_index(k,dict)
        if ki then
            dent = getd_by_index(ki,dict)
        elsif k=dictSize then
            dent = word&word[1]
        else
            return {NULL,i}
        end if
        result &= dent
        setd(dictSize,word&dent[1],dict)
        dictSize += 1
        word = dent
    end for
    destroy_dict(dict)
    return result
end function

constant example = "TOBEORNOTTOBEORTOBEORNOT"
sequence com = compress(example)
pp(com,{pp_IntCh,true,pp_Maxlen,90})
?decompress(com)


prologues:=3;
outputtemplate:="%j-%c.svg";
outputformat:="svg";

def mandelbrot(expr maxX, maxY) =
  max_iteration := 500;

  color col[];
  for i := 0 upto max_iteration:
    t := i / max_iteration;
    col[i] = (t,t,t);
  endfor;

  for px := 0 upto maxX:
    for py := 0 upto maxY:
      xz := px * 3.5 / maxX - 2.5;  % (-2.5,1)
      yz := py * 2 / maxY - 1;      % (-1,1)

      x := 0;
      y := 0;

      iteration := 0;

      forever: exitunless ((x*x + y*y < 4) and (iteration < max_iteration));
        xtemp := x*x - y*y + xz;
        y := 2*x*y + yz;
        x := xtemp;
        iteration := iteration + 1;
      endfor;

      draw (px,py) withpen pencircle withcolor col[iteration];

    endfor;
  endfor;
enddef;

beginfig(1);
  mandelbrot(200, 150);
endfig;

end


class LZW
{
    function compress($unc) {
        $i;$c;$wc;
        $w = "";
        $dictionary = array();
        $result = array();
        $dictSize = 256;
        for ($i = 0; $i < 256; $i += 1) {
            $dictionary[chr($i)] = $i;
        }
        for ($i = 0; $i < strlen($unc); $i++) {
            $c = $unc[$i];
            $wc = $w.$c;
            if (array_key_exists($w.$c, $dictionary)) {
                $w = $w.$c;
            } else {
                array_push($result,$dictionary[$w]);
                $dictionary[$wc] = $dictSize++;
                $w = (string)$c;
            }
        }
        if ($w !== "") {
            array_push($result,$dictionary[$w]);
        }
        return implode(",",$result);
    }

    function decompress($com) {
        $com = explode(",",$com);
        $i;$w;$k;$result;
        $dictionary = array();
        $entry = "";
        $dictSize = 256;
        for ($i = 0; $i < 256; $i++) {
            $dictionary[$i] = chr($i);
        }
        $w = chr($com[0]);
        $result = $w;
        for ($i = 1; $i < count($com);$i++) {
            $k = $com[$i];
            if ($dictionary[$k]) {
                $entry = $dictionary[$k];
            } else {
                if ($k === $dictSize) {
                    $entry = $w.$w[0];
                } else {
                    return null;
                }
            }
            $result .= $entry;
            $dictionary[$dictSize++] = $w . $entry[0];
            $w = $entry;
        }
        return $result;
    }
}

//How to use
$str = 'TOBEORNOTTOBEORTOBEORNOT';
$lzw = new LZW();
$com = $lzw->compress($str);
$dec = $lzw->decompress($com);
echo $com . "<br>" . $dec;


ZOOM = 100
MAX_ITER = 40
gfx.clear color.black
for y in range(0,200)
	for x in range(0,300)
		zx = 0
		zy = 0
		cx = (x - 200) / ZOOM
		cy = (y - 100) / ZOOM
		for iter in range(MAX_ITER)
			if zx*zx + zy*zy > 4 then break
			tmp = zx * zx - zy * zy + cx
			zy = 2 * zx * zy + cy
			zx = tmp
		end for
		if iter then
			gfx.setPixel x, y, rgb(255-iter*6, 0, iter*6)
		end if
	end for
end for


go =>
  S = "TOBEORNOTTOBEORTOBEORNOT",
  println(s=S),
  println(len=S.length),

  Compressed = compress(S),
  println(compressed=Compressed),
  println(len=Compressed.length),

  Uncompressed = uncompress(Compressed),
  println(uncompressed=Uncompressed),

  printf("compressed to %3.3f%%\n", 100*(Compressed.length / S.length)),

  if S = Uncompressed then
    println("Same!")
  else
    println("Error: S != Uncompressed!"),
    printf("S.length: %d  Uncompressed.length: %d\n", S.length, Uncompressed.length),
    edit(S,Uncompressed,Distance,Diffs),
    println(distance=Distance),
    println(diffs=Diffs)
  end,
  nl.

compress(Uncompressed) = Compressed =>
  DictSize = 256,
  Dict = new_map([C=C : I in 1..DictSize-1, C=chr(I).to_string()]),
  W = "",
  Result = [],
  foreach(C in Uncompressed)
    C := C.to_string(),
    WC = W ++ C,
    if Dict.has_key(WC) then
      W := WC
    else
      Result := Result ++ [Dict.get(W)],
      Dict.put(WC, DictSize),
      DictSize := DictSize + 1,
      W := C
    end
  end,
  if W.length > 0 then
     Result := Result ++ [Dict.get(W)]
  end,
  Compressed = Result.

uncompress(Compressed) = Uncompressed =>
  DictSize = 256,
  Dict = new_map([ C=C : I in 1..DictSize-1, C=chr(I).to_string()]),
  W = Compressed.first(),
  Compressed := Compressed.tail(),
  Result = W,

  Entry = "",
  foreach(K in Compressed)
    if Dict.has_key(K) then
      Entry := Dict.get(K)
    elseif K == DictSize then
      Entry := W ++ W[1].to_string()
    else
      printf("Bad compressed K: %w\n", K)
    end,
    Result := Result ++ Entry,
    Dict.put(DictSize,(W ++ Entry[1].to_string())),
    DictSize := DictSize + 1,
    W := Entry
  end,
  Uncompressed = Result.flatten().

%
% Computing the minimal editing distance of two given lists
%
table(+,+,min,-)
edit([],[],D,Diffs) => D=0, Diffs=[].
edit([X|Xs],[X|Ys],D,Diffs) =>   % copy
    edit(Xs,Ys,D,Diffs).
edit(Xs,[Y|Ys],D,Diffs) ?=>      % insert
    edit(Xs,Ys,D1,Diffs1),
    D=D1+1,
    Diffs = [insert=Y,xPos=Xs.length,yPos=Ys.length|Diffs1].
edit([X|Xs],Ys,D,Diffs) =>       % delete
    edit(Xs,Ys,D1,Diffs1),
    D=D1+1,
    Diffs = [[delete=X,xPos=Xs.length,yPos=Ys.length]|Diffs1].


(de lzwCompress (Lst)
   (let (Codes 255  Dict)
      (balance 'Dict
         (make
            (for C Codes
               (link (cons (char C) C)) ) ) )
      (make
         (let W (pop 'Lst)
            (for C Lst
               (let WC (pack W C)
                  (if (lup Dict WC)
                     (setq W WC)
                     (link (cdr (lup Dict W)))
                     (idx 'Dict (cons WC (inc 'Codes)) T)
                     (setq W C) ) ) )
            (and W (link (cdr (lup Dict W)))) ) ) ) )

(de lzwDecompress (Lst)
   (let (Codes 255  Dict)
      (balance 'Dict
         (make
            (for C Codes
               (link (list C (char C))) ) ) )
      (make
         (let W NIL
            (for N Lst
               (let WC (if (lup Dict N) (cdr @) (cons (last W) W))
                  (chain (reverse WC))
                  (when W
                     (idx 'Dict (cons (inc 'Codes) (cons (last WC) W)) T) )
                  (setq W WC) ) ) ) ) ) )


MODULE Mandelbrot EXPORTS Main;

IMPORT Wr, Stdio, Fmt, Word;

CONST m = 50;
      limit2 = 4.0;

TYPE UByte = BITS 8 FOR [0..16_FF];

VAR width := 200;
    height := 200;
    bitnum: CARDINAL := 0;
    byteacc: UByte := 0;
    isOverLimit: BOOLEAN;
    Zr, Zi, Cr, Ci, Tr, Ti: REAL;

BEGIN

  Wr.PutText(Stdio.stdout, "P4\n" & Fmt.Int(width) & " " & Fmt.Int(height) & "\n");

  FOR y := 0 TO height - 1 DO
    FOR x := 0 TO width - 1 DO
      Zr := 0.0; Zi := 0.0;
      Cr := 2.0 * FLOAT(x) / FLOAT(width) - 1.5;
      Ci := 2.0 * FLOAT(y) / FLOAT(height) - 1.0;

      FOR i := 1 TO m + 1 DO
        Tr := Zr*Zr - Zi*Zi + Cr;
        Ti := 2.0*Zr*Zi + Ci;
        Zr := Tr; Zi := Ti;
        isOverLimit := Zr*Zr + Zi*Zi > limit2;
        IF isOverLimit THEN EXIT; END;
      END;

      IF isOverLimit THEN
        byteacc := Word.Xor(Word.LeftShift(byteacc, 1), 16_00);
      ELSE
        byteacc := Word.Xor(Word.LeftShift(byteacc, 1), 16_01);
      END;

      INC(bitnum);

      IF bitnum = 8 THEN
        Wr.PutChar(Stdio.stdout, VAL(byteacc, CHAR));
        byteacc := 0;
        bitnum := 0;
      ELSIF x = width - 1 THEN
        byteacc := Word.LeftShift(byteacc, 8 - (width MOD 8));
        Wr.PutChar(Stdio.stdout, VAL(byteacc, CHAR));
        byteacc := 0;
        bitnum := 0
      END;
      Wr.Flush(Stdio.stdout);
    END;
  END;
END Mandelbrot.


*process source xref attributes or(!);
 lzwt: Proc Options(main);

 Dcl (LEFT,LENGTH,SUBSTR,TRANSLATE,TRIM,UNSPEC) Builtin;
 Dcl SYSPRINT Print;

 Dcl str Char(50) Var Init('TOBEORNOTTOBEORTOBEORNOT');
 Dcl compressed Char(80) Var;
 Dcl decompressed Char(80) Var;

 Dcl 1 dict(0:300),
      2 key Char(5) Var,
      2 inx Bin Fixed(16) Unsigned;
 Dcl dict_size Bin Fixed(31) Init(256);
 Dcl hi Bin Fixed(16) Unsigned Init(65535);

 Put Edit('str=',str)(Skip,a,a);
 compressed = compress(str);
 Put Edit(compressed)(Skip,a);
 decompressed = decompress(compressed);
 Put Edit('dec=',decompressed)(Skip,a,a);
 If decompressed=str Then
   Put Edit('decompression ok')(Skip,a);
 Else
   Put Edit('decompression not ok')(Skip,a);

 compress: Proc(s) Returns(Char(80) Var);
 Dcl s Char(*) Var;
 Dcl res Char(80) Var;
 Dcl i Bin Fixed(31);
 Dcl c  Char(1);
 Dcl w  Char(5) Var;
 Dcl wc Char(5) Var;
 dict.key='';
 Dcl ii Bin Fixed(8) Unsigned;
 Do i=0 To 255;
   ii=i;
   Unspec(c)=unspec(ii);
   dict.key(i)=c;
   dict.inx(i)=i;
   End;
 res='[';
 w='';
 Do i=1 To length(s);
   c=substr(s,i,1);
   wc=w!!c;
   If dicti(wc)^=hi Then Do;
     w=wc;
     End;
   Else Do;
     res=res!!trim(dicti(w))!!', ';
     Call dict_add(wc,dict_size);
     w=c;
     End;
   End;
 If w^='' Then
   res=res!!trim(dicti(w))!!', ';
 substr(res,length(res)-1,1)=']';
 Return(res);

 dicti: Proc(needle) Returns(Bin Fixed(31));
   Dcl needle Char(*) Var;
   Dcl i Bin Fixed(31);
   Do i=1 To dict_size;
     If dict.key(i)=needle Then
       Return(i);
     End;
   Return(hi);
   End;

 dict_add: Proc(needle,dict_size);
   Dcl needle Char(*) Var;
   Dcl dict_size Bin Fixed(31);
   dict.key(dict_size)=needle;
   dict.inx(dict_size)=dict_size;
   dict_size+=1;
   End;

 End;

 decompress: Proc(s) Returns(Char(80) Var);
 Dcl s Char(80) Var;
 Dcl ss Char(80) Var;
 Dcl words(50) Char(5) Var;
 Dcl wn Bin Fixed(31);
 Dcl ww  Bin Fixed(31);
 Dcl c  Char(1);
 Dcl entry Char(5) Var;
 Dcl w Char(5) Var;
 Dcl res Char(80) Var;
 ss=translate(s,'    ','[],');
 Call mk_words(ss,words,wn);
 dict.key='';
 dict.inx=hi;
 Dcl i Bin Fixed(31);
 Dcl ii Bin Fixed(8) Unsigned;
 Dcl dict(0:300) Char(5) Var;
 Dcl dict_size Bin Fixed(31);
 Do i=0 To 255;
   ii=i;
   Unspec(c)=unspec(ii);
   dict(i)=c;
   End;
 dict_size=256;
 ww=words(1);
 w=dict(ww);
 res=w;
 Do i=2 To wn;
   ww=words(i);
   Select;
     When(dict(ww)^='')
       entry=dict(ww);
     When(ww=dict_size)
       entry=w!!substr(w,1,1);
     Otherwise
       Put Edit('Bad compressed k: ',ww)(Skip,a,a);
     End;
   res=res!!entry;
   dict(dict_size)=w!!substr(entry,1,1);
   dict_size+=1;
   w=entry;
   End;
 Return(res);
 End;

 mk_words: Proc(st,arr,arrn);
 Dcl st Char(*) Var;
 Dcl sv Char(80) Var;
 Dcl arr(*) Char(5) Var;
 Dcl arrn Bin fixed(31);
 Dcl elem Char(5) Var;
 arrn=0;
 sv=st!!' ';
 elem='';
 Do While(length(sv)>0);
   If left(sv,1)=' ' Then Do;
     If elem>'' Then Do;
       arrn+=1;
       arr(arrn)=elem;
       elem='';
       End;
     End;
   Else
     elem=elem!!left(sv,1);
   sv=substr(sv,2);
   End;
 End;
 Return;

 End;


-- Table to contain all the data points
CREATE TABLE points (
  c_re DOUBLE,
  c_im DOUBLE,
  z_re DOUBLE DEFAULT 0,
  z_im DOUBLE DEFAULT 0,
  znew_re DOUBLE DEFAULT 0,
  znew_im DOUBLE DEFAULT 0,
  steps INT DEFAULT 0,
  active CHAR DEFAULT 1
);

DELIMITER |

-- Iterate over all the points in the table 'points'
CREATE PROCEDURE itrt (IN n INT)
BEGIN
  label: LOOP
    UPDATE points
      SET
        znew_re=POWER(z_re,2)-POWER(z_im,2)+c_re,
        znew_im=2*z_re*z_im+c_im,
        steps=steps+1
      WHERE active=1;
    UPDATE points SET
        z_re=znew_re,
        z_im=znew_im,
        active=IF(POWER(z_re,2)+POWER(z_im,2)>4,0,1)
      WHERE active=1;
    SET n = n - 1;
    IF n > 0 THEN
      ITERATE label;
    END IF;
    LEAVE label;
  END LOOP label;
END|

-- Populate the table 'points'
CREATE PROCEDURE populate (
  r_min DOUBLE,
  r_max DOUBLE,
  r_step DOUBLE,
  i_min DOUBLE,
  i_max DOUBLE,
  i_step DOUBLE)
BEGIN
  DELETE FROM points;
  SET @rl = r_min;
  SET @a = 0;
  rloop: LOOP
    SET @im = i_min;
    SET @b = 0;
    iloop: LOOP
      INSERT INTO points (c_re, c_im)
        VALUES (@rl, @im);
      SET @b=@b+1;
      SET @im=i_min + @b * i_step;
      IF @im < i_max THEN
        ITERATE iloop;
      END IF;
      LEAVE iloop;
    END LOOP iloop;
      SET @a=@a+1;
    SET @rl=r_min + @a * r_step;
    IF @rl < r_max THEN
      ITERATE rloop;
    END IF;
    LEAVE rloop;
  END LOOP rloop;
END|

DELIMITER ;

-- Choose size and resolution of graph
--             R_min, R_max, R_step, I_min, I_max, I_step
CALL populate( -2.5,  1.5,   0.005,  -2,    2,     0.005 );

-- Calculate 50 iterations
CALL itrt( 50 );

-- Create the image (/tmp/image.ppm)
-- Note, MySQL will not over-write an existing file and you may need
-- administrator access to delete or move it
SELECT @xmax:=COUNT(c_re) INTO @xmax FROM points GROUP BY c_im LIMIT 1;
SELECT @ymax:=COUNT(c_im) INTO @ymax FROM points GROUP BY c_re LIMIT 1;
SET group_concat_max_len=11*@xmax*@ymax;
SELECT
  'P3', @xmax, @ymax, 200,
  GROUP_CONCAT(
    CONCAT(
      IF( active=1, 0, 55+MOD(steps, 200) ), ' ',
      IF( active=1, 0, 55+MOD(POWER(steps,3), 200) ), ' ',
      IF( active=1, 0, 55+MOD(POWER(steps,2), 200) ) )
    ORDER BY c_im ASC, c_re ASC SEPARATOR ' ' )
    INTO OUTFILE '/tmp/image.ppm'
  FROM points;


Procedure compress(uncompressed.s, List result.u())
  ;Compress a string to a list of output symbols

  ;Build the dictionary.
  Protected  dict_size = 255, i
  newmap dict.u()
  For i = 0 To 254
    dict(Chr(i + 1)) = i
  Next

  Protected w.s, wc.s, *c.Character = @uncompressed
  w = ""
  LastElement(result())
  While *c\c <> #Null
    wc = w + Chr(*c\c)
    If FindMapElement(dict(), wc)
      w = wc
    Else
      AddElement(result())
      result() = dict(w)
      ;Add wc to the dictionary
      dict(wc) = dict_size
      dict_size + 1 ;no check is performed for overfilling the dictionary.
      w = Chr(*c\c)
    EndIf
    *c + 1
  Wend

  ;Output the code for w
  If w
    AddElement(result())
    result() = dict(w)
  EndIf
EndProcedure

Procedure.s decompress(List compressed.u())
  ;Decompress a list of encoded values to a string
  If ListSize(compressed()) = 0: ProcedureReturn "": EndIf

  ;Build the dictionary.
  Protected  dict_size = 255, i

  Dim dict.s(255)
  For i = 1 To 255
    dict(i - 1) = Chr(i)
  Next

  Protected w.s, entry.s, result.s
  FirstElement(compressed())
  w = dict(compressed())
  result = w

  i = 0
  While NextElement(compressed())
    i + 1
    If compressed() < dict_size
    entry = dict(compressed())
    ElseIf i = dict_size
      entry = w + Left(w, 1)
    Else
      MessageRequester("Error","Bad compression at [" + Str(i) + "]")
      ProcedureReturn result;abort
    EndIf
    result + entry
    ;Add w + Left(entry, 1) to the dictionary
    If ArraySize(dict()) <= dict_size
      Redim dict(dict_size + 256)
    EndIf
    dict(dict_size) = w + Left(entry, 1)
    dict_size + 1 ;no check is performed for overfilling the dictionary.

    w = entry
  Wend
  ProcedureReturn result
EndProcedure

If OpenConsole()
  ;How to use:

  Define initial.s, decompressed.s

  Print("Type something: ")
  initial = Input()
  NewList compressed.u()
  compress(initial, compressed())
  ForEach compressed()
    Print(Str(compressed()) + " ")
  Next
  PrintN("")

  decompressed = decompress(compressed())
  PrintN(decompressed)

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
  Input()
  CloseConsole()
EndIf


import complex

proc inMandelbrotSet(c: Complex, maxEscapeIterations = 50): bool =
  result = true; var z: Complex
  for i in 0..maxEscapeIterations:
    z = z * z + c
    if abs2(z) > 4: return false

iterator steps(start, step: float, numPixels: int): float =
  for i in 0..numPixels:
    yield start + i.float * step

proc mandelbrotImage(yStart, yStep, xStart, xStep: float, height, width: int): string =
  for y in steps(yStart, yStep, height):
    for x in steps(xStart, xStep, width):
      result.add(if complex(x, y).inMandelbrotSet: '*'
                 else: ' ')
    result.add('\n')

echo mandelbrotImage(1.0, -0.05, -2.0, 0.0315, 40, 80)


def compress(uncompressed):
    """Compress a string to a list of output symbols."""

    # Build the dictionary.
    dict_size = 256
    dictionary = dict((chr(i), i) for i in range(dict_size))
    # in Python 3: dictionary = {chr(i): i for i in range(dict_size)}

    w = ""
    result = []
    for c in uncompressed:
        wc = w + c
        if wc in dictionary:
            w = wc
        else:
            result.append(dictionary[w])
            # Add wc to the dictionary.
            dictionary[wc] = dict_size
            dict_size += 1
            w = c

    # Output the code for w.
    if w:
        result.append(dictionary[w])
    return result

def decompress(compressed):
    """Decompress a list of output ks to a string."""
    from io import StringIO

    # Build the dictionary.
    dict_size = 256
    dictionary = dict((i, chr(i)) for i in range(dict_size))
    # in Python 3: dictionary = {i: chr(i) for i in range(dict_size)}

    # use StringIO, otherwise this becomes O(N^2)
    # due to string concatenation in a loop
    result = StringIO()
    w = chr(compressed.pop(0))
    result.write(w)
    for k in compressed:
        if k in dictionary:
            entry = dictionary[k]
        elif k == dict_size:
            entry = w + w[0]
        else:
            raise ValueError('Bad compressed k: %s' % k)
        result.write(entry)

        # Add w+entry[0] to the dictionary.
        dictionary[dict_size] = w + entry[0]
        dict_size += 1

        w = entry
    return result.getvalue()

# How to use:
compressed = compress('TOBEORNOTTOBEORTOBEORNOT')
print (compressed)
decompressed = decompress(compressed)
print (decompressed)


#load "graphics.cma";;

let mandelbrot xMin xMax yMin yMax xPixels yPixels maxIter =
  let rec mandelbrotIterator z c n =
    if (Complex.norm z) > 2.0 then false else
      match n with
      | 0 -> true
      | n -> let z' = Complex.add (Complex.mul z z) c in
             mandelbrotIterator z' c (n-1) in
  Graphics.open_graph
    (" "^(string_of_int xPixels)^"x"^(string_of_int yPixels));
  let dx = (xMax -. xMin) /. (float_of_int xPixels)
  and dy = (yMax -. yMin) /. (float_of_int yPixels) in
  for xi = 0 to xPixels - 1 do
    for yi = 0 to yPixels - 1 do
      let c = {Complex.re = xMin +. (dx *. float_of_int xi);
               Complex.im = yMin +. (dy *. float_of_int yi)} in
      if (mandelbrotIterator Complex.zero c maxIter) then
        (Graphics.set_color Graphics.white;
         Graphics.plot xi yi )
      else
        (Graphics.set_color Graphics.black;
         Graphics.plot xi yi )
    done
  done;;

mandelbrot (-1.5) 0.5 (-1.0) 1.0 500 500 200;;


#lang racket
; utilities
(define-syntax def (make-rename-transformer #'define))
(define (dict-ref d w) (hash-ref d w #f))
(define (append-char w c)  (string-append w (string c)))
(define (append-first w s) (append-char w (string-ref s 0)))

;; Compress a string with LZW
(define (compress uncompressed)
  (def d (make-hash))
  (def (dict-add d w) (hash-set! d w (hash-count d)))
  ; build initial dictionary
  (for ([i (in-range 256)])
    (def s (string (integer->char i)))
    (hash-set! d s s))
  ; compress the string
  (def result '())
  (def (emit! i) (set! result (cons i result)))
  (def w "")
  (for ([c uncompressed])
    (define wc (append-char w c))
    (cond
      [(dict-ref d wc) (set! w wc)]
      [else            (emit! (dict-ref d w))
                       (dict-add d wc)
                       (set! w (string c))]))
  (emit! (dict-ref d w))
  (reverse result))

;; Decompress a LZW compressed string
(define (decompress compressed)
  (def d (make-hash))
  (def (dict-add! w) (hash-set! d (hash-count d) w))
  ; build initial dictionary
  (for ([i (in-range 256)])
    (def s (string (integer->char i)))
    (hash-set! d s s))
  ; decompress the list
  (def w (first compressed))
  (apply string-append
         w
         (for/list ([k (rest compressed)])
           (def entry
             (or (dict-ref d k)
                 (if (eqv? k (hash-count d))
                     (append-first w w)
                     (error 'lzq-decompress "faulty input"))))
           (dict-add! (append-first w entry))
           (set! w entry)
           entry)))

(def uncompressed "TOBEORNOTTOBEORTOBEORNOT")
(displayln uncompressed)
(def compressed (compress uncompressed))
(displayln compressed)
(def decompressed (decompress compressed))
(displayln decompressed)


# 20200421 Updated Raku programming solution ; add unicode support

sub compress(Str $uncompressed --> Seq)  {
    my $dict-size = 256;
    my %dictionary = (.chr => .chr for ^$dict-size);

    my $w = "";
    gather {
  for $uncompressed.encode('utf8').list.chrs.comb -> $c {
      my $wc = $w ~ $c;
      if %dictionary{$wc}:exists { $w = $wc }
      else {
    take %dictionary{$w};
    %dictionary{$wc} = +%dictionary;
    $w = $c;
      }
  }

  take %dictionary{$w} if $w.chars;
    }
}

sub decompress(@compressed --> Str) {
    my $dict-size = 256;
    my %dictionary = (.chr => .chr for ^$dict-size);

    my $w = shift @compressed;
    ( Blob.new: flat ( gather {
  take $w;
  for @compressed -> $k {
      my $entry;
      if %dictionary{$k}:exists { take $entry = %dictionary{$k} }
      elsif $k == $dict-size    { take $entry = $w ~ $w.substr(0,1) }
      else                      { die "Bad compressed k: $k" }

      %dictionary{$dict-size++} = $w ~ $entry.substr(0,1);
      $w = $entry;
  }
    }  )».ords ).decode('utf-8')
}

say my @compressed = compress('TOBEORNOTTOBEORTOBEORNOT');
say decompress(@compressed);

@compressed = compress('こんにちは𝒳𝒴𝒵こんにちは𝒳𝒴𝒵こんにちは𝒳𝒴𝒵');
say decompress(@compressed);


#! /usr/bin/octave -qf
global width = 200;
global height = 200;
maxiter = 100;

z0 = 0;
global cmax = 1 + i;
global cmin = -2 - i;

function cs = pscale(c)
  global cmax;
  global cmin;
  global width;
  global height;
  persistent px = (real(cmax-cmin))/width;
  persistent py = (imag(cmax-cmin))/height;
  cs = real(cmin) + px*real(c) + i*(imag(cmin) + py*imag(c));
endfunction

ms = zeros(width, height);
for x = 0:width-1
  for y = 0:height-1
    z0 = 0;
    c = pscale(x+y*i);
    for ic = 1:maxiter
      z1 = z0^2 + c;
      if ( abs(z1) > 2 ) break; endif
      z0 = z1;
    endfor
    ms(x+1, y+1) = ic/maxiter;
  endfor
endfor

saveimage("mandel.ppm", round(ms .* 255).', "ppm");


/* REXX ---------------------------------------------------------------
* 20.07.2014 Walter Pachl translated from Java
* 21.07.2014 WP allow for blanks in the string
*--------------------------------------------------------------------*/
Parse Arg str
default="TOBEORNOTTOBEORTOBEORNOT"
If str='' Then
  str=default
/* str=space(str,0) */
Say 'str='str
compressed = compress(str)
Say compressed
If str=default Then Do
  cx='[84, 79, 66, 69, 79, 82, 78, 79, 84, 256, 258, 260, 265, 259, 261, 263]'
  If cx==compressed Then Say 'compression ok'
  End
decompressed = decompress(compressed)
Say 'dec='decompressed
If decompressed=str Then Say 'decompression ok'
Exit

compress: Procedure
Parse Arg uncompressed
dict.=''
Do i=0 To 255
  z=d2c(i)
  d.i=z
  dict.z=i
  End
dict_size=256
res='['
w=''
Do i=1 To length(uncompressed)
  c=substr(uncompressed,i,1)
  wc=w||c
  If dict.wc<>'' Then
    w=wc
  Else Do
    res=res||dict.w', '
    dict.wc=dict_size
    dict_size=dict_size+1
    w=c
    End
  End
If w<>'' Then
  res=res||dict.w', '
Return left(res,length(res)-2)']'

decompress: Procedure
Parse Arg compressed
compressed=space(translate(compressed,'','[],'))
d.=''
Do i=0 To 255
  z=d2c(i)
  d.i=z
  End
dict_size=256
Parse Var compressed w compressed
res=d.w
w=d.w
Do i=1 To words(compressed)
  k=word(compressed,i)
  Select
    When d.k<>'' | d.k==' ' then /* allow for blank */
      entry=d.k
    When k=dict_size Then
      entry=w||substr(w,1,1)
    Otherwise
      Say "Bad compressed k: "  k
    End
  res=res||entry
  d.dict_size=w||substr(entry,1,1)
  dict_size=dict_size+1
  w=entry
  End
Return res


(define x-size 59)
(define y-size 21)
(define min-im -1)
(define max-im 1)
(define min-re -2)
(define max-re 1)

(define step-x (/ (- max-re min-re) x-size))
(define step-y (/ (- max-im min-im) y-size))

(for-each (lambda (y)
      (let ((im (+ min-im (* step-y y))))
         (for-each (lambda (x)
            (let*((re (+ min-re (* step-x x)))
                  (zr (inexact re))
                  (zi (inexact im)))
               (let loop ((n 0) (zi zi) (zr zr))
                  (let ((a (* zr zr))
                        (b (* zi zi)))
                     (cond
                        ((> (+ a b) 4)
                           (display (string (- 62 n))))
                        ((= n 30)
                           (display (string (- 62 n))))
                        (else
                           (loop (+ n 1) (+ (* 2 zr zi) im) (- (+ a re) b))))))))
            (iota x-size))
         (print)))
   (iota y-size))


# Project : LZW compression

plaintext = "TOBEORNOTTOBEORTOBEORNOT"
result = []
encode = encodelzw(plaintext)
for i = 1 to len(encode) step 2
    add(result,ascii(substr(encode,i,1)) + 256*ascii(substr(encode,i+1,1)))
next
showarray(result)
see decodelzw(encode)

func encodelzw(text)
       o = ""
       dict = list(4096)
       for i = 1 to 255
            dict[i] = char(i)
       next
       l = i
       i = 1
       w = left(text,1)
       while i < len(text)
              d = 0
              while d < l
                      c = d
                      if i > len(text)
                         exit
                      ok
                      for d = 1 to l
                           if w = dict[d]
                             exit
                           ok
                      next
                      if d < l
                         i = i + 1
                         w = w + substr(text,i,1)
                      ok
              end
              dict[l] = w
              l = l + 1
              w = right(w,1)
              o = o + char(c % 256) + char(floor(c / 256))
       end
       return o

func decodelzw(text)
       o = ""
       dict = list(4096)
       for i = 1 to 255
            dict[i] = char(i)
       next
       l = i
       c = ascii(left(text,1)) + 256*ascii(substr(text,2,1))
       w = dict[c]
       o = w
       if len(text) < 4
          return o
       ok
       for i = 3 to len(text) step 2
            c = ascii(substr(text,i,1)) + 256*ascii(substr(text,i+1,1))
            if c < l
               t = dict[c]
            else
               t = w + left(w,1)
            ok
            o = o + t
            dict[l] = w + left(t,1)
            l = l + 1
            w = t
       next
       return o

func showarray(vect)
        svect = ""
        for n = 1 to len(vect)
              svect = svect + vect[n] + " "
        next
        svect = left(svect, len(svect) - 1)
        see svect + nl


# Compress a string to a list of output symbols.
def compress(uncompressed)
    # Build the dictionary.
    dict_size = 256
    dictionary = Hash[ Array.new(dict_size) {|i| [i.chr, i.chr]} ]

    w = ""
    result = []
    for c in uncompressed.split('')
        wc = w + c
        if dictionary.has_key?(wc)
            w = wc
        else
            result << dictionary[w]
            # Add wc to the dictionary.
            dictionary[wc] = dict_size
            dict_size += 1
            w = c
        end
    end

    # Output the code for w.
    result << dictionary[w] unless w.empty?
    result
end

# Decompress a list of output ks to a string.
def decompress(compressed)
    # Build the dictionary.
    dict_size = 256
    dictionary = Hash[ Array.new(dict_size) {|i| [i.chr, i.chr]} ]

    w = result = compressed.shift
    for k in compressed
        if dictionary.has_key?(k)
            entry = dictionary[k]
        elsif k == dict_size
            entry = w + w[0,1]
        else
            raise 'Bad compressed k: %s' % k
        end
        result += entry

        # Add w+entry[0] to the dictionary.
        dictionary[dict_size] = w + entry[0,1]
        dict_size += 1

        w = entry
    end
    result
end

# How to use:
compressed = compress('TOBEORNOTTOBEORTOBEORNOT')
p compressed
decompressed = decompress(compressed)
puts decompressed


DEFINE VARIABLE print_str AS CHAR NO-UNDO INIT ''.
DEFINE VARIABLE X1 AS DECIMAL NO-UNDO INIT 50.
DEFINE VARIABLE Y1 AS DECIMAL NO-UNDO INIT 21.
DEFINE VARIABLE X AS DECIMAL NO-UNDO.
DEFINE VARIABLE Y AS DECIMAL NO-UNDO.
DEFINE VARIABLE N AS DECIMAL NO-UNDO.
DEFINE VARIABLE I3 AS DECIMAL NO-UNDO.
DEFINE VARIABLE R3 AS DECIMAL NO-UNDO.
DEFINE VARIABLE Z1 AS DECIMAL NO-UNDO.
DEFINE VARIABLE Z2 AS DECIMAL NO-UNDO.
DEFINE VARIABLE A AS DECIMAL NO-UNDO.
DEFINE VARIABLE B AS DECIMAL NO-UNDO.
DEFINE VARIABLE I1 AS DECIMAL NO-UNDO INIT -1.0.
DEFINE VARIABLE I2 AS DECIMAL NO-UNDO INIT 1.0.
DEFINE VARIABLE R1 AS DECIMAL NO-UNDO INIT -2.0.
DEFINE VARIABLE R2 AS DECIMAL NO-UNDO INIT 1.0.
DEFINE VARIABLE S1 AS DECIMAL NO-UNDO.
DEFINE VARIABLE S2 AS DECIMAL NO-UNDO.

S1 = (R2 - R1) / X1.
S2 = (I2 - I1) / Y1.
DO Y = 0 TO Y1 - 1:
  I3 = I1 + S2 * Y.
  DO X = 0 TO X1 - 1:
    R3 = R1 + S1 * X.
    Z1 = R3.
    Z2 = I3.
    DO N = 0 TO 29:
      A = Z1 * Z1.
      B = Z2 * Z2.
      IF A + B > 4.0 THEN
        LEAVE.
      Z2 = 2 * Z1 * Z2 + I3.
      Z1 = A - B + R3.
    END.
    print_str = print_str + CHR(62 - N).
  END.
  print_str = print_str + '~n'.
END.

OUTPUT TO "C:\Temp\out.txt".
MESSAGE print_str.
OUTPUT CLOSE.


use std::collections::HashMap;

fn compress(data: &[u8]) -> Vec<u32> {
    // Build initial dictionary.
    let mut dictionary: HashMap<Vec<u8>, u32> = (0u32..=255)
        .map(|i| (vec![i as u8], i))
        .collect();

    let mut w = Vec::new();
    let mut compressed = Vec::new();

    for &b in data {
        let mut wc = w.clone();
        wc.push(b);

        if dictionary.contains_key(&wc) {
            w = wc;
        } else {
            // Write w to output.
            compressed.push(dictionary[&w]);

            // wc is a new sequence; add it to the dictionary.
            dictionary.insert(wc, dictionary.len() as u32);
            w.clear();
            w.push(b);
        }
    }

    // Write remaining output if necessary.
    if !w.is_empty() {
        compressed.push(dictionary[&w]);
    }

    compressed
}

fn decompress(mut data: &[u32]) -> Vec<u8> {
    // Build the dictionary.
    let mut dictionary: HashMap::<u32, Vec<u8>> = (0u32..=255)
        .map(|i| (i, vec![i as u8]))
        .collect();

    let mut w = dictionary[&data[0]].clone();
    data = &data[1..];
    let mut decompressed = w.clone();

    for &k in data {
        let entry = if dictionary.contains_key(&k) {
            dictionary[&k].clone()
        } else if k == dictionary.len() as u32 {
            let mut entry = w.clone();
            entry.push(w[0]);
            entry
        } else {
            panic!("Invalid dictionary!");
        };

        decompressed.extend_from_slice(&entry);

        // New sequence; add it to the dictionary.
        w.push(entry[0]);
        dictionary.insert(dictionary.len() as u32, w);

        w = entry;
    }

    decompressed
}

fn main() {
    let compressed = compress("TOBEORNOTTOBEORTOBEORNOT".as_bytes());
    println!("{:?}", compressed);

    let decompressed = decompress(&compressed);
    let decompressed = String::from_utf8(decompressed).unwrap();
    println!("{}", decompressed);
}