use AppleScript version "2.3.1" -- Mac OS X 10.9 (Mavericks) or later.
use sorter : script "Custom Iterative Ternary Merge Sort" -- <https://macscripter.net/viewtopic.php?pid=194430#p194430>

on stateNamePuzzle()
    script o
        property stateNames : {"Alabama", "Alaska", "Arizona", "Arkansas", ¬
            "California", "Colorado", "Connecticut", "Delaware", ¬
            "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", ¬
            "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", ¬
            "Maine", "Maryland", "Massachusetts", "Michigan", ¬
            "Minnesota", "Mississippi", "Missouri", "Montana", ¬
            "Nebraska", "Nevada", "New Hampshire", "New Jersey", ¬
            "New Mexico", "New York", "North Carolina", "North Dakota", ¬
            "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", ¬
            "South Carolina", "South Dakota", "Tennessee", "Texas", ¬
            "Utah", "Vermont", "Virginia", ¬
            "Washington", "West Virginia", "Wisconsin", "Wyoming", ¬
            "New Kory", "Wen Kory", "York New", "Kory New", "New Kory"}
        property namePairs : {}
        property checkList : {}
    end script

    ignoring case
        -- Remove duplicates.
        repeat with i from 1 to (count o's stateNames)
            set thisName to item i of o's stateNames
            if (thisName is not in o's checkList) then set end of o's checkList to thisName
        end repeat
        set o's stateNames to o's checkList

        -- Build lists containing unique pairs of names preceded by
        -- texts composed of their combined visible characters, sorted.
        set stateCount to (count o's stateNames)
        repeat with i from 1 to (stateCount - 1)
            set name1 to item i of o's stateNames
            repeat with j from (i + 1) to stateCount
                set name2 to item j of o's stateNames
                set chrs to characters of (name1 & name2)
                tell sorter to sort(chrs, 1, -1, {})
                set end of o's namePairs to {word 1 of join(chrs, ""), name1, name2}
            end repeat
        end repeat

        -- Sort the lists on the character strings
        set pairCount to (count o's namePairs)
        tell sorter to sort(o's namePairs, 1, pairCount, {comparer:me})

        -- Look for groups of equal character strings and match
        -- associated name pairs not containing the same name(s).
        set output to {}
        set l to 1
        repeat while (l < pairCount)
            set chrs to beginning of item l of o's namePairs
            set r to l
            repeat while ((r < pairCount) and (beginning of item (r + 1) of o's namePairs = chrs))
                set r to r + 1
            end repeat
            if (r > l) then
                repeat with i from l to (r - 1)
                    set {name1, name2} to rest of item i of o's namePairs
                    set text1 to join(result, " and ") & " --> "
                    repeat with j from (i + 1) to r
                        set pair2 to rest of item j of o's namePairs
                        if (not ((name1 is in pair2) or (name2 is in pair2))) then
                            set end of output to text1 & join(pair2, " and ")
                        end if
                    end repeat
                end repeat
            end if
            set l to r + 1
        end repeat
    end ignoring

    return join(output, linefeed)
end stateNamePuzzle

-- Custom comparison handler used when the sort comparer is 'me'. Compares the first items of two lists.
on isGreater(a, b)
    return (beginning of a comes after beginning of b)
end isGreater

on join(lst, delim)
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to delim
    set txt to lst as text
    set AppleScript's text item delimiters to astid
    return txt
end join

stateNamePuzzle()


from __future__ import division
import matplotlib.pyplot as plt
import random

mean, stddev, size = 50, 4, 100000
data = [random.gauss(mean, stddev) for c in range(size)]

mn = sum(data) / size
sd = (sum(x*x for x in data) / size
      - (sum(data) / size) ** 2) ** 0.5

print("Sample mean = %g; Stddev = %g; max = %g; min = %g for %i values"
      % (mn, sd, max(data), min(data), size))

plt.hist(data,bins=50)


n <- 100000
u <- sqrt(-2*log(runif(n)))
v <- 2*pi*runif(n)
x <- u*cos(v)
y <- v*sin(v)
hist(x)


#lang racket
(require math (planet williams/science/histogram-with-graphics))

(define data (sample (normal-dist 50 4) 100000))

(displayln (~a "Mean:\t"   (mean data)))
(displayln (~a "Stddev:\t" (stddev data)))
(displayln (~a "Max:\t"    (apply max data)))
(displayln (~a "Min:\t"    (apply min data)))

(define h (make-histogram-with-ranges-uniform 40 30 70))
(for ([x data]) (histogram-increment! h x))
(histogram-plot h "Normal distribution μ=50 σ=4")


(     Alabama
      Alaska
      Arizona
      Arkansas
      California
      Colorado
      Connecticut
      Delaware
      Florida
      Georgia
      Hawaii
      Idaho
      Illinois
      Indiana
      Iowa
      Kansas
      Kentucky
      Louisiana
      Maine
      Maryland
      Massachusetts
      Michigan
      Minnesota
      Mississippi
      Missouri
      Montana
      Nebraska
      Nevada
      "New Hampshire"
      "New Jersey"
      "New Mexico"
      "New York"
      "North Carolina"
      "North Dakota"
      Ohio
      Oklahoma
      Oregon
      Pennsylvania
      "Rhode Island"
      "South Carolina"
      "South Dakota"
      Tennessee
      Texas
      Utah
      Vermont
      Virginia
      Washington
      "West Virginia"
      Wisconsin
      Wyoming
  : ?states
& "New Kory" "Wen Kory" "York New" "Kory New" "New Kory":?extrastates
& ( "State name puzzle"
  =     allStates State state statechars char
      , A Z S1 S2 S3 S4 L1 L2 L3 L4 L12
    .   0:?allStates
      &   whl
        ' ( !arg:%?State ?arg
          & low$!State:?state
          & 0:?statechars
          &   whl
            ' ( @(!state:? (%@:~" ":?char) ?state)
              & !char+!statechars:?statechars
              )
          & (!State.!statechars)+!allStates:?allStates
          )
      & (   !allStates
          :   ?
            + ?*(?S1.?L1)
            + ?A
            + ?*(?S2.?L2)
            + ( ?Z
              & !L1+!L2:?L12
              &   !A+!Z
                :   ?
                  + ?*(?S3.?L3&!L12+-1*!L3:?L4)
                  + ?
                  +   ?
                    * ( ?S4
                      .   !L4
                        & out$(!S1 "+" !S2 "=" !S3 "+" !S4)
                        & ~
                      )
                  + ?
              )
        | out$"No more solutions"
        )
  )
& "State name puzzle"$!states
& "State name puzzle"$(!states !extrastates)
);


#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#define USE_FAKES 1

const char *states[] = {
#if USE_FAKES
	"New Kory", "Wen Kory", "York New", "Kory New", "New Kory",
#endif
	"Alabama", "Alaska", "Arizona", "Arkansas",
	"California", "Colorado", "Connecticut",
	"Delaware",
	"Florida", "Georgia", "Hawaii",
	"Idaho", "Illinois", "Indiana", "Iowa",
	"Kansas", "Kentucky", "Louisiana",
	"Maine", "Maryland", "Massachusetts", "Michigan",
	"Minnesota", "Mississippi", "Missouri", "Montana",
	"Nebraska", "Nevada", "New Hampshire", "New Jersey",
	"New Mexico", "New York", "North Carolina", "North Dakota",
	"Ohio", "Oklahoma", "Oregon",
	"Pennsylvania", "Rhode Island",
	"South Carolina", "South Dakota", "Tennessee", "Texas",
	"Utah", "Vermont", "Virginia",
	"Washington", "West Virginia", "Wisconsin", "Wyoming"
};

int n_states = sizeof(states)/sizeof(*states);
typedef struct { unsigned char c[26]; const char *name[2]; } letters;

void count_letters(letters *l, const char *s)
{
	int c;
	if (!l->name[0]) l->name[0] = s;
	else l->name[1] = s;

	while ((c = *s++)) {
		if (c >= 'a' && c <= 'z') l->c[c - 'a']++;
		if (c >= 'A' && c <= 'Z') l->c[c - 'A']++;
	}
}

int lcmp(const void *aa, const void *bb)
{
	int i;
	const letters *a = aa, *b = bb;
	for (i = 0; i < 26; i++)
		if      (a->c[i] > b->c[i]) return  1;
		else if (a->c[i] < b->c[i]) return -1;
	return 0;
}

int scmp(const void *a, const void *b)
{
	return strcmp(*(const char *const *)a, *(const char *const *)b);
}

void no_dup()
{
	int i, j;

	qsort(states, n_states, sizeof(const char*), scmp);

	for (i = j = 0; i < n_states;) {
		while (++i < n_states && !strcmp(states[i], states[j]));
		if (i < n_states) states[++j] = states[i];
	}

	n_states = j + 1;
}

void find_mix()
{
	int i, j, n;
	letters *l, *p;

	no_dup();
	n = n_states * (n_states - 1) / 2;
	p = l = calloc(n, sizeof(letters));

	for (i = 0; i < n_states; i++)
		for (j = i + 1; j < n_states; j++, p++) {
			count_letters(p, states[i]);
			count_letters(p, states[j]);
		}

	qsort(l, n, sizeof(letters), lcmp);

	for (j = 0; j < n; j++) {
		for (i = j + 1; i < n && !lcmp(l + j, l + i); i++) {
			if (l[j].name[0] == l[i].name[0]
				|| l[j].name[1] == l[i].name[0]
				|| l[j].name[1] == l[i].name[1])
				continue;
			printf("%s + %s => %s + %s\n",
				l[j].name[0], l[j].name[1], l[i].name[0], l[i].name[1]);
		}
	}
	free(l);
}

int main(void)
{
	find_mix();
	return 0;
}


sub normdist ($m, $σ) {
    my $r = sqrt -2 * log rand;
    my $Θ = τ * rand;
    $r * cos($Θ) * $σ + $m;
}

sub MAIN ($size = 100000, $mean = 50, $stddev = 4) {
    my @dataset = normdist($mean,$stddev) xx $size;

    my $m = [+](@dataset) / $size;
    say (:$m);

    my $σ = sqrt [+](@dataset X** 2) / $size - $m**2;
    say (:$σ);

    (my %hash){.round}++ for @dataset;
    my $scale = 180 * $stddev / $size;
    constant @subbar = < ⎸ ▏ ▎ ▍ ▌ ▋ ▊ ▉ █ >;
    for %hash.keys».Int.minmax(+*) -> $i {
        my $x = (%hash{$i} // 0) * $scale;
        my $full = floor $x;
        my $part = 8 * ($x - $full);
        say $i, "\t", '█' x $full, @subbar[$part];
    }
}


/*REXX program generates  10,000  normally distributed numbers  (Gaussian distribution).*/
numeric digits 20                                /*use twenty decimal digs for accuracy.*/
parse arg n seed .                               /*obtain optional arguments from the CL*/
if n==''  |  n==","     then n= 10000            /*Not specified?  Then use the default.*/
if datatype(seed, 'W')  then call random ,,seed  /*seed is for repeatable RANDOM numbers*/
call pi                                          /*call subroutine to define pi constant*/
        do g=1  for n;   #.g= sqrt( -2 * ln( rand() ) )      *      cos( 2 * pi * rand() )
        end   /*g*/                              /* [↑]  uniform random number ───► #.g */
s= 0
mn= #.1;        mx= mn;        noise= n * .0005  /*calculate the noise:  1/20th %  of N.*/
ss= 0
        do j=1  for n;         _= #.j            /*the sum,  and  the sum of squares.   */
        s= s + _;              ss= ss  +  _ * _  /*the sum,  and  the sum of squares.   */
        mn= min(mn, _);        mx= max(mx, _)    /*find the minimum  and the maximum.   */
        end   /*j*/
!.= 0
say 'number of data points = '   fmt(n  )
say '              minimum = '   fmt(mn )
say '              maximum = '   fmt(mx )
say '      arithmetic mean = '   fmt(s/n)
say '   standard deviation = '   fmt(sqrt( ss/n - (s/n) **2) )
?mn= !.1;    ?mx= ?mn                            /*define minimum & maximum value so far*/
parse value  scrSize()  with  sd sw .            /*obtain the (true) screen size of term*/  /*◄──not all REXXes have this BIF*/
sdE= sd - 4                                      /*the effective (usable) screen depth. */
swE= sw - 1                                      /* "      "         "        "   width.*/
$= 1 / max(1, mx-mn) * sdE                       /*$  is used for scaling depth of histo*/
            do i=1  for n; ?= trunc((#.i-mn) *$) /*calculate the relative line.         */
            !.?= !.? + 1                         /*bump the counter.                    */
            ?mn= min(?mn, !.?)                   /*find the minimum.                    */
            ?mx= max(?mx, !.?)                   /*  "   "  maximum.                    */
            end   /*i*/
f= swE/?mx                                                /*limit graph to 1 full screen*/
            do h=0  for sdE;     _= !.h                   /*obtain a data point.        */
            if _>noise  then say copies('─', trunc(_*f) ) /*display a bar of histogram. */
            end   /*h*/                                   /*[↑]  use a hyphen for histo.*/
exit                                             /*stick a fork in it,  we're all done. */
/*───────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
fmt:  parse arg @; return left('', (@>=0) + 2 * datatype(@, 'W'))@  /*prepend a blank if #>=0, add 2 blanks if whole.*/
e:    e = 2.7182818284590452353602874713526624977572470936999595749669676277240766303535;                     return e
pi:   pi= 3.1415926535897932384626433832795028841971693993751058209749445923078164062862;                     return pi
r2r:  return arg(1)  //  (pi() * 2)                                 /*normalize the given angle (in radians) to ±2pi.*/
rand: return random(1, 1e5)  /  1e5                                 /*REXX generates uniform random postive integers.*/
/*───────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
ln:   procedure; parse arg x,f; call e; ig= x>1.5; is= 1 -2*(ig\==1); ii= 0; xx= x;  do while ig & xx>1.5 | \ig & xx<.5
      _= e;  do k=-1; iz= xx*_ **-is;  if k>=0 & (ig & iz<1 | \ig & iz>.5)  then leave;  _= _*_; izz= iz; end;  xx= izz
      ii= ii +is*2**k; end; x= x*e**-ii-1; z=0; _=-1; p=z; do k=1;_=-_*x;z=z+_/k;if z=p then leave;p=z;end; return z+ii
/*───────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
cos:  procedure; parse arg x; x=r2r(x); a=abs(x); hpi= pi*.5;  numeric fuzz min(6, digits()-3); if a=pi  then return -1
      if a=hpi | a=hpi*3  then return 0;   if a=pi/3  then return .5;   if a=pi*2/3 then return -.5;   z= 1;   _= 1
      x= x*x;  p= z;      do k=2  by 2; _= -_ * x / (k*(k-1));   z= z + _;  if z=p  then leave;  p= z; end;    return z
/*───────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x;  if x=0  then return 0;  d= digits();   m.= 9;   numeric digits;   numeric form;   h= d+6
      parse value format(x,2,1,,0) 'E0'  with  g 'E' _ .; g=g*.5'e'_%2;    do j=0  while h>9; m.j=h; h=h%2+1; end /*j*/
        do k=j+5  to 0  by -1;  numeric digits m.k;  g=(g+x/g)*.5;  end  /*k*/;          numeric digits d;   return g/1


#include <algorithm>
#include <iostream>
#include <string>
#include <array>
#include <vector>

template<typename T>
T unique(T&& src)
{
    T retval(std::move(src));
    std::sort(retval.begin(), retval.end(), std::less<typename T::value_type>());
    retval.erase(std::unique(retval.begin(), retval.end()), retval.end());
    return retval;
}

#define USE_FAKES 1

auto states = unique(std::vector<std::string>({
#if USE_FAKES
    "Slender Dragon", "Abalamara",
#endif
    "Alabama", "Alaska", "Arizona", "Arkansas",
    "California", "Colorado", "Connecticut",
    "Delaware",
    "Florida", "Georgia", "Hawaii",
    "Idaho", "Illinois", "Indiana", "Iowa",
    "Kansas", "Kentucky", "Louisiana",
    "Maine", "Maryland", "Massachusetts", "Michigan",
    "Minnesota", "Mississippi", "Missouri", "Montana",
    "Nebraska", "Nevada", "New Hampshire", "New Jersey",
    "New Mexico", "New York", "North Carolina", "North Dakota",
    "Ohio", "Oklahoma", "Oregon",
    "Pennsylvania", "Rhode Island",
    "South Carolina", "South Dakota", "Tennessee", "Texas",
    "Utah", "Vermont", "Virginia",
    "Washington", "West Virginia", "Wisconsin", "Wyoming"
}));

struct counted_pair
{
    std::string name;
    std::array<int, 26> count{};

    void count_characters(const std::string& s)
    {
        for (auto&& c : s) {
            if (c >= 'a' && c <= 'z') count[c - 'a']++;
            if (c >= 'A' && c <= 'Z') count[c - 'A']++;
        }
    }

    counted_pair(const std::string& s1, const std::string& s2)
        : name(s1 + " + " + s2)
    {
        count_characters(s1);
        count_characters(s2);
    }
};

bool operator<(const counted_pair& lhs, const counted_pair& rhs)
{
    auto lhs_size = lhs.name.size();
    auto rhs_size = rhs.name.size();
    return lhs_size == rhs_size
            ? std::lexicographical_compare(lhs.count.begin(),
                                           lhs.count.end(),
                                           rhs.count.begin(),
                                           rhs.count.end())
            : lhs_size < rhs_size;
}

bool operator==(const counted_pair& lhs, const counted_pair& rhs)
{
    return lhs.name.size() == rhs.name.size() && lhs.count == rhs.count;
}

int main()
{
    const int n_states = states.size();

    std::vector<counted_pair> pairs;
    for (int i = 0; i < n_states; i++) {
        for (int j = 0; j < i; j++) {
            pairs.emplace_back(counted_pair(states[i], states[j]));
        }
    }
    std::sort(pairs.begin(), pairs.end());

    auto start = pairs.begin();
    while (true) {
        auto match = std::adjacent_find(start, pairs.end());
        if (match == pairs.end()) {
            break;
        }
        auto next = match + 1;
        std::cout << match->name << " => " << next->name << "\n";
        start = next;
    }
}


# Class to implement a Normal distribution, generated from a Uniform distribution.
# Uses the Marsaglia polar method.

class NormalFromUniform
  # Initialize an instance.
  def initialize()
    @next = nil
  end
  # Generate and return the next Normal distribution value.
  def rand()
    if @next
      retval, @next = @next, nil
      return retval
    else
      u = v = s = nil
      loop do
        u = Random.rand(-1.0..1.0)
        v = Random.rand(-1.0..1.0)
        s = u**2 + v**2
        break if (s > 0.0) && (s <= 1.0)
      end
      f = Math.sqrt(-2.0 * Math.log(s) / s)
      @next = v * f
      return u * f
    end
  end
end


s	= 100000
h$	= "============================================================="
h$	= h$ + h$
dim ndis(s)
' mean and standard deviation.
mx	= -9999
mn	=  9999
sum	= 0
sumSqr	= 0
for i = 1 to s	' find minimum and maximum
	ms	= rnd(1)
	ss	= rnd(1)
	nd 	= (-2 * log(ms))^0.5 * cos(2 *3.14159265 * ss) ' normal distribution
	ndis(i)	= nd
	mx	= max(mx, nd)
	mn	= min(mn, nd)
	sum	= sum + nd
	sumSqr	= sumSqr + nd ^ 2
next i

mean	= sum / s
range	= mx - mn

print "Samples   :"; s
print "Largest   :"; mx
print "Smallest  :"; mn
print "Range     :"; range
print "Mean      :"; mean
print "Stand Dev :"; (sumSqr /s -mean^2)^0.5

'Show chart of histogram
nBins	= 50
dim bins(nBins)
for i = 1 to s
	z	= int((ndis(i) -mn) /range *nBins)
	bins(z)	= bins(z) + 1
	mb	= max(bins(z),mb)
next i
for b = 0 to nBins -1
 print using("##",b);" ";using("#####",bins(b));" ";left$(h$,(bins(b) / mb) * 90)
next b
END


//! Rust rosetta example for normal distribution
use math::{histogram::Histogram, traits::ToIterator};
use rand;
use rand_distr::{Distribution, Normal};

/// Returns the mean of the provided samples
///
/// ## Arguments
/// * data -- reference to float32 array
fn mean(data: &[f32]) -> Option<f32> {
    let sum: f32 = data.iter().sum();
    Some(sum / data.len() as f32)
}

/// Returns standard deviation of the provided samples
///
/// ## Arguments
/// * data -- reference to float32 array
fn standard_deviation(data: &[f32]) -> Option<f32> {
    let mean = mean(data).expect("invalid mean");
    let sum = data.iter().fold(0.0, |acc, &x| acc + (x - mean).powi(2));
    Some((sum / data.len() as f32).sqrt())
}

/// Prints a histogram in the shell
///
/// ## Arguments
/// * data -- reference to float32 array
/// * maxwidth -- the maxwidth of the histogram in # of characters
/// * bincount -- number of bins in the histogram
/// * ch -- character used to plot the graph
fn print_histogram(data: &[f32], maxwidth: usize, bincount: usize, ch: char) {
    let min_val = data.iter().cloned().fold(f32::NAN, f32::min);
    let max_val = data.iter().cloned().fold(f32::NAN, f32::max);
    let histogram = Histogram::new(Some(&data.to_vec()), bincount, min_val, max_val).unwrap();
    let max_bin_value = histogram.get_counters().iter().max().unwrap();
    println!();
    for x in histogram.to_iter() {
        let (bin_min, bin_max, freq) = x;
        let bar_width = (((freq as f64) / (*max_bin_value as f64)) * (maxwidth as f64)) as u32;
        let bar_as_string = (1..bar_width).fold(String::new(), |b, _| b + &ch.to_string());
        println!(
            "({:>6},{:>6}) |{} {:.2}%",
            format!("{:.2}", bin_min),
            format!("{:.2}", bin_max),
            bar_as_string,
            (freq as f64) * 100.0 / (data.len() as f64)
        );
    }
    println!();
}

/// Runs the demo to generate normal distribution of three different sample sizes
fn main() {
    let expected_mean: f32 = 0.0;
    let expected_std_deviation: f32 = 4.0;
    let normal = Normal::new(expected_mean, expected_std_deviation).unwrap();

    let mut rng = rand::thread_rng();
    for &number_of_samples in &[1000, 10_000, 1_000_000] {
        let data: Vec<f32> = normal
            .sample_iter(&mut rng)
            .take(number_of_samples)
            .collect();
        println!("Statistics for sample size {}:", number_of_samples);
        println!("\tMean: {:?}", mean(&data).expect("invalid mean"));
        println!(
            "\tStandard deviation: {:?}",
            standard_deviation(&data).expect("invalid standard deviation")
        );
        print_histogram(&data, 80, 40, '-');
    }
}


(ns clojure-sandbox.statenames
  (:require [clojure.data.csv :as csv]
            [clojure.java.io :as io]
            [clojure.string :refer [lower-case]]
            [clojure.math.combinatorics :as c]
            [clojure.pprint :as pprint]))

(def made-up-states ["New Kory" "Wen Kory" "York New" "Kory New" "New Kory"])

;; I saved the list of states in a local file to keep the code clean but you can copy and paste the list instead
(def real-states (with-open [in-file (io/reader (io/resource "states.csv"))]
                   (->> (doall
                         (csv/read-csv in-file))
                        (map first))))

(defn- state->charset [state-name]
  "Convert state name into sorted list of characters with no spaces"
  (->> state-name
       char-array
       sort
       (filter (set (map char (range 97 123)))))) ;; ASCII range for lower case letters

(defn- add-charsets [states]
  "Calculate sorted character list for each state and store with name"
  (->> states
       (map lower-case) ;; Convert all names to lower case
       set ;; remove duplicates
       (map
        (fn [s] {:name s
                 :characters (state->charset s)})))) ;; add characters

(defn- pair-chars [state1 state2]
  "Join the characters of two states together and sort them"
  (-> state1
      :characters
      (concat (:characters state2))
      sort))

(defn- pair [[state1 state2]]
  "Record representing two state names and the total characters used in them"
  {:inputs [(:name state1) (:name state2)]
   :characters (pair-chars state1 state2)})

(defn- find-all-pairs [elements]
  (c/combinations elements 2))

(defn- pairs-to-search [state-names]
  "Create character lists for all states and return a list of all possible pairs"
  (->> state-names
       add-charsets
       find-all-pairs
       (map pair)))

(defn- pairs-have-same-letters? [[pair1 pair2]]
  (= (:characters pair1) (:characters pair2)))

(defn- inputs-are-distinct? [[pair1 pair2 :as pairs]]
  "Check that two pairs of states don't contain the same state"
  (= 4 ;; There should be a total of 4 distinct states in the two pairs
     (->> pairs
          (map :inputs)
          flatten
          set
          count)))

(defn- search [pairs]
  (->> pairs
       find-all-pairs ;; find pairs of pairs to search
       (filter pairs-have-same-letters?) ;; Keep only those where each pair has the same characters
       (filter inputs-are-distinct?))) ;; Remove pairs with duplicate states

(defn find-matches [state-names]
  "Find all state pairs and return pairs of them using the same letters"
  (-> state-names
      pairs-to-search
      search))

(defn- format-match-output [[pair1 pair2]]
  "Format a pair of state pairs to print out"
  (str (first (:inputs pair1))
       " + "
       (last (:inputs pair1))
       " = "
       (first (:inputs pair2))
       " + "
       (last (:inputs pair2))))

(defn- evaluate-and-print [states]
  (->> states
       find-matches
       (map format-match-output)
       pprint/pprint))

(defn -main [& args]
  (println "Solutions for 50 real states")
  (evaluate-and-print real-states)
  (println "Solutions with made up states added")
  (evaluate-and-print (concat real-states made-up-states)))


data test;
n=100000;
twopi=2*constant('pi');
do i=1 to n;
	u=ranuni(0);
	v=ranuni(0);
	r=sqrt(-2*log(u));
	x=r*cos(twopi*v);
	y=r*sin(twopi*v);
	z=rannor(0);
	output;
end;
keep x y z;

proc means mean stddev;

proc univariate;
histogram /normal;

run;

/*
Variable            Mean         Std Dev
----------------------------------------
x             -0.0052720       0.9988467
y            0.000023995       1.0019996
z              0.0012857       1.0056536
*/


define τ = Num.tau

func normdist (m, σ) {
    var r = sqrt(-2 * 1.rand.log)
    var Θ = (τ * 1.rand)
    r * Θ.cos * σ + m
}

var size = 100_000
var mean = 50
var stddev = 4

var dataset = size.of { normdist(mean, stddev) }
var m = (dataset.sum / size)
say ("m: #{m}")

var σ = sqrt(dataset »**» 2 -> sum / size - m**2)
say ("s: #{σ}")

var hash = Hash()
dataset.each { |n| hash{ n.round } := 0 ++ }

var scale = (180 * stddev / size)
const subbar = < ⎸ ▏ ▎ ▍ ▌ ▋ ▊ ▉ █ >

for i in (hash.keys.map{.to_i}.sort) {
    var x = (hash{i} * scale)
    var full = x.int
    var part = (8 * (x - full))
    say (i, "\t", '█' * full, subbar[part])
}


import std.stdio, std.algorithm, std.string, std.exception;

auto states = ["Alabama", "Alaska", "Arizona", "Arkansas",
"California", "Colorado", "Connecticut", "Delaware", "Florida",
"Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas",
"Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts",
"Michigan", "Minnesota", "Mississippi", "Missouri", "Montana",
"Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico",
"New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma",
"Oregon", "Pennsylvania", "Rhode Island", "South Carolina",
"South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia",
"Washington", "West Virginia", "Wisconsin", "Wyoming",
// Uncomment the next line for the fake states.
// "New Kory", "Wen Kory", "York New", "Kory New", "New Kory"
];

void main() {
  states.length -= states.sort().uniq.copy(states).length;

  string[][const ubyte[]] smap;
  foreach (immutable i, s1; states[0 .. $ - 1])
    foreach (s2; states[i + 1 .. $])
      smap[(s1 ~ s2).dup.representation.sort().release.assumeUnique]
        ~= s1 ~ " + " ~ s2;

  writefln("%-(%-(%s = %)\n%)",
           smap.values.sort().filter!q{ a.length > 1 });
}


package main

import (
    "fmt"
    "unicode"
)

var states = []string{"Alabama", "Alaska", "Arizona", "Arkansas",
    "California", "Colorado", "Connecticut",
    "Delaware",
    "Florida", "Georgia", "Hawaii",
    "Idaho", "Illinois", "Indiana", "Iowa",
    "Kansas", "Kentucky", "Louisiana",
    "Maine", "Maryland", "Massachusetts", "Michigan",
    "Minnesota", "Mississippi", "Missouri", "Montana",
    "Nebraska", "Nevada", "New Hampshire", "New Jersey",
    "New Mexico", "New York", "North Carolina", "North Dakota",
    "Ohio", "Oklahoma", "Oregon",
    "Pennsylvania", "Rhode Island",
    "South Carolina", "South Dakota", "Tennessee", "Texas",
    "Utah", "Vermont", "Virginia",
    "Washington", "West Virginia", "Wisconsin", "Wyoming"}

func main() {
    play(states)
    play(append(states,
        "New Kory", "Wen Kory", "York New", "Kory New", "New Kory"))
}

func play(states []string) {
    fmt.Println(len(states), "states:")
    // get list of unique state names
    set := make(map[string]bool, len(states))
    for _, s := range states {
        set[s] = true
    }
    // make parallel arrays for unique state names and letter histograms
    s := make([]string, len(set))
    h := make([][26]byte, len(set))
    var i int
    for us := range set {
        s[i] = us
        for _, c := range us {
            if u := uint(unicode.ToLower(c)) - 'a'; u < 26 {
                h[i][u]++
            }
        }
        i++
    }
    // use map to find matches.  map key is sum of histograms of
    // two different states.  map value is indexes of the two states.
    type pair struct {
        i1, i2 int
    }
    m := make(map[string][]pair)
    b := make([]byte, 26) // buffer for summing histograms
    for i1, h1 := range h {
        for i2 := i1 + 1; i2 < len(h); i2++ {
            // sum histograms
            for i := range b {
                b[i] = h1[i] + h[i2][i]
            }
            k := string(b) // make key from buffer.
            // now loop over any existing pairs with the same key,
            // printing any where both states of this pair are different
            // than the states of the existing pair
            for _, x := range m[k] {
                if i1 != x.i1 && i1 != x.i2 && i2 != x.i1 && i2 != x.i2 {
                    fmt.Printf("%s, %s = %s, %s\n", s[i1], s[i2],
                        s[x.i1], s[x.i2])
                }
            }
            // store this pair in the map whether printed or not.
            m[k] = append(m[k], pair{i1, i2})
        }
    }
}


package require Tcl 8.5
# Uses the Box-Muller transform to compute a pair of normal random numbers
proc tcl::mathfunc::nrand {mean stddev} {
    variable savednormalrandom
    if {[info exists savednormalrandom]} {
	return [expr {$savednormalrandom*$stddev + $mean}][unset savednormalrandom]
    }
    set r [expr {sqrt(-2*log(rand()))}]
    set theta [expr {2*3.1415927*rand()}]
    set savednormalrandom [expr {$r*sin($theta)}]
    expr {$r*cos($theta)*$stddev + $mean}
}
proc stats {size {slotfactor 10}} {
    set sum 0.0
    set sum2 0.0
    for {set i 0} {$i < $size} {incr i} {
	set r [expr { nrand(0.5, 0.2) }]

	incr histo([expr {int(floor($r*$slotfactor))}])
	set sum [expr {$sum + $r}]
	set sum2 [expr {$sum2 + $r**2}]
    }
    set mean [expr {$sum / $size}]
    set stddev [expr {sqrt($sum2/$size - $mean**2)}]
    puts "$size numbers"
    puts "Mean:   $mean"
    puts "StdDev: $stddev"
    foreach i [lsort -integer [array names histo]] {
	puts [string repeat "*" [expr {$histo($i)*350/int($size)}]]
    }
}

stats 100
puts ""
stats 1000
puts ""
stats 10000
puts ""
stats 100000 20


Public Sub standard_normal()
    Dim s() As Variant, bins(71) As Single
    ReDim s(20000)
    For i = 1 To 20000
        s(i) = WorksheetFunction.Norm_S_Inv(Rnd())
    Next i
    For i = -35 To 35
        bins(i + 36) = i / 10
    Next i
    Debug.Print "sample size"; UBound(s), "mean"; mean(s), "standard deviation"; standard_deviation(s)
            t = WorksheetFunction.Frequency(s, bins)
    For i = -35 To 35
        Debug.Print Format((i - 1) / 10, "0.00");
        Debug.Print "-"; Format(i / 10, "0.00"),
        Debug.Print String$(t(i + 36, 1) / 10, "X");
        Debug.Print
    Next i
End Sub


{-# LANGUAGE TupleSections #-}

import Data.Char (isLetter, toLower)
import Data.Function (on)
import Data.List (groupBy, nub, sort, sortBy)

-------------------- STATE NAME PUZZLE -------------------

puzzle :: [String] -> [((String, String), (String, String))]
puzzle states =
  concatMap
    ((filter isValid . pairs) . map snd)
    ( filter ((> 1) . length) $
        groupBy ((==) `on` fst) $
          sortBy
            (compare `on` fst)
            [ (pkey (a <> b), (a, b))
              | (a, b) <- pairs (nub $ sort states)
            ]
    )
  where
    pkey = sort . filter isLetter . map toLower
    isValid ((a0, a1), (b0, b1)) =
      (a0 /= b0)
        && (a0 /= b1)
        && (a1 /= b0)
        && (a1 /= b1)

pairs :: [a] -> [(a, a)]
pairs [] = []
pairs (y : ys) = map (y,) ys <> pairs ys

--------------------------- TEST -------------------------
main :: IO ()
main = do
  putStrLn $
    "Matching pairs generated from "
      <> show (length stateNames)
      <> " state names and "
      <> show (length fakeStateNames)
      <> " fake state names:"
  mapM_ print $ puzzle $ stateNames <> fakeStateNames

stateNames :: [String]
stateNames =
  [ "Alabama",
    "Alaska",
    "Arizona",
    "Arkansas",
    "California",
    "Colorado",
    "Connecticut",
    "Delaware",
    "Florida",
    "Georgia",
    "Hawaii",
    "Idaho",
    "Illinois",
    "Indiana",
    "Iowa",
    "Kansas",
    "Kentucky",
    "Louisiana",
    "Maine",
    "Maryland",
    "Massachusetts",
    "Michigan",
    "Minnesota",
    "Mississippi",
    "Missouri",
    "Montana",
    "Nebraska",
    "Nevada",
    "New Hampshire",
    "New Jersey",
    "New Mexico",
    "New York",
    "North Carolina",
    "North Dakota",
    "Ohio",
    "Oklahoma",
    "Oregon",
    "Pennsylvania",
    "Rhode Island",
    "South Carolina",
    "South Dakota",
    "Tennessee",
    "Texas",
    "Utah",
    "Vermont",
    "Virginia",
    "Washington",
    "West Virginia",
    "Wisconsin",
    "Wyoming"
  ]

fakeStateNames :: [String]
fakeStateNames =
  [ "New Kory",
    "Wen Kory",
    "York New",
    "Kory New",
    "New Kory"
  ]


import "random" for Random
import "/fmt" for Fmt
import "/math" for Nums

var rgen = Random.new()

// Box-Muller method from Wikipedia
var normal  = Fn.new { |mu, sigma|
    var u1  = rgen.float()
    var u2  = rgen.float()
    var mag = sigma * (-2 * u1.log).sqrt
    var z0  = mag * (2 * Num.pi * u2).cos + mu
    var z1  = mag * (2 * Num.pi * u2).sin + mu
    return [z0, z1]
}

var N = 100000
var NUM_BINS = 12
var HIST_CHAR = "■"
var HIST_CHAR_SIZE = 250
var bins = List.filled(NUM_BINS, 0)
var binSize = 0.1
var samples = List.filled(N, 0)
var mu = 0.5
var sigma = 0.25
for (i in 0...N/2) {
    var rns = normal.call(mu, sigma)
    for (j in 0..1) {
        var rn = rns[j]
        var bn
        if (rn < 0) {
            bn = 0
        } else if (rn >= 1) {
            bn = 11
        } else {
            bn = (rn/binSize).floor + 1
        }
        bins[bn] = bins[bn] + 1
        samples[i*2 + j] = rn
    }
}

Fmt.print("Normal distribution with mean $0.2f and S/D $0.2f for $,d samples:\n", mu, sigma, N)
System.print("    Range           Number of samples within that range")
for (i in 0...NUM_BINS) {
    var hist = HIST_CHAR * (bins[i] / HIST_CHAR_SIZE).round
    if (i == 0) {
        Fmt.print("  -∞ ..< 0.00  $s $,d", hist, bins[0])
    } else if (i < NUM_BINS - 1) {
        Fmt.print("$4.2f ..< $4.2f  $s $,d", binSize * (i-1), binSize * i, hist, bins[i])
    } else {
        Fmt.print("1.00 ... +∞    $s $,d", hist, bins[NUM_BINS - 1])
    }
}
Fmt.print("\nActual mean for these samples : $0.5f", Nums.mean(samples))
Fmt.print("Actual S/D  for these samples : $0.5f", Nums.stdDev(samples))


link strings                 # for csort and deletec

procedure main(arglist)
    ECsolve(S1 := getStates())     # original state names puzzle
    ECsolve(S2 := getStates2())    # modified fictious names puzzle
    GNsolve(S1)
    GNsolve(S2)
end

procedure ECsolve(S)         # Solve challenge using equivalence classes
    local T,x,y,z,i,t,s,l,m
    st := &time              # mark runtime
    /S := getStates()        # default
    every insert(states := set(),deletec(map(!S),' \t'))  # ignore case & space

    # Build a table containing sets of state name pairs
    # keyed off of canonical form of the pair
    # Use csort(s) rather than cset(s) to preserve the numbers of each letter
    # Since we care not of X&Y .vs. Y&X keep only X&Y

    T := table()
    every (x := !states ) & ( y := !states ) do
    if z := csort(x || (x << y)) then {
        /T[z] := []
        put(T[z],set(x,y))
    }

    # For each unique key (canonical pair) find intersection of all pairs
    # Output is <current key matched> <key> <pairs>

    i := m := 0       # keys (i) and pairs (m) matched
    every z := key(T) do {
        s := &null
        every l := !T[z] do {
            /s :=  l
            s **:= l
        }
        if *s = 0 then {
            i +:= 1
            m +:= *T[z]
            every x := !T[z] do {
                #writes(i," ",z)  # uncomment for equiv class and match count
                every writes(!x," ")
                write()
            }
        }
    }
    write("... runtime ",(&time - st)/1000.,"\n",m," matches found.")
end


fcn norm2{   // Box-Muller
   const PI2=(0.0).pi*2;;
   rnd:=(0.0).random.fp(1);  // random number in [0,1), using partial application
   r,a:=(-2.0*rnd().log()).sqrt(), PI2*rnd();
   return(r*a.cos(), r*a.sin());  // z0,z1
}
const N=100000, BINS=12, SIG=3, SCALE=500;
var sum=0.0,sumSq=0.0, h=BINS.pump(List(),0);	// (0,0,0,...)
fcn accum(v){
   sum+=v;
   sumSq+=v*v;
   b:=(v + SIG)*BINS/SIG/2;
   if(0<=b<BINS) h[b]+=1;
};


require'strings stats'

states=:<;._2]0 :0-.LF

Alabama,Alaska,Arizona,Arkansas,California,Colorado,
Connecticut,Delaware,Florida,Georgia,Hawaii,Idaho,
Illinois,Indiana,Iowa,Kansas,Kentucky,Louisiana,
Maine,Maryland,Massachusetts,Michigan,Minnesota,
Mississippi,Missouri,Montana,Nebraska,Nevada,
New Hampshire,New Jersey,New Mexico,New York,
North Carolina,North Dakota,Ohio,Oklahoma,Oregon,
Pennsylvania,Rhode Island,South Carolina,
South Dakota,Tennessee,Texas,Utah,Vermont,Virginia,
Washington,West Virginia,Wisconsin,Wyoming,
Maine,Maine,Maine,Maine,Maine,Maine,Maine,Maine,

)

pairUp=: (#~ matchUp)@({~ 2 comb #)@~.
matchUp=: (i.~ ~: i:~)@:(<@[email protected];"1)
normalize=: /:[email protected]@-.&' '


import java.util.*;
import java.util.stream.*;

public class StateNamePuzzle {

    static String[] states = {"Alabama", "Alaska", "Arizona", "Arkansas",
        "California", "Colorado", "Connecticut", "Delaware", "Florida",
        "Georgia", "hawaii", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa",
        "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts",
        "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana",
        "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico",
        "New York", "North Carolina ", "North Dakota", "Ohio", "Oklahoma",
        "Oregon", "Pennsylvania", "Rhode Island", "South Carolina",
        "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia",
        "Washington", "West Virginia", "Wisconsin", "Wyoming",
        "New Kory", "Wen Kory", "York New", "Kory New", "New Kory",};

    public static void main(String[] args) {
        solve(Arrays.asList(states));
    }

    static void solve(List<String> input) {
        Map<String, String> orig = input.stream().collect(Collectors.toMap(
                s -> s.replaceAll("\\s", "").toLowerCase(), s -> s, (s, a) -> s));

        input = new ArrayList<>(orig.keySet());

        Map<String, List<String[]>> map = new HashMap<>();
        for (int i = 0; i < input.size() - 1; i++) {
            String pair0 = input.get(i);
            for (int j = i + 1; j < input.size(); j++) {

                String[] pair = {pair0, input.get(j)};
                String s = pair0 + pair[1];
                String key = Arrays.toString(s.chars().sorted().toArray());

                List<String[]> val = map.getOrDefault(key, new ArrayList<>());
                val.add(pair);
                map.put(key, val);
            }
        }

        map.forEach((key, list) -> {
            for (int i = 0; i < list.size() - 1; i++) {
                String[] a = list.get(i);
                for (int j = i + 1; j < list.size(); j++) {
                    String[] b = list.get(j);

                    if (Stream.of(a[0], a[1], b[0], b[1]).distinct().count() < 4)
                        continue;

                    System.out.printf("%s + %s = %s + %s %n", orig.get(a[0]),
                            orig.get(a[1]), orig.get(b[0]), orig.get(b[1]));
                }
            }
        });
    }
}


# Input: a string
# Output: an array, being the exploded form of the normalized input
def normalize:
  explode
  | map(if . >= 97 then (. - 97) elif . >= 65 then (. - 65) else empty end);

# Input: an array of strings
# Output: a dictionary with key:value pairs: normalizedString:string
def dictionary:
  reduce .[] as $s ( {}; . + { ($s|normalize|implode): $s });

# Input: an array of strings (e.g. state names)
# Output: a stream of solutions
def solve:

  # Given a pair of normalized state names as lists of integers:
  def nletters: map(length) | add;

  # input [[s1,s2], [t2,t2]]
  def solved:
    ( .[0] | add | sort) ==  (.[1] | add | sort);

  unique
  | length as $l
  | dictionary as $dictionary
  | ($dictionary | keys | map(explode)) as $states
  | reduce ( range(0; $l) as $s1
                 | range($s1+1; $l) as $s2
                 | range($s1+1; $l) as $t1
	         | select($s2 != $t1)
	         | range($t1+1; $l) as $t2
     	         | select($s2 != $t2)
	         | [[$states[$s1], $states[$s2]], [$states[$t1], $states[$t2]]] ) as $quad
       ([];
        if ($quad[0] | nletters) == ($quad[1] | nletters)
	   and ($quad | solved)
	then . + [$quad | map( map(  $dictionary[ implode ] ))]
	else .
	end)
  | .[];


module StateNamePuzzle

const realnames = ["Alabama", "Alaska", "Arizona", "Arkansas", "California",
"Colorado", "Connecticut", "Delaware", "Florida", "Georgia", "Hawaii", "Idaho",
"Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine",
"Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri",
"Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico",
"New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon",
"Pennsylvania", "Rhode Island", "South Carolina", "South Dakota", "Tennessee",
"Texas", "Utah", "Vermont", "Virginia", "Washington", "West Virginia",
"Wisconsin", "Wyoming"]

const fictitious = ["New Kory", "Wen Kory", "York New", "Kory New", "New Kory"]

function combine(a::AbstractString, b::AbstractString)
    chars = vcat(collect(Char, a), collect(Char, b))
    sort!(chars)
    return join(chars)
end

function solve(input::Vector{<:AbstractString})
    dict = Dict{String,String}()
    for state in input
        key = replace(state, " ", "") |> lowercase
        if !haskey(dict, key)
            dict[key] = state
        end
    end
    keyset = collect(keys(dict))
    solutions = String[]
    duplicates = String[]
    for i in eachindex(keyset), j in (i+1):endof(keyset)
        len1 = length(keyset[i]) + length(keyset[j])
        combined1 = combine(keyset[i], keyset[j])
        for k in eachindex(keyset), l in k+1:endof(keyset)
            k ∈ (i, j) && continue
            l ∈ (i, j) && continue
            len2 = length(keyset[k]) + length(keyset[l])
            len1 != len2 && continue
            combined2 = combine(keyset[k], keyset[l])
            if combined1 == combined2
                f1 = dict[keyset[i]] * " + " * dict[keyset[j]]
                f2 = dict[keyset[k]] * " + " * dict[keyset[l]]
                f3 = f1 * " = " * f2
                f3 ∈ duplicates && continue
                push!(solutions, f3)
                f4 = f2 * " = " * f1
                push!(duplicates, f4)
            end
        end
    end
    return sort!(solutions)
end

end  # module StateNamePuzzle


// version 1.2.10

fun solve(states: List<String>) {
    val dict = mutableMapOf<String, String>()
    for (state in states) {
        val key = state.toLowerCase().replace(" ", "")
        if (dict[key] == null) dict.put(key, state)
    }
    val keys = dict.keys.toList()
    val solutions = mutableListOf<String>()
    val duplicates = mutableListOf<String>()
    for (i in 0 until keys.size) {
        for (j in i + 1 until keys.size) {
            val len = keys[i].length + keys[j].length
            val chars = (keys[i] + keys[j]).toCharArray()
            chars.sort()
            val combined = String(chars)
            for (k in 0 until keys.size) {
                for (l in k + 1 until keys.size) {
                    if (k == i || k == j || l == i || l == j) continue
                    val len2 = keys[k].length + keys[l].length
                    if (len2 != len) continue
                    val chars2 = (keys[k] + keys[l]).toCharArray()
                    chars2.sort()
                    val combined2 = String(chars2)
                    if (combined == combined2) {
                        val f1 = "${dict[keys[i]]} + ${dict[keys[j]]}"
                        val f2 = "${dict[keys[k]]} + ${dict[keys[l]]}"
                        val f3 = "$f1 = $f2"
                        if (f3 in duplicates) continue
                        solutions.add(f3)
                        val f4 = "$f2 = $f1"
                        duplicates.add(f4)
                    }
                }
            }
        }
    }
    solutions.sort()
    for ((i, sol) in solutions.withIndex()) {
        println("%2d  %s".format(i + 1, sol))
    }
}

fun main(args: Array<String>) {
    val states = listOf(
        "Alabama", "Alaska", "Arizona", "Arkansas",
        "California", "Colorado", "Connecticut",
        "Delaware",
        "Florida", "Georgia", "Hawaii",
        "Idaho", "Illinois", "Indiana", "Iowa",
        "Kansas", "Kentucky", "Louisiana",
        "Maine", "Maryland", "Massachusetts", "Michigan",
        "Minnesota", "Mississippi", "Missouri", "Montana",
        "Nebraska", "Nevada", "New Hampshire", "New Jersey",
        "New Mexico", "New York", "North Carolina", "North Dakota",
        "Ohio", "Oklahoma", "Oregon",
        "Pennsylvania", "Rhode Island",
        "South Carolina", "South Dakota", "Tennessee", "Texas",
        "Utah", "Vermont", "Virginia",
        "Washington", "West Virginia", "Wisconsin", "Wyoming"
    )
    println("Real states only:")
    solve(states)
    println()
    val fictitious = listOf(
        "New Kory", "Wen Kory", "York New", "Kory New", "New Kory"
    )
    println("Real and fictitious states:")
    solve(states + fictitious)
}


function pairwiseAnagrams X
   if the optionkey is down then breakpoint
   put the long seconds into T
   put empty into itemsSoFar
   repeat for each item W in X
      put word 1 to -1 of W into W
      if D[W] = 1 then next repeat
      put 1 into D[W]
      repeat for each item W2 in itemsSoFar
         put W,W2 & cr after WPairs[sortChars(W & W2,true)]
      end repeat
      put W & comma after itemsSoFar
   end repeat
   repeat for each key K in WPairs
      put empty into pairsSoFar
      repeat for each line L in WPairs[K]
         repeat for each line L2 in pairsSoFar
            if item 1 of L is among the items of L2 or item 2 of L is among the items of L2 then next repeat
            put L && "and" && L2 & cr after R
         end repeat
         put L & cr after pairsSoFar
      end repeat
   end repeat
   put the long seconds - T
   return char 1 to -2 of R
end pairwiseAnagrams

function sortChars X,lettersOnly
   get charsToItems(X,lettersOnly)
   sort items of it
   return itemsToChars(it)
end sortChars

function charsToItems X,lettersOnly
   repeat for each char C in X
      if lettersOnly and C is not in "abcdefghijklmnopqrstuvwxyz" then next repeat
      put C & comma after R
   end repeat
   return char 1 to -2 of R
end charsToItems

function itemsToChars X
   replace comma with empty in X
   return X
end itemsToChars


letters[words_,n_] := Sort[Flatten[Characters /@ Take[words,n]]];
groupSameQ[g1_, g2_] := Sort /@ Partition[g1, 2] === Sort /@ Partition[g2, 2];
permutations[{a_, b_, c_, d_}] = Union[Permutations[{a, b, c, d}], SameTest -> groupSameQ];
Select[Flatten[permutations /@
   Subsets[Union[ToLowerCase/@{"Alabama", "Alaska", "Arizona", "Arkansas", "California", "Colorado", "Connecticut", "Delaware", "Florida",
      "Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland",
      "Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire",
      "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon", "Pennsylvania",
      "Rhode Island", "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington",
      "West Virginia", "Wisconsin", "Wyoming"}], {4}], 1],
 letters[#, 2] === letters[#, -2] &]


import algorithm, sequtils, strformat, strutils, tables

const
  States = @["Alabama",  "Alaska",  "Arizona",  "Arkansas",
             "California",  "Colorado",  "Connecticut",  "Delaware",
             "Florida",  "Georgia",  "Hawaii",  "Idaho",  "Illinois",
             "Indiana",  "Iowa",  "Kansas",  "Kentucky",  "Louisiana",
             "Maine",  "Maryland",  "Massachusetts",  "Michigan",
             "Minnesota",  "Mississippi",  "Missouri",  "Montana",
             "Nebraska",  "Nevada",  "New Hampshire",  "New Jersey",
             "New Mexico",  "New York",  "North Carolina",  "North Dakota",
             "Ohio",  "Oklahoma",  "Oregon",  "Pennsylvania",  "Rhode Island",
             "South Carolina",  "South Dakota",  "Tennessee",  "Texas",
             "Utah",  "Vermont",  "Virginia",
             "Washington",  "West Virginia",  "Wisconsin",  "Wyoming"]

  Fictitious = @["New Kory", "Wen Kory", "York New", "Kory New", "New Kory"]

type MatchingPairs = ((string, string), (string, string))

proc matchingPairs(states: openArray[string]): seq[MatchingPairs] =
  ## Build the list of matching pairs of states.

  let states = sorted(states).deduplicate()

  # Build a mapping from ordered sequence of chars to sequence of (state, state).
  var mapping: Table[seq[char], seq[(string, string)]]
  for i in 0..<states.high:
    let s1 = states[i]
    for j in (i + 1)..states.high:
      let s2 = states[j]
      mapping.mgetOrPut(sorted(map(s1 & s2, toLowerAscii)), @[]).add (s1, s2)

  # Keep only the couples of pairs of states with no common state.
  for pairs in mapping.values:
    if pairs.len > 1:
      # These pairs are candidates.
      for i in 0..<pairs.high:
        let pair1 = pairs[i]
        for j in i..pairs.high:
          let pair2 = pairs[j]
          if pair1[0] != pair2[0] and pair1[0] != pair2[1] and
             pair1[1] != pair2[0] and pair1[1] != pair2[1]:
            # "pair1" and "pair2" have no common state.
            result.add (pair1, pair2)

proc `$`(pairs: MatchingPairs): string =
  ## Return the string representation of two matching pairs.
  "$1 & $2 = $3 & $4".format(pairs[0][0], pairs[0][1], pairs[1][0], pairs[1][1])

echo "For real states:"
for n, pairs in matchingPairs(States):
  echo &"{n+1:2}:  {pairs}"
echo()
echo "For real + fictitious states:"
for n, pairs in matchingPairs(States & Fictitious):
  echo &"{n+1:2}:  {pairs}"


#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

sub uniq {
    my %uniq;
    undef @uniq{ @_ };
    return keys %uniq
}

sub puzzle {
    my @states = uniq(@_);

    my %pairs;
    for my $state1 (@states) {
        for my $state2 (@states) {
            next if $state1 le $state2;
            my $both = join q(),
                       grep ' ' ne $_,
                       sort split //,
                       lc "$state1$state2";
            push @{ $pairs{$both} }, [ $state1, $state2 ];
        }
    }

    for my $pair (keys %pairs) {
        next if 2 > @{ $pairs{$pair} };

        for my $pair1 (@{ $pairs{$pair} }) {
            for my $pair2 (@{ $pairs{$pair} }) {
                next if 4 > uniq(@$pair1, @$pair2)
                     or $pair1->[0] lt $pair2->[0];

                say join ' = ', map { join ' + ', @$_ } $pair1, $pair2;
            }
        }
    }
}

my @states = ( 'Alabama', 'Alaska', 'Arizona', 'Arkansas',
               'California', 'Colorado', 'Connecticut', 'Delaware',
               'Florida', 'Georgia', 'Hawaii',
               'Idaho', 'Illinois', 'Indiana', 'Iowa',
               'Kansas', 'Kentucky', 'Louisiana',
               'Maine', 'Maryland', 'Massachusetts', 'Michigan',
               'Minnesota', 'Mississippi', 'Missouri', 'Montana',
               'Nebraska', 'Nevada', 'New Hampshire', 'New Jersey',
               'New Mexico', 'New York', 'North Carolina', 'North Dakota',
               'Ohio', 'Oklahoma', 'Oregon',
               'Pennsylvania', 'Rhode Island',
               'South Carolina', 'South Dakota', 'Tennessee', 'Texas',
               'Utah', 'Vermont', 'Virginia',
               'Washington', 'West Virginia', 'Wisconsin', 'Wyoming',
             );

my @fictious = ( 'New Kory', 'Wen Kory', 'York New', 'Kory New', 'New Kory' );

say scalar @states, ' states:';
puzzle(@states);

say @states + @fictious, ' states:';
puzzle(@states, @fictious);


with javascript_semantics
constant states = {"Alabama", "Alaska", "Arizona", "Arkansas",
                   "California", "Colorado", "Connecticut", "Delaware",
                   "Florida", "Georgia", "Hawaii", "Idaho", "Illinois",
                   "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana",
                   "Maine", "Maryland", "Massachusetts", "Michigan",
                   "Minnesota", "Mississippi", "Missouri", "Montana",
                   "Nebraska", "Nevada", "New Hampshire", "New Jersey",
                   "New Mexico", "New York", "North Carolina", "North Dakota",
                   "Ohio", "Oklahoma", "Oregon", "Pennsylvania",
                   "Rhode Island", "South Carolina", "South Dakota",
                   "Tennessee", "Texas", "Utah", "Vermont", "Virginia",
                   "Washington", "West Virginia", "Wisconsin", "Wyoming"},
--       extras = {"New Kory", "Wen Kory", "York New", "Kory New", "New Kory"}
         extras = {"Slender Dragon", "Abalamara"}

function no_dup(sequence s)
    s = sort(s)
    for i=length(s) to 2 by -1 do
        if s[i]=s[i-1] then
            s[i] = s[$]
            s = s[1..$-1]
        end if
    end for
    return s
end function

procedure play(sequence s)
    s = no_dup(deep_copy(s))
    destroy_dict(1) -- empty dict
    for i=1 to length(s)-1 do
        for j=i+1 to length(s) do
            string key = trim(sort(lower(s[i]&s[j])))
            object data = getd(key)
            if data=0 then
                putd(key,{{i,j}})
            else
                for k=1 to length(data) do
                    integer {m,n} = data[k]
                    if m!=i and m!=j and n!=i and n!=j then
                        ?{s[i],s[j],"<==>",s[m],s[n]}
                    end if
                end for
                putd(key,append(deep_copy(data),{i,j}))
            end if
        end for
    end for
end procedure
play(states)
?"==="
play(states&extras)


(setq *States
   (group
      (mapcar '((Name) (cons (clip (sort (chop (lowc Name)))) Name))
         (quote
            "Alabama" "Alaska" "Arizona" "Arkansas"
            "California" "Colorado" "Connecticut"
            "Delaware"
            "Florida" "Georgia" "Hawaii"
            "Idaho" "Illinois" "Indiana" "Iowa"
            "Kansas" "Kentucky" "Louisiana"
            "Maine" "Maryland" "Massachusetts" "Michigan"
            "Minnesota" "Mississippi" "Missouri" "Montana"
            "Nebraska" "Nevada" "New Hampshire" "New Jersey"
            "New Mexico" "New York" "North Carolina" "North Dakota"
            "Ohio" "Oklahoma" "Oregon"
            "Pennsylvania" "Rhode Island"
            "South Carolina" "South Dakota" "Tennessee" "Texas"
            "Utah" "Vermont" "Virginia"
            "Washington" "West Virginia" "Wisconsin" "Wyoming"
            "New Kory" "Wen Kory" "York New" "Kory New" "New Kory" ) ) ) )

(extract
   '((P)
      (when (cddr P)
         (mapcar
            '((X)
               (cons
                  (cadr (assoc (car X) *States))
                  (cadr (assoc (cdr X) *States)) ) )
            (cdr P) ) ) )
   (group
      (mapcon
         '((X)
            (extract
               '((Y)
                  (cons
                     (sort (conc (copy (caar X)) (copy (car Y))))
                     (caar X)
                     (car Y) ) )
               (cdr X) ) )
         *States ) ) )


state_name_puzzle :-
	L = ["Alabama", "Alaska", "Arizona", "Arkansas",
	     "California", "Colorado", "Connecticut",
	     "Delaware",
	     "Florida", "Georgia", "Hawaii",
	     "Idaho", "Illinois", "Indiana", "Iowa",
	     "Kansas", "Kentucky", "Louisiana",
	     "Maine", "Maryland", "Massachusetts", "Michigan",
	     "Minnesota", "Mississippi", "Missouri", "Montana",
	     "Nebraska", "Nevada", "New Hampshire", "New Jersey",
	     "New Mexico", "New York", "North Carolina", "North Dakota",
	     "Ohio", "Oklahoma", "Oregon",
	     "Pennsylvania", "Rhode Island",
	     "South Carolina", "South Dakota", "Tennessee", "Texas",
	     "Utah", "Vermont", "Virginia",
	     "Washington", "West Virginia", "Wisconsin", "Wyoming",
	     "New Kory", "Wen Kory", "York New", "Kory New", "New Kory"],

	maplist(goedel, L, R),

	% sort remove duplicates
	sort(R, RS),

	study(RS).

study([]).

study([V-Word|T]) :-
	study_1_Word(V-Word, T, T),
	study(T).

study_1_Word(_, [], _).
study_1_Word(V1-W1, [V2-W2 | T1], T) :-
	TT is V1+V2,
	study_2_Word(W1, W2, TT, T),
	study_1_Word(V1-W1, T1, T).

study_2_Word(_W1, _W2, _TT, []).

study_2_Word(W1, W2, TT, [V3-W3 | T]) :-
	(   W2 \= W3 -> study_3_Word(W1, W2, TT, V3-W3, T); true),
	study_2_Word(W1, W2, TT, T).

study_3_Word(_W1, _W2, _TT, _V3-_W3, []).

study_3_Word(W1, W2, TT, V3-W3, [V4-W4|T]) :-
	TT1 is V3 + V4,
	(   TT1 < TT -> study_3_Word(W1, W2, TT, V3-W3, T)
	;   (TT1 = TT -> ( W4 \= W2 -> format('~w & ~w  with ~w & ~w~n', [W1, W2, W3, W4])
	                               ; true),
           	         study_3_Word(W1, W2, TT, V3-W3, T))
	;   true).

% Compute a Goedel number for the word
goedel(Word, Goedel-A) :-
	name(A, Word),
	downcase_atom(A, Amin),
	atom_codes(Amin, LA),
	compute_Goedel(LA, 0, Goedel).

compute_Goedel([], G, G).

compute_Goedel([32|T], GC, GF) :-
	compute_Goedel(T, GC, GF).

compute_Goedel([H|T], GC, GF) :-
	Ind is H - 97,
	GC1 is GC + 26 ** Ind,
	compute_Goedel(T, GC1, GF).


from collections import defaultdict

states = ["Alabama", "Alaska", "Arizona", "Arkansas",
"California", "Colorado", "Connecticut", "Delaware", "Florida",
"Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas",
"Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts",
"Michigan", "Minnesota", "Mississippi", "Missouri", "Montana",
"Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico",
"New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma",
"Oregon", "Pennsylvania", "Rhode Island", "South Carolina",
"South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia",
"Washington", "West Virginia", "Wisconsin", "Wyoming",
# Uncomment the next line for the fake states.
# "New Kory", "Wen Kory", "York New", "Kory New", "New Kory"
]

states = sorted(set(states))

smap = defaultdict(list)
for i, s1 in enumerate(states[:-1]):
    for s2 in states[i + 1:]:
        smap["".join(sorted(s1 + s2))].append(s1 + " + " + s2)

for pairs in sorted(smap.itervalues()):
    if len(pairs) > 1:
        print " = ".join(pairs)


#lang racket
(define states
  (list->set
   (map string-downcase
        '("Alabama" "Alaska" "Arizona" "Arkansas"
          "California" "Colorado" "Connecticut"
          "Delaware"
          "Florida" "Georgia" "Hawaii"
          "Idaho" "Illinois" "Indiana" "Iowa"
          "Kansas" "Kentucky" "Louisiana"
          "Maine" "Maryland" "Massachusetts" "Michigan"
          "Minnesota" "Mississippi" "Missouri" "Montana"
          "Nebraska""Nevada" "New Hampshire" "New Jersey"
          "New Mexico" "New York" "North Carolina" "North Dakota"
          "Ohio" "Oklahoma" "Oregon"
          "Pennsylvania" "Rhode Island"
          "South Carolina" "South Dakota" "Tennessee" "Texas"
          "Utah" "Vermont" "Virginia"
          "Washington" "West Virginia" "Wisconsin" "Wyoming"
          ; "New Kory" "Wen Kory" "York New" "Kory New" "New Kory"
          ))))

(define (canon s t)
  (sort (append (string->list s) (string->list t)) char<? ))

(define seen (make-hash))
(for* ([s1 states] [s2 states] #:when (string<? s1 s2))
  (define c (canon s1 s2))
  (cond [(hash-ref seen c (λ() (hash-set! seen c (list s1 s2)) #f))
         => (λ(states) (displayln (~v states (list s1 s2))))]))


my @states = <
    Alabama Alaska Arizona Arkansas California Colorado Connecticut Delaware
    Florida Georgia Hawaii Idaho Illinois Indiana Iowa Kansas Kentucky
    Louisiana Maine Maryland Massachusetts Michigan Minnesota Mississippi
    Missouri Montana Nebraska Nevada New_Hampshire New_Jersey New_Mexico
    New_York North_Carolina North_Dakota Ohio Oklahoma Oregon Pennsylvania
    Rhode_Island South_Carolina South_Dakota Tennessee Texas Utah Vermont
    Virginia Washington West_Virginia Wisconsin Wyoming
>;

say "50 states:";
.say for anastates @states;

say "\n54 states:";
.say for sort anastates @states, < New_Kory Wen_Kory York_New Kory_New New_Kory >;

sub anastates (*@states) {
    my @s = @states.unique».subst('_', ' ');

    my @pairs = gather for ^@s -> $i {
	for $i ^..^ @s -> $j {
	    take [ @s[$i], @s[$j] ];
	}
    }

    my $equivs = hash @pairs.classify: *.lc.comb.sort.join;

    gather for $equivs.values -> @c {
	for ^@c -> $i {
	    for $i ^..^ @c -> $j {
		my $set = set @c[$i].list, @c[$j].list;
		take @c[$i].list.join(', ') ~ ' = ' ~ @c[$j].list.join(', ') if $set == 4;
	    }
	}
    }
}


/*REXX program  (state name puzzle)  rearranges two state's names ──► two new states.   */
!='Alabama,  Alaska, Arizona,  Arkansas, California,    Colorado, Connecticut,       Delaware, Florida, Georgia,',
  'Hawaii,   Idaho,  Illinois, Indiana,  Iowa, Kansas,  Kentucky, Louisiana,  Maine, Maryland, Massachusetts,   ',
  'Michigan, Minnesota, Mississippi, Missouri, Montana, Nebraska, Nevada, New Hampshire, New Jersey, New Mexico,',
  'New York, North Carolina,  North Dakota,  Ohio, Oklahoma, Oregon, Pennsylvania, Rhode Island, South Carolina,',
  'South Dakota,  Tennessee,  Texas,  Utah,  Vermont,   Virginia, Washington, West Virginia, Wisconsin,  Wyoming'
parse arg xtra;    !=! ',' xtra                     /*add optional  (fictitious)  names.*/
@abcU= 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';     !=space(!) /*!: the state list, no extra blanks*/
deads=0;    dups=0;    L.=0;     !orig=!;      @@.= /*initialize some REXX variables.   */
z=0                                                 /* [↑]  elide  dend─end (DE) states.*/
    do de=0  for 2;              !=!orig            /*use original state list for each. */
    @.=
        do states=0  by 0  until !==''              /*parse until the cows come home.   */
        parse var !  x  ','  !;       x=space(x)    /*remove all blanks from state name.*/
        if @.x\==''  then do                        /*was state was already specified?  */
                          if de  then iterate       /*don't tell error if doing 2nd pass*/
                          dups=dups + 1             /*bump the duplicate counter.       */
                          say 'ignoring the 2nd naming of the state: '    x;      iterate
                          end
        @.x=x                                       /*indicate this state name exists.  */
        y=space(x,0);    upper y;    yLen=length(y) /*get upper name with no spaces; Len*/
        if de  then do                              /*Is the firstt pass?  Then process.*/
                         do j=1  for yLen           /*see if it's a dead─end state name.*/
                         _=substr(y, j, 1)          /* _:  is some state name character.*/
                         if L._ \== 1  then iterate /*Count ¬ 1?  Then state name is OK.*/
                         say 'removing dead─end state  [which has the letter '   _"]: "  x
                         deads=deads + 1            /*bump number of dead─ends states.  */
                         iterate states             /*go and process another state name.*/
                         end   /*j*/
                    z=z+1                           /*bump counter of the state names.  */
                    #.z=y;  ##.z=x                  /*assign state name;  also original.*/
                    end
               else do k=1  for yLen                /*inventorize letters of state name.*/
                    _=substr(y,k,1);   L._=L._ + 1  /*count each letter in state name.  */
                    end   /*k*/
        end   /*states*/                            /*the index STATES isn't incremented*/
    end       /*de*/
call list                                           /*list state names in order given.  */
                   say z     'state name's(z)                "are useable."
if dups \==0  then say dups  'duplicate of a state's(dups)   'ignored.'
if deads\==0  then say deads 'dead─end state's(deads)        'deleted.'
sols=0                                              /*number of solutions found (so far)*/
say                                                 /*[↑]  look for mix and match states*/
     do j=1  for z     /* ◄──────────────────────────────────────────────────────────┐  */
       do k=j+1  to z                               /* ◄─── state K,  state J  ►─────┘  */
       if #.j<<#.k  then JK=#.j || #.k              /*is the state in the proper order? */
                    else JK=#.k || #.j              /*No,  then use the new state name. */
         do m=1  for z; if m==j | m==k then iterate /*no state  overlaps  are allowed.  */
         if verify(#.m, jk) \== 0      then iterate /*is this state name even possible? */
         nJK=elider(JK, #.m)                        /*a new JK, after eliding #.m chars.*/
           do n=m+1  to z; if n==j | n==k then iterate      /*no overlaps are allowed.  */
           if verify(#.n, nJK) \== 0      then iterate      /*is it possible?           */
           if elider(nJK, #.n) \== ''     then iterate      /*any leftovers letters?    */
           if #.m<<#.n  then MN=#.m || #.n                  /*is it in the proper order?*/
                        else MN=#.n || #.m                  /*we found a new state name.*/
           if @@.JK.MN\=='' | @@.MN.JK\==""  then iterate   /*was it done before?       */
           say 'found: '      ##.j','     ##.k       "  ───►  "        ##.m','      ##.n
           @@.JK.MN=1                            /*indicate this solution as being found*/
           sols=sols+1                           /*bump the number of solutions found.  */
           end   /*n*/
         end     /*m*/
       end       /*k*/
     end         /*j*/
say                                              /*show a blank line for easier reading.*/
if sols==0  then sols= 'No'                      /*use mucher gooder (sic) Englishings. */
say sols  'solution's(sols)    "found."          /*display the number of solutions found*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
elider: parse arg hay,pins                       /*remove letters (pins) from haystack. */
                            do e=1  for length(pins);    p=pos( substr( pins, e, 1),  hay)
                            if p==0  then iterate   ;    hay=overlay(' ', hay, p)
                            end   /*e*/          /* [↑]  remove a letter from haystack. */
        return space(hay, 0)                     /*remove blanks from the haystack.     */
/*──────────────────────────────────────────────────────────────────────────────────────*/
list:   say;   do i=1  for z;   say right(i, 9)   ##.i;   end;            say;      return
s:      if arg(1)==1  then return arg(3);    return word(arg(2) 's', 1)    /*pluralizer.*/


require 'set'

# 26 prime numbers
Primes = [ 2,  3,  5,  7, 11, 13, 17, 19, 23, 29, 31, 37, 41,
          43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101]
States = [
    "Alabama", "Alaska", "Arizona", "Arkansas", "California", "Colorado",
    "Connecticut", "Delaware", "Florida", "Georgia", "Hawaii", "Idaho",
    "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine",
    "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi",
    "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey",
    "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio",
    "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina",
    "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia",
    "Washington", "West Virginia", "Wisconsin", "Wyoming"
]

def print_answer(states)
  # find goedel numbers for all pairs of states
  goedel = lambda {|str| str.chars.map {|c| Primes[c.ord - 65]}.reduce(:*)}
  pairs = Hash.new {|h,k| h[k] = Array.new}
  map = states.uniq.map {|state| [state, goedel[state.upcase.delete("^A-Z")]]}
  map.combination(2) {|(s1,g1), (s2,g2)| pairs[g1 * g2] << [s1, s2]}

  # find pairs without duplicates
  result = []
  pairs.values.select {|val| val.length > 1}.each do |list_of_pairs|
    list_of_pairs.combination(2) do |pair1, pair2|
      if Set[*pair1, *pair2].length == 4
        result << [pair1, pair2]
      end
    end
  end

  # output the results
  result.each_with_index do |(pair1, pair2), i|
    puts "%d\t%s\t%s" % [i+1, pair1.join(', '), pair2.join(', ')]
  end
end

puts "real states only"
print_answer(States)
puts ""
puts "with fictional states"
print_answer(States + ["New Kory", "Wen Kory", "York New", "Kory New", "New Kory"])


object StateNamePuzzle extends App {
  // Logic:
  def disjointPairs(pairs: Seq[Set[String]]) =
    for (a <- pairs; b <- pairs; if a.intersect(b).isEmpty) yield Set(a,b)

  def anagramPairs(words: Seq[String]) =
    (for (a <- words; b <- words; if a != b) yield Set(a, b)) // all pairs
    .groupBy(_.mkString.toLowerCase.replaceAll("[^a-z]", "").sorted) // grouped anagram pairs
    .values.map(disjointPairs).flatMap(_.distinct) // unique non-overlapping anagram pairs

  // Test:
  val states = List(
    "New Kory", "Wen Kory", "York New", "Kory New", "New Kory",
    "Alabama", "Alaska", "Arizona", "Arkansas", "California", "Colorado",
    "Connecticut", "Delaware", "Florida", "Georgia", "Hawaii", "Idaho",
    "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine",
    "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi",
    "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey",
    "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio",
    "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina",
    "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia",
    "Washington", "West Virginia", "Wisconsin", "Wyoming"
  )

  println(anagramPairs(states).map(_.map(_ mkString " + ") mkString " = ") mkString "\n")
}


package require Tcl 8.5
# Gödel number generator
proc goedel s {
    set primes {
	2 3 5 7 11 13 17 19 23 29 31 37 41
	43 47 53 59 61 67 71 73 79 83 89 97 101
    }
    set n 1
    foreach c [split [string toupper $s] ""] {
	if {![string is alpha $c]} continue
	set n [expr {$n * [lindex $primes [expr {[scan $c %c] - 65}]]}]
    }
    return $n
}
# Calculates the pairs of states
proc groupStates {stateList} {
    set stateList [lsort -unique $stateList]
    foreach state1 $stateList {
	foreach state2 $stateList {
	    if {$state1 >= $state2} continue
	    dict lappend group [goedel $state1$state2] [list $state1 $state2]
	}
    }
    foreach g [dict values $group] {
	if {[llength $g] > 1} {
	    foreach p1 $g {
		foreach p2 $g {
		    if {$p1 < $p2 && [unshared $p1 $p2]} {
			lappend result [list $p1 $p2]
		    }
		}
	    }
	}
    }
    return $result
}
proc unshared args {
    foreach p $args {
	foreach a $p {incr s($a)}
    }
    expr {[array size s] == [llength $args]*2}
}
# Pretty printer for state name pair lists
proc printPairs {title groups} {
    foreach group $groups {
	puts "$title Group #[incr count]"
	foreach statePair $group {
	    puts "\t[join $statePair {, }]"
	}
    }
}

set realStates {
    "Alabama" "Alaska" "Arizona" "Arkansas" "California" "Colorado"
    "Connecticut" "Delaware" "Florida" "Georgia" "Hawaii" "Idaho" "Illinois"
    "Indiana" "Iowa" "Kansas" "Kentucky" "Louisiana" "Maine" "Maryland"
    "Massachusetts" "Michigan" "Minnesota" "Mississippi" "Missouri" "Montana"
    "Nebraska" "Nevada" "New Hampshire" "New Jersey" "New Mexico" "New York"
    "North Carolina" "North Dakota" "Ohio" "Oklahoma" "Oregon" "Pennsylvania"
    "Rhode Island" "South Carolina" "South Dakota" "Tennessee" "Texas" "Utah"
    "Vermont" "Virginia" "Washington" "West Virginia" "Wisconsin" "Wyoming"
}
printPairs "Real States" [groupStates $realStates]
set falseStates {
    "New Kory" "Wen Kory" "York New" "Kory New" "New Kory"
}
printPairs "Real and False States" [groupStates [concat $realStates $falseStates]]


import "/str" for Str
import "/sort" for Sort
import "/fmt" for Fmt

var solve = Fn.new { |states|
    var dict = {}
    for (state in states) {
        var key = Str.lower(state).replace(" ", "")
        if (!dict[key]) dict[key] = state
    }
    var keys = dict.keys.toList
    Sort.quick(keys)
    var solutions = []
    var duplicates = []
    for (i in 0...keys.count) {
        for (j in i+1...keys.count) {
            var len = keys[i].count + keys[j].count
            var chars = (keys[i] + keys[j]).toList
            Sort.quick(chars)
            var combined = chars.join()
            for (k in 0...keys.count) {
                for (l in k+1...keys.count) {
                    if (k != i && k != j && l != i && l != j) {
                        var len2 = keys[k].count + keys[l].count
                        if (len2 == len) {
                            var chars2 = (keys[k] + keys[l]).toList
                            Sort.quick(chars2)
                            var combined2 = chars2.join()
                            if (combined == combined2) {
                                var f1 = "%(dict[keys[i]]) + %(dict[keys[j]])"
                                var f2 = "%(dict[keys[k]]) + %(dict[keys[l]])"
                                var f3 = "%(f1) = %(f2)"
                                if (!duplicates.contains(f3)) {
                                    solutions.add(f3)
                                    var f4 = "%(f2) = %(f1)"
                                    duplicates.add(f4)
                                }
                            }
                        }
                    }
                }
            }
        }
    }
    Sort.quick(solutions)
    var i = 0
    for (sol in solutions) {
        Fmt.print("$2d  $s", i + 1, sol)
        i = i + 1
    }
}

var states = [
    "Alabama", "Alaska", "Arizona", "Arkansas",
    "California", "Colorado", "Connecticut",
    "Delaware",
    "Florida", "Georgia", "Hawaii",
    "Idaho", "Illinois", "Indiana", "Iowa",
    "Kansas", "Kentucky", "Louisiana",
    "Maine", "Maryland", "Massachusetts", "Michigan",
    "Minnesota", "Mississippi", "Missouri", "Montana",
    "Nebraska", "Nevada", "New Hampshire", "New Jersey",
    "New Mexico", "New York", "North Carolina", "North Dakota",
    "Ohio", "Oklahoma", "Oregon",
    "Pennsylvania", "Rhode Island",
    "South Carolina", "South Dakota", "Tennessee", "Texas",
    "Utah", "Vermont", "Virginia",
    "Washington", "West Virginia", "Wisconsin", "Wyoming"
]
System.print("Real states only:")
solve.call(states)
System.print()
var fictitious = [ "New Kory", "Wen Kory", "York New", "Kory New", "New Kory"  ]
System.print("Real and fictitious states:")
solve.call(states + fictitious)


#<<<  // here doc
states:=("Alabama, Alaska, Arizona, Arkansas,
   California, Colorado, Connecticut, Delaware, Florida,
   Georgia, Hawaii, Idaho, Illinois, Indiana, Iowa, Kansas,
   Kentucky, Louisiana, Maine, Maryland, Massachusetts,
   Michigan, Minnesota, Mississippi, Missouri, Montana,
   Nebraska, Nevada, New Hampshire, New Jersey, New Mexico,
   New York, North Carolina, North Dakota, Ohio, Oklahoma,
   Oregon, Pennsylvania, Rhode Island, South Carolina,
   South Dakota, Tennessee, Texas, Utah, Vermont, Virginia,
   Washington, West Virginia, Wisconsin, Wyoming"
   /* Uncomment the next line for the fake states. */
   # ",New Kory, Wen Kory, York New, Kory New, New Kory"
#<<<
).split(",").apply("strip");

smap:=Dictionary();
Utils.Helpers.pickNFrom(2,states).apply2('wrap(ss){ // 1225 combinations
   key:=(ss.concat()).toLower().sort()-" ";
   smap[key]=smap.find(key,List()).append(ss.concat(" + "));
});

foreach pairs in (smap.values){ // 1224 keys
//    pairs=Utils.Helpers.listUnique(pairs);  // eliminate dups
    if(pairs.len()>1)
        println(pairs.concat(" = ")) }


F step_up1()
   V deficit = 1
   L deficit > 0
      I step()
         deficit--
      E
         deficit++


function stepUp()
{
	var i:int = 0;
	while(i < 1)
		if(step())i++;
		else i--;
}


procedure Step_Up is
begin
   while not Step loop
      Step_Up;
   end loop;
end Step_Up;


void step_up(void)
{
    while (!step()) {
        step_up();
    }
}


   PROC step up = VOID:
   BEGIN
      WHILE NOT step DO
         step up
      OD
   END # step up #;


Position: 0

stepUp: function [].export:[Position][
    startPos: Position
    until -> step [
        Position = startPos + 1
    ]
]

step: function [].export:[Position][
    (0.5 > random 0 1.0)? [
        Position: Position - 1
        print ~"fall (|Position|)"
        false
    ][
        Position: Position + 1
        print ~"rise (|Position|)"
        true
    ]
]

stepUp


step_up()
{
    While !step()
       step_up()
}


function step_up() {
    while (!step()) { step_up() }
}


SUB stepup
    IF NOT step1 THEN stepup: stepup
END SUB


      DEF PROCstepup
      IF NOT FNstep PROCstepup : PROCstepup
      ENDPROC


void step_up() {
    while (!step()) step_up();
}


with Ada.Text_IO;  use Ada.Text_IO;
with GNAT.Traceback;
with GNAT.Traceback.Symbolic;

procedure Test_Stack_Trace is
   procedure Call_Stack is
      Trace  : GNAT.Traceback.Tracebacks_Array (1..1_000);
      Length : Natural;
   begin
      GNAT.Traceback.Call_Chain (Trace, Length);
      Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (Trace (1..Length)));
   end Call_Stack;

   procedure Inner (K : Integer) is
   begin
      Call_Stack;
   end Inner;

   procedure Middle (X, Y : Integer) is
   begin
      Inner (X * Y);
   end Middle;

   procedure Outer (A, B, C : Integer) is
   begin
     Middle (A + B, B + C);
   end Outer;

begin
  Outer (2,3,5);
end Test_Stack_Trace;


void step_up()
{
  while (!step()) step_up();
}


;; the initial level
(def level (atom 41))

;; the probability of success
(def prob 0.5001)

(defn step
  []
  (let [success (< (rand) prob)]
    (swap! level (if success inc dec))
    success) )


(defun step-up ()
  (unless (step) (step-up) (step-up)))


void step_up()
{
    while(!step)
        step_up;
}


var level := 41
var prob := 0.5001

def step() {
    def success := entropy.nextDouble() < prob
    level += success.pick(1, -1)
    return success
}


f()
return

f()
{
return g()
}

g()
{
ListLines
msgbox, lines recently executed
x = local to g
ListVars
msgbox, variable bindings
}
#Persistent


 100 DEF PROC callstack
 110   ON ERROR GOTO 1000
 120   FOR i=1 TO 100
 130      POP lnum
 140      LIST lnum TO lnum
 150   NEXT i
 190 END PROC

1000 PRINT "End of stack"
1010 STOP


#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>

#include <execinfo.h>

#define MAX_BT 200

void print_stack_trace()
{
  void *buffer[MAX_BT];
  int n;

  n = backtrace(buffer, MAX_BT);
  fprintf(stderr, "--- (depth %d) ---\n", n);
  backtrace_symbols_fd(buffer, n, STDERR_FILENO);
}

void inner(int k)
{
  print_stack_trace();
}

void middle(int x, int y)
{
  inner(x*y);
}

void outer(int a, int b, int c)
{
  middle(a+b, b+c);
}

int main()
{
  outer(2,3,5);
  return EXIT_SUCCESS;
}


using System;
using System.Diagnostics;

class Program
{
    static void Inner()
    {
        Console.WriteLine(new StackTrace());
    }

    static void Middle()
    {
        Inner();
    }

    static void Outer()
    {
        Middle();
    }

    static void Main()
    {
        Outer();
    }
}


(define (step-up) (while (not (step)) (step-up)))
;; checking this is tail-recusive :
step-up
   → (#λ null (#while (#not (step)) (#lambda-tail-call)))

;; Experimentation (not part of the task)
;; How much step calls to climb  1000 stairs ?
;; success is the robot success probability
(define (step)
 (set! STEPS (1+ STEPS)) ;; count
 (< (random) SUCCESS)) ;; ->#t or #f

(define (climb stairs)
	(when (> stairs 0)  (step-up) (climb (1- stairs))))

(define (task  (stairs 1000))
	(for ((success (in-range 1 0 -5/100)))
	(set! SUCCESS success)
	(set! STEPS 0)
	(climb stairs)
	(writeln 'stairs stairs 'probability success 'steps STEPS)))


defmodule Stair_climbing do
  defp step, do: 1 == :rand.uniform(2)

  defp step_up(true), do: :ok
  defp step_up(false) do
    step_up(step)
    step_up(step)
  end

  def step_up, do: step_up(step)
end

IO.inspect Stair_climbing.step_up


-module(stair).
-compile(export_all).

step() ->
    1 == random:uniform(2).

step_up(true) ->
    ok;
step_up(false) ->
    step_up(step()),
    step_up(step()).

step_up() ->
    step_up(step()).


(doall
  (map println (.dumpAllThreads (java.lang.management.ManagementFactory/getThreadMXBean) false false)))


(swank-backend:call-with-debugging-environment
  (lambda ()
    (swank:backtrace 0 nil)))


import std.stdio, core.runtime;

void inner() { defaultTraceHandler.writeln; }
void middle() { inner; }
void outer() { middle; }

void main() {
    outer;
    "After the stack trace.".writeln;
}


procedure Inner;
begin
   try
      raise Exception.Create('');
   except
      on E: Exception do
         PrintLn(E.StackTrace);
   end;
end;

procedure Middle;
begin
   Inner;
end;

procedure Outer;
begin
   Middle;
end;

Outer;


import extensions;

public singleton program
{
    inner()
    {
        console.printLine(new CallStack())
    }

    middle()
    {
        self.inner()
    }

    outer()
    {
        self.middle()
    }

    // program entry point
    function()
    {
        program.outer()
    }
}


procedure step_up()
    if not step() then
        step_up()
        step_up()
    end if
end procedure


: step-up ( -- ) step [ step-up step-up ] unless ;


: step-up   begin step 0= while recurse repeat ;


module StairRobot
  implicit none

contains

  logical function step()
    ! try to climb up and return true or false
    step = .true.     ! to avoid compiler warning
  end function step

  recursive subroutine step_up_rec
    do while ( .not. step() )
       call step_up_rec
    end do
  end subroutine step_up_rec

  subroutine step_up_iter
    integer :: i = 0
    do while ( i < 1 )
       if ( step() ) then
          i = i + 1
       else
          i = i - 1
       end if
    end do
  end subroutine step_up_iter

end module StairRobot


Sub step_up()
    Dim As Integer i
    Do
        If step_() Then
            i += 1
        Else
            i -= 1
        End If
    Loop Until i = 1
End Sub


defmodule Stack_traces do
  def main do
    {:ok, a} = outer
    IO.inspect a
  end

  defp outer do
    {:ok, a} = middle
    {:ok, a}
  end

  defp middle do
    {:ok, a} = inner
    {:ok, a}
  end

  defp inner do
    try do
      throw(42)
    catch 42 -> {:ok, :erlang.get_stacktrace}
    end
  end
end

Stack_traces.main


-module(stack_traces).

-export([main/0]).

main() ->
	{ok,A} = outer(),
	io:format("~p\n", [A]).

outer() ->
	{ok,A} = middle(),
	{ok,A}.

middle() ->
	{ok,A} = inner(),
	{ok,A}.

inner() ->
	try throw(42) catch 42 -> {ok,erlang:get_stacktrace()} end.


open System.Diagnostics

type myClass() =
    member this.inner() = printfn "%A" (new StackTrace())
    member this.middle() = this.inner()
    member this.outer() = this.middle()

[<EntryPoint>]
let main args =
    let that = new myClass()
    that.outer()
    0


USE: prettyprint
get-callstack callstack.


class Stair_climbing{
static void main(String[] args){
}
static def step_up(){
    while not step(){
            step_up();
            }
}

}


stepUp :: Robot ()
stepUp = untilM step stepUp

untilM :: Monad m => m Bool -> m () -> m ()
untilM test action = do
    result <- test
    if result then return () else action >> untilM test action


procedure step_up()
    return step() | (step_up(),step_up())
end


step         =: 0.6 > [email protected]:
attemptClimb =: [: <:`>:@.step 0:
isNotUpOne   =: [email protected](+/@])

step_up=: (] , attemptClimb)^:isNotUpOne^:_


public void stepUp() {
  while (!step()) stepUp();
}


[UNDEFINED] R.S [IF]
\ Return stack counterpart of DEPTH
\ Note the STACK-CELLS correction is there to hide RDEPTH itself
                                       ( -- n)
: RDEPTH STACK-CELLS -2 [+] CELLS [email protected] - ;

\ Return stack counterpart of .S
\ Note the : R.S R> .. >R ; sequence is there to hide R.S itself
                                       ( --)
: R.S R> CR RDEPTH DUP 0> IF DUP
  BEGIN DUP WHILE R> -ROT 1- REPEAT DROP DUP
  BEGIN DUP WHILE ROT DUP . >R 1- REPEAT DROP
  THEN ." (TORS) " DROP >R ;
[THEN]


Gnash: croak Life is troubled
Goodbye, cruel world!
Routine XeqACard croaks: Life is troubled
...from XeqACard Confronting croak Life is troubled
...from Attack   some input
...from Gnash    Gnash gnashing
Omitted exit from level 3:XeqACard
Omitted exit from level 2:Attack


package main

import (
    "fmt"
    "runtime"
)

func main() {
    stackTrace := make([]byte, 1024)
    n := runtime.Stack(stackTrace, true)
    stackTrace = stackTrace[:n]
    fmt.Printf("%s\n", stackTrace)
    fmt.Printf("(%d bytes)\n", len(stackTrace))
}


def rawTrace = { Thread.currentThread().stackTrace }


import Utils  # for buildStackTrace

procedure main()
   g()
   write()
   f()
end

procedure f()
   g()
end

procedure g()
   # Using 1 as argument omits the trace of buildStackTrace itself
   every write("\t",!buildStackTrace(1))
end


// version 1.2.0

import java.util.Random

val rand = Random(6321L) // generates short repeatable sequence
var position = 0

fun step(): Boolean {
    val r = rand.nextBoolean()
    if (r)
        println("Climbed up to ${++position}")
    else
        println("Fell down to ${--position}")
    return r
}

fun stepUp() {
    while (!step()) stepUp()
}

fun main(args: Array<String>) {
    stepUp()
}


'This demo will try to get the robot to step up
'Run it several times to see the differences; sometimes the robot falls
'quite a ways before making it to the next step up, but sometimes he makes it
'on the first try

result = Stepp.Up()

Function Stepp.Up()
    While Not(Stepp())
        result = Stepp.Up()
    Wend
End Function

Function Stepp()
    Stepp = Int((Rnd(1) * 2))
    If Stepp Then
        Print "Robot stepped up"
    Else
        Print "Robot fell down"
    End If
End Function


to step.up
  if not step [step.up step.up]
end


public class StackTracer {
    public static void printStackTrace() {
	StackTraceElement[] elems = Thread.currentThread().getStackTrace();

	System.out.println("Stack trace:");
	for (int i = elems.length-1, j = 2 ; i >= 3 ; i--, j+=2) {
	    System.out.printf("%" + j + "s%s.%s%n", "",
		    elems[i].getClassName(), elems[i].getMethodName());
	}
    }
}


try {
  throw new Error;
} catch(e) {
  alert(e.stack);
}


f() = g()
g() = println.(stacktrace())

f()


// version 1.1.2 (stacktrace.kt which compiles to StacktraceKt.class)

fun myFunc() {
    println(Throwable().stackTrace.joinToString("\n"))
}

fun main(args:Array<String>) {
    myFunc()
    println("\nContinuing ... ")
}


function step_up()
    while not step() do step_up() end
end


StepUp[] := If[!Step[], StepUp[]; StepUp[]]


function step_up()
    while ~step()
        step_up();
    end


proc stepUp = (while not step(): stepUp())


let rec step_up() =
  while not(step()) do
    step_up()
  done
;;


proc {StepUp}
   if {Not {Step}} then
      {StepUp}  %% make up for the fall
      {StepUp}  %% repeat original attempt
   end
end


// Define our own trace method
define trace => {
    local(gb) = givenblock

    // Set a depth counter
    var(::_tracedepth)->isnota(::integer) ? $_tracedepth = 0
    handle => {$_tracedepth--}

    // Only output when supplied a capture
    #gb ? stdoutnl(
        // Indent
        ('\t' * $_tracedepth++) +

        // Type + Method
        #gb->self->type + '.' + #gb->calledname +

        // Call site file
        ': ' + #gb->home->callsite_file +

        // Line number and column number
        ' (line '+#gb->home->callsite_line + ', col ' + #gb->home->callsite_col +')'
    )
    return #gb()
}


function Inner( k )
    print( debug.traceback() )
    print "Program continues..."
end

function Middle( x, y )
    Inner( x+y )
end

function Outer( a, b, c )
    Middle( a*b, c )
end

Outer( 2, 3, 5 )


def print_stack()
        global __calls__

        println "stack trace:"
        for i in range(len(__calls__) - 2, 0)
                println "\t" + __calls__[i]
        end
end

print_stack()
println

for i in range(1, 1)
        print_stack()
end

println
println "The program would continue."


/* NetRexx */
options replace format comments java crossref symbols nobinary

class RStackTraces
  method inner() static
    StackTracer.printStackTrace()
  method middle() static
    inner()
  method outer() static
    middle()
  method main(args = String[]) public static
    outer()

class RStackTraces.StackTracer
  method printStackTrace() public static
    elems = Thread.currentThread().getStackTrace()
    say 'Stack trace:'
    j_ = 2
    loop i_ = elems.length - 1 to 2 by -1
      say ''.left(j_) || elems[i_].getClassName()'.'elems[i_].getMethodName()
      j_ = j_ + 2
      end i_


procedure stepUp;
begin
  while not step do
    stepUp;
end;


procedure step_up()
    while not step() do step_up() end while
end procedure


(de stepUp ()
   (until (step1)  # ('step1', because 'step' is a system function)
      (stepUp) ) )


function StepUp
    {
    If ( -not ( Step ) )
        {
        StepUp
        StepUp
        }
    }

#  Step simulator for testing
function Step
    {
    If ( Get-Random 0,1 )
        {
        $Success = $True
        Write-Verbose "Up one step"
        }
    Else
        {
        $Success = $False
        Write-Verbose "Fell one step"
        }
    return $Success
    }

#  Test
$VerbosePreference = 'Continue'
StepUp


(defun insert (x xs)
   (cond ((endp xs) (list x))
         ((> x (first xs))
          (cons (first xs) (insert x (rest xs))))
         (t (cons x xs))))

(defun isort (xs)
   (if (endp xs)
       nil
       (insert (first xs) (isort (rest xs)))))

(defun stem-and-leaf-bins (xs bin curr)
   (cond ((endp xs) (list curr))
         ((= (floor (first xs) 10) bin)
          (stem-and-leaf-bins (rest xs)
                              bin
                              (cons (first xs) curr)))
         (t (cons curr
                  (stem-and-leaf-bins (rest xs)
                                      (floor (first xs) 10)
                                      (list (first xs)))))))

(defun print-bin (bin)
   (if (endp bin)
       nil
       (progn$ (cw " ~x0" (mod (first bin) 10))
               (print-bin (rest bin)))))

(defun stem-and-leaf-plot-r (bins)
   (if (or (endp bins) (endp (first bins)))
       nil
       (progn$ (cw "~x0 |" (floor (first (first bins)) 10))
               (print-bin (first bins))
               (cw "~%")
               (stem-and-leaf-plot-r (rest bins)))))

(defun stem-and-leaf-plot (xs)
   (stem-and-leaf-plot-r
    (reverse (stem-and-leaf-bins (reverse (isort xs))
                                 0
                                 nil))))


proc g() =
  # Writes the current stack trace to stderr.
  writeStackTrace()
  # Or fetch the stack trace entries for the current stack trace:
  echo "----"
  for e in getStackTraceEntries():
    echo e.filename, "@", e.line, " in ", e.procname

proc f() =
  g()

f()


#include <execinfo.h>

void *frames[128];
int len = backtrace(frames, 128);
char **symbols = backtrace_symbols(frames, len);
for (int i = 0; i < len; ++i) {
    NSLog(@"%s", symbols[i]);
}
free(symbols);


let div a b = a / b

let () =
  try let _ = div 3 0 in ()
  with e ->
    prerr_endline(Printexc.to_string e);
    Printexc.print_backtrace stderr;
;;


: f1   Exception throw("An exception") ;
Integer method: f2  self f1 ;
: f3   f2 ;
: f4   f3 ;

10 f4


'32bit x86

static string Report

macro ReportStack(n)
'===================

  '
  scope
  '
  static sys stack[0X100],stackptr,e
  '
  'CAPTURE IMAGE OF UP TO 256 ENTRIES
  '
  '
  mov eax,n
  cmp eax,0x100
  (
    jle exit
    mov eax,0x100 'UPPER LIMIT
  )
  mov e,eax
  mov stackptr,esp
  lea edx,stack
  mov ecx,e
  mov esi,esp
  (
    mov eax,[esi]
    mov [edx],eax
    add esi,4
    add edx,4
    dec ecx
    jg repeat
  )
  sys i
  string cr=chr(13)+chr(10), tab=chr(9)
  '
  for i=1 to e
    report+=hex(stackptr+(i-1)*4,8) tab hex(i-1,2) tab hex(stack[i],8) cr
  next
  '
  end scope
  '
end macro

'====
'TEST
'====

  function foo()
  '=============

  push 0x44556677
  push 0x33445566
  push 0x22334455
  push 0x11223344
  ReportStack(8)

  end function

Report+="Trace inside foo
"
foo()
print report
'putfile "s.txt",Report

/*
RESULT:

Trace inside foo
0017FE00	00	11223344
0017FE04	01	22334455
0017FE08	02	33445566
0017FE0C	03	44556677
0017FE10	04	005EAB1C
0017FE14	05	0017FE40
0017FE18	06	10002D5F
0017FE1C	07	00000000
*/


declare
  proc {Test}
     _ = 1 div 0
  end
in
  try
     {Test}
  catch E then
     {Inspect E}
  end


Procedure step_up()
  Protected i
  Repeat: If _step(): i + 1: Else: i - 1: EndIf: Until i = 1
EndProcedure


def step_up1():
  """Straightforward implementation: keep track of how many level we
     need to ascend, and stop when this count is zero."""
  deficit = 1
  while deficit > 0:
    if step():
      deficit -= 1
    else:
      deficit += 1


[ step if done recurse again ] is step-up


step <- function() {
    success <- runif(1) > p
    ## Requires that the "robot" is a variable named "level"
    level <<- level - 1 + (2 * success)
    success
}


#lang racket
(define p 0.5001)
(define (step)
  (> p (random)))

(define (step-up n)
  (cond ((zero? n) 'done)
        ((step) (step-up (sub1 n)))
        (else (step-up (add1 n)))))

(step-up 1)


rebol [
    Title: "Stair Climber"
    URL: http://rosettacode.org/wiki/Stair_Climbing
]

random/seed now

step: does [random/only reduce [yes no]]

; Iterative solution with symbol stack. No numbers, draws a nifty
; diagram of number of steps to go. This is intended more to
; demonstrate a correct solution:

step_up: func [/steps s] [
	either not steps [
		print "Starting up..."
		step_up/steps copy [|]
	][
		while [not empty? s][
			print ["    Steps left:" s]
			either step [remove s][append s '|]
		]
	]
]

step_up  print ["Success!" crlf]

; Recursive solution. No numbers, no variables. "R" means a recover
; step, "+" means a step up.

step_upr: does [if not step [prin "R " step_upr  prin "+ " step_upr]]

step_upr  print ["Success!" crlf]

; Small recursive solution, no monitoring:

step_upt: does [if not step [step_upt step_upt]]

step_upt  print "Success!"


with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Gnat.Heap_Sort_G;
procedure stemleaf is
	data : array(Natural Range <>) of Integer := (
	0,12,127,28,42,39,113, 42,18,44,118,44,37,113,124,37,48,127,36,29,31,
	125,139,131,115,105,132,104,123,35,113,122,42,117,119,58,109,23,105,
	63,27,44,105,99,41,128,121,116,125,32,61,37,127,29,113,121,58,114,126,
	53,114,96,25,109,7,31,141,46,13,27,43,117,116,27,7,68,40,31,115,124,42,
	128,52,71,118,117,38,27,106,33,117,116,111,40,119,47,105,57,122,109,
	124,115,43,120,43,27,27,18,28,48,125,107,114,34,133,45,120, 30,127,
	31,116,146); -- Position 0 is used for storage during sorting, initialized as 0

	procedure Move (from, to : in Natural) is
	begin data(to) := data(from);
	end Move;

	function Cmp (p1, p2 : Natural) return Boolean is
	begin return data(p1)<data(p2);
	end Cmp;

	package Sorty is new GNAT.Heap_Sort_G(Move,Cmp);
	min,max,p,stemw: Integer;
begin
	Sorty.Sort(data'Last);
	min := data(1);
	max := data(data'Last);
	stemw := Integer'Image(max)'Length;
	p := 1;
	for stem in min/10..max/10 loop
		put(stem,Width=>stemw); put(" |");
		Leaf_Loop:
			while data(p)/10=stem loop
				put(" "); put(data(p) mod 10,Width=>1);
				exit Leaf_loop when p=data'Last;
				p := p+1;
		end loop Leaf_Loop;
		new_line;
	end loop;
end stemleaf;


use Carp 'cluck';

sub g {cluck 'Hello from &g';}
sub f {g;}

f;


constant W = machine_word(),
         {RTN,PREVEBP} = iff(W=4?{8,20}:{16,40})

procedure show_stack()
sequence symtab, symtabN
integer rtn
atom prev_ebp

    #ilASM{
        [32]
            lea edi,[symtab]
            call :%opGetST      -- [edi]=symtab (ie our local:=the real symtab)
            mov edi,[ebp+20]    -- prev_ebp
            mov eax,[edi+8]     -- calling routine no
            mov [rtn],eax
            mov eax,edi
            lea edi,[prev_ebp]
            call :%pStoreMint
        [64]
            lea rdi,[symtab]
            call :%opGetST      -- [rdi]=symtab (ie our local:=the real symtab)
            mov rdi,[rbp+40]    -- prev_ebp
            mov rax,[rdi+16]    -- calling routine no
            mov [rtn],rax
            mov rax,rdi
            lea rdi,[prev_ebp]
            call :%pStoreMint
        []
          }
    while rtn!=21 do -- (T_maintls, main top level routine, always present)
        symtabN = symtab[rtn]
        ?symtabN[1]
        prev_ebp = peekNS(prev_ebp+PREVEBP,W,0)
        rtn = peekNS(prev_ebp+RTN,W,0)
    end while
end procedure

procedure three(bool die)
    if die then
        ?9/0
    else
        show_stack()
    end if
end procedure

procedure two(bool die)
    three(die)
end procedure

procedure one(bool die)
    two(die)
end procedure

one(0)
?routine_id("dummy")    -- see note below
one(1)


<?php
class StackTraceDemo {
    static function inner() {
        debug_print_backtrace();
    }
    static function middle() {
        self::inner();
    }
    static function outer() {
        self::middle();
    }
}

StackTraceDemo::outer();
?>


step_up:           do  while \step();   call step_up
                   end
          return


stepup()

func stepup
     n = 0
     while n < 1
           if stp() n=n+1 else n= n-1 ok
           see n + nl
     end

func stp
     return 0


def step_up
  start_position = $position
  step until ($position == start_position + 1)
end

# assumptions about the step function:
# - it maintains the current position of the robot "as a side effect"
# - the robot is equally likely to step back as to step up
def step
  if rand < 0.5
    $position -= 1
    p "fall (#$position)" if $DEBUG
    return false
  else
    $position += 1
    p "rise (#$position)" if $DEBUG
    return true
  end
end

$position = 0
step_up


result = stepUp()

Function stepUp()
    While Not(stepp())
        result = stepUp()
    Wend
End Function

Function stepp()
	stepp = int((Rnd(1) * 2))
	print "Robot stepped "+word$("up down",stepp+1)
End Function


fn step_up() {
	while !step() {
		step_up();
	}
}


%macro step();
	%sysfunc(round(%sysfunc(ranuni(0))))
	%mend step;