$define MinLength 5

procedure get_analysis(seq)

   if *seq < MinLength then return simageb(seq)

   return (
      get_scollate(seq) |
      get_srepeat(seq) |
      remod(seq, get_srun) |
      remod(seq, get_sruns) |
      get_splace(seq) |
      simageb(seq)
      )

end

procedure remod(seq, p)
   local nseq, bound

   nseq := sunmod(seq)

   if (sbound ! nseq) > (bound := sbound ! seq) then
      return "smod(" || p(nseq) || ", " || bound || ")"
   else return p(copy(seq))

end

procedure get_srepeat(seq)
   local i

   i := speriod(seq) | fail
   return "srepeat(" || get_analysis(seq[1+:i]) ||
      ", " || (*seq / i) || ")"

end

procedure speriod(seq)
   local i, segment

   every i := 1 | divisors(*seq) do {
      segment := seq[1+:i]
      if sequiv(sextend(segment, *seq), seq) then
         return i
      }

   fail

end

procedure get_splace(seq)
   local i, j, motif, seq2, path

   every i := divisors(*seq) do {
      motif := seq[1+:i]
      every j := i + 1 to *seq by i do
         if not sequiv(motif, sground(seq[j+:i], seq[1]))
            then break next
      path := []
      every put(path, seq[1 to *seq by i])
      return "splace(" || get_analysis(motif) ||
         ", " || get_analysis(path) || ")"
      }

   fail

end

procedure sground(seq, i)
   local j

   j := smin ! seq

   every !seq -:= (j - i)

   return seq

end

procedure get_srun(seq)	# connected runs
   local i, j, new_seq, dir

   seq := copy(seq)

   i := get(seq)
   j := get(seq)

   if j = i - 1 then dir := -1	# down going
   else if j = i + 1 then dir := 1	# up going
   else fail

   new_seq := [i]

   while i := get(seq) do {
      if i = j + 1 then {
         if dir = -1 then put(new_seq, j)
         dir := 1
         }
      else if i =  j - 1 then {
         if dir = 1 then put(new_seq, j)
         dir := -1
         }
      else {
         put(new_seq, j)
         push(seq, i)		# put back
         break
         }
      j := i
      }

   if *seq ~= 0 then fail		# remaining terms?

   put(new_seq, j)

   return "srun(" || get_analysis(new_seq) || ")"

end

procedure get_sruns(seq)	# disconnected runs
   local i, j, seq1, seq2, dir

   seq1 := []
   seq2 := []

   repeat {
      i := get(seq) | {
         put(seq2, j)
         break			# end of road
         }
      j := get(seq) | fail		# isolated end point
      if j = i - 1 then dir := -1	# down going
      else if j = i + 1 then dir := 1	# up going
      else fail
      put(seq1, i)		# beginning point
      while i := get(seq) do {
         if i = j + dir then {
            j := i
            next
            }
         else {
            push(seq, i)		# put back
            put(seq2, j)
            break
            }
         }
      }

   return "sruns(" || get_analysis(seq1) || ", " ||
      get_analysis(seq2) || ")"

end

procedure get_scollate(seq)
   local bound, deltas, i, j, poses, positions, oper
   local results, result, k, count, oseq, m, nonperiod
   local seqs, facts, period

   speriod(seq) | fail	# only do periodic case

   bound := (sbound ! seq)

   deltas := table()
   positions := table()

   every  i := 1 to bound do {
      poses := spositions(seq, i)
      positions[i] := poses
      j := sconstant(sdelta(poses))
      /deltas[j] := []
      put(deltas[j], i) 
      }

   if *deltas < 2 then fail

   oseq := list(*deltas)		# decollation order

   count := 0

   every k := key(deltas) do {
      count +:= 1
      every j := !deltas[k] do
         every m := !positions[j] do
            oseq[m] := count
      }

   seqs := sdecollate(oseq, seq) | fail

   oper := "scollate(" ||
      (simageb(oseq[1+:speriod(oseq)]) |
         get_analysis(oseq))

   every oper ||:= ", " || get_analysis(!seqs)

   return oper || ")"

end

procedure spositions(seq, i)
   local lseq, count

   seq := copy(seq)

   lseq := []

   count := 0

   while i := get(seq) do {
      count +:= 1
      if member(seq, i) then
         put(lseq, count)
      }

   return lseq

end

procedure sdecollate(order, seq)
   local lseq, i, j

   order := copy(order)

   lseq := list(sbound ! order)	# sequences to return

   every !lseq := []		# all initially empty

   every j := !seq do {
      i := get(order)
      put(order, i)
      put(lseq[i], j)
      }

   return lseq

end

procedure concat_image(seq)

   if *seq = 1 then return seq[1]

   return "sconcat(" || simage(seq) || ")"

end