Point = Struct.new(:x,:y) do
  def to_s; "(#{x}, #{y})" end
end

def sutherland_hodgman(subjectPolygon, clipPolygon)
  # These inner functions reduce the argument passing to
  # "inside" and "intersection".
  cp1, cp2, s, e = nil
  inside = proc do |p|
    (cp2.x-cp1.x)*(p.y-cp1.y) > (cp2.y-cp1.y)*(p.x-cp1.x)
  end
  intersection = proc do
    dcx, dcy = cp1.x-cp2.x, cp1.y-cp2.y
    dpx, dpy = s.x-e.x, s.y-e.y
    n1 = cp1.x*cp2.y - cp1.y*cp2.x
    n2 = s.x*e.y - s.y*e.x
    n3 = 1.0 / (dcx*dpy - dcy*dpx)
    Point[(n1*dpx - n2*dcx) * n3, (n1*dpy - n2*dcy) * n3]
  end

  outputList = subjectPolygon
  cp1 = clipPolygon.last
  for cp2 in clipPolygon
    inputList = outputList
    outputList = []
    s = inputList.last
    for e in inputList
      if inside[e]
        outputList << intersection[] unless inside[s]
        outputList << e
      elsif inside[s]
        outputList << intersection[]
      end
      s = e
    end
    cp1 = cp2
  end
  outputList
end

subjectPolygon = [[50, 150], [200, 50], [350, 150], [350, 300],
                  [250, 300], [200, 250], [150, 350], [100, 250],
                  [100, 200]].collect{|pnt| Point[*pnt]}

clipPolygon = [[100, 100], [300, 100], [300, 300], [100, 300]].collect{|pnt| Point[*pnt]}

puts sutherland_hodgman(subjectPolygon, clipPolygon)


// Summarize and say sequence . Nigel Galloway: April 23rd., 2021
let rec fN g=let n=let n,g=List.head g|>List.countBy id|>List.unzip in [email protected](g|>List.collect(fun g->if g<10 then [g] else [g/10;g%10]))
             if List.contains n g then g.Tail|>List.rev else fN(n::g)
let rec fG n g=seq{yield! n; if g>1 then yield! fG(n|>Seq.collect(fun n->[for g in 0..List.head n->g::n]))(g-1)}
let n,g=seq{yield [0]; yield! fG(Seq.init 9 (fun n->[n+1])) 6}
        |>Seq.fold(fun(n,l) g->let g=fN [g] in match g.Length with e when e<n->(n,l) |e when e>n->(e,[[g]]) |e->(n,[g]::l))(0,[])
printfn "maximum number of iterations is %d" (n+1)
for n in g do for n in n do
                printf "Permutations of "; n.Head|>List.rev|>List.iter(printf "%d"); printfn " produce:"
                for n in n do (for n,g in List.countBy id n|>List.sort|>List.rev do printf "%d%d" g n); printfn ""


#[derive(Debug, Clone)]
struct Point {
    x: f64,
    y: f64,
}

#[derive(Debug, Clone)]
struct Polygon(Vec<Point>);

fn is_inside(p: &Point, cp1: &Point, cp2: &Point) -> bool {
    (cp2.x - cp1.x) * (p.y - cp1.y) > (cp2.y - cp1.y) * (p.x - cp1.x)
}

fn compute_intersection(cp1: &Point, cp2: &Point, s: &Point, e: &Point) -> Point {
    let dc = Point {
        x: cp1.x - cp2.x,
        y: cp1.y - cp2.y,
    };
    let dp = Point {
        x: s.x - e.x,
        y: s.y - e.y,
    };
    let n1 = cp1.x * cp2.y - cp1.y * cp2.x;
    let n2 = s.x * e.y - s.y * e.x;
    let n3 = 1.0 / (dc.x * dp.y - dc.y * dp.x);
    Point {
        x: (n1 * dp.x - n2 * dc.x) * n3,
        y: (n1 * dp.y - n2 * dc.y) * n3,
    }
}

fn sutherland_hodgman_clip(subject_polygon: &Polygon, clip_polygon: &Polygon) -> Polygon {
    let mut result_ring = subject_polygon.0.clone();
    let mut cp1 = clip_polygon.0.last().unwrap();
    for cp2 in &clip_polygon.0 {
        let input = result_ring;
        let mut s = input.last().unwrap();
        result_ring = vec![];
        for e in &input {
            if is_inside(e, cp1, cp2) {
                if !is_inside(s, cp1, cp2) {
                    result_ring.push(compute_intersection(cp1, cp2, s, e));
                }
                result_ring.push(e.clone());
            } else if is_inside(s, cp1, cp2) {
                result_ring.push(compute_intersection(cp1, cp2, s, e));
            }
            s = e;
        }
        cp1 = cp2;
    }
    Polygon(result_ring)
}

fn main() {
    let _p = |x: f64, y: f64| Point { x, y };
    let subject_polygon = Polygon(vec![
        _p(50.0, 150.0), _p(200.0, 50.0), _p(350.0, 150.0), _p(350.0, 300.0), _p(250.0, 300.0),
        _p(200.0, 250.0), _p(150.0, 350.0), _p(100.0, 250.0), _p(100.0, 200.0),
    ]);
    let clip_polygon = Polygon(vec![
        _p(100.0, 100.0),_p(300.0, 100.0),_p(300.0, 300.0),_p(100.0, 300.0),
    ]);
    let result = sutherland_hodgman_clip(&subject_polygon, &clip_polygon);
    println!("{:?}", result);
}


import javax.swing.{ JFrame, JPanel }

object SutherlandHodgman extends JFrame with App {
    import java.awt.BorderLayout

    setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE)
    setVisible(true)
    val content = getContentPane()
    content.setLayout(new BorderLayout())
    content.add(SutherlandHodgmanPanel, BorderLayout.CENTER)
    setTitle("SutherlandHodgman")
    pack()
    setLocationRelativeTo(null)
}

object SutherlandHodgmanPanel extends JPanel {
    import java.awt.{ Color, Graphics, Graphics2D }

    setPreferredSize(new java.awt.Dimension(600, 500))

    // subject and clip points are assumed to be valid
    val subject = Seq((50D, 150D), (200D, 50D), (350D, 150D), (350D, 300D), (250D, 300D), (200D, 250D), (150D, 350D), (100D, 250D), (100D, 200D))
    val clipper = Seq((100D, 100D), (300D, 100D), (300D, 300D), (100D, 300D))
    var result = subject

    val len = clipper.size
    for (i <- 0 until len) {
        val len2 = result.size
        val input = result
        result = Seq()

        val A = clipper((i + len - 1) % len)
        val B = clipper(i)

        for (j <- 0 until len2) {
            val P = input((j + len2 - 1) % len2)
            val Q = input(j)

            if (inside(A, B, Q)) {
                if (!inside(A, B, P))
                    result = result :+ intersection(A, B, P, Q)
                result = result :+ Q
            }
            else if (inside(A, B, P))
                result = result :+ intersection(A, B, P, Q)
        }
    }

    override def paintComponent(g: Graphics) {
        import java.awt.RenderingHints._

        super.paintComponent(g)
        val g2 = g.asInstanceOf[Graphics2D]
        g2.translate(80, 60)
        g2.setStroke(new java.awt.BasicStroke(3))
        g2.setRenderingHint(KEY_ANTIALIASING, VALUE_ANTIALIAS_ON)
        g2.draw_polygon(subject, Color.blue)
        g2.draw_polygon(clipper, Color.red)
        g2.draw_polygon(result, Color.green)
    }

    private def inside(a: (Double, Double), b: (Double, Double), c: (Double, Double)) =
        (a._1 - c._1) * (b._2 - c._2) > (a._2 - c._2) * (b._1 - c._1)

    private def intersection(a: (Double, Double), b: (Double, Double), p: (Double, Double), q: (Double, Double)) = {
        val A1 = b._2 - a._2
        val B1 = a._1 - b._1
        val C1 = A1 * a._1 + B1 * a._2
        val A2 = q._2 - p._2
        val B2 = p._1 - q._1
        val C2 = A2 * p._1 + B2 * p._2

        val det = A1 * B2 - A2 * B1
        ((B2 * C1 - B1 * C2) / det, (A1 * C2 - A2 * C1) / det)
    }

    private implicit final class Polygon_drawing(g: Graphics2D) {
        def draw_polygon(points: Seq[(Double, Double)], color: Color) {
            g.setColor(color)
            val len = points.length
            val line = new java.awt.geom.Line2D.Double()
            for (i <- 0 until len) {
                val p1 = points(i)
                val p2 = points((i + 1) % len)
                line.setLine(p1._1, p1._2, p2._1, p2._2)
                g.draw(line)
            }
        }
    }
}


USING: assocs grouping io kernel math math.combinatorics
math.functions math.ranges math.statistics math.text.utils
prettyprint sequences sets ;
IN: rosetta-code.self-referential-sequence

: next-term ( seq -- seq ) histogram >alist concat ;

! Output the self-referential sequence, given a seed value.
: srs ( seq -- seq n )
    V{ } clone [ 2dup member? ] [ 2dup push [ next-term ] dip ]
    until nip dup length ;

: digit-before? ( m n -- ? ) dup zero? [ 2drop t ] [ <= ] if ;

! The numbers from 1 rto n sans permutations.
: candidates ( n -- seq )
    [1,b] [ 1 digit-groups reverse ] map
    [ [ digit-before? ] monotonic? ] filter ;

: max-seed ( n -- seq ) candidates [ srs nip ] supremum-by ;

: max-seeds ( n -- seq )
    max-seed <permutations> members [ first zero? ] reject ;

: digits>number ( seq -- n ) [ 10^ * ] map-index sum ;

: >numbers ( seq -- seq ) [ digits>number ] map ;

: main ( -- )
    "Seed value(s): " write
    1,000,000 max-seeds
    [ [ reverse ] map >numbers . ]
    [ first srs ] bi
    "Iterations: " write .
    "Sequence:" print >numbers . ;

MAIN: main


package main

import (
    "fmt"
    "strconv"
)

func main() {
    var maxLen int
    var seqMaxLen [][]string
    for n := 1; n < 1e6; n++ {
        switch s := seq(n); {
        case len(s) == maxLen:
            seqMaxLen = append(seqMaxLen, s)
        case len(s) > maxLen:
            maxLen = len(s)
            seqMaxLen = [][]string{s}
        }
    }
    fmt.Println("Max sequence length:", maxLen)
    fmt.Println("Sequences:", len(seqMaxLen))
    for _, seq := range seqMaxLen {
        fmt.Println("Sequence:")
        for _, t := range seq {
            fmt.Println(t)
        }
    }
}

func seq(n int) []string {
    s := strconv.Itoa(n)
    ss := []string{s}

    for {
        dSeq := sortD(s)
        d := dSeq[0]
        nd := 1
        s = ""
        for i := 1; ; i++ {
            if i == len(dSeq) {
                s = fmt.Sprintf("%s%d%c", s, nd, d)
                break
            }
            if dSeq[i] == d {
                nd++
            } else {
                s = fmt.Sprintf("%s%d%c", s, nd, d)
                d = dSeq[i]
                nd = 1
            }
        }
        for _, s0 := range ss {
            if s == s0 {
                return ss
            }
        }
        ss = append(ss, s)
    }
    panic("unreachable")
}

func sortD(s string) []rune {
    r := make([]rune, len(s))
    for i, d := range s {
        j := 0
        for ; j < i; j++ {
            if d > r[j] {
                copy(r[j+1:], r[j:i])
                break
            }
        }
        r[j] = d
    }
    return r
}


interface XYCoords  {
    x : number;
    y : number;
}

const inside = ( cp1 : XYCoords, cp2 : XYCoords, p : XYCoords) : boolean => {
    return (cp2.x-cp1.x)*(p.y-cp1.y) > (cp2.y-cp1.y)*(p.x-cp1.x);
};

const intersection = ( cp1 : XYCoords ,cp2 : XYCoords ,s : XYCoords, e : XYCoords ) : XYCoords => {
    const dc = {
	x:  cp1.x - cp2.x,
	y : cp1.y - cp2.y
	 },
    dp = { x: s.x - e.x,
	   y : s.y - e.y
	 },
    n1 = cp1.x * cp2.y - cp1.y * cp2.x,
    n2 = s.x * e.y - s.y * e.x,
    n3 = 1.0 / (dc.x * dp.y - dc.y * dp.x);
    return { x : (n1*dp.x - n2*dc.x) * n3,
	     y : (n1*dp.y - n2*dc.y) * n3
	   };
};

export const sutherland_hodgman = ( subjectPolygon : Array<XYCoords>,
				   clipPolygon : Array<XYCoords> ) : Array<XYCoords> => {

    let cp1 : XYCoords = clipPolygon[clipPolygon.length-1];
    let cp2 : XYCoords;
    let s : XYCoords;
    let e : XYCoords;

    let outputList : Array<XYCoords> = subjectPolygon;

    for( var j in clipPolygon ) {
        cp2 = clipPolygon[j];
        var inputList = outputList;
        outputList = [];
        s = inputList[inputList.length - 1]; // last on the input list
        for (var i in inputList) {
	    e = inputList[i];
	    if (inside(cp1,cp2,e)) {
                if (!inside(cp1,cp2,s)) {
		    outputList.push(intersection(cp1,cp2,s,e));
                }
                outputList.push(e);
	    }
	    else if (inside(cp1,cp2,s)) {
                outputList.push(intersection(cp1,cp2,s,e));
	    }
	    s = e;
        }
        cp1 = cp2;
    }
    return outputList
}


class Point(x, y) {
    method to_s {
        "(#{'%.2f' % x}, #{'%.2f' % y})"
    }
}

func sutherland_hodgman(subjectPolygon, clipPolygon) {
  var inside = { |cp1, cp2, p|
    ((cp2.x-cp1.x)*(p.y-cp1.y)) > ((cp2.y-cp1.y)*(p.x-cp1.x))
  }

  var intersection = { |cp1, cp2, s, e|
    var (dcx, dcy) = (cp1.x-cp2.x, cp1.y-cp2.y)
    var (dpx, dpy) = (s.x-e.x, s.y-e.y)
    var n1 = (cp1.x*cp2.y - cp1.y*cp2.x)
    var n2 = (s.x*e.y - s.y*e.x)
    var n3 = (1 / (dcx*dpy - dcy*dpx))
    Point((n1*dpx - n2*dcx) * n3, (n1*dpy - n2*dcy) * n3)
  }

  var outputList = subjectPolygon
  var cp1 = clipPolygon.last
  for cp2 in clipPolygon {
    var inputList = outputList
    outputList = []
    var s = inputList.last
    for e in inputList {
      if (inside(cp1, cp2, e)) {
        outputList << intersection(cp1, cp2, s, e) if !inside(cp1, cp2, s)
        outputList << e
      }
      elsif(inside(cp1, cp2, s)) {
        outputList << intersection(cp1, cp2, s, e)
      }
      s = e
    }
    cp1 = cp2
  }
  outputList
}

var subjectPolygon = [
    [50,  150], [200,  50], [350, 150], [350, 300],
    [250, 300], [200, 250], [150, 350], [100, 250],
    [100, 200]
].map{|pnt| Point(pnt...) }

var clipPolygon = [
    [100, 100], [300, 100],
    [300, 300], [100, 300]
].map{|pnt| Point(pnt...) }

sutherland_hodgman(subjectPolygon, clipPolygon).each { .say }


Number.metaClass.getSelfReferentialSequence = {
  def number = delegate as String; def sequence = []

  while (!sequence.contains(number)) {
    sequence << number
    def encoded = new StringBuilder()
    ((number as List).sort().join('').reverse() =~ /(([0-9])\2*)/).each { matcher, text, digit ->
      encoded.append(text.size()).append(digit)
    }
    number = encoded.toString()
  }
  sequence
}

def maxSeqSize = { List values ->
  values.inject([seqSize: 0, seeds: []]) { max, n ->
    if (n % 100000 == 99999) println 'HT'
    else if (n % 10000 == 9999) print '.'
    def seqSize = n.selfReferentialSequence.size()
    switch (seqSize) {
      case max.seqSize: max.seeds << n
      case { it < max.seqSize }: return max
      default: return [seqSize: seqSize, seeds: [n]]
    }
  }
}


struct Point {
  var x: Double
  var y: Double
}

struct Polygon {
  var points: [Point]

  init(points: [Point]) {
    self.points = points
  }

  init(points: [(Double, Double)]) {
    self.init(points: points.map({ Point(x: $0.0, y: $0.1) }))
  }
}

func isInside(_ p1: Point, _ p2: Point, _ p3: Point) -> Bool {
  (p3.x - p2.x) * (p1.y - p2.y) > (p3.y - p2.y) * (p1.x - p2.x)
}

func computeIntersection(_ p1: Point, _ p2: Point, _ s: Point, _ e: Point) -> Point {
  let dc = Point(x: p1.x - p2.x, y: p1.y - p2.y)
  let dp = Point(x: s.x - e.x, y: s.y - e.y)
  let n1 = p1.x * p2.y - p1.y * p2.x
  let n2 = s.x * e.y - s.y * e.x
  let n3 = 1.0 / (dc.x * dp.y - dc.y * dp.x)

  return Point(x: (n1 * dp.x - n2 * dc.x) * n3, y: (n1 * dp.y - n2 * dc.y) * n3)
}

func sutherlandHodgmanClip(subjPoly: Polygon, clipPoly: Polygon) -> Polygon {
  var ring = subjPoly.points
  var p1 = clipPoly.points.last!

  for p2 in clipPoly.points {
    let input = ring
    var s = input.last!

    ring = []

    for e in input {
      if isInside(e, p1, p2) {
        if !isInside(s, p1, p2) {
          ring.append(computeIntersection(p1, p2, s, e))
        }

        ring.append(e)
      } else if isInside(s, p1, p2) {
        ring.append(computeIntersection(p1, p2, s, e))
      }

      s = e
    }

    p1 = p2
  }

  return Polygon(points: ring)
}

let subj = Polygon(points: [
  (50.0, 150.0),
  (200.0, 50.0),
  (350.0, 150.0),
  (350.0, 300.0),
  (250.0, 300.0),
  (200.0, 250.0),
  (150.0, 350.0),
  (100.0, 250.0),
  (100.0, 200.0)
])

let clip = Polygon(points: [
  (100.0, 100.0),
  (300.0, 100.0),
  (300.0, 300.0),
  (100.0, 300.0)
])

print(sutherlandHodgmanClip(subjPoly: subj, clipPoly: clip))


# Find intersection of an arbitrary polygon with a convex one.
package require Tcl 8.6

#	Does the path (x0,y0)->(x1,y1)->(x2,y2) turn clockwise
#	or counterclockwise?
proc cw {x0 y0 x1 y1 x2 y2} {
    set dx1 [expr {$x1 - $x0}]; set dy1 [expr {$y1 - $y0}]
    set dx2 [expr {$x2 - $x0}]; set dy2 [expr {$y2 - $y0}]
    # (0,0,$dx1*$dy2 - $dx2*$dy1) is the crossproduct of
    # ($x1-$x0,$y1-$y0,0) and ($x2-$x0,$y2-$y0,0).
    # Its z-component is positive if the turn
    # is clockwise, negative if the turn is counterclockwise.
    set pr1 [expr {$dx1 * $dy2}]
    set pr2 [expr {$dx2 * $dy1}]
    if {$pr1 > $pr2} {
	# Clockwise
	return 1
    } elseif {$pr1 < $pr2} {
	# Counter-clockwise
	return -1
    } elseif {$dx1*$dx2 < 0 || $dy1*$dy2 < 0} {
	# point 0 is the middle point
	return 0
    } elseif {($dx1*$dx1 + $dy1*$dy1) < ($dx2*$dx2 + $dy2+$dy2)} {
	# point 1 is the middle point
	return 0
    } else {
	# point 2 lies on the segment joining points 0 and 1
	return 1
    }
}

#	Calculate the point of intersection of two lines
#	containing the line segments (x1,y1)-(x2,y2) and (x3,y3)-(x4,y4)
proc intersect {x1 y1 x2 y2 x3 y3 x4 y4} {
    set d [expr {($y4 - $y3) * ($x2 - $x1) - ($x4 - $x3) * ($y2 - $y1)}]
    set na [expr {($x4 - $x3) * ($y1 - $y3) - ($y4 - $y3) * ($x1 - $x3)}]
    if {$d == 0} {
	return {}
    }
    set r [list \
	    [expr {$x1 + $na * ($x2 - $x1) / $d}] \
	    [expr {$y1 + $na * ($y2 - $y1) / $d}]]
    return $r
}

#	Coroutine that yields the elements of a list in pairs
proc pairs {list} {
    yield [info coroutine]
    foreach {x y} $list {
	yield [list $x $y]
    }
    return {}
}

#	Coroutine to clip one segment of a polygon against a line.
proc clipsegment {inside0 cx0 cy0 cx1 cy1 sx0 sy0 sx1 sy1} {
    set inside1 [expr {[cw $cx0 $cy0 $cx1 $cy1 $sx1 $sy1] > 0}]
    if {$inside1} {
	if {!$inside0} {
	    set int [intersect $cx0 $cy0 $cx1 $cy1 \
		    $sx0 $sy0 $sx1 $sy1]
	    if {[llength $int] >= 0} {
		yield $int
	    }
	}
	yield [list $sx1 $sy1]
    } else {
	if {$inside0} {
	    set int [intersect $cx0 $cy0 $cx1 $cy1 \
		    $sx0 $sy0 $sx1 $sy1]
	    if {[llength $int] >= 0} {
		yield $int
	    }
	}
    }
    return $inside1
}

#	Coroutine to perform one step of Sutherland-Hodgman polygon clipping
proc clipstep {source cx0 cy0 cx1 cy1} {
    yield [info coroutine]
    set pt0 [{*}$source]
    if {[llength $pt0] == 0} {
	return
    }
    lassign $pt0 sx0 sy0
    set inside0 [expr {[cw $cx0 $cy0 $cx1 $cy1 $sx0 $sy0] > 0}]
    set finished 0
    while {!$finished} {
	set thispt [{*}$source]
	if {[llength $thispt] == 0} {
	    set thispt $pt0
	    set finished 1
	}
	lassign $thispt sx1 sy1
	set inside0 [clipsegment $inside0 \
		$cx0 $cy0 $cx1 $cy1 $sx0 $sy0 $sx1 $sy1]
	set sx0 $sx1
	set sy0 $sy1
    }
    return {}
}

#	Perform Sutherland-Hodgman polygon clipping
proc clippoly {cpoly spoly} {
    variable clipindx
    set source [coroutine clipper[incr clipindx] pairs $spoly]
    set cx0 [lindex $cpoly end-1]
    set cy0 [lindex $cpoly end]
    foreach {cx1 cy1} $cpoly {
	set source [coroutine clipper[incr clipindx] \
		clipstep $source $cx0 $cy0 $cx1 $cy1]
	set cx0 $cx1; set cy0 $cy1
    }
    set result {}
    while {[llength [set pt [{*}$source]]] > 0} {
	lappend result {*}$pt
    }
    return $result
}


import Data.Set (Set, member, insert, empty)
import Data.List (group, sort)

step :: String -> String
step = concatMap (\list -> show (length list) ++ [head list]) . group . sort

findCycle :: (Ord a) => [a] -> [a]
findCycle = aux empty where
	aux set (x : xs)
		| x `member` set = []
		| otherwise = x : aux (insert x set) xs

select :: [[a]] -> [[a]]
select = snd . foldl (\(len, acc) xs -> case len `compare` length xs of
		LT -> (length xs, [xs])
		EQ -> (len, xs : acc)
		GT -> (len, acc)) (0, [])

main :: IO ()
main = mapM_ (mapM_ print) $ -- Print out all the numbers
	select $ -- find the longest ones
	map findCycle $ -- run the sequences until there is a repeat
	map (iterate step) $ -- produce the sequence
	map show -- turn the numbers into digits
	[1..1000000] -- The input seeds


import "graphics" for Canvas, Color
import "dome" for Window
import "./polygon" for Polygon

class SutherlandHodgman {
    construct new(width, height, subject, clipper) {
        Window.title = "Sutherland-Hodgman"
        Window.resize(width, height)
        Canvas.resize(width, height)
        _subject = subject
        _result = subject.toList
        _clipper = clipper
    }

    init() {
        clipPolygon()
        System.print("Clipped polygon points:")
        for (p in _result) {
            p[1] = (1000*p[1]).round/1000
            System.print(p)
        }
        // display all 3 polygons
        Polygon.quick(_subject).drawfill(Color.blue)
        Polygon.quick(_clipper).drawfill(Color.red)
        Polygon.quick(_result ).drawfill(Color.green)
    }

    clipPolygon() {
        var len = _clipper.count
        for (i in 0...len) {
            var len2 = _result.count
            var input = _result
            _result = []
            var a = _clipper[(i + len - 1) % len]
            var b = _clipper[i]

            for (j in 0...len2) {
                var p = input[(j + len2 - 1) % len2]
                var q = input[j]

                if (isInside(a, b, q)) {
                    if (!isInside(a, b, p)) _result.add(intersection(a, b, p, q))
                    _result.add(q)
                } else if (isInside(a, b, p)) _result.add(intersection(a, b, p, q))
            }
        }
    }

    isInside(a, b, c) {  (a[0] - c[0]) * (b[1] - c[1]) > (a[1] - c[1]) * (b[0] - c[0]) }

    intersection(a, b, p, q) {
        var a1 = b[1] - a[1]
        var b1 = a[0] - b[0]
        var c1 = a1 * a[0] + b1 * a[1]

        var a2 = q[1] - p[1]
        var b2 = p[0] - q[0]
        var c2 = a2 * p[0] + b2 * p[1]

        var d = a1 * b2 - a2 * b1
        var x = (b2 * c1 - b1 * c2) / d
        var y = (a1 * c2 - a2 * c1) / d

        return [x, y]
    }
    update() {}

    draw(alpha) {}
}

var subject = [
    [ 50, 150], [200,  50], [350, 150],
    [350, 300], [250, 300], [200, 250],
    [150, 350], [100, 250], [100, 200]
]
var clipper = [
    [100, 100], [300, 100],
    [300, 300], [100, 300]
]
var Game = SutherlandHodgman.new(600, 500, subject, clipper)


link printf

procedure main()
every L := !longestselfrefseq(1000000) do
   every printf(" %i : %i\n",i := 1 to *L,L[i])
end

procedure longestselfrefseq(N)    #: find longest sequences from 1 to N

mlen := 0
every L := selfrefseq(n := 1 to N) do {
   if mlen <:= *L then
      ML := [L]
   else if mlen = *L then
      put(ML,L)
   }

return ML
end

procedure selfrefseq(n) #: return list of sequence oeis:A036058 for seed n
S := set()
L := []
every p := seq(1) do
   if member(S,n) then return L   # ends at a repeat
   else {
      insert(S,n)
      put(L,n)
      n := nextselfrefseq(n)
      }
end

procedure nextselfrefseq(n)  #: return next element of sequence oeis:A036058
every (Counts := table(0))[integer(!n)] +:= 1              # count digits
every (n := "") ||:= (0 < Counts[i := 9 to 0 by -1]) || i  # assemble counts
return integer(n)
end


open window 400, 400
backcolor 0,0,0
clear window

DPOL = 8
DREC = 3
CX = 1 : CY = 2

dim poligono(DPOL, 2)
dim rectang(DREC, 2)
dim clipped(DPOL + DREC, 2)

for n = 0 to DPOL : read poligono(n, CX), poligono(n, CY) : next n
DATA 50,150, 200,50, 350,150, 350,300, 250,300, 200,250, 150,350, 100,250, 100,200
for n = 0 to DREC : read rectang(n, CX), rectang(n, CY) : next n
DATA 100,100, 300,100, 300,300, 100,300

color 255,0,0
dibuja(poligono(), DPOL)
color 0,0,255
dibuja(rectang(), DREC)

nvert = FNsutherland_hodgman(poligono(), rectang(), clipped(), DPOL + DREC)
color 250,250,0
dibuja(clipped(), nvert - 1)

sub dibuja(figura(), i)
	local n

	print
	new curve
	for n = 0 to i
		line to figura(n, CX), figura(n, CY)
		print figura(n, CX), ", ", figura(n, CY)
	next n
	close curve
end sub

sub FNsutherland_hodgman(subj(), clip(), out(), n)
	local i, j, o, tclip, p1(2), p2(2), s(2), e(2), p(2), inp(n, 2)

	FOR o = 0 TO arraysize(subj(), 1) : out(o, CX) = subj(o, CX) : out(o, CY) = subj(o, CY) : NEXT o

	tclip = arraysize(clip(),1)
	p1(CX) = clip(tclip, CX) : p1(CY) = clip(tclip, CY)

	FOR i = 0 TO tclip
	    p2(CX) = clip(i, CX) : p2(CY) = clip(i, CY)
	    FOR n = 0 TO o - 1 : inp(n, CX) = out(n, CX) : inp(n, CY) = out(n, CY) : NEXT n : o = 0
	  	IF n >= 2 THEN
	            s(CX) = inp(n - 1, CX) : s(CY) = inp(n - 1, CY)

	    	    FOR j = 0 TO n - 1
	      		e(CX) = inp(j, CX) : e(CY) = inp(j, CY)
	      		IF FNside(e(), p1(), p2()) THEN
	        		IF NOT FNside(s(), p1(), p2()) THEN
	          			PROCintersection(p1(), p2(), s(), e(), p())
	          			out(o, CX) = round(p(CX)) : out(o, CY) = round(p(CY))
	          			o = o + 1
	        		ENDIF
	        		out(o, CX) = round(e(CX)) : out(o, CY) = round(e(CY))
	        		o = o + 1
	      		ELSE
	        		IF FNside(s(), p1(), p2()) THEN
	          			PROCintersection(p1(), p2(), s(), e(), p())
	          			out(o, CX) = round(p(CX)) : out(o, CY) = round(p(CY))
	          			o = o + 1
	        		ENDIF
	      		ENDIF
	      		s(CX) = e(CX) : s(CY) = e(CY)
	    	    NEXT j
	  	ENDIF
	  	p1(CX) = p2(CX) : p1(CY) = p2(CY)
	NEXT i
	return o
end sub

sub FNside(p(), p1(), p2())
	return  (p2(CX) - p1(CX)) * (p(CY) - p1(CY)) > (p2(CY) - p1(CY)) * (p(CX) - p1(CX))
end sub

sub PROCintersection(p1(), p2(), p3(), p4(), p())
	LOCAL a(2), b(2), k, l, m

	a(CX) = p1(CX) - p2(CX) : a(CY) = p1(CY) - p2(CY)
	b(CX) = p3(CX) - p4(CX) : b(CY) = p3(CY) - p4(CY)
	k = p1(CX) * p2(CY) - p1(CY) * p2(CX)
	l = p3(CX) * p4(CY) - p3(CY) * p4(CX)
	m = 1 / (a(CX) * b(CY) - a(CY) * b(CX))
	p(CX) =  m * (k * b(CX) - l * a(CX))
	p(CY) =  m * (k * b(CY) - l * a(CY))

end sub

sub round(n)
	return int(n + .5)
end sub


class P{	// point
   fcn init(_x,_y){ var [const] x=_x.toFloat(), y=_y.toFloat() }
   fcn __opSub(p) { self(x - p.x, y - p.y) }
   fcn cross(p)   { x*p.y - y*p.x          }
   fcn toString   { "(%7.2f,%7.2f)".fmt(x,y) }
   var [const,proxy] ps=fcn{ T(x.toInt(),y.toInt()) };    // property
}
fcn shClipping(clip,polygon){
   inputList,outputList,clipEdge:=List(), polygon.copy(), List(Void,clip[-1]);
   foreach p in (clip){
      clipEdge.del(0).append(p);
      inputList.clear().extend(outputList);
      outputList.clear();
      S:=inputList[-1];
      foreach E in (inputList){
         if(leftOf(clipEdge,E)){
	    if(not leftOf(clipEdge,S))
	       outputList.append(intersection(S,E,clipEdge));
	    outputList.append(E);
	 }
	 else if(leftOf(clipEdge,S))
	         outputList.append(intersection(S,E,clipEdge));
	 S=E;
      }
   }
   outputList
}
fcn leftOf(line,p){ //-->True (p is left of line), direction of line matters
   p1,p2:=line;		// line is (p1,p2)
   (p2-p1).cross(p-p2)>0;
}
fcn intersection(p1,p2, line){	//-->Point of intersection or False
   p3,p4:=line;
   dx,dy,d:=p2-p1, p3-p4, p1-p3;
   // x0 + a dx = y0 + b dy ->
   // x0 X dx = y0 X dx + b dy X dx ->
   // b = (x0 - y0) X dx / (dy X dx)
   dyx:=dy.cross(dx);
   if(not dyx) return(False);  // parallel lines, could just throw on next line
   dyx=d.cross(dx)/dyx;
   P(p3.x + dyx*dy.x, p3.y + dyx*dy.y);
}
fcn drawPolygon(ppm,listOfPoints,rgb){
   foreach n in (listOfPoints.len()-1){
      ppm.line(listOfPoints[n].ps.xplode(),listOfPoints[n+1].ps.xplode(),rgb);
   }
   ppm.line(listOfPoints[0].ps.xplode(),listOfPoints[-1].ps.xplode(),rgb);
}


require'stats'
digits=: 10&#.inv"0 :. ([: "[email protected]; (<'x'),~":&.>)
summar=: (#/.~ ,@,. ~.)@\:~&.digits
sequen=: [email protected](, [email protected]{:)^:_
values=: ~. \:~&.digits i.1e6
allvar=: [:(#~(=&<.&(10&^.) >./))@~.({~ [email protected]#)&.(digits"1)


import java.util.*;
import java.util.concurrent.ConcurrentHashMap;
import java.util.stream.IntStream;

public class SelfReferentialSequence {

    static Map<String, Integer> cache = new ConcurrentHashMap<>(10_000);

    public static void main(String[] args) {
        Seeds res = IntStream.range(0, 1000_000)
                .parallel()
                .mapToObj(n -> summarize(n, false))
                .collect(Seeds::new, Seeds::accept, Seeds::combine);

        System.out.println("Seeds:");
        res.seeds.forEach(e -> System.out.println(Arrays.toString(e)));

        System.out.println("\nSequence:");
        summarize(res.seeds.get(0)[0], true);
    }

    static int[] summarize(int seed, boolean display) {
        String n = String.valueOf(seed);

        String k = Arrays.toString(n.chars().sorted().toArray());
        if (!display && cache.get(k) != null)
            return new int[]{seed, cache.get(k)};

        Set<String> seen = new HashSet<>();
        StringBuilder sb = new StringBuilder();

        int[] freq = new int[10];

        while (!seen.contains(n)) {
            seen.add(n);

            int len = n.length();
            for (int i = 0; i < len; i++)
                freq[n.charAt(i) - '0']++;

            sb.setLength(0);
            for (int i = 9; i >= 0; i--) {
                if (freq[i] != 0) {
                    sb.append(freq[i]).append(i);
                    freq[i] = 0;
                }
            }
            if (display)
                System.out.println(n);
            n = sb.toString();
        }

        cache.put(k, seen.size());

        return new int[]{seed, seen.size()};
    }

    static class Seeds {
        int largest = Integer.MIN_VALUE;
        List<int[]> seeds = new ArrayList<>();

        void accept(int[] s) {
            int size = s[1];
            if (size >= largest) {
                if (size > largest) {
                    largest = size;
                    seeds.clear();
                }
                seeds.add(s);
            }
        }

        void combine(Seeds acc) {
            acc.seeds.forEach(this::accept);
        }
    }
}


function selfReferential(n) {
    n = n.toString();
    let res = [n];
    const makeNext = (n) => {
        let matchs = {
            '9':0,'8':0,'7':0,'6':0,'5':0,'4':0,'3':0,'2':0,'1':0,'0':0}, res = [];
        for(let index=0;index<n.length;index++)
            matchs[n[index].toString()]++;
        for(let index=9;index>=0;index--)
            if(matchs[index]>0)
                res.push(matchs[index],index);
        return res.join("").toString();
    }
    for(let i=0;i<10;i++)
        res.push(makeNext(res[res.length-1]));
    return [...new Set(res)];
}


# Given any array, produce an array of [item, count] pairs for each run.
def runs:
  reduce .[] as $item
    ( [];
      if . == [] then [ [ $item, 1] ]
      else  .[length-1] as $last
            | if $last[0] == $item
              then (.[0:length-1] + [ [$item, $last[1] + 1] ] )
              else . + [[$item, 1]]
              end
      end ) ;

# string to string
def next_self_referential:
  def runs2integer: # input is an array as produced by runs,
    # i.e. an array of [count, n] pairs, where count is an int,
    # and n is an "exploded" digit
    reduce .[] as $pair
      (""; . + ($pair[1] | tostring) + ([$pair[0]]|implode) ) ;

  explode | sort | reverse | runs | runs2integer;

# Given an integer as a string,
# compute the entire sequence (of strings) to convergence:
def sequence_of_self_referentials:
  def seq:
     . as $ary
     | (.[length-1] | next_self_referential) as $next
     | if ($ary|index($next)) then $ary
       else $ary + [$next] | seq
       end;
  [.] | seq;

def maximals(n):
  def interesting:
    tostring | (. == (explode | sort | reverse | implode));

  reduce range(0;n) as $i
    ([[], 0];  # maximalseeds, length
      if ($i | interesting) then
        ($i|tostring|sequence_of_self_referentials|length) as $length
        | if .[1] == $length then [ .[0] + [$i], $length]
          elif .[1] < $length then [ [$i], $length]
          else .
          end
      else .
      end );

def task(n):
  maximals(n) as $answer
  | "The maximal length to convergence for seeds up to \(n) is \($answer[1]).",
    "The corresponding seeds are the allowed permutations",
    "of the representative number(s): \($answer[0][])",
    "For each representative seed, the self-referential sequence is as follows:",
    ($answer[0][] | tostring
     | ("Representative: \(.)",
        "Self-referential sequence:",
	(sequence_of_self_referentials | map(tonumber))))
    ;

task(1000000)


const seen = Dict{Vector{Char}, Vector{Char}}()

function findnextterm(prevterm)
    counts = Dict{Char, Int}()
    reversed = Vector{Char}()
    for c in prevterm
        if !haskey(counts, c)
            counts[c] = 0
        end
        counts[c] += 1
    end
    for c in sort(collect(keys(counts)))
        if counts[c] > 0
            push!(reversed, c)
            if counts[c] == 10
                push!(reversed, '0'); push!(reversed, '1')
            else
                push!(reversed, Char(UInt8(counts[c]) + UInt8('0')))
            end
        end
    end
    reverse(reversed)
end

function findsequence(seedterm)
    term = seedterm
    sequence = Vector{Vector{Char}}()
    while !(term in sequence)
        push!(sequence, term)
        if !haskey(seen, term)
            nextterm = findnextterm(term)
            seen[term] = nextterm
        end
        term = seen[term]
    end
    return sequence
end

function selfseq(maxseed)
    maxseqlen = -1
    maxsequences = Vector{Pair{Int, Vector{Char}}}()
    for i in 1:maxseed
        seq = findsequence([s[1] for s in split(string(i), "")])
        seqlen = length(seq)
        if seqlen > maxseqlen
            maxsequences = [Pair(i, seq)]
            maxseqlen = seqlen
        elseif seqlen == maxseqlen
            push!(maxsequences, Pair(i, seq))
        end
    end
    println("The longest sequence length is $maxseqlen.")
    for p in maxsequences
        println("\n Seed: $(p[1])")
        for seq in p[2]
            println("     ", join(seq, ""))
        end
    end
end

selfseq(1000000)


// version 1.1.2

const val LIMIT = 1_000_000

val sb = StringBuilder()

fun selfRefSeq(s: String): String {
    sb.setLength(0)  // faster than using a local StringBuilder object
    for (d in '9' downTo '0') {
        if (d !in s) continue
        val count = s.count { it == d }
        sb.append("$count$d")
    }
    return sb.toString()
}

fun permute(input: List<Char>): List<List<Char>> {
    if (input.size == 1) return listOf(input)
    val perms = mutableListOf<List<Char>>()
    val toInsert = input[0]
    for (perm in permute(input.drop(1))) {
        for (i in 0..perm.size) {
            val newPerm = perm.toMutableList()
            newPerm.add(i, toInsert)
            perms.add(newPerm)
        }
    }
    return perms
}

fun main(args: Array<String>) {
    val sieve = IntArray(LIMIT) // all zero by default
    val elements = mutableListOf<String>()
    for (n in 1 until LIMIT) {
        if (sieve[n] > 0) continue
        elements.clear()
        var next = n.toString()
        elements.add(next)
        while (true) {
            next = selfRefSeq(next)
            if (next in elements) {
                val size = elements.size
                sieve[n] = size
                if (n > 9) {
                    val perms = permute(n.toString().toList()).distinct()
                    for (perm in perms) {
                        if (perm[0] == '0') continue
                        val k = perm.joinToString("").toInt()
                        sieve[k] = size
                    }
                }
                break
            }
            elements.add(next)
        }
    }
    val maxIterations = sieve.max()!!
    for (n in 1 until LIMIT) {
        if (sieve[n] < maxIterations) continue
        println("$n -> Iterations = $maxIterations")
        var next = n.toString()
        for (i in 1..maxIterations) {
            println(next)
            next = selfRefSeq(next)
        }
        println()
    }
}


-- Return the next term in the self-referential sequence
function findNext (nStr)
    local nTab, outStr, pos, count = {}, "", 1, 1
    for i = 1, #nStr do nTab[i] = nStr:sub(i, i) end
    table.sort(nTab, function (a, b) return a > b end)
    while pos <= #nTab do
        if nTab[pos] == nTab[pos + 1] then
            count = count + 1
        else
            outStr = outStr .. count .. nTab[pos]
            count = 1
        end
        pos = pos + 1
    end
    return outStr
end

-- Return boolean indicating whether table t contains string s
function contains (t, s)
    for k, v in pairs(t) do
        if v == s then return true end
    end
    return false
end

-- Return the sequence generated by the given seed term
function buildSeq (term)
    local sequence = {}
    repeat
        table.insert(sequence, term)
        if not nextTerm[term] then nextTerm[term] = findNext(term) end
        term = nextTerm[term]
    until contains(sequence, term)
    return sequence
end

-- Main procedure
nextTerm = {}
local highest, seq, hiSeq = 0
for i = 1, 10^6 do
    seq = buildSeq(tostring(i))
    if #seq > highest then
        highest = #seq
        hiSeq = {seq}
    elseif #seq == highest then
        table.insert(hiSeq, seq)
    end
end
io.write("Seed values: ")
for _, v in pairs(hiSeq) do io.write(v[1] .. " ") end
print("\n\nIterations: " .. highest)
print("\nSample sequence:")
for _, v in pairs(hiSeq[1]) do print(v) end


selfRefSequence[ x_ ] := [email protected]@[email protected][[email protected]{RotateRight[[email protected],1], Range[0,9]},Except[{0,_}]]
DisplaySequence[ x_ ] := NestWhileList[selfRefSequence,x,UnsameQ[##]&,4]
data= {#, [email protected][#]}&/@Range[1000000];
Print["Values: ", Select[data  ,#[[2]] == [email protected][[;;,2]]&][[1,;;]]]
Print["Iterations: ", [email protected][#]&/@Select[data  ,#[[2]] == [email protected][[;;,2]]&][[1,;;]]]
[email protected][data, #[[2]] == [email protected][[;;,2]]&][[1]]//Column


import algorithm, sequtils, sets, strutils, tables

var cache: Table[seq[char], int]   # Maps key -> number of iterations.

iterator sequence(seed: string): string =
  ## Yield the successive strings of a sequence.

  var history: HashSet[string]
  history.incl seed
  var current = seed
  yield current

  while true:
    var counts = current.toCountTable()
    var next: string
    for ch in sorted(toSeq(counts.keys), Descending):
      next.add $counts[ch] & ch
    if next in history: break
    current = move(next)
    history.incl current
    yield current

proc seqLength(seed: string): int =
  ## Return the number of iterations for the given seed.
  let key = sorted(seed, Descending)
  if key in cache: return cache[key]
  result = toSeq(sequence(seed)).len
  cache[key] = result

var seeds: seq[int]
var itermax = 0
for seed in 0..<1_000_000:
  let itercount = seqLength($seed)
  if itercount > itermax:
    itermax = itercount
    seeds = @[seed]
  elif itercount == itermax:
    seeds.add seed

echo "Maximum iterations: ", itermax
echo "Seed values: ", seeds.join(", ")
echo "Sequence for $#:".format(seeds[0])
for s in sequence($seeds[0]): echo s


sub next_num {
	my @a;
	$a[$_]++ for split '', shift;
	join('', map(exists $a[$_] ? $a[$_].$_ : "", reverse 0 .. 9));
}

my %cache;
sub seq {
	my $a = shift;
	my (%seen, @s);
	until ($seen{$a}) {
		$seen{$a} = 1;
		push(@s, $a);
		last if !wantarray && $cache{$a};
		$a = next_num($a);
	}
	return (@s) if wantarray;

	my $l = $cache{$a};
	if ($l) { $cache{$s[$_]} = $#s - $_ + $l for (0 .. $#s); }
	else {
		$l++ while ($s[-$l] != $a);
		$cache{pop @s} = $l 	for (1 .. $l);
		$cache{pop @s} = ++$l	while @s;
	}
	$cache{$s[0]}
}

my (@mlist, $mlen);
for (1 .. 100_000) { # 1_000_000 takes very, very long
	my $l = seq($_);
	next if $l < $mlen;
	if ($l > $mlen) { $mlen = $l; @mlist = (); }
	push @mlist, $_;
}

print "longest ($mlen): @mlist\n";
print join("\n", seq($_)), "\n\n" for @mlist;


with javascript_semantics
string n = "000000"

function incn()
    for i=length(n) to 1 by -1 do
        if n[i]='9' then
            if i=1 then return false end if
            n[i]='0'
        else
            n[i] += 1
            exit
        end if
    end for
    return true
end function

sequence res = {}, bestseen
integer maxcycle = 0

procedure srs()
    sequence curr = n
    while length(curr)>1 and curr[1]='0' do
        curr = curr[2..$]
    end while
    integer ch = curr[1]
    for i=2 to length(curr) do
        if curr[i]>ch then return end if
        ch = curr[i]
    end for
    sequence seen = {curr}
    integer cycle = 1
    while true do
        sequence digits = repeat(0,10)
        for i=1 to length(curr) do
            integer idx = curr[i]-'0'+1
            digits[idx] += 1
        end for
        string next = ""
        for i=length(digits) to 1 by -1 do
            if digits[i]!=0 then
                next &= sprint(digits[i])
                next &= i+'0'-1
            end if
        end for
        if find(next,seen) then exit end if
        seen = append(seen,next)
        curr = next
        cycle += 1
    end while
    if cycle>maxcycle then
        res = {seen[1]}
        maxcycle = cycle
        bestseen = seen
    elsif cycle=maxcycle then
        res = append(res,seen[1])
    end if
end procedure

while true do
    srs()
    if not incn() then exit end if
end while

-- add non-leading-0 perms:
for i=length(res) to 1 by -1 do
    string ri = res[i]
    for p=1 to factorial(length(ri)) do
        string pri = permute(p,ri)
        if pri[1]!='0' and not find(pri,res) then
            res = append(res,pri)
        end if
    end for
end for
?res
puts(1,"cycle length is ") ?maxcycle
pp(bestseen,{pp_Nest,1})


(de selfRefSequence (Seed)
   (let L (mapcar format (chop Seed))
      (make
         (for (Cache NIL  (not (idx 'Cache L T)))
            (setq L
               (las (flip (sort (copy (link L))))) ) ) ) ) )

(let Res NIL
   (for Seed 1000000
      (let N (length (selfRefSequence Seed))
         (cond
            ((> N (car Res)) (setq Res (list N Seed)))
            ((= N (car Res)) (queue 'Res Seed)) ) ) )
   (println 'Values: (cdr Res))
   (println 'Iterations: (car Res))
   (mapc prinl (selfRefSequence (cadr Res))) )


from itertools import groupby, permutations

def A036058(number):
    return ''.join( str(len(list(g))) + k
                    for k,g in groupby(sorted(str(number), reverse=True)) )

def A036058_length(numberstring='0', printit=False):
    iterations, last_three, queue_index = 1, ([None] * 3), 0

    def A036058(number):
        # rely on external reverse-sort of digits of number
        return ''.join( str(len(list(g))) + k
                        for k,g in groupby(number) )

    while True:
        if printit:
            print("  %2i %s" % (iterations, numberstring))
        numberstring = ''.join(sorted(numberstring, reverse=True))
        if numberstring in last_three:
            break
        assert iterations < 1000000
        last_three[queue_index], numberstring = numberstring, A036058(numberstring)
        iterations += 1
        queue_index +=1
        queue_index %=3
    return iterations

def max_A036058_length( start_range=range(11) ):
    already_done = set()
    max_len = (-1, [])
    for n in start_range:
        sn = str(n)
        sns = tuple(sorted(sn, reverse=True))
        if sns not in already_done:
            already_done.add(sns)
            size = A036058_length(sns)
            if size > max_len[0]:
                max_len = (size, [n])
            elif size == max_len[0]:
                max_len[1].append(n)
    return max_len

lenmax, starts = max_A036058_length( range(1000000) )

# Expand
allstarts = []
for n in starts:
    allstarts += [int(''.join(x))
                  for x in set(k
                               for k in permutations(str(n), 4)
                               if k[0] != '0')]
allstarts = [x for x in sorted(allstarts) if x < 1000000]

print ( '''\
The longest length, followed by the number(s) with the longest sequence length
for starting sequence numbers below 1000000 are:
  Iterations = %i and sequence-starts = %s.''' % (lenmax, allstarts)   )

print ( '''
Note that only the first of any sequences with the same digits is printed below.
(The others will differ only in their first term)''' )

for n in starts:
    print()
    A036058_length(str(n), printit=True)


ls:{raze(string 1_ deltas d,count x),'x d:where differ x}  / look & say
sumsay:ls desc@                                            / summarize & say

seeds:group desc each string til 1000000                   / seeds for million integers
seq:(key seeds)!30 sumsay\'key seeds                       / sequences for unique seeds
top:max its:(count distinct@)each seq                      / count iterations

/ report results
rpt:{1 x,": ",y,"\n\n";}
rpt["Seeds"]" "sv string raze seeds where its=top          / all forms of top seed/s
rpt["Iterations"]string top
rpt["Sequence"]"\n\n","\n"sv raze seq where its=top


#lang racket

(define (next s)
  (define v (make-vector 10 0))
  (for ([c s])
    (define d (- (char->integer #\9) (char->integer c)))
    (vector-set! v d (add1 (vector-ref v d))))
  (string-append* (for/list ([x v] [i (in-range 9 -1 -1)] #:when (> x 0))
                    (format "~a~a" x i))))

(define (seq-of s)
  (reverse (let loop ([ns (list s)])
             (define n (next (car ns)))
             (if (member n ns) ns (loop (cons n ns))))))

(define (sort-string s)
  (list->string (sort (string->list s) char>?)))

(define-values [len nums seq]
  (for/fold ([*len #f] [*nums #f] [*seq #f])
            ([n (in-range 1000000 -1 -1)]) ; start at the high end
    (define s (number->string n))
    (define sorted (sort-string s))
    (cond [(equal? s sorted)
           (define seq (seq-of s))
           (define len (length seq))
           (cond [(or (not *len) (> len *len)) (values len (list s) seq)]
                 [(= len *len) (values len (cons s *nums) seq)]
                 [else (values *len *nums *seq)])]
          ;; not sorted: see if it's a permutation of the best
          [else (values
                 *len
                 (if (and *nums (member sorted *nums)) (cons s *nums) *nums)
                 *seq)])))
(printf "Numbers: ~a\nLength: ~a\n" (string-join nums ", ") len)
(for ([n seq]) (printf "  ~a\n" n))


my @list;
my $longest = 0;
my %seen;

for 1 .. 1000000 -> $m {
    next unless $m ~~ /0/;         # seed must have a zero
    my $j = join '', $m.comb.sort;
    next if %seen{$j}:exists;      # already tested a permutation
    %seen{$j} = '';
    my @seq = converging($m);
    my %elems;
    my $count;
    for @seq[] -> $value { last if ++%elems{$value} == 2; $count++; };
    if $longest == $count {
        @list.push($m);
    }
    elsif $longest < $count {
        $longest = $count;
        @list = $m;
        print "\b" x 20, "$count, $m"; # monitor progress
    }
};

for @list -> $m {
    say "\nSeed Value(s): ", my $seeds = ~permutations($m).unique.grep( { .substr(0,1) != 0 } );
    my @seq = converging($m);
    my %elems;
    my $count;
    for @seq[] -> $value { last if ++%elems{$value} == 2; $count++; };
    say "\nIterations: ", $count;
    say "\nSequence: (Only one shown per permutation group.)";
   .say for |@seq[^$count], "\n";
}

sub converging ($seed) { return $seed, -> $l { join '', map { $_.value.elems~$_.key }, $l.comb.classify({$^b}).sort: {-$^c.key} } ... * }

sub permutations ($string, $sofar? = '' ) {
    return $sofar unless $string.chars;
    my @perms;
    for ^$string.chars -> $idx {
        my $this = $string.substr(0,$idx)~$string.substr($idx+1);
        my $char = substr($string, $idx,1);
        @perms.push( |permutations( $this, join '', $sofar, $char ) );
    }
    return @perms;
}


/*REXX pgm generates a self─referential sequence and displays sequences with max length.*/
parse arg LO HI .                                /*obtain optional arguments from the CL*/
if LO=='' | LO==","  then LO=      1             /*Not specified?  Then use the default.*/
if HI=='' | HI==","  then HI=1000000 - 1         /* "      "         "   "   "     "    */
max$=;      seeds=;    maxL=0                    /*inialize some defaults and counters. */

  do #=LO  to HI;      n=#;     @.=0;     @.#=1  /*loop thru seed; define some defaults.*/
  $=n
      do c=1  until x==n;       x=n              /*generate a self─referential sequence.*/
      n=;           do k=9  by -1  for 10        /*generate a new sequence (downwards). */
                    _=countstr(k, x)             /*obtain the number of sequence counts.*/
                    if _\==0  then n=n || _ || k /*is count > zero?  Then append it to N*/
                    end   /*k*/
      if @.n  then leave                         /*has sequence been generated before ? */
      $=$'-'n;     @.n=1                         /*add the number to sequence and roster*/
      end   /*c*/

  if c==maxL then do;  seeds=seeds #             /*is the sequence equal to max so far ?*/
                       max$=max$   $             /*append this self─referential # to  $ */
                  end
             else if c>maxL  then do;  seeds=#   /*use the new number as the new seed.  */
                                  maxL=c; max$=$ /*also, set the new maximum L; max seq.*/
                                  end            /* [↑]  have we found a new best seq ? */
  end   /*#*/

say  ' seeds that had the most iterations: '     seeds
say  'the maximum self─referential length: '     maxL

  do j=1  for words(max$) ;      say
  say copies('─',30)  "iteration sequence for: "   word(seeds,j)  '  ('maxL  "iterations)"
  q=translate( word( max$, j), ,'-')
                                     do k=1  for words(q);     say  word(q, k)
                                     end   /*k*/
  end   /*j*/                                    /*stick a fork in it,  we're all done. */


$cache = {}
def selfReferentialSequence_cached(n, seen = [])
  return $cache[n] if $cache.include? n
  return [] if seen.include? n

  digit_count = Array.new(10, 0)
  n.to_s.chars.collect {|char| digit_count[char.to_i] += 1}
  term = ''
  9.downto(0).each do |d|
    if digit_count[d] > 0
      term += digit_count[d].to_s + d.to_s
    end
  end
  term = term.to_i
  $cache[n] = [n] + selfReferentialSequence_cached(term, [n] + seen)
end

limit = 1_000_000
max_len = 0
max_vals = []

1.upto(limit - 1) do |n|
  seq = selfReferentialSequence_cached(n)
  if seq.length > max_len
    max_len = seq.length
    max_vals = [n]
  elsif seq.length == max_len
    max_vals << n
  end
end

puts "values: #{max_vals.inspect}"
puts "iterations: #{max_len}"
puts "sequence:"
selfReferentialSequence_cached(max_vals[0]).each_with_index do |val, idx|
  puts "%2d %d" % [idx + 1, val]
end


import spire.math.SafeLong

import scala.annotation.tailrec
import scala.collection.parallel.immutable.ParVector

object SelfReferentialSequence {
  def main(args: Array[String]): Unit = {
    val nums = ParVector.range(1, 1000001).map(SafeLong(_))
    val seqs = nums.map{ n => val seq = genSeq(n); (n, seq, seq.length) }.toVector.sortWith((a, b) => a._3 > b._3)
    val maxes = seqs.takeWhile(t => t._3 == seqs.head._3)

    println(s"Seeds: ${maxes.map(_._1).mkString(", ")}\nIterations: ${maxes.head._3}")
    for(e <- maxes.distinctBy(a => nextTerm(a._1.toString))){
      println(s"\nSeed: ${e._1}\n${e._2.mkString("\n")}")
    }
  }

  def genSeq(seed: SafeLong): Vector[String] = {
    @tailrec
    def gTrec(seq: Vector[String], n: String): Vector[String] = {
      if(seq.contains(n)) seq
      else gTrec(seq :+ n, nextTerm(n))
    }
    gTrec(Vector[String](), seed.toString)
  }

  def nextTerm(num: String): String = {
    @tailrec
    def dTrec(digits: Vector[(Int, Int)], src: String): String = src.headOption match{
      case Some(n) => dTrec(digits :+ ((n.asDigit, src.count(_ == n))), src.filter(_ != n))
      case None => digits.sortWith((a, b) => a._1 > b._1).map(p => p._2.toString + p._1.toString).mkString
    }
    dTrec(Vector[(Int, Int)](), num)
  }
}


proc nextterm n {
    foreach c [split $n ""] {incr t($c)}
    foreach c {9 8 7 6 5 4 3 2 1 0} {
	if {[info exist t($c)]} {append r $t($c) $c}
    }
    return $r
}
# Local context of lambda term is just for speed
apply {limit {
    #  Build a digit cache; this adds quite a bit of speed
    set done [lrepeat [set l2 [expr {$limit * 100}]] 0]
    # Iterate over search space
    set maxlen 0
    set maxes {}
    for {set i 0} {$i < $limit} {incr i} {
	if {[lindex $done $i]} continue
	# Compute the sequence length for this value (with help from cache)
	set seq {}
	for {set seed $i} {$seed ni $seq} {set seed [nextterm $seed]} {
	    if {$seed < $l2 && [lindex $done $seed]} {
		set len [expr {[llength $seq] + [lindex $done $seed]}]
		break
	    }
	    set len [llength [lappend seq $seed]]
	}
	# What are we going to do about it?
	if {$len > $maxlen} {
	    set maxlen $len
	    set maxes [list $i]
	} elseif {$len == $maxlen} {
	    lappend maxes $i
	}
	# Update the cache with what we have learned
	foreach n $seq {
	    if {$n < $l2} {lset done $n $len}
	    incr len -1
	}
    }
    # Output code
    puts "max length: $maxlen"
    foreach c $maxes {puts $c}
    puts "Sample max-len sequence:"
    set seq {}
    # Rerun the sequence generator for printing; faster for large limits
    for {set seed [lindex $c 0]} {$seed ni $seq} {set seed [nextterm $seed]} {
	lappend seq $seed
        puts "\t$seed"
    }
}} 1000000


;; Syntactic sugar for calling reduce-left
(defmacro reduce-with ((acc init item sequence) . body)
  ^(reduce-left (lambda (,acc ,item) ,*body) ,sequence ,init))

 ;; Macro similar to clojure's ->> and ->
(defmacro opchain (val . ops)
  ^[[chain ,*[mapcar [iffi consp (op cons 'op)] ops]] ,val])

;; Reduce integer to a list of integers representing its decimal digits.
(defun digits (n)
  (if (< n 10)
    (list n)
    (opchain n tostring list-str (mapcar (op - @1 #\0)))))

(defun dcount (ds)
  (digits (length ds)))

;; Perform a look-say step like (1 2 2) --"one 1, two 2's"-> (1 1 2 2).
(defun summarize-prev (ds)
  (opchain ds copy (sort @1 >) (partition-by identity)
           (mapcar [juxt dcount first]) flatten))

;; Take a starting digit string and iterate the look-say steps,
;; to generate the whole sequence, which ends when convergence is reached.
(defun convergent-sequence (ds)
  (reduce-with (cur-seq nil ds [giterate true summarize-prev ds])
    (if (member ds cur-seq)
      (return-from convergent-sequence cur-seq)
      (nconc cur-seq (list ds)))))

;; A candidate sequence is one which begins with montonically
;; decreasing digits. We don't bother with (9 0 9 0) or (9 0 0 9);
;; which yield identical sequences to (9 9 0 0).
(defun candidate-seq (n)
  (let ((ds (digits n)))
    (if [apply >= ds]
      (convergent-sequence ds))))

;; Discover the set of longest sequences.
(defun find-longest (limit)
  (reduce-with (max-seqs nil new-seq [mapcar candidate-seq (range 1 limit)])
    (let ((cmp (- (opchain max-seqs first length) (length new-seq))))
      (cond ((> cmp 0) max-seqs)
            ((< cmp 0) (list new-seq))
            (t (nconc max-seqs (list new-seq)))))))

(defvar *results* (find-longest 1000000))

(each ((result *results*))
  (flet ((strfy (list) ;; (strfy '((1 2 3 4) (5 6 7 8))) -> ("1234" "5678")
           (mapcar [chain (op mapcar tostring) cat-str] list)))
    (let* ((seed (first result))
           (seeds (opchain seed perm uniq (remove-if zerop @1 first))))
      (put-line `Seed value(s): @(strfy seeds)`)
      (put-line)
      (put-line `Iterations: @(length result)`)
      (put-line)
      (put-line `Sequence: @(strfy result)`))))


import "/seq" for Lst
import "/math" for Nums

var limit = 1e6

var selfRefSeq = Fn.new { |s|
    var sb = ""
    for (d in "9876543210") {
        if (s.contains(d)) {
            var count = s.count { |c| c == d }
            sb = sb + "%(count)%(d)"
        }
    }
    return sb
}

var permute // recursive
permute = Fn.new { |input|
    if (input.count == 1) return [input]
    var perms = []
    var toInsert = input[0]
    for (perm in permute.call(input[1..-1])) {
        for (i in 0..perm.count) {
            var newPerm = perm.toList
            newPerm.insert(i, toInsert)
            perms.add(newPerm)
        }
    }
    return perms
}

var sieve = List.filled(limit, 0)
var elements = []
for (n in 1...limit) {
    if (sieve[n] == 0) {
        elements.clear()
        var next = n.toString
        elements.add(next)
        while (true) {
            next = selfRefSeq.call(next)
            if (elements.contains(next)) {
                var size = elements.count
                sieve[n] = size
                if (n > 9) {
                    var perms = permute.call(n.toString.toList).map { |p| p.join("") }.toList
                    perms = Lst.distinct(perms)
                    for (perm in perms) {
                        if (perm[0] != "0") {
                            var k = Num.fromString(perm.join(""))
                            sieve[k] = size
                        }
                    }
                }
                break
            }
            elements.add(next)
        }
    }
}
var maxIterations = Nums.max(sieve)
for (n in 1...limit) {
    if (sieve[n] >= maxIterations) {
        System.print("%(n) -> Iterations = %(maxIterations)")
        var next = n.toString
        for (i in 1..maxIterations) {
            System.print(next)
            next = selfRefSeq.call(next)
        }
        System.print()
    }
}


N:=0d1_000_001;

fcn lookAndJustSaying(seed){ // numeric String --> numeric String
   "9876543210".pump(String,'wrap(n){
      (s:=seed.inCommon(n)) and String(s.len(),n) or ""
   });
}
fcn sequence(seed){ // numeric string --> sequence until it repeats
   seq:=L();
   while(not seq.holds(seed)){ seq.append(seed); seed=lookAndJustSaying(seed); }
   seq
}
fcn decending(str) //--> True if digits are in descending (or equal) order
   { (not str.walker().zipWith('<,str[1,*]).filter1()) }

szs:=List.createLong(25); max:=0;
foreach seed in (N){
   z:=seed.toString();
   if(decending(z)){ // 321 generates same sequence as 312,132,123,213
      len:=sequence(z).len();
      if(len>max) szs.clear();
      if(len>=max){ szs.append(seed.toString()); max=len; }
   }
}

// List permutations of longest seeds
// ("9900"-->(((9,0,0,9),...))-->((9,0,0,9),...)-->("9009"...)
//        -->remove numbers w/leading zeros-->remove dups
zs:=szs.apply(Utils.Helpers.permute).flatten().apply("concat")
   .filter(fcn(s){ s[0]!="0" }) : Utils.Helpers.listUnique(_);
println(max," iterations for ",zs.concat(", "));
zs.pump(Console.println,sequence,T("concat",", "));


*        Sum of squares            27/08/2015
SUMOFSQR CSECT
         USING  SUMOFSQR,R12
         LR     R12,R15
         LA     R7,A               a(1)
         SR     R6,R6              sum=0
         LA     R3,1               i=1
LOOPI    CH     R3,N               do i=1 to hbound(a)
         BH     ELOOPI
         L      R5,0(R7)           a(i)
         M      R4,0(R7)           a(i)*a(i)
         AR     R6,R5              sum=sum+a(i)**2
         LA     R7,4(R7)           next a
         LA     R3,1(R3)           i=i+1
         B      LOOPI              end i
ELOOPI   XDECO  R6,PG+23           edit sum
         XPRNT  PG,80
         XR     R15,R15
         BR     R14
A        DC     F'1',F'2',F'3',F'4',F'5',F'6',F'7',F'8',F'9',F'10'
PG       DC     CL80'The sum of squares is: '
N        DC     AL2((PG-A)/4)
         YREGS
         END    SUMOFSQR


		;;; Sum of squares
		cpu	8086
		bits	16
section		.text
		org	100h
		jmp	demo
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;;; Calculate the sum of the squares of the array in SI.
		;;; The array should contain 16-bit unsigned integers.
		;;; The output will be 32-bit.
		;;; Input: (DS:)SI = array, CX = array length
		;;; Output: DX:AX = sum of squares
		;;; Registers used: AX,BX,CX,DX,SI,DI
sumsqr:		xor	bx,bx	; Keep accumulator in BX:DI.
		xor	di,di	; (So zero it out first)
		and	cx,cx	; Counter register 0? "Program should work
		jz	.done	; on a zero-length vector"
.loop:		mov	ax,[si]	; Grab value from array
		mul	ax	; Calculate square of value (into DX:AX)
		add	di,ax	; Add low 16 bits to accumulator
		adc	bx,dx	; Add high 16 bits, plus carry
		inc	si	; Point to next value
		inc	si
		loop	.loop	; Next value in array
.done:		mov	ax,di	; Return the value in DX:AX as is tradition
		mov	dx,bx
		ret
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;;; Demo: use the subroutine to calculate the sum of squares
		;;; in the included array, and show the result
demo:		mov	si,array
		mov	cx,arrlen
		call	sumsqr
		;;; Print the return value in DX:AX as a decimal number
		;;; (Note: max supported value 655359 - this is a limitation
		;;; of this rudimentary output code, not of the sum of squares
		;;; routine.)
		mov	di,outstr_end
		mov	cx,10
.decloop:	div	cx
		dec	di
		add	dl,'0'
		mov	[di],dl
		xor	dx,dx
		and	ax,ax
		jnz	.decloop
		mov	dx,di
		mov	ah,9
		int	21h
		ret
section		.data
outstr:		db	'######'	; Placeholder for decimal output
outstr_end:	db	'$'
array:		dw	1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20
arrlen:		equ	($-array)/2	; length is in words


(defun sum-of-squares (xs)
   (if (endp xs)
       0
       (+ (* (first xs) (first xs))
          (sum-of-squares (rest xs)))))


CARD FUNC SumOfSqr(BYTE ARRAY a BYTE count)
  BYTE i
  CARD res

  IF count=0 THEN
    RETURN (0)
  FI

  res=0
  FOR i=0 TO count-1
  DO
    res==+a(i)*a(i)
  OD
RETURN (res)

PROC Test(BYTE ARRAY a BYTE count)
  BYTE i
  CARD res

  res=SumOfSqr(a,count)
  Print("[")
  IF count>0 THEN
    FOR i=0 to count-1
    DO
      PrintB(a(i))
      IF i<count-1 THEN
        Put(' )
      FI
    OD
  FI
  PrintF("]->%U%E%E",res)
RETURN

PROC Main()
  BYTE ARRAY a=[1 2 3 4 5]
  BYTE ARRAY b=[10 20 30 40 50 60 70 80 90]
  BYTE ARRAY c=[11]

  Test(a,5)
  Test(b,9)
  Test(c,1)
  Test(c,0)
RETURN


function sumOfSquares(vector:Vector.<Number>):Number
{
	var sum:Number = 0;
	for(var i:uint = 0; i < vector.length; i++)
		sum += vector[i]*vector[i];
	return sum;
}


with Ada.Text_IO;  use Ada.Text_IO;

procedure Test_Sum_Of_Squares is
   type Float_Array is array (Integer range <>) of Float;

   function Sum_Of_Squares (X : Float_Array) return Float is
      Sum : Float := 0.0;
   begin
      for I in X'Range loop
         Sum := Sum + X (I) ** 2;
      end loop;
      return Sum;
   end Sum_Of_Squares;

begin
   Put_Line (Float'Image (Sum_Of_Squares ((1..0 => 1.0)))); -- Empty array
   Put_Line (Float'Image (Sum_Of_Squares ((3.0, 1.0, 4.0, 1.0, 5.0, 9.0))));
end Test_Sum_Of_Squares;


real
squaredsum(list l)
{
    integer i;
    real s;

    s = 0;
    i = -~l;
    while (i) {
        s += sq(l[i += 1]);
    }

    s;
}

integer
main(void)
{
    list l;

    l = list(0, 1, 2, 3);

    o_form("~\n", squaredsum(l));
    o_form("~\n", squaredsum(list()));
    o_form("~\n", squaredsum(list(.5, -.5, 2)));

    0;
}


PROC sum of squares = ([]REAL argv)REAL:(
  REAL sum := 0;
  FOR i FROM LWB argv TO UPB argv DO
    sum +:= argv[i]**2
  OD;
  sum
);
test:(
  printf(($g(0)l$,sum of squares([]REAL(3, 1, 4, 1, 5, 9))));
)


begin
    % procedure to sum the elements of a vector. As the procedure can't find %
    % the bounds of the array for itself, we pass them in lb and ub          %
    real procedure sumSquares ( real    array vector ( * )
                              ; integer value lb
                              ; integer value ub
                              ) ;
    begin
        real sum;
        sum := 0;
        for i := lb until ub do sum := sum + ( vector( i ) * vector( i ) );
        sum
    end sumOfSquares ;

    % test the sumSquares procedure                                          %
    real array numbers ( 1 :: 5 );
    for i := 1 until 5 do numbers( i ) := i;
    r_format := "A"; r_w := 10; r_d := 1; % set fixed point output           %
    write( sumSquares( numbers, 1, 5 ) );
end.


def sum_squares(a)
   var sum = 0
   for i in a
      sum = sum + i**2
   end
   return sum
end

WriteLn(sum_squares([3,1,4,1,5,9]))
end


      square_sum←{+/⍵*2}
      square_sum 1 2 3 4 5
55
      square_sum ⍬ ⍝The empty vector
0


------ TWO APPROACHES – SUM OVER MAP, AND DIRECT FOLD ----

-- sumOfSquares :: Num a => [a] -> a
on sumOfSquares(xs)
    script squared
        on |λ|(x)
            x ^ 2
        end |λ|
    end script

    sum(map(squared, xs))
end sumOfSquares

-- sumOfSquares2 :: Num a => [a] -> a
on sumOfSquares2(xs)
    script plusSquare
        on |λ|(a, x)
            a + x ^ 2
        end |λ|
    end script

    foldl(plusSquare, 0, xs)
end sumOfSquares2

--------------------------- TEST -------------------------
on run
    set xs to [3, 1, 4, 1, 5, 9]

    {sumOfSquares(xs), sumOfSquares2(xs)}

    -- {133.0, 133.0}
end run

-------------------- GENERIC FUNCTIONS -------------------

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- sum :: Num a => [a] -> a
on sum(xs)
    script add
        on |λ|(a, b)
            a + b
        end |λ|
    end script

    foldl(add, 0, xs)
end sum


int suma;
int[] a={1, 2, 3, 4, 5, 6};

for(var i : a)
    suma = suma + a[i] ^ 2;

write("The sum of squares is: ", suma);


list = 3 1 4 1 5 9
Loop, Parse, list, %A_Space%
 sum += A_LoopField**2
MsgBox,% sum


sum = 0
FOR I = LBOUND(a) TO UBOUND(a)
  sum = sum + a(I) ^ 2
NEXT I
PRINT "The sum of squares is: " + sum


define s(a[], n) {
    auto i, s

    for (i = 0; i < n; i++) {
        s += a[i] * a[i]
    }

    return(s)
}


get "libhdr"

let sumsquares(v, len) =
    len=0 -> 0,
    !v * !v + sumsquares(v+1, len-1)

let start() be
$(  let vector = table 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
    writef("%N*N", sumsquares(vector, 10))
$)


SSq ← +´√⁼

•Show SSq 1‿2‿3‿4‿5
•Show SSq ⟨⟩


( ( sumOfSquares
  =   sum component
    .   0:?sum
      &   whl
        ' ( !arg:%?component ?arg
          & !component^2+!sum:?sum
          )
      & !sum
  )
& out$(sumOfSquares$(3 4))
& out$(sumOfSquares$(3 4 i*5))
& out$(sumOfSquares$(a b c))
);


p 1.to(10).reduce 0 { res, n | res = res + n ^ 2 }  #Prints 385


#include <stdio.h>

double squaredsum(double *l, int e)
{
   int i; double sum = 0.0;
   for(i = 0 ; i < e ; i++) sum += l[i]*l[i];
   return sum;
}

int main()
{
   double list[6] = {3.0, 1.0, 4.0, 1.0, 5.0, 9.0};

   printf("%lf\n", squaredsum(list, 6));
   printf("%lf\n", squaredsum(list, 0));
   /* the same without using a real list as if it were 0-element long */
   printf("%lf\n", squaredsum(NULL, 0));
   return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;

class Program
{
    static int SumOfSquares(IEnumerable<int> list)
    {
        return list.Sum(x => x * x);
    }
    static void Main(string[] args)
    {
        Console.WriteLine(SumOfSquares(new int[] { 4, 8, 15, 16, 23, 42 })); // 2854
        Console.WriteLine(SumOfSquares(new int[] { 1, 2, 3, 4, 5 })); // 55
        Console.WriteLine(SumOfSquares(new int[] { })); // 0
    }
}


#include <iostream>
#include <numeric>
#include <vector>

double add_square(double prev_sum, double new_val)
{
  return prev_sum + new_val*new_val;
}

double vec_add_squares(std::vector<double>& v)
{
  return std::accumulate(v.begin(), v.end(), 0.0, add_square);
}

int main()
{
  // first, show that for empty vectors we indeed get 0
  std::vector<double> v; // empty
  std::cout << vec_add_squares(v) << std::endl;

  // now, use some values
  double data[] = { 0, 1, 3, 1.5, 42, 0.1, -4 };
  v.assign(data, data+7);
  std::cout << vec_add_squares(v) << std::endl;
  return 0;
}


Sum of squares.

First input is length of vector, then rest of input is vector.

Ingredients.
1 g eggs
0 g bacon

Method.
Put bacon into the 1st mixing bowl.
Take eggs from refrigerator.
Square the eggs.
Take bacon from refrigerator.
Put bacon into 2nd mixing bowl.
Combine bacon into 2nd mixing bowl.
Fold bacon into 2nd mixing bowl.
Add the bacon into the 1st mixing bowl.
Ask the eggs until squared.
Pour contents of the 1st mixing bowl into the 1st baking dish.

Serves 1.


(defn sum-of-squares [v]
  (reduce #(+ %1 (* %2 %2)) 0 v))


sum_squares = proc (ns: sequence[int]) returns (int)
    sum: int := 0
    for n: int in sequence[int]$elements(ns) do
        sum := sum + n ** 2
    end
    return(sum)
end sum_squares

start_up = proc ()
    po: stream := stream$primary_output()

    stream$putl(po, int$unparse(sum_squares(sequence[int]$[])))
    stream$putl(po, int$unparse(sum_squares(sequence[int]$[1,2,3,4,5])))
    stream$putl(po, int$unparse(sum_squares(sequence[int]$[42])))
end start_up


sumOfSquares = ( list ) ->
    list.reduce (( sum, x ) -> sum + ( x * x )), 0


(defun sum-of-squares (vector)
  (loop for x across vector sum (expt x 2)))


include "cowgol.coh";
include "argv.coh";

# Sum of squares
sub sumsquare(vec: [int32], len: intptr): (out: uint32) is
    out := 0;
    while len > 0 loop
        var cur := [vec];
        # make positive first so we can use extra range of uint32
        if cur < 0 then cur := -cur; end if;
        out := out + cur as uint32 * cur as uint32;
        vec := @next vec;
        len := len - 1;
    end loop;
end sub;

# Read array from command line, allowing empty line (giving 0)
var nums: int32[128];
var len: @indexof nums := 0;

ArgvInit();
loop
    var argmt := ArgvNext(); # read number
    if argmt == (0 as [uint8]) then
        break; # stop when no more numbers
    end if;

    var dummy: [uint8];
    (nums[len], dummy) := AToI(argmt);
    len := len + 1;
end loop;

# Print sum of squares of numbers
print_i32(sumsquare(&nums[0], len as intptr));
print_nl();


def sum_squares(a)
    a.map{|e| e*e}.sum()
end

puts sum_squares([1, 2, 3])
# => 14


T sumSquares(T)(T[] a) pure nothrow @safe @nogc {
    T sum = 0;
    foreach (e; a)
        sum += e ^^ 2;
    return sum;
}

void main() {
    import std.stdio: writeln;

    [3.1, 1.0, 4.0, 1.0, 5.0, 9.0].sumSquares.writeln;
}


sumOfSquares(list) {
  var sum=0;
  list.forEach((var n) { sum+=(n*n); });
  return sum;
}

main() {
  print(sumOfSquares([]));
  print(sumOfSquares([1,2,3]));
  print(sumOfSquares([10]));
}


program SumOfSq;

{$APPTYPE CONSOLE}

uses Math;

type
  TDblArray = array of Double;

var
  A: TDblArray;

begin
  Writeln(SumOfSquares([]):6:2);            //  0.00
  Writeln(SumOfSquares([1, 2, 3, 4]):6:2);  // 30.00
  A:= nil;
  Writeln(SumOfSquares(A):6:2);             //  0.00
  A:= TDblArray.Create(1, 2, 3, 4);
  Writeln(SumOfSquares(A):6:2);             // 30.00
  Readln;
end.


proc nonrec sum_squares([*] int arr) ulong:
    ulong sum, item;
    word i, len;
    sum := 0;
    len := dim(arr,1);
    if len>0 then
        for i from 0 upto len-1 do
            item := |arr[i];
            sum := sum + item * item
        od
    fi;
    sum
corp

proc nonrec main() void:
    type A0 = [0] int,
         A1 = [1] int,
         A5 = [5] int;

    writeln(sum_squares(A0()));
    writeln(sum_squares(A1(42)));
    writeln(sum_squares(A5(1,2,3,4,5)))
corp


def sumOfSquares(numbers) {
    var sum := 0
    for x in numbers {
        sum += x**2
    }
    return sum
}


class
	APPLICATION

create
	make

feature -- Initialization

	make
		local
			a: ARRAY [INTEGER]
		do
			a := <<1, -2, 3>>
			print ("%NSquare sum of <<1, 2, 3>>: " + sum_of_square (a).out)

			a := <<>>
			print ("%NSquare sum of <<>>: " + sum_of_square (a).out)
		end

feature -- Access

	sum_of_square (a: ITERABLE [INTEGER]): NATURAL
			-- sum of square of each items
		do
			Result := 0
			across a as it loop
				Result := Result + (it.item * it.item).as_natural_32
			end
		end

end


import system'routines;
import extensions;

SumOfSquares(list)
    = list.selectBy:(x => x * x).summarize(new Integer());

public program()
{
    console
        .printLine(SumOfSquares(new int[]{4, 8, 15, 16, 23, 42}))
        .printLine(SumOfSquares(new int[]{1, 2, 3, 4, 5}))
        .printLine(SumOfSquares(Array.MinValue))
}


(defun sum-of-squares (numbers)
  (apply #'+ (mapcar (lambda (k) (* k k)) numbers)))

(sum-of-squares (number-sequence 0 3)) ;=> 14


function SumOfSquares(sequence v)
    atom sum
    sum = 0
    for i = 1 to length(v) do
        sum += v[i]*v[i]
    end for
    return sum
end function


USE: math sequences ;

: sum-of-squares ( seq -- n ) [ sq ] map-sum ;

{ 1.0 2.0 4.0 8.0 16.0 } sum-of-squares


class SumSquares
{
  static Int sumSquares (Int[] numbers)
  {
    Int sum := 0
    numbers.each |n| { sum += n * n }
    return sum
  }

  public static Void main ()
  {
    Int[] n := [,]
    echo ("Sum of squares of $n = ${sumSquares(n)}")
    n = [1,2,3,4,5]
    echo ("Sum of squares of $n = ${sumSquares(n)}")
  }
}


: fsum**2 ( addr n -- f )
  0e
  dup 0= if 2drop exit then
  floats bounds do
    i [email protected] fdup f* f+
  1 floats +loop ;

create test 3e f, 1e f, 4e f, 1e f, 5e f, 9e f,
test 6 fsum**2 f.     \ 133.


real, dimension(1000) :: a = (/ (i, i=1, 1000) /)
real, pointer, dimension(:) :: p => a(2:1)       ! pointer to zero-length array
real :: result, zresult

result = sum(a*a)    ! Multiply array by itself to get squares

result = sum(a**2)   ! Use exponentiation operator to get squares

zresult = sum(p*p)   ! P is zero-length; P*P is valid zero-length array expression; SUM(P*P) == 0.0 as expected


' FB 1.05.0 Win64

Function SumSquares(a() As Double) As Double
  Dim As Integer length = UBound(a) - LBound(a) + 1
  If length = 0 Then Return 0.0
  Dim As Double sum = 0.0
  For i As Integer = LBound(a) To UBound(a)
    sum += a(i) * a(i)
  Next
  Return sum
End Function

Dim a(5) As Double = {1.0, 2.0, 3.0, -1.0, -2.0, -3.0}
Dim sum As Double = SumSquares(a())
Print "The sum of the squares is"; sum
Print
Print "Press any key to quit"
Sleep


f = {|x| x^2}   // Anonymous function which squares its argument
a = [1,2,3,5,7]
println[sum[map[f,a], 0]]


# Just multiplying a vector by itself yields the sum of squares (it's an inner product)
# It's necessary to check for the empty vector though
SumSq := function(v)
	if Size(v) = 0 then
		return 0;
	else
		return v*v;
	fi;
end;


read (n) print ;
0
1, n rep (i)
   read print dup mult +
   ]
print


package main

import "fmt"

var v = []float32{1, 2, .5}

func main() {
    var sum float32
    for _, x := range v {
        sum += x * x
    }
    fmt.Println(sum)
}


{0\{.*+}%}:sqsum;
# usage example
[1 2 3]sqsum puts


def array = 1..3

// square via multiplication
def sumSq = array.collect { it * it }.sum()
println sumSq

// square via exponentiation
sumSq = array.collect { it ** 2 }.sum()

println sumSq


procedure main()
   local lst
   lst := []
   #Construct a simple list and pass it to getsum
   every put(lst,seq()\2)
   write(getsum(lst))
end

procedure getsum(lst)
   local total
   total := 0
   every total +:= !lst ^ 2
   return total
end


Sum Of Squares is a room.

To decide which number is the sum of (N - number) and (M - number) (this is summing):
	decide on N + M.

To decide which number is (N - number) squared (this is squaring):
	decide on N * N.

To decide which number is the sum of squares of (L - list of numbers):
	decide on the summing reduction of squaring applied to L.

When play begins:
	say the sum of squares of {};
	say line break;
	say the sum of squares of {1, 2, 3};
	end the story.


public class SumSquares
{
 public static void main(final String[] args)
 {
  double sum = 0;
  int[] nums = {1,2,3,4,5};
  for (int i : nums)
   sum += i * i;
  System.out.println("The sum of the squares is: " + sum);
 }
}


function sumsq(array) {
  var sum = 0;
  var i, iLen;

  for (i = 0, iLen = array.length; i < iLen; i++) {
    sum += array[i] * array[i];
  }
  return sum;
}

alert(sumsq([1,2,3,4,5]));  // 55


# ss for an input array:
def ss: map(.*.) | add;

# ss for a stream, S, without creating an intermediate array:
def ss(S): reduce S as $x (0; . + ($x * $x) );


  ss: {+/x*x}
  ss 1 2 3 4 5
55
  [email protected]!0
0


import kotlin.random.Random
import kotlin.system.measureTimeMillis
import kotlin.time.milliseconds

enum class Summer {
    MAPPING {
        override fun sum(values: DoubleArray) = values.map {it * it}.sum()
    },
    SEQUENCING {
        override fun sum(values: DoubleArray) = values.asSequence().map {it * it}.sum()
    },
    FOLDING {
        override fun sum(values: DoubleArray) = values.fold(0.0) {acc, it -> acc + it * it}
    },
    FOR_LOOP {
        override fun sum(values: DoubleArray): Double {
            var sum = 0.0
            values.forEach { sum += it * it }
            return sum
        }
    },
    ;
    abstract fun sum(values: DoubleArray): Double
}

fun main() {
    run {
        val testArrays = listOf(
            doubleArrayOf(),
            doubleArrayOf(Random.nextInt(100) / 10.0),
            DoubleArray(6) { Random.nextInt(100) / 10.0 },
        )
        for (impl in Summer.values()) {
            println("Test with ${impl.name}:")
            for (v in testArrays) println("  ${v.contentToString()} -> ${impl.sum(v)}")
        }
    }

    run {
        val elements = 100_000
        val longArray = DoubleArray(elements) { Random.nextDouble(10.0) }

        for (impl in Summer.values()) {
            val time = measureTimeMillis {
                impl.sum(longArray)
            }.milliseconds
            println("Summing $elements with ${impl.name} takes: $time")
        }
        var acc = 0.0
        for (v in longArray) acc += v
    }
}


{def sumsq
 {lambda {:s}
  {+ {S.map {lambda {:i} {* :i :i}} :s}}}}
-> sumsq

{sumsq 1 2 3 4 5}
-> 55
{sumsq 0}
-> 0


define sumofsquares(values::array) => {

	local(sum = 0)

	with value in #values do {
		#sum += #value * #value
	}

	return #sum
}

sumofsquares(array(1,2,3,4,5))


(defun sum-sq (nums)
  (lists:foldl
    (lambda (x acc)
      (+ acc (* x x)))
    0 nums))


'   [RC] Sum of Squares

    SourceList$     ="3 1 4 1 5 9"
    'SourceList$     =""

    '   If saved as an array we'd have to have a flag for last data.
    '   LB has the very useful word$() to read from delimited strings.
    '   The default delimiter is a space character, " ".

    SumOfSquares    =0
    n               =0
    data$           ="666"  '   temporary dummy to enter the loop.

    while data$ <>""                                '   we loop until no data left.
        data$           =word$( SourceList$, n +1)  '   first data, as a string
        NewVal          =val( data$)                '   convert string to number
        SumOfSquares    =SumOfSquares +NewVal^2     '   add to existing sum of squares
        n =n +1                                     '   increment number of data items found
    wend

    n =n -1

    print "Supplied data was ";         SourceList$
    print "This contained ";            n; " numbers."
    print "Sum of squares is ";         SumOfSquares

    end


put "1,2,3,4,5" into nums
repeat for each item n in nums
    add (n * n) to m
end repeat
put m  // 55


print apply "sum map [? * ?] [1 2 3 4 5]  ; 55


sum(List, Sum) :-
    sum(List, 0, Sum).

sum([], Sum, Sum).
sum([X| Xs], Acc, Sum) :-
    Acc2 is Acc + X,
    sum(Xs, Acc2, Sum).


function squaresum(a, ...) return a and a^2 + squaresum(...) or 0 end
function squaresumt(t) return squaresum(unpack(t)) end

print(squaresumt{3, 5, 4, 1, 7})


Dim A() 'make an array with zero items

A=(,) 'make a pointer to array with zero items

A=(1,) 'make a pointer to array with one item

A()=A 'make a copy of array pointed by A to A()

A=A() 'make A a pointer for A()

Dim A(10)=1 'redim A() and pass 1 to each item

k=lambda m=1->{=m:m++}  ' a lambda function with a closure m

Dim B(10)<<k()    'fill B() from 1 to 10

A()=B() ' copy B() to A(), A() object stay as is, but new items loaded, so pointer A points to A.

A+=100 ' add 100 to each element of A()

A(0)+=100 ' add 100 to first element

A()=Cons(A,A)

Now A and A() prints a 20 item array (Cons() add a list of arrays)
Print A   ' or Print A() print the same


function [squaredSum] = sumofsquares(inputVector)
   squaredSum = sum( inputVector.^2 );


:- module sum_of_squares.
:- interface.

:- import_module io.
:- pred main(io::di, io::uo) is det.

:- implementation.
:- import_module int, list.

main(!IO) :-
    io.write_int(sum_of_squares([3, 1, 4, 1, 5, 9]), !IO),
    io.nl(!IO).

:- func sum_of_squares(list(int)) = int.

sum_of_squares(Ns) = list.foldl((func(N, Acc) = Acc + N * N), Ns, 0).


((bool) ((dup *) (+) map-reduce) (pop 0) if) :sq-sum

(1 2 3 4 5) sq-sum puts
() sq-sum puts


sumOfSquares = function(seq)
    sum = 0
    for item in seq
        sum = sum + item*item
    end for
    return sum
end function

print sumOfSquares([4, 8, 15, 16, 23, 42])
print sumOfSquares([1, 2, 3, 4, 5])
print sumOfSquares([])


MODULE SumSquares EXPORTS Main;

IMPORT IO, Fmt;

TYPE RealArray = ARRAY OF REAL;

PROCEDURE SumOfSquares(x: RealArray): REAL =
  VAR sum := 0.0;
  BEGIN
    FOR i := FIRST(x) TO LAST(x) DO
      sum := sum + x[i] * x[i];
    END;
    RETURN sum;
  END SumOfSquares;

BEGIN
  IO.Put(Fmt.Real(SumOfSquares(RealArray{3.0, 1.0, 4.0, 1.0, 5.0, 9.0})));
  IO.Put("\n");
END SumSquares.


@verb #100:sum_squares this none this rd
@program #100:sum_squares
sum = 0;
list = args[1];
for i in (list)
  sum = sum + (i^2);
endfor
player:tell(toliteral(list), " => ", sum);
.

{{out}}
;#100:sum_squares({3,1,4,1,5,9})
{3, 1, 4, 1, 5, 9} => 133
;#100:sum_squares({})
{} => 0


SUMSQUARE(X)
 ;X is assumed to be a list of numbers separated by "^"
 NEW RESULT,I
 SET RESULT=0,I=1
 FOR  QUIT:(I>$LENGTH(X,"^"))  SET RESULT=($PIECE(X,"^",I)*$PIECE(X,"^",I))+RESULT,I=I+1
 QUIT RESULT


def sum_squares(vector)
        if len(vector) = 0
                return 0
        end

        sum = 0
        for n in vector
                sum += n ^ 2
        end
        return sum
end

println sum_squares({})
println sum_squares({1, 2, 3, 4, 5})
println sum_squares({10, 3456, 2, 6})


SS(x : list[double]) : double
{
    |[] => 0.0
    |_  => x.Map(fun (x) {x*x}).FoldLeft(0.0, _+_)
}


/*NetRexx *************************************************************
* program to sum the squares of a vector of fifteen numbers.
* translated from REXX
* 14.05.2013 Walter Pachl
**********************************************************************/
numeric digits 50                   /*allow 50-digit # (default is 9)*/
v='-100 9 8 7 6 0 3 4 5 2 1 .5 10 11 12' /* vector with some #s.     */
n=v.words()
x=''
sum=0                               /*initialize   SUM   to zero.    */
                                    /*if vector is empty, sum = zero.*/
loop Until x=''                     /*loop until list is exhausted   */
  Parse v x v                       /* pick next number              */
  If x>'' Then                      /* there is a number             */
    sum=sum + x**2                  /*add its square to the sum.     */
  end
say "The sum of" n "elements for the V vector is:" sum


import math, sequtils

proc sumSquares[T: SomeNumber](a: openArray[T]): T =
  sum(a.mapIt(it * it))

let a1 = [1, 2, 3, 4, 5]
echo a1, " → ", sumSquares(a1)

let a2: seq[float] = @[]
echo a2, " → ", sumSquares(a2)


bundle Default {
  class Sum {
    function : native : SquaredSum(values : Float[]) ~ Float {
       sum := 0.0;
       for(i := 0 ; i < values->Size()	; i += 1;) {
         sum += (values[i] * values[i]);
       };

       return sum;
    }

    function : Main(args : String[]) ~ Nil {
       SquaredSum([3.0, 1.0, 4.0, 1.0, 5.0, 9.0])->PrintLine();
     }
  }
}


List.fold_left (fun sum a -> sum + a * a) 0 ints


(define (sum-of-squares l)
   (fold + 0 (map * l l)))

(print (sum-of-squares '(1 2 3 4 5 6 7 8 9 10)))
; ==> 385


#include <order/interpreter.h>

ORDER_PP(8to_lit(
  8seq_fold(8plus, 0,
            8seq_map(8fn(8X, 8times(8X, 8X)), 8seq(3, 1, 4, 1, 5, 9)))
))


declare
  fun {SumOfSquares Xs}
     for X in Xs sum:S do
        {S X*X}
     end
  end
in
  {Show {SumOfSquares [3 1 4 1 5 9]}}


Program Example45;

{ Program to demonstrate the SumOfSquares function. }

Uses math;

Var
  I : 1..100;
  ExArray : Array[1..100] of Float;

begin
  Randomize;
  for I:=low(ExArray) to high(ExArray) do
    ExArray[i]:=(Random-Random)*100;
  Writeln('Max             : ',MaxValue(ExArray):8:4);
  Writeln('Min             : ',MinValue(ExArray):8:4);
  Writeln('Sum squares     : ',SumOfSquares(ExArray):8:4);
  Writeln('Sum squares (b) : ',SumOfSquares(@ExArray[1],100):8:4);
end.


sub sum_of_squares {
  my $sum = 0;
  $sum += $_**2 foreach @_;
  return $sum;
}

print sum_of_squares(3, 1, 4, 1, 5, 9), "\n";


function sum_of_squares(sequence s) return sum(sq_power(s,2)) end function
?apply({{},{3,1,4,1,5,9},tagset(10)},sum_of_squares)


0 tolist
10 for 0 put endfor

0 swap len for
	get
	2 power rot + swap
endfor

drop print	/# 385 #/


function sum_squares(array $args) {
    return array_reduce(
        $args, create_function('$x, $y', 'return $x+$y*$y;'), 0
    );
}


go =>
  List = 1..666,
  println(sum_squares(List)),
  println(sum_squares([])),
  nl.

sum_squares([]) = 0.
sum_squares(List) = sum([I*I : I in List]).


To run:
Start up.
Create a list.
Sum the squares of the list giving a ratio.
Destroy the list.
Write "Sum of squares: " then the ratio on the console.
Wait for the escape key.
Shut down.

An element is a thing with a ratio.

A list is some elements.

To add a ratio to a list:
Allocate memory for an element.
Put the ratio into the element's ratio.
Append the element to the list.

To create a list:
Add 3-1/10 to the list.
Add 1/1 to the list.
Add 4/1 to the list.
Add 1/1 to the list.
Add 5/1 to the list.
Add 9/1 to the list.

To sum the squares of a list giving a ratio:
Put 0 into the ratio.
Get an element from the list.
Loop.
If the element is nil, exit.
Add the element's ratio times the element's ratio to the ratio.
Put the element's next into the element.
Repeat.


define sum_squares(v);
    lvars s = 0, j;
    for j from 1 to length(v) do
        s + v(j)*v(j) -> s;
    endfor;
    s;
enddefine;

sum_squares({1 2 3 4 5}) =>


/sqrsum{
/x exch def
/sum 0 def
/i 0 def
x length 0 eq
{}
{
x length{
/sum sum x i get 2 exp add def
/i i 1 add def
}repeat
}ifelse
sum ==
}def


function Get-SquareSum ($a) {
    if ($a.Length -eq 0) {
        return 0
    } else {
        $x = $a `
             | ForEach-Object { $_ * $_ } `
             | Measure-Object -Sum
        return $x.Sum
    }
}


Procedure SumOfSquares(List base())
  ForEach base()
    Sum + base()*base()
  Next
  ProcedureReturn Sum
EndProcedure


[ 0 swap witheach [ 2 ** + ] ] is sumofsquares ( [ --> n )


define sumOfSqrs use $lst
   0 $lst each dup * +

[ 1 2 3 4] sumOfSqrs "Sum of squares: %d\n" print


Red [
    date: 2021-10-25
    red-version: 0.6.4
    description: "Find the sum of squares of a numeric vector"
]

sum-squares: function [
    "Returns the sum of squares of all values in a block"
    values [any-list! vector!]
][
    result: 0
    foreach value values [result: value * value + result]
    result
]

print sum-squares []
print sum-squares [1 2 0.5]


let sumOfSquares = (acc, item) => { acc + item * item }

Js.log(Js.Array2.reduce([10, 2, 4], sumOfSquares, 0))


/*REXX program  sums  the squares of the numbers  in a (numeric)  vector of 15 numbers. */
numeric digits 100                               /*allow 100─digit numbers; default is 9*/
v= -100 9 8 7 6 0 3 4 5 2 1 .5 10 11 12          /*define a vector with fifteen numbers.*/
#=words(v)                                       /*obtain number of words in the V list.*/
$= 0                                             /*initialize the  sum  ($)  to zero.   */
       do k=1  for #                             /*process each number in the V vector. */
       $=$ + word(v,k)**2                        /*add a squared element to the ($) sum.*/
       end   /*k*/                               /* [↑]  if vector is empty, then sum=0.*/
                                                 /*stick a fork in it,  we're all done. */
say 'The sum of '      #      " squared elements for the  V  vector is: "   $


aList = [1,2,3,4,5]
see sumOfSquares(aList)

func sumOfSquares sos
sumOfSquares = 0
for i=1 to len(sos)
    sumOfSquares = sumOfSquares + pow(sos[i],2)
next
return sumOfSquares


list$ = "1,2,3,4,5"
print sumOfSquares(list$)

FUNCTION sumOfSquares(sos$)
  while word$(sos$,i+1,",") <> ""
    i = i + 1
    sumOfSquares = sumOfSquares + val(word$(sos$,i,","))^2
  wend
END FUNCTION


class MAIN is

  sqsum(s, e:FLT):FLT is
    return s + e*e;
  end;

  sum_of_squares(v :ARRAY{FLT}):FLT is
    return (#ARRAY{FLT}(|0.0|).append(v)).reduce(bind(sqsum(_,_)));
  end;

  main is
    v :ARRAY{FLT} := |3.0, 1.0, 4.0, 1.0, 5.0, 9.0|;
    #OUT + sum_of_squares(v) + "\n";
  end;

end;


def sum_of_squares(xs: Seq[Double]) = xs.foldLeft(0) {(a,x) => a + x*x}


(define (sum-of-squares l)
  (apply + (map * l l)))


$ include "seed7_05.s7i";
  include "float.s7i";

const array float: list1 is [] (3.0, 1.0, 4.0, 1.0, 5.0, 9.0);
const array float: list2 is 0 times 0.0;

const func float: squaredSum (in array float: floatList) is func
  result
    var float: sum is 0.0;
  local
    var float: number is 0.0;
  begin
    for number range floatList do
      sum +:= number ** 2;
    end for;
  end func;

const proc: main is func
  begin
    writeln(squaredSum(list1));
    writeln(squaredSum(list2));
  end func;


func sum_of_squares(vector) {
    var sum = 0;
    vector.each { |n| sum += n**2 };
    return sum;
}

say sum_of_squares([]);         # 0
say sum_of_squares([1,2,3]);    # 14


{1. 2. 3} reduce: [|:x :y| y squared + x].
{} reduce: [|:x :y| y squared + x] ifEmpty: [0].


#(3 1 4 1 5 9) inject: 0 into: [:sum :aNumber | sum + aNumber squared]


        define('ssq(a)i') :(ssq_end)
ssq     i = i + 1; ssq = ssq + (a<i> * a<i>) :s(sumsq)f(return)
ssq_end

*       # Fill array, test and display
        str = '1 2 3 5 7 11 13 17 19 23'; a = array(10)
loop    i = i + 1; str len(p) span('0123456789') . a<i> @p :s(loop)
        output = str ' -> ' sumsq(a)
end


foldl (fn (a, sum) => sum + a * a) 0 ints


func sumSq(s: [Int]) -> Int {
  return s.map{$0 * $0}.reduce(0, +)
}


templates ssq
  when <[](0)> do 0 !
  otherwise $... -> $*$ -> ..=Sum&{of: :()} !
end ssq

[] -> ssq -> !OUT::write // outputs 0
[1..5] -> ssq -> !OUT::write // outputs 55


package require Tcl 8.6
namespace path ::tcl::mathop

# {*} is like apply in Scheme--it turns a list into multiple arguments
proc sum_of_squares lst {
    + {*}[lmap x $lst {* $x $x}]
}
puts [sum_of_squares {1 2 3 4}]; # ==> 30
puts [sum_of_squares {}];        # ==> 0


$$ MODE TUSCRIPT
array="3'1'4'1'5'9",sum=0
LOOP a=array
sum=sum+(a*a)
ENDLOOP
PRINT sum


folder() {
   (read B; res=$( expr $1 \* $1 ) ; test -n "$B" && expr $res + $B || echo $res)
}

fold() {
   (while read a ; do
       fold | folder $a
   done)
}

(echo 3; echo 1; echo 4;echo 1;echo 5; echo 9) | fold


$ cat toto
1
2
4
8
16
$ cat toto toto | paste -sd*
1*2*4*8*16*1*2*4*8*16
$ cat toto toto | paste -sd* | bc -l
1048576


[sumsq [dup *] map 0 [+] fold].

[] sumsq
=0
[1 2 3] sumsq


Public Sub sum_of_squares()
    Debug.Print WorksheetFunction.SumSq([{1,2,3,4,5,6,7,8,9,10}])
End Sub


Function sum_of_squares(arr)
	If UBound(arr) = -1 Then
		sum_of_squares = 0
	End If
	For i = 0 To UBound(arr)
		sum_of_squares = sum_of_squares + (arr(i)^2)
	Next
End Function

WScript.StdOut.WriteLine sum_of_squares(Array(1,2,3,4,5))
WScript.StdOut.WriteLine sum_of_squares(Array())


 Private Shared Function sumsq(ByVal i As ICollection(Of Integer)) As Integer
        If i Is Nothing OrElse i.Count = 0 Then
            Return 0
        End If
        Return i.[Select](Function(x) x * x).Sum()
 End Function

 Private Shared Sub Main()
        Dim a As Integer() = New Integer() {1, 2, 3, 4, 5}
        ' 55
        Console.WriteLine(sumsq(a))

        For K As Integer = 0 To 16
               Console.WriteLine("SumOfSquares({0}) = {1}", K, SumOfSquares(K))
        Next
 End Sub
 Function SumOfSquares(ByVal Max As Integer)
        Dim Square As Integer = 0
        Dim Add As Integer = 1
        Dim Sum As Integer = 0
        For J As Integer = 0 To Max - 1
            Square += Add
            Add += 2
            Sum += Square
        Next
        Return Sum
 End Function

 Function SumOfSquaresByMult(ByVal Max As Integer)
        Dim Sum As Integer = 0
        For J As Integer = 1 To Max
            Sum += J * J
        Next
        Return Sum
 End Function


var sumSquares = Fn.new { |v| v.reduce(0) { |sum, n| sum + n * n } }

var v = [1, 2, 3, -1, -2, -3]
System.print("Vector         : %(v)")
System.print("Sum of squares : %(sumSquares.call(v))")


(defun sum-of-squares (vec)
    (defun sumsq (xs)
        (if (null xs)
            0
            (+ (expt (car xs) 2) (sumsq (cdr xs)))))
    (sumsq (vector->list vec)))

(define first-seven-primes #(2 3 5 7 11 13 17))

(define zero-length-vector #())

(print `(the sum of the squares of the first seven prime numbers is ,(sum-of-squares first-seven-primes)))

(print `(the sum of the squares of no numbers at all is ,(sum-of-squares zero-length-vector)))


include c:\cxpl\codes;  \intrinsic 'code' declarations

func SumSq(V, L);
int  V, L;
int  S, I;
[S:= 0;
for I:= 0 to L-1 do S:= S+sq(V(I));
return S;
]; \SumSq

[IntOut(0, SumSq([1,2,3,4,5,6,7,8,9,10], 10));  CrLf(0);
 IntOut(0, SumSq([0], 0));  CrLf(0);    \zero-length vector "[]" doesn't compile
]


-V
   NUMBER_OF_DIGITS = 9
   THREE_POW_4 = 3 * 3 * 3 * 3
   NUMBER_OF_EXPRESSIONS = 2 * THREE_POW_4 * THREE_POW_4

T.enum Op
   ADD
   SUB
   JOIN

T Expression
   code = [Op.ADD] * :NUMBER_OF_DIGITS

   F inc()
      L(i) 0 .< .code.len
         .code[i] = Op((Int(.code[i]) + 1) % 3)
         I .code[i] != ADD
            L.break

   F toInt()
      V value = 0
      V number = 0
      V sign = 1
      L(digit) 1..9
         V c = .code[:NUMBER_OF_DIGITS - digit]
         I   c == ADD {value += sign * number; number = digit; sign =  1}
         E I c == SUB {value += sign * number; number = digit; sign = -1}
         E            {number = 10 * number + digit}
      R value + sign * number

   F String()
      V s = ‘’
      L(digit) 1 .. :NUMBER_OF_DIGITS
         V c = .code[:NUMBER_OF_DIGITS - digit]
         I c == ADD
            I digit > 1
               s ‘’= ‘ + ’
         E I c == SUB
            s ‘’= ‘ - ’
         s ‘’= String(digit)
      R s.ltrim(‘ ’)

F printe(givenSum)
   V expression = Expression()
   L 0 .< :NUMBER_OF_EXPRESSIONS
      I expression.toInt() == givenSum
         print(‘#9’.format(givenSum)‘ = ’expression)
      expression.inc()

T Stat
   DefaultDict[Int, Int] countSum
   DefaultDict[Int, Set[Int]] sumCount
   F ()
      V expression = Expression()
      L 0 .< :NUMBER_OF_EXPRESSIONS
         V sum = expression.toInt()
         .countSum[sum]++
         expression.inc()
      L(k, v) .countSum
         .sumCount[v].add(k)

print("100 has the following solutions:\n")
printe(100)

V stat = Stat()
V maxCount = max(stat.sumCount.keys())
V maxSum = max(stat.sumCount[maxCount])
print("\n#. has the maximum number of solutions, namely #.".format(maxSum, maxCount))

V value = 0
L value C stat.countSum
   value++
print("\n#. is the lowest positive number with no solutions".format(value))

print("\nThe ten highest numbers that do have solutions are:\n")
L(i) sorted(stat.countSum.keys(), reverse' 1B)[0.<10]
   printe(i)


package Sum_To is

   generic
      with procedure Callback(Str: String; Int: Integer);
   procedure Eval;

   generic
      Number: Integer;
      with function Print_If(Sum, Number: Integer) return Boolean;
   procedure Print(S: String; Sum: Integer);

end Sum_To;