import java.util.ArrayList;
import java.util.List;

public class ResistorMesh {
    private static final int S = 10;

    private static class Node {
        double v;
        int fixed;

        Node(double v, int fixed) {
            this.v = v;
            this.fixed = fixed;
        }
    }

    private static void setBoundary(List<List<Node>> m) {
        m.get(1).get(1).v = 1.0;
        m.get(1).get(1).fixed = 1;

        m.get(6).get(7).v = -1.0;
        m.get(6).get(7).fixed = -1;
    }

    private static double calcDiff(List<List<Node>> m, List<List<Node>> d, int w, int h) {
        double total = 0.0;
        for (int i = 0; i < h; ++i) {
            for (int j = 0; j < w; ++j) {
                double v = 0.0;
                int n = 0;
                if (i > 0) {
                    v += m.get(i - 1).get(j).v;
                    n++;
                }
                if (j > 0) {
                    v += m.get(i).get(j - 1).v;
                    n++;
                }
                if (i + 1 < h) {
                    v += m.get(i + 1).get(j).v;
                    n++;
                }
                if (j + 1 < w) {
                    v += m.get(i).get(j + 1).v;
                    n++;
                }
                v = m.get(i).get(j).v - v / n;
                d.get(i).get(j).v = v;
                if (m.get(i).get(j).fixed == 0) {
                    total += v * v;
                }
            }
        }
        return total;
    }

    private static double iter(List<List<Node>> m, int w, int h) {
        List<List<Node>> d = new ArrayList<>(h);
        for (int i = 0; i < h; ++i) {
            List<Node> t = new ArrayList<>(w);
            for (int j = 0; j < w; ++j) {
                t.add(new Node(0.0, 0));
            }
            d.add(t);
        }

        double[] cur = new double[3];
        double diff = 1e10;

        while (diff > 1e-24) {
            setBoundary(m);
            diff = calcDiff(m, d, w, h);
            for (int i = 0; i < h; ++i) {
                for (int j = 0; j < w; ++j) {
                    m.get(i).get(j).v -= d.get(i).get(j).v;
                }
            }
        }

        for (int i = 0; i < h; ++i) {
            for (int j = 0; j < w; ++j) {
                int k = 0;
                if (i != 0) k++;
                if (j != 0) k++;
                if (i < h - 1) k++;
                if (j < w - 1) k++;
                cur[m.get(i).get(j).fixed + 1] += d.get(i).get(j).v * k;
            }
        }

        return (cur[2] - cur[0]) / 2.0;
    }

    public static void main(String[] args) {
        List<List<Node>> mesh = new ArrayList<>(S);
        for (int i = 0; i < S; ++i) {
            List<Node> t = new ArrayList<>(S);
            for (int j = 0; j < S; ++j) {
                t.add(new Node(0.0, 0));
            }
            mesh.add(t);
        }

        double r = 2.0 / iter(mesh, S, S);
        System.out.printf("R = %.15f", r);
    }
}


// version 1.1.4-3

typealias List2D<T> = List<List<T>>

const val S = 10

class Node(var v: Double, var fixed: Int)

fun setBoundary(m: List2D<Node>) {
    m[1][1].v =  1.0; m[1][1].fixed =  1
    m[6][7].v = -1.0; m[6][7].fixed = -1
}

fun calcDiff(m: List2D<Node>, d: List2D<Node>, w: Int, h: Int): Double {
    var total = 0.0
    for (i in 0 until h) {
        for (j in 0 until w) {
            var v = 0.0
            var n = 0
            if (i > 0) { v += m[i - 1][j].v; n++ }
            if (j > 0) { v += m[i][j - 1].v; n++ }
            if (i + 1 < h) { v += m[i + 1][j].v; n++ }
            if (j + 1 < w) { v += m[i][j + 1].v; n++ }
            v = m[i][j].v - v / n
            d[i][j].v = v
            if (m[i][j].fixed == 0) total += v * v
        }
    }
    return total
}

fun iter(m: List2D<Node>, w: Int, h: Int): Double {
    val d = List(h) { List(w) { Node(0.0, 0) } }
    val cur = DoubleArray(3)
    var diff = 1e10

    while (diff > 1e-24) {
        setBoundary(m)
        diff = calcDiff(m, d, w, h)
        for (i in 0 until h) {
            for (j in 0 until w) m[i][j].v -= d[i][j].v
        }
    }

    for (i in 0 until h) {
        for (j in 0 until w) {
            var k = 0
            if (i != 0) k++
            if (j != 0) k++
            if (i < h - 1) k++
            if (j < w - 1) k++
            cur[m[i][j].fixed + 1] += d[i][j].v * k
        }
    }
    return (cur[2] - cur[0]) / 2.0
}

fun main(args: Array<String>) {
    val mesh = List(S) { List(S) { Node(0.0, 0) } }
    val r = 2.0 / iter(mesh, S, S)
    println("R = $r")
}


ResistanceMatrix[g_Graph] := With[{n = VertexCount[g], km = KirchhoffMatrix[g]},
  Table[ ReplacePart[ Diagonal[ DrazinInverse[ ReplacePart[km, k -> UnitVector[n, k]]]], k -> 0],
  {k, n}]
]

rm = ResistanceMatrix[GridGraph[{10, 10}]];

N[rm[[12, 68]], 40]


/* Place a current souce between A and B, providing 1 A. Then we are really looking
   for the potential at A and B, since I = R (V(B) - V(A)) where I is given and we want R.

   Atually, we will compute potential at each node, except A where we assume it's 0.
   Without this assumption, there would be infinitely many solutions since potential
   is known up to a constant. For A we will simply write the equation V(A) = 0, to
   keep the program simple.

   Hence, for a general grid of p rows and q columns, there are n = p * q nodes,
   so n unknowns, and n equations. Write Kirchhoff's current law at each node.
   Be careful with the node A (equation A = 0) and the node B (there is a constant
   current to add, from the source, that will go in the constant terms of the system).

   Finally, we have a n x n linear system of equations to solve. Simply use Maxima's
   builtin LU decomposition.

   Since all computations are exact, the result will be also exact, written as a fraction.
   Also, the program can work with any grid, and any two nodes on the grid.

   For those who want more speed and less space, notice the system is sparse and necessarily
   symmetric, so one can use conjugate gradient or any other sparse symmetric solver. */

/* Auxiliary function to get rid of the borders */
ongrid(i, j, p, q) := is(i >= 1 and i <= p and j >= 1 and j <= q)$

grid_resistor(p, q, ai, aj, bi, bj) := block(
   [n: p * q, A, B, M, k, c, V],
   A: zeromatrix(n, n),
   for i thru p do
      for j thru q do (
         k: (i - 1) * q + j,
         if i = ai and j = aj then
            A[k, k]: 1
         else (
            c: 0,
            if ongrid(i + 1, j, p, q) then (c: c + 1, A[k, k + q]: -1),
            if ongrid(i - 1, j, p, q) then (c: c + 1, A[k, k - q]: -1),
            if ongrid(i, j + 1, p, q) then (c: c + 1, A[k, k + 1]: -1),
            if ongrid(i, j - 1, p, q) then (c: c + 1, A[k, k - 1]: -1),
            A[k, k]: c
         )
      ),
   B: zeromatrix(n, 1),
   B[k: (bi - 1) * q + bj, 1]: 1,
   M: lu_factor(A),
   V: lu_backsub(M, B),
   V[k, 1]
)$

grid_resistor(10, 10, 2, 2, 8, 7);
455859137025721 / 283319837425200

bfloat(%), fpprec = 40;
1.608991241730729655954495520510088761201b0

/* Some larger example */
grid_resistor(20, 20, 1, 1, 20, 20);
129548954101732562831760781545158173626645023 / 33283688571680493510612137844679320717594861

bfloat(%), fpprec = 40;
3.89226554090400912102670691601064387507b0


MODULE ResistorMesh;
FROM RConversions IMPORT RealToStringFixed;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;

CONST S = 10;

TYPE Node = RECORD
    v : LONGREAL;
    fixed : INTEGER;
END;

PROCEDURE SetBoundary(VAR m : ARRAY OF ARRAY OF Node);
BEGIN
    m[1][1].v := 1.0;
    m[1][1].fixed := 1;

    m[6][7].v := -1.0;
    m[6][7].fixed := -1;
END SetBoundary;

PROCEDURE CalcDiff(VAR m,d : ARRAY OF ARRAY OF Node) : LONGREAL;
VAR
    total,v : LONGREAL;
    i,j,n : INTEGER;
BEGIN
    total := 0.0;
    FOR i:=0 TO S DO
        FOR j:=0 TO S DO
            v := 0.0;
            n := 0;
            IF i>0 THEN
                v := v + m[i-1][j].v;
                INC(n);
            END;
            IF j>0 THEN
                v := v + m[i][j-1].v;
                INC(n);
            END;
            IF i+1<S THEN
                v := v + m[i+1][j].v;
                INC(n);
            END;
            IF j+1<S THEN
                v := v + m[i][j+1].v;
                INC(n);
            END;
            v := m[i][j].v - v / LFLOAT(n);
            d[i][j].v := v;
            IF m[i][j].fixed=0 THEN
                total := total + v*v;
            END;
        END;
    END;
    RETURN total;
END CalcDiff;

PROCEDURE Iter(m : ARRAY OF ARRAY OF Node) : LONGREAL;
VAR
    d : ARRAY[0..S] OF ARRAY[0..S] OF Node;
    i,j,k : INTEGER;
    cur : ARRAY[0..2] OF LONGREAL;
    diff : LONGREAL;
BEGIN
    FOR i:=0 TO S DO
        FOR j:=0 TO S DO
            d[i][j] := Node{0.0,0};
        END;
    END;

    diff := 1.0E10;
    WHILE diff>1.0E-24 DO
        SetBoundary(m);
        diff := CalcDiff(m,d);
        FOR i:=0 TO S DO
            FOR j:=0 TO S DO
                m[i][j].v := m[i][j].v - d[i][j].v;
            END;
        END;
    END;

    FOR i:=0 TO S DO
        FOR j:=0 TO S DO
            k:=0;
            IF i#0 THEN INC(k) END;
            IF j#0 THEN INC(k) END;
            IF i<S-1 THEN INC(k) END;
            IF j<S-1 THEN INC(k) END;
            cur[m[i][j].fixed+1] := cur[m[i][j].fixed+1] + d[i][j].v*LFLOAT(k);
        END;
    END;

    RETURN (cur[2]-cur[0]) / 2.0;
END Iter;

VAR
    mesh : ARRAY[0..S] OF ARRAY[0..S] OF Node;
    buf : ARRAY[0..32] OF CHAR;
    r : LONGREAL;
    pos : CARDINAL;
    ok : BOOLEAN;
BEGIN
    pos := 0;
    r := 2.0 / Iter(mesh);
    WriteString("R = ");
    RealToStringFixed(r, 15,0, buf, pos, ok);
    WriteString(buf);
    WriteString(" ohms");
    WriteLn;

    ReadChar;
END ResistorMesh.


const S = 10

type

  NodeKind = enum nodeFree, nodeA, nodeB

  Node = object
    v: float
    fixed: NodeKind

  Mesh[H, W: static int] = array[H, array[W, Node]]

func setBoundary(m: var Mesh) =
  m[1][1].v =  1.0
  m[1][1].fixed = nodeA
  m[6][7].v = -1.0
  m[6][7].fixed = nodeB

func calcDiff[H, W: static int](m,: Mesh[H, W]; d: var Mesh[H, W]): float =
  for i in 0..<H:
    for j in 0..<W:
      var v = 0.0
      var n = 0
      if i > 0:
        v += m[i - 1][j].v
        inc n
      if j > 0:
        v += m[i][j - 1].v
        inc n
      if i + 1 < m.H:
        v += m[i + 1][j].v
        inc n
      if j + 1 < m.W:
        v += m[i][j + 1].v
        inc n
      v = m[i][j].v - v / n.toFloat
      d[i][j].v = v
      if m[i][j].fixed == nodeFree:
        result += v * v

func iter[H, W: static int](m: var Mesh[H, W]): float =
  var
    d: Mesh[H, W]
    cur: array[NodeKind, float]
    diff = 1e10

  while diff > 1e-24:
    m.setBoundary()
    diff = calcDiff(m, d)
    for i in 0..<H:
      for j in 0..<W:
        m[i][j].v -= d[i][j].v

  for i in 0..<H:
    for j in 0..<W:
      var k = 0
      if i != 0: inc k
      if j != 0: inc k
      if i < m.H - 1: inc k
      if j < m.W - 1: inc k
      cur[m[i][j].fixed] += d[i][j].v * k.toFloat

  result = (cur[nodeA] - cur[nodeB]) / 2

when isMainModule:

  var mesh: Mesh[S, S]
  let r = 2 / mesh.iter()
  echo "R = ", r


N = 10;
NN = N*N;
G = sparse(NN, NN);

node = 0;
for row=1:N;
    for col=1:N;
	node++;
	if row > 1
	    G(node, node)++;
	    G(node, node - N) = -1;
	end
	if row < N;
	    G(node, node)++;
	    G(node, node + N) = -1;
	end
	if col > 1
	    G(node, node)++;
	    G(node, node - 1) = -1;
	end
	if col < N;
	    G(node, node)++;
	    G(node, node + 1) = -1;
	end
    end
end

current = sparse(NN, 1);

Ar = 2; Ac = 2; A = Ac + N*( Ar - 1 );
Br = 7; Bc = 8; B = Bc + N*( Br - 1 );
current( A ) = -1;
current( B ) = +1;

voltage = G \ current;

VA = voltage( A );
VB = voltage( B );

full( abs( VA - VB ) )


function resistormesh(integer ni, nj, ai, aj, bi, bj)
    integer n = ni*nj, k, c
    sequence A = repeat(repeat(0,n),n),
             B = repeat({0},n)
    for i=1 to ni do
        for j=1 to nj do
            k = (i-1)*nj + j--1
            if i=ai and j=aj then
                A[k,k] = 1
            else
                c = 0
                if i<ni then c += 1; A[k,k+nj] = -1 end if
                if i>1 then  c += 1; A[k,k-nj] = -1 end if
                if j<nj then c += 1; A[k,k+1] = -1 end if
                if j>1 then  c += 1; A[k,k-1] = -1 end if
                A[k,k] = c
            end if
        end for
    end for
    k = (bi-1)*nj +bj
    B[k,1] = 1
    A = inverse(A)
    B = matrix_mul(A,B)
    return B[k,1]
end function

printf(1,"Resistance = %.13f ohms\n",resistormesh(10, 10, 2, 2, 8, 7))


DIFF_THRESHOLD = 1e-40

class Fixed:
    FREE = 0
    A = 1
    B = 2

class Node:
    __slots__ = ["voltage", "fixed"]
    def __init__(self, v=0.0, f=Fixed.FREE):
        self.voltage = v
        self.fixed = f

def set_boundary(m):
    m[1][1] = Node( 1.0, Fixed.A)
    m[6][7] = Node(-1.0, Fixed.B)

def calc_difference(m, d):
    h = len(m)
    w = len(m[0])
    total = 0.0

    for i in xrange(h):
        for j in xrange(w):
            v = 0.0
            n = 0
            if i != 0:  v += m[i-1][j].voltage; n += 1
            if j != 0:  v += m[i][j-1].voltage; n += 1
            if i < h-1: v += m[i+1][j].voltage; n += 1
            if j < w-1: v += m[i][j+1].voltage; n += 1
            v = m[i][j].voltage - v / n

            d[i][j].voltage = v
            if m[i][j].fixed == Fixed.FREE:
                total += v ** 2
    return total

def iter(m):
    h = len(m)
    w = len(m[0])
    difference = [[Node() for j in xrange(w)] for i in xrange(h)]

    while True:
        set_boundary(m) # Enforce boundary conditions.
        if calc_difference(m, difference) < DIFF_THRESHOLD:
            break
        for i, di in enumerate(difference):
            for j, dij in enumerate(di):
                m[i][j].voltage -= dij.voltage

    cur = [0.0] * 3
    for i, di in enumerate(difference):
        for j, dij in enumerate(di):
            cur[m[i][j].fixed] += (dij.voltage *
                (bool(i) + bool(j) + (i < h-1) + (j < w-1)))

    return (cur[Fixed.A] - cur[Fixed.B]) / 2.0

def main():
    w = h = 10
    mesh = [[Node() for j in xrange(w)] for i in xrange(h)]
    print "R = %.16f" % (2 / iter(mesh))

main()


#lang racket
(require racket/flonum)

(define-syntax-rule (fi c t f) (if c f t))

(define (neighbours w h)
  (define h-1 (sub1 h))
  (define w-1 (sub1 w))
  (lambda (i j)
    (+ (fi (zero? i) 1 0)
       (fi (zero? j) 1 0)
       (if (< i h-1) 1 0)
       (if (< j w-1) 1 0))))

(define (mesh-R probes w h)
  (define h-1 (sub1 h))
  (define w-1 (sub1 w))

  (define-syntax-rule (v2ref v r c) ; 2D vector ref
    (flvector-ref v (+ (* r w) c)))

  (define w*h (* w h))

  (define (alloc2 (v 0.))
    (make-flvector w*h v))

  (define nghbrs (neighbours w h))

  (match-define `((,fix+r ,fix+c) (,fix-r ,fix-c)) probes)
  (define fix+idx (+ fix+c (* fix+r w)))
  (define fix-idx (+ fix-c (* fix-r w)))
  (define fix-val
    (match-lambda**
     [((== fix+idx) _) 1.]
     [((== fix-idx) _) -1.]
     [(_ v) v]))

  (define (calc-diff m)
    (define d
      (for*/flvector #:length w*h ((i (in-range h)) (j (in-range w)))
        (define v
          (+ (fi (zero? i) (v2ref m (- i 1) j) 0)
             (fi (zero? j) (v2ref m i (- j 1)) 0)
             (if (< i h-1) (v2ref m (+ i 1) j) 0)
             (if (< j w-1) (v2ref m i (+ j 1)) 0)))
        (- (v2ref m i j) (/ v (nghbrs i j)))))

    (define Δ
      (for/sum ((i (in-naturals)) (d.v (in-flvector d)) #:when (= (fix-val i 0.) 0.))
        (sqr d.v)))

    (values d Δ))

  (define final-d
    (let loop ((m (alloc2)) (d (alloc2)))
      (define m+ ; do this first will get the boundaries on
        (for/flvector #:length w*h ((j (in-naturals)) (m.v (in-flvector m)) (d.v (in-flvector d)))
          (fix-val j (- m.v d.v))))

      (define-values (d- Δ) (calc-diff m+))

      (if (< Δ 1e-24) d (loop m+ d-))))

  (/ 2
     (/ (- (* (v2ref final-d fix+r fix+c) (nghbrs fix+r fix+c))
           (* (v2ref final-d fix-r fix-c) (nghbrs fix-r fix-c)))
        2)))

(module+ main
  (printf "R = ~a~%" (mesh-R '((1 1) (6 7)) 10 10)))


my $*TOLERANCE = 1e-12;

sub set-boundary(@mesh,@p1,@p2) {
    @mesh[ @p1[0] ; @p1[1] ] =  1;
    @mesh[ @p2[0] ; @p2[1] ] = -1;
}

sub solve(@p1, @p2, Int \w, Int \h) {
    my @d     = [0 xx w] xx h;
    my @V     = [0 xx w] xx h;
    my @fixed = [0 xx w] xx h;
    set-boundary(@fixed,@p1,@p2);

    loop {
        set-boundary(@V,@p1,@p2);
        my $diff = 0;
        for (flat ^h X ^w) -> \i, \j {
            my @neighbors = (@V[i-1;j], @V[i;j-1], @V[i+1;j], @V[i;j+1]).grep: *.defined;
            @d[i;j] = my \v = @V[i;j] - @neighbors.sum / @neighbors;
            $diff += v × v unless @fixed[i;j];
        }
        last if $diff =~= 0;

        for (flat ^h X ^w) -> \i, \j {
            @V[i;j] -= @d[i;j];
        }
    }

    my @current;
    for (flat ^h X ^w) -> \i, \j {
        @current[ @fixed[i;j]+1 ] += @d[i;j] × (?i + ?j + (i < h-1) + (j < w-1) );
    }
    (@current[2] - @current[0]) / 2
}

say 2 / solve (1,1), (6,7), 10, 10;


/*REXX program calculates the  resistance  between any  two points  on a  resistor grid.*/
if 2=='f2'x  then ohms = "ohms"                  /*EBCDIC machine?    Then use  'ohms'. */
             else ohms = "Ω"                     /* ASCII    "          "   "   Greek Ω.*/
parse arg high wide  Arow Acol  Brow Bcol digs . /*obtain optional arguments from the CL*/
if high=='' | high==","  then high= 10           /*Not specified?  Then use the default.*/
if wide=='' | wide==","  then wide= 10           /* "      "         "   "   "      "   */
if Arow=='' | Arow==","  then Arow=  2           /* "      "         "   "   "      "   */
if Acol=='' | Acol==","  then Acol=  2           /* "      "         "   "   "      "   */
if Brow=='' | Brow==","  then Brow=  7           /* "      "         "   "   "      "   */
if Bcol=='' | Bcol==","  then Bcol=  8           /* "      "         "   "   "      "   */
if digs=='' | digs==","  then digs= 20           /* "      "         "   "   "      "   */
numeric digits digs                              /*use moderate decimal digs (precision)*/
minVal = 1'e-' || (digs*2)                       /*calculate the threshold minimal value*/
say '    minimum value is '  format(minVal,,,,0)  " using "  digs  ' decimal digits';  say
say '    resistor mesh size is: '       wide      "wide, "    high   'high'         ;  say
say '    point  A  is at (row,col): '   Arow"," Acol
say '    point  B  is at (row,col): '   Brow"," Bcol
@.=0;                                      cell.= 1
            do  until  $<=minVal;          v= 0
            @.Arow.Acol=   1  ;            cell.Arow.Acol= 0
            @.Brow.Bcol= '-1' ;            cell.Brow.Bcol= 0
            $=0
                do   i=1  for high;        im= i-1;       ip= i+1
                  do j=1  for wide;        n= 0;          v= 0
                  if i\==1   then do;                     v= v + @.im.j;    n= n+1;    end
                  if j\==1   then do;      jm= j-1;       v= v + @.i.jm;    n= n+1;    end
                  if i<high  then do;                     v= v + @.ip.j;    n= n+1;    end
                  if j<wide  then do;      jp= j+1;       v= v + @.i.jp;    n= n+1;    end
                  v= @.i.j  -  v / n;      #.i.j= v;      if cell.i.j  then $= $ + v*v
                  end   /*j*/
                end     /*i*/
                                 do   r=1  for High
                                   do c=1  for Wide;      @.r.c= @.r.c   -   #.r.c
                                   end   /*c*/
                                 end     /*r*/
            end   /*until*/
say
Acur= #.Arow.Acol  *  sides(Arow, Acol)
Bcur= #.Brow.Bcol  *  sides(Brow, Bcol)
say '    resistance between point  A  and point  B  is: '     4 / (Acur - Bcur)       ohms
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
sides:  parse arg row,col;   z=0;    if row\==1 & row\==high  then  z= z+2;    else z= z+1
                                     if col\==1 & col\==wide  then  z= z+2;    else z= z+1
        return z


var (w, h) = (10, 10)

var v = h.of { w.of(0) } # voltage
var f = h.of { w.of(0) } # fixed condition
var d = h.of { w.of(0) } # diff
var n = []               # neighbors

for i in ^h {
    for j in (1 ..^ w  ) { n[i][j] := [] << [i, j-1] }
    for j in (0 ..^ w-1) { n[i][j] := [] << [i, j+1] }
}

for j in ^w {
    for i in (1 ..^ h  ) { n[i][j] := [] << [i-1, j] }
    for i in (0 ..^ h-1) { n[i][j] := [] << [i+1, j] }
}

func set_boundary {
    f[1][1] = 1; f[6][7] = -1;
    v[1][1] = 1; v[6][7] = -1;
}

func calc_diff {
    var total_diff = 0
    for i,j in (^h ~X ^w) {
        var w = n[i][j].map { |a| v.dig(a...) }.sum
        d[i][j] = (w = (v[i][j] - w/n[i][j].len))
        f[i][j] || (total_diff += w*w)
    }
    total_diff
}

func iter {
    var diff = 1
    while (diff > 1e-24) {
        set_boundary()
        diff = calc_diff()
        for i,j in (^h ~X ^w) {
            v[i][j] -= d[i][j]
        }
    }

    var current = 3.of(0)
    for i,j in (^h ~X ^w) {
        current[ f[i][j] ] += (d[i][j] * n[i][j].len)
    }
    (current[1] - current[-1]) / 2
}

say "R = #{2 / iter()}"


package require Tcl 8.6;  # Or 8.5 with the TclOO package

# This code is structured as a class with a little trivial DSL parser
# so it is easy to change what problem is being worked on.
oo::class create ResistorMesh {
    variable forcePoints V fixed w h

    constructor {boundaryConditions} {
	foreach {op condition} $boundaryConditions {
	    switch $op {
		size {
		    lassign $condition w h
		    set fixed [lrepeat $h [lrepeat $w 0]]
		    set V [lrepeat $h [lrepeat $w 0.0]]
		}
		fixed {
		    lassign $condition j i v
		    lset fixed $i $j [incr ctr]
		    lappend forcePoints $j $i $v
		}
	    }
	}
    }

    method CalculateDifferences {*dV} {
	upvar 1 ${*dV} dV
	set error 0.0
	for {set i 0} {$i < $h} {incr i} {
	    for {set j 0} {$j < $w} {incr j} {
		set v 0.0
		set n 0
		if {$i} {
		    set v [expr {$v + [lindex $V [expr {$i-1}] $j]}]
		    incr n
		}
		if {$j} {
		    set v [expr {$v + [lindex $V $i [expr {$j-1}]]}]
		    incr n
		}
		if {$i+1 < $h} {
		    set v [expr {$v + [lindex $V [expr {$i+1}] $j]}]
		    incr n
		}
		if {$j+1 < $w} {
		    set v [expr {$v + [lindex $V $i [expr {$j+1}]]}]
		    incr n
		}
		lset dV $i $j [set v [expr {[lindex $V $i $j] - $v/$n}]]
		if {![lindex $fixed $i $j]} {
		    set error [expr {$error + $v**2}]
		}
	    }
	}
	return $error
    }

    method FindCurrentFixpoint {epsilon} {
	set dV [lrepeat $h [lrepeat $w 0.0]]
	set current {0.0 0.0 0.0}
	while true {
	    # Enforce the boundary conditions
	    foreach {j i v} $forcePoints {
		lset V $i $j $v
	    }
	    # Compute the differences and the error
	    set error [my CalculateDifferences dV]
	    # Apply the differences
	    for {set i 0} {$i < $h} {incr i} {
		for {set j 0} {$j < $w} {incr j} {
		    lset V $i $j [expr {
			[lindex $V $i $j] - [lindex $dV $i $j]}]
		}
	    }
	    # Done if the error is small enough
	    if {$error < $epsilon} break
	}
	# Compute the currents from the error
	for {set i 0} {$i < $h} {incr i} {
	    for {set j 0} {$j < $w} {incr j} {
		lset current [lindex $fixed $i $j] [expr {
		    [lindex $current [lindex $fixed $i $j]] +
		    [lindex $dV $i $j] * (!!$i+!!$j+($i<$h-1)+($j<$w-1))}]
	    }
	}
	# Compute the actual current flowing between source and sink
	return [expr {([lindex $current 1] - [lindex $current 2]) / 2.0}]
    }

    # Public entry point
    method solveForResistance {{epsilon 1e-24}} {
	set voltageDifference [expr {
	    [lindex $forcePoints 2] - [lindex $forcePoints 5]}]
	expr {$voltageDifference / [my FindCurrentFixpoint $epsilon]}
    }
}


class Node {
    construct new(v, fixed) {
        _v = v
        _fixed = fixed
    }

    v { _v }
    v=(value) { _v = value }

    fixed { _fixed }
    fixed=(value) { _fixed = value }
}

var setBoundary = Fn.new { |m|
    m[1][1].v = 1
    m[1][1].fixed = 1
    m[6][7].v = -1
    m[6][7].fixed = -1
}

var calcDiff = Fn.new { |m, d, w, h|
    var total = 0
    for (i in 0...h) {
        for (j in 0...w) {
            var v = 0
            var n = 0
            if (i > 0) {
                v = v + m[i-1][j].v
                n = n + 1
            }
            if (j > 0) {
                v = v + m[i][j-1].v
                n = n + 1
            }
            if (i + 1 < h) {
                v =  v + m[i+1][j].v
                n = n + 1
            }
            if (j + 1 < w) {
                v = v + m[i][j+1].v
                n = n + 1
            }
            v = m[i][j].v - v/n
            d[i][j].v = v
            if (m[i][j].fixed == 0) total = total + v*v
        }
    }
    return total
}

var iter = Fn.new { |m, w, h|
    var d = List.filled(h, null)
    for (i in 0...h) {
        d[i] = List.filled(w, null)
        for (j in 0...w) d[i][j] = Node.new(0, 0)
    }
    var cur = [0] * 3
    var diff = 1e10
    while (diff > 1e-24) {
        setBoundary.call(m)
        diff = calcDiff.call(m, d, w, h)
        for (i in 0...h) {
            for (j in 0...w) m[i][j].v = m[i][j].v - d[i][j].v
        }
    }
    for (i in 0...h) {
        for (j in 0...w) {
            var k = 0
            if (i != 0) k = k + 1
            if (j != 0) k = k + 1
            if (i < h - 1) k = k + 1
            if (j < w - 1) k = k + 1
            cur[m[i][j].fixed + 1] = cur[m[i][j].fixed + 1] + d[i][j].v * k
        }
    }
    return (cur[2] - cur[0]) / 2
}

var S = 10
var mesh = List.filled(S, null)
for (i in 0...S) {
    mesh[i] = List.filled(S, null)
    for (j in 0...S) mesh[i][j] = Node.new(0, 0)
}
var r = 2 / iter.call(mesh, S, S)
System.print("R = %(r)")


code real RlRes=46, RlOut=48;
def  S = 10;

proc SetBoundary(MV, MF);
real MV; int MF;
[MF(1,1):= 1;  MV(1,1):= 1.0;
 MF(6,7):= -1; MV(6,7):= -1.0;
];

func real CalcDiff(MV, MF, DV, W, H);
real MV; int MF; real DV; int W, H;
int  I, J, N; real V, Total;
[Total:= 0.0;
for I:= 0 to H-1 do
    for J:= 0 to W-1 do
        [V:= 0.0;  N:= 0;
        if I then [V:= V + MV(I-1,J);  N:= N+1];
        if J then [V:= V + MV(I,J-1);  N:= N+1];
        if I+1 < H then [V:= V + MV(I+1,J);  N:= N+1];
        if J+1 < W then [V:= V + MV(I,J+1);  N:= N+1];
        V:= MV(I,J) - V/float(N);  DV(I,J):= V;
        if MF(I,J) = 0 then Total:= Total + V*V;
        ];
return Total;
];

func real Iter(MV, MF, W, H);
real MV; int MF, W, H;
real DV, Diff, Cur; int I, J;
[DV:= RlRes(W);  for I:= 0 to W-1 do DV(I):= RlRes(H);
Diff:= 1E10;
Cur:= [0.0, 0.0, 0.0];
while Diff > 1E-24 do
        [SetBoundary(MV, MF);
        Diff:= CalcDiff(MV, MF, DV, W, H);
        for I:= 0 to H-1 do
            for J:= 0 to W-1 do
                MV(I,J):= MV(I,J) - DV(I,J);
        ];
for I:= 0 to H-1 do
    for J:= 0 to W-1 do
        Cur(MF(I,J)+1):= Cur(MF(I,J)+1) +
                DV(I,J) * float(-(I>0) - (J>0) - (I<H-1) - (J<W-1));
                                \middle=4; side=3; corner=2
return (Cur(2)-Cur(0))/2.0;
];

real MeshV(S,S); int MeshF(S,S);
RlOut(0, 2.0 / Iter(MeshV, MeshF, S, S))


  N=10
  NN=N*N
  DIM A(NN,NN+1)

  NODE=0
  FOR ROW=1 TO N
    FOR COL=1 TO N
        NODE=NODE+1
        IF ROW>1 THEN
            A(NODE,NODE)=A(NODE,NODE)+1
            A(NODE,NODE-N)=-1
        END IF
        IF ROW<N THEN
            A(NODE,NODE)=A(NODE,NODE)+1
            A(NODE,NODE+N)=-1
        END IF
        IF COL>1 THEN
            A(NODE,NODE)=A(NODE,NODE)+1
            A(NODE,NODE-1)=-1
        END IF
        IF COL<N THEN
            A(NODE,NODE)=A(NODE,NODE)+1
            A(NODE,NODE+1)=-1
        END IF
    NEXT
  NEXT

  AR=2 : AC=2 : A=AC+N*(AR-1)
  BR=7 : BC=8 : B=BC+N*(BR-1)
  A(A,NN+1)=-1
  A(B,NN+1)=1

  PRINT "Nodes ",A,B

  // solve linear system
  // using Gauss-Seidel method
  // with pivoting
  R=NN

  FOR J=1 TO R
    FOR I=J TO R
      IF A(I,J)<>0 BREAK
    NEXT
    IF I=R+1 THEN
      PRINT "No solution!"
      END
    END IF
    FOR K=1 TO R+1
      T = A(J,K)
      A(J,K) = A(I,K)
      A(I,K) = T
    NEXT
    Y=1/A(J,J)
    FOR K=1 TO R+1
      A(J,K)=Y*A(J,K)
    NEXT
    FOR I=1 TO R
      IF I<>J THEN
         Y=-A(I,J)
         FOR K=1 TO R+1
            A(I,K)=A(I,K)+Y*A(J,K)
         NEXT
      END IF
    NEXT
  NEXT
  PRINT "Resistence = "; : PRINT ABS(A(A,NN+1)-A(B,NN+1)) USING "%1.13f"


var [const] GSL=Import("zklGSL");	// libGSL (GNU Scientific Library)
fcn onGrid(i,j,p,q){ ((0<=i<p) and (0<=j<q)) }
fcn gridResistor(p,q, ai,aj, bi,bj){
   n,A := p*q, GSL.Matrix(n,n);  // zero filled
   foreach i,j in (p,q){
      k:=i*q + j;
      if(i==ai and j==aj) A[k,k]=1;
      else{
	 c:=0;
	 if(onGrid(i+1,j,   p,q)){ c+=1; A[k, k+q]=-1 }
	 if(onGrid(i-1,j,   p,q)){ c+=1; A[k, k-q]=-1 }
	 if(onGrid(i,  j+1, p,q)){ c+=1; A[k, k+1]=-1 }
	 if(onGrid(i,  j-1, p,q)){ c+=1; A[k, k-1]=-1 }
	 A[k,k]=c;
      }
   }
   b:=GSL.Vector(n);  // zero filled
   b[k:=bi*q + bj]=1;
   A.AxEQb(b)[k];
}


BYTE FUNC IsCycle(CHAR ARRAY s,sub)
  BYTE i,j,count

  IF sub(0)=0 OR s(0)<sub(0) THEN
    RETURN (0)
  FI

  j=1 count=0
  FOR i=1 TO s(0)
  DO
    IF s(i)#sub(j) THEN
      RETURN (0)
    FI
    j==+1
    IF j>sub(0) THEN
      j=1 count==+1
    FI
  OD
  IF count>1 THEN
    RETURN (1)
  FI
RETURN (0)

PROC Test(CHAR ARRAY s)
  CHAR ARRAY sub
  BYTE len,count

  PrintF("%S -> ",s)
  count=0
  FOR len=1 TO s(0)-1
  DO
    SCopyS(sub,s,1,len)
    IF IsCycle(s,sub) THEN
      IF count>0 THEN
        Print(", ")
      FI
      Print(sub)
      count==+1
    FI
  OD
  IF count=0 THEN
    Print("none")
  FI
  PutE()
RETURN

PROC Main()
  Test("1001110011")
  Test("1110111011")
  Test("0010010010")
  Test("1010101010")
  Test("1111111111")
  Test("0100101101")
  Test("0100100")
  Test("101")
  Test("11")
  Test("00")
  Test("1")
RETURN


with Ada.Command_Line, Ada.Text_IO, Ada.Strings.Fixed;

procedure Rep_String is

   function Find_Largest_Rep_String(S:String) return String is
      L: Natural := S'Length;
   begin
      for I in reverse 1 .. L/2 loop
	 declare
	    use Ada.Strings.Fixed;
	    T: String := S(S'First .. S'First + I-1); -- the first I characters of S
	    U: String := (1+(L/I)) * T; -- repeat T so often that U'Length >= L
	 begin -- compare first L characers of U with S
	    if U(U'First .. U'First + S'Length -1) = S then
	       return T; -- T is a rep-string
	    end if;
	 end;
      end loop;
      return ""; -- no rep string;
   end Find_Largest_Rep_String;

   X: String := Ada.Command_Line.Argument(1);
   Y: String := Find_Largest_Rep_String(X);

begin
   if Y="" then
      Ada.Text_IO.Put_Line("No rep-string for """ & X & """");
   else
      Ada.Text_IO.Put_Line("Longest rep-string for """& X &""": """& Y &"""");
   end if;
end Rep_String;


# procedure to find the longest rep-string in a given string               #
# the input string is not validated to contain only "0" and "1" characters #
PROC longest rep string = ( STRING input )STRING:
BEGIN

    STRING result           := "";

    # ensure the string we are working on has a lower-bound of 1           #
    STRING str               = input[ AT 1 ];

    # work backwards from half the input string looking for a rep-string   #
    FOR string length FROM UPB str OVER 2 BY -1 TO 1
    WHILE
        STRING left substring  = str[ 1 : string length ];
        # if the left substgring repeated a sufficient number of times     #
        # (truncated on the right) is equal to the original string, then   #
        # we have found the longest rep-string                             #
        STRING repeated string = ( left substring
                                 * ( ( UPB str OVER string length ) + 1 )
                                 )[ 1 : UPB str ];
        IF str = repeated string
        THEN
            # found a rep-string                                           #
            result := left substring;
            FALSE
        ELSE
            # not a rep-string, keep looking                               #
            TRUE
        FI
    DO
        SKIP
    OD;

    result
END; # longest rep string #

# test the longest rep string procedure                                    #
main:
(

    []STRING tests = ( "1001110011"
                     , "1110111011"
                     , "0010010010"
                     , "1010101010"
                     , "1111111111"
                     , "0100101101"
                     , "0100100"
                     , "101"
                     , "11"
                     , "00"
                     , "1"
                     );

    FOR test number FROM LWB tests TO UPB tests
    DO
        STRING rep string = longest rep string( tests[ test number ] );
        print( ( tests[ test number ]
               , ": "
               , IF rep string = ""
                 THEN "no rep string"
                 ELSE "longest rep string: """ + rep string + """"
                 FI
               , newline
               )
             )
    OD
)


rep ← ⊢ (⊢(/⍨)(⊂⊣)≡¨(≢⊣)⍴¨⊢) ⍳∘(⌊0.5×≢)↑¨⊂


------------------------REP-CYCLES-------------------------

-- repCycles :: String -> [String]
on repCycles(xs)
    set n to length of xs

    script isCycle
        on |λ|(cs)
            xs = takeCycle(n, cs)
        end |λ|
    end script

    filter(isCycle, tail(inits(take(quot(n, 2), xs))))
end repCycles

-- cycleReport :: String -> [String]
on cycleReport(xs)
    set reps to repCycles(xs)

    if isNull(reps) then
        {xs, "(n/a)"}
    else
        {xs, item -1 of reps}
    end if
end cycleReport

---------------------------TEST----------------------------
on run
    set samples to {"1001110011", "1110111011", "0010010010", ¬
        "1010101010", "1111111111", "0100101101", "0100100", ¬
        "101", "11", "00", "1"}

    unlines(cons("Longest cycle:" & linefeed, ¬
        map(intercalate(" -> "), ¬
            map(cycleReport, samples))))

end run

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

-- concat :: [[a]] -> [a] | [String] -> String
on concat(xs)
    if length of xs > 0 and class of (item 1 of xs) is string then
        set acc to ""
    else
        set acc to {}
    end if
    repeat with i from 1 to length of xs
        set acc to acc & item i of xs
    end repeat
    acc
end concat

-- cons :: a -> [a] -> [a]
on cons(x, xs)
    {x} & xs
end cons

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

-- 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

-- inits :: [a] -> [[a]]
-- inits :: String -> [String]
on inits(xs)
    script elemInit
        on |λ|(_, i, xs)
            items 1 thru i of xs
        end |λ|
    end script

    script charInit
        on |λ|(_, i, xs)
            text 1 thru i of xs
        end |λ|
    end script

    if class of xs is string then
        {""} & map(charInit, xs)
    else
        {{}} & map(elemInit, xs)
    end if
end inits

-- intercalate :: Text -> [Text] -> Text
on intercalate(strText)
    script
        on |λ|(xs)
            set {dlm, my text item delimiters} to {my text item delimiters, strText}
            set strJoined to xs as text
            set my text item delimiters to dlm
            return strJoined
        end |λ|
    end script
end intercalate

-- 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

-- isNull :: [a] -> Bool
on isNull(xs)
    xs = {}
end isNull

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- quot :: Integral a => a -> a -> a
on quot(n, m)
    n div m
end quot

-- replicate :: Int -> a -> [a]
on replicate(n, a)
    set out to {}
    if n < 1 then return out
    set dbl to {a}

    repeat while (n > 1)
        if (n mod 2) > 0 then set out to out & dbl
        set n to (n div 2)
        set dbl to (dbl & dbl)
    end repeat
    return out & dbl
end replicate

-- tail :: [a] -> [a]
on tail(xs)
    if length of xs > 1 then
        items 2 thru -1 of xs
    else
        {}
    end if
end tail

-- take :: Int -> [a] -> [a]
on take(n, xs)
    if class of xs is string then
        if n > 0 then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else
        if n > 0 then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    end if
end take

-- takeCycle :: Int -> [a] -> [a]
on takeCycle(n, xs)
    set lng to length of xs
    if lng ≥ n then
        set cycle to xs
    else
        set cycle to concat(replicate((n div lng) + 1, xs))
    end if

    if class of xs is string then
        items 1 thru n of cycle as string
    else
        items 1 thru n of cycle
    end if
end takeCycle

-- unlines :: [String] -> String
on unlines(xs)
    |λ|(xs) of intercalate(linefeed)
end unlines


repeated?: function [text][
    loop ((size text)/2)..0 'x [
        if prefix? text slice text x (size text)-1 [
            (x>0)? -> return slice text 0 x-1
                   -> return false
        ]
    ]
    return false
]

strings: {
    1001110011
    1110111011
    0010010010
    1010101010
    1111111111
    0100101101
    0100100
    101
    11
    00
    1
}

loop split.lines strings 'str [
    rep: repeated? str
    if? false = rep ->
        print [str "-> *not* a rep-string"]
    else ->
        print [str "->" rep "( length:" size rep ")"]
]


all$ = "1001110011 1110111011 0010010010 1010101010 1111111111 0100101101 0100100 101 11 00 1"

FOR word$ IN all$
    FOR x = LEN(word$)/2 DOWNTO 1

        ex$ = EXPLODE$(word$, x)

        FOR st$ IN UNIQ$(ex$)
            IF NOT(REGEX(HEAD$(ex$, 1), "^" & st$)) THEN CONTINUE 2
        NEXT

        PRINT "Repeating string: ", word$, " -> ", HEAD$(ex$, 1)
        CONTINUE 2
    NEXT

    PRINT "Not a repeating string: ", word$
NEXT


get "libhdr"

// Returns the length of the longest rep-string
// (0 if there are none)
let repstring(s) = valof
$(  for i = s%0/2 to 1 by -1 do
    $(  for j = 1 to i
        $(  let k = i
            while j+k <= s%0 do
            $(  unless s%(j+k)=s%j goto next
                k := k + i
            $)
        $)
        resultis i
        next: loop
    $)
    resultis 0
$)

// Print first N characters of string
let writefirst(s, n) be
$(  let x = s%0
    s%0 := n
    writes(s)
    s%0 := x
$)

// Test string
let rep(s) be
$(  let n = repstring(s)
    writef("%S: ",s)
    test n=0
        do writes("none")
        or writefirst(s,n)
    wrch('*N')
$)

let start() be
$(  rep("1001110011")
    rep("1110111011")
    rep("0010010010")
    rep("1010101010")
    rep("1111111111")
    rep("0100101101")
    rep("0100100")
    rep("101")
    rep("11")
    rep("00")
    rep("1")
$)


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

int repstr(char *str)
{
    if (!str) return 0;

    size_t sl = strlen(str) / 2;
    while (sl > 0) {
        if (strstr(str, str + sl) == str)
            return sl;
        --sl;
    }

    return 0;
}

int main(void)
{
    char *strs[] = { "1001110011", "1110111011", "0010010010", "1111111111",
        "0100101101", "0100100", "101", "11", "00", "1" };

    size_t strslen = sizeof(strs) / sizeof(strs[0]);
    size_t i;
    for (i = 0; i < strslen; ++i) {
        int n = repstr(strs[i]);
        if (n)
            printf("\"%s\" = rep-string \"%.*s\"\n", strs[i], n, strs[i]);
        else
            printf("\"%s\" = not a rep-string\n", strs[i]);
    }

    return 0;
}


#include <string>
#include <vector>
#include <boost/regex.hpp>

bool is_repstring( const std::string & teststring , std::string & repunit ) {
   std::string regex( "^(.+)\\1+(.*)$" ) ;
   boost::regex e ( regex ) ;
   boost::smatch what ;
   if ( boost::regex_match( teststring , what , e , boost::match_extra ) ) {
      std::string firstbracket( what[1 ] ) ;
      std::string secondbracket( what[ 2 ] ) ;
      if ( firstbracket.length( ) >= secondbracket.length( ) &&
	    firstbracket.find( secondbracket ) != std::string::npos ) {
	 repunit = firstbracket  ;
      }
   }
   return !repunit.empty( ) ;
}

int main( ) {
   std::vector<std::string> teststrings { "1001110011" , "1110111011" , "0010010010" ,
      "1010101010" , "1111111111" , "0100101101" , "0100100" , "101" , "11" , "00" , "1" } ;
   std::string theRep ;
   for ( std::string myString : teststrings ) {
      if ( is_repstring( myString , theRep ) ) {
	 std::cout << myString << " is a rep string! Here is a repeating string:\n" ;
	 std::cout << theRep << " " ;
      }
      else {
	 std::cout << myString << " is no rep string!" ;
      }
      theRep.clear( ) ;
      std::cout << std::endl ;
   }
   return 0 ;
}


(defn rep-string [s]
  (let [len        (count s)
        first-half (subs s 0 (/ len 2))
        test-group (take-while seq (iterate butlast first-half))
        test-reptd (map (comp #(take len %) cycle) test-group)]
    (some #(= (seq s) %) test-reptd)))


rep_strings = iter (s: string) yields (string)
    for len: int in int$from_to_by(string$size(s)/2, 1, -1) do
        repstr: string := string$substr(s, 1, len)
        attempt: string := ""
        while string$size(attempt) < string$size(s) do
            attempt := attempt || repstr
        end
        if s = string$substr(attempt, 1, string$size(s)) then
            yield(repstr)
        end
    end
end rep_strings

start_up = proc ()
    as = array[string]
    po: stream := stream$primary_output()
    tests: as := as$["1001110011","1110111011","0010010010","1010101010",
                     "1111111111","0100101101","0100100","101","11","00",
                     "1"]

    for test: string in as$elements(tests) do
        stream$puts(po, test || ": ")
        for rep_str: string in rep_strings(test) do
            stream$puts(po, "<" || rep_str || "> ")
        end
        stream$putc(po, '\n')
    end
end start_up


(ql:quickload :alexandria)
(defun rep-stringv (a-str &optional (max-rotation (floor (/ (length a-str) 2))))
  ;; Exit condition if no repetition found.
  (cond ((< max-rotation 1) "Not a repeating string")
        ;; Two checks:
        ;; 1. Truncated string must be equal to rotation by repetion size.
        ;; 2. Remaining chars (rest-str) are identical to starting chars (beg-str)
        ((let* ((trunc (* max-rotation (truncate (length a-str) max-rotation)))
                (truncated-str (subseq a-str 0 trunc))
                (rest-str (subseq a-str trunc))
                (beg-str (subseq a-str 0 (rem (length a-str) max-rotation))))
           (and (string= beg-str rest-str)
                (string= (alexandria:rotate (copy-seq truncated-str) max-rotation)
                         truncated-str)))
         ;; If both checks pass, return the repeting string.
         (subseq a-str 0 max-rotation))
        ;; Recurse function reducing length of rotation.
        (t (rep-stringv a-str (1- max-rotation)))))


import std.stdio, std.string, std.conv, std.range, std.algorithm,
       std.ascii, std.typecons;

Nullable!(size_t, 0) repString1(in string s) pure nothrow @safe @nogc
in {
    //assert(s.all!isASCII);
    assert(s.representation.all!isASCII);
} body {
    immutable sr = s.representation;
    foreach_reverse (immutable n; 1 .. sr.length / 2 + 1)
        if (sr.take(n).cycle.take(sr.length).equal(sr))
            return typeof(return)(n);
    return typeof(return)();
}

Nullable!(size_t, 0) repString2(in string s) pure @safe /*@nogc*/
in {
    assert(s.countchars("01") == s.length);
} body {
    immutable bits = s.to!ulong(2);

    foreach_reverse (immutable left; 1 .. s.length / 2 + 1) {
        immutable right = s.length - left;
        if ((bits ^ (bits >> left)) == ((bits >> right) << right))
            return typeof(return)(left);
    }
    return typeof(return)();
}

void main() {
    immutable words = "1001110011 1110111011 0010010010 1010101010
                       1111111111 0100101101 0100100 101 11 00 1".split;

    foreach (immutable w; words) {
        immutable r1 = w.repString1;
        //assert(r1 == w.repString2);
        immutable r2 = w.repString2;
        assert((r1.isNull && r2.isNull) || r1 == r2);
        if (r1.isNull)
            writeln(w, " (no repeat)");
        else
            writefln("%(%s %)", w.chunks(r1));
    }
}


program Rep_string;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

const
  m =   '1001110011'#10 +
        '1110111011'#10 +
        '0010010010'#10 +
        '1010101010'#10 +
        '1111111111'#10 +
        '0100101101'#10 +
        '0100100'#10 +
        '101'#10 +
        '11'#10 +
        '00'#10 +
        '1';

function Rep(s: string; var sub:string): Integer;
var
  x: Integer;
begin
  for x := s.Length div 2 downto 1 do
  begin
    sub :=  s.Substring(x);
    if s.StartsWith(sub) then
      exit(x);
  end;
  sub := '';
  Result := 0;
end;

begin
  for var s in m.Split([#10]) do
  begin
    var sub := '';
    var n := rep(s,sub);
    if n > 0 then
      writeln(format('"%s"  %d rep-string "%s"', [s, n, sub]))
    else
      writeln(format('"%s"  not a rep-string', [s]));
  end;
  {$IFNDEF UNIX}readln;{$ENDIF}
end.


(lib 'list) ;; list-rotate

;; a list is a rep-list if equal? to itself after a rotation of lam units
;; lam <= list length / 2
;; truncate to a multiple of lam before rotating
;; try cycles in decreasing lam order (longest wins)

(define (cyclic? cyclic)
    (define len (length cyclic))
    (define trunc null)

    (if (> len 1)
        (for ((lam (in-range (quotient len 2) 0 -1)))
        (set! trunc (take cyclic (- len (modulo len lam))))
         #:break (equal? trunc  (list-rotate trunc lam)) => (list->string (take cyclic lam))
         'no-rep )
   'too-short-no-rep))


defmodule Rep_string do
  def find(""), do: IO.puts "String was empty (no repetition)"
  def find(str) do
    IO.puts str
    rep_pos = Enum.find(div(String.length(str),2)..1, fn pos ->
      String.starts_with?(str, String.slice(str, pos..-1))
    end)
    if rep_pos && rep_pos>0 do
      IO.puts String.duplicate(" ", rep_pos) <> String.slice(str, 0, rep_pos)
    else
      IO.puts "(no repetition)"
    end
    IO.puts ""
  end
end

strs = ~w(1001110011
          1110111011
          0010010010
          1010101010
          1111111111
          0100101101
          0100100
          101
          11
          00
          1)

Enum.each(strs, fn str -> Rep_string.find(str) end)


REPCYCLES
=LAMBDA(s,
    LET(
        n, LEN(s),
        xs, FILTERP(
            LAMBDA(pfx,
                s = TAKECYCLESTRING(n)(pfx)
            )
        )(
            TAILCOLS(
                INITS(
                   MID(s, 1, QUOTIENT(n, 2))
                )
            )
        ),

        IF(ISERROR(xs), NA(), xs)
    )
)

TAKECYCLESTRING
=LAMBDA(n,
    LAMBDA(s,
        LET(
            lng, LEN(s),

            MID(
                IF(n < lng,
                    s,
                    REPT(s, CEILING.MATH(n / lng))
                ),
                1, n
            )
        )
    )
)


let isPrefix p (s : string) = s.StartsWith(p)
let getPrefix n (s : string) = s.Substring(0,n)

let repPrefixOf str =
    let rec isRepeatedPrefix p s =
        if isPrefix p s then isRepeatedPrefix p (s.Substring (p.Length))
        else isPrefix s p

    let rec getLongestRepeatedPrefix n =
        if n = 0 then None
        elif isRepeatedPrefix (getPrefix n str) str then Some(getPrefix n str)
        else getLongestRepeatedPrefix (n-1)

    getLongestRepeatedPrefix (str.Length/2)

[<EntryPoint>]
let main argv =
    printfn "Testing for rep-string (and showing the longest repeated prefix in case):"
    [
    "1001110011"
    "1110111011"
    "0010010010"
    "1010101010"
    "1111111111"
    "0100101101"
    "0100100"
    "101"
    "11"
    "00"
    "1"
    ] |>
    List.map (fun s ->
        match repPrefixOf s with | None -> s + ": NO" | Some(p) -> s + ": YES ("+ p + ")")
    |> List.iter (printfn "%s")
    0


USING: formatting grouping kernel math math.ranges qw sequences ;
IN: rosetta-code.rep-string

: (find-rep-string) ( str -- str )
    dup dup length 2/ [1,b]
    [ <groups> [ head? ] monotonic? ] with find nip dup
    [ head ] [ 2drop "N/A" ] if ;

: find-rep-string ( str -- str )
    dup length 1 <= [ drop "N/A" ] [ (find-rep-string) ] if ;

qw{ 1001110011 1110111011 0010010010 1010101010 1111111111
    0100101101 0100100 101 11 00 1 }
"Shortest cycle:\n\n" printf
[ dup find-rep-string "%-10s -> %s\n" printf ] each


: rep-string ( caddr1 u1 -- caddr2 u2 ) \ u2=0: not a rep-string
   2dup dup >r  [email protected] 2/ /string
   begin  2over 2over string-prefix? 0=  over [email protected] <  and  while  -1 /string  repeat
   r> swap - >r  2drop  r> ;

: test ( caddr u -- )
   2dup type ."  has "
   rep-string ?dup 0= if drop ." no " else type ."  as " then
   ." repeating substring" cr ;
: tests
   s" 1001110011" test
   s" 1110111011" test
   s" 0010010010" test
   s" 1010101010" test
   s" 1111111111" test
   s" 0100101101" test
   s" 0100100" test
   s" 101" test
   s" 11" test
   s" 00" test
   s" 1" test ;


Data "1001110011", "1110111011", "0010010010", "1010101010", "1111111111", "0100101101", "0100100", "101", "11", "00", "1", ""

Function rep(c As String, n As Integer) As String
    Dim As String r

    For i As Integer = 1 To n
        r = r + c
    Next i
    Return r
End Function

Do
    Dim As String p, b = "", t, s
    Read p : If p = "" Then Exit Do
    Dim As Integer l = Len(p), m = Int(l / 2)

    For i As Integer = m To 1 Step -1
        t = Left(p, i)
        s = rep(t, l / i + 1)
        If p = Left(s, l) Then b = t : Exit For
    Next i

    If b = "" Then
        Print p; " no es una cadena repetida"
    Else
        Print p; "  secuencia m s larga: "; b
    End If
Loop
Sleep


package main

import (
    "fmt"
    "strings"
)

func rep(s string) int {
    for x := len(s) / 2; x > 0; x-- {
        if strings.HasPrefix(s, s[x:]) {
            return x
        }
    }
    return 0
}

const m = `
1001110011
1110111011
0010010010
1010101010
1111111111
0100101101
0100100
101
11
00
1`

func main() {
    for _, s := range strings.Fields(m) {
        if n := rep(s); n > 0 {
            fmt.Printf("%q  %d rep-string %q\n", s, n, s[:n])
        } else {
            fmt.Printf("%q  not a rep-string\n", s)
        }
    }
}


import Data.List (inits, maximumBy)
import Data.Maybe (fromMaybe)

repstring :: String -> Maybe String
-- empty strings are not rep strings
repstring [] = Nothing
-- strings with only one character are not rep strings
repstring [_] = Nothing
repstring xs
  | any (`notElem` "01") xs = Nothing
  | otherwise = longest xs
  where
    -- length of the original string
    lxs = length xs
    -- half that length
    lq2 = lxs `quot` 2
    -- make a string of same length using repetitions of a part
    -- of the original string, and also return the substring used
    subrepeat x = (x, take lxs $ concat $ repeat x)
    -- check if a repeated string matches the original string
    sndValid (_, ys) = ys == xs
    -- make all possible strings out of repetitions of parts of
    -- the original string, which have max. length lq2
    possible = map subrepeat . take lq2 . tail . inits
    -- filter only valid possibilities, and return the substrings
    -- used for building them
    valid = map fst . filter sndValid . possible
    -- see which string is longer
    compLength a b = compare (length a) (length b)
    -- get the longest substring that, repeated, builds a string
    -- that matches the original string
    longest ys = case valid ys of
      [] -> Nothing
      zs -> Just $ maximumBy compLength zs

main :: IO ()
main =
  mapM_ processIO examples
  where
    examples =
      [ "1001110011",
        "1110111011",
        "0010010010",
        "1010101010",
        "1111111111",
        "0100101101",
        "0100100",
        "101",
        "11",
        "00",
        "1"
      ]
    process = fromMaybe "Not a rep string" . repstring
    processIO xs = do
      putStr (xs <> ": ")
      putStrLn $ process xs


procedure main(A)
   every write(s := !A,": ",(repString(s) | "Not a rep string!")\1)
end

procedure repString(s)
    rs := s[1+:*s/2]
    while (*rs > 0) & (s ~== lrepl(rs,*s,rs)) do rs := rs[1:-1]
    return (*rs > 0, rs)
end

procedure lrepl(s1,n,s2)   # The standard left() procedure won't work.
    while *s1 < n do s1 ||:= s2
    return s1[1+:n]
end


replengths=: >:@[email protected]<[email protected]:@#
rep=: [email protected]] $ $

isRepStr=: +./@((] -: rep)"0 1~ replengths)


public class RepString {

    static final String[] input = {"1001110011", "1110111011", "0010010010",
        "1010101010", "1111111111", "0100101101", "0100100", "101", "11",
        "00", "1", "0100101"};

    public static void main(String[] args) {
        for (String s : input)
            System.out.printf("%s : %s%n", s, repString(s));
    }

    static String repString(String s) {
        int len = s.length();
        outer:
        for (int part = len / 2; part > 0; part--) {
            int tail = len % part;
            if (tail > 0 && !s.substring(0, tail).equals(s.substring(len - tail)))
                continue;
            for (int j = 0; j < len / part - 1; j++) {
                int a = j * part;
                int b = (j + 1) * part;
                int c = (j + 2) * part;
                if (!s.substring(a, b).equals(s.substring(b, c)))
                    continue outer;
            }
            return s.substring(0, part);
        }
        return "none";
    }
}


(() => {
    'use strict';

    const main = () => {

        // REP-CYCLES -------------------------------------

        // repCycles :: String -> [String]
        const repCycles = s => {
            const n = s.length;
            return filter(
                x => s === take(n, cycle(x)).join(''),
                tail(inits(take(quot(n, 2), s)))
            );
        };

        // TEST -------------------------------------------
        console.log(fTable(
            'Longest cycles:\n',
            str,
            xs => 0 < xs.length ? concat(last(xs)) : '(none)',
            repCycles,
            [
                '1001110011',
                '1110111011',
                '0010010010',
                '1010101010',
                '1111111111',
                '0100101101',
                '0100100',
                '101',
                '11',
                '00',
                '1'
            ]
        ));
    };

    // GENERIC FUNCTIONS ----------------------------------

    // concat :: [[a]] -> [a]
    // concat :: [String] -> String
    const concat = xs =>
        0 < xs.length ? (() => {
            const unit = 'string' !== typeof xs[0] ? (
                []
            ) : '';
            return unit.concat.apply(unit, xs);
        })() : [];

    // cycle :: [a] -> Generator [a]
    function* cycle(xs) {
        const lng = xs.length;
        let i = 0;
        while (true) {
            yield(xs[i])
            i = (1 + i) % lng;
        }
    }

    // filter :: (a -> Bool) -> [a] -> [a]
    const filter = (f, xs) => xs.filter(f);

    // fTable :: String -> (a -> String) ->
    //                     (b -> String) -> (a -> b) -> [a] -> String
    const fTable = (s, xShow, fxShow, f, xs) => {
        // Heading -> x display function ->
        //           fx display function ->
        //    f -> values -> tabular string
        const
            ys = xs.map(xShow),
            w = Math.max(...ys.map(length));
        return s + '\n' + zipWith(
            (a, b) => a.padStart(w, ' ') + ' -> ' + b,
            ys,
            xs.map(x => fxShow(f(x)))
        ).join('\n');
    };

    // inits([1, 2, 3]) -> [[], [1], [1, 2], [1, 2, 3]
    // inits('abc') -> ["", "a", "ab", "abc"]

    // inits :: [a] -> [[a]]
    // inits :: String -> [String]
    const inits = xs => [
            []
        ]
        .concat(('string' === typeof xs ? xs.split('') : xs)
            .map((_, i, lst) => lst.slice(0, 1 + i)));

    // last :: [a] -> a
    const last = xs =>
        0 < xs.length ? xs.slice(-1)[0] : undefined;

    // Returns Infinity over objects without finite length.
    // This enables zip and zipWith to choose the shorter
    // argument when one is non-finite, like cycle, repeat etc

    // length :: [a] -> Int
    const length = xs =>
        (Array.isArray(xs) || 'string' === typeof xs) ? (
            xs.length
        ) : Infinity;

    // quot :: Int -> Int -> Int
    const quot = (n, m) => Math.floor(n / m);

    // str :: a -> String
    const str = x => x.toString();

    // tail :: [a] -> [a]
    const tail = xs => 0 < xs.length ? xs.slice(1) : [];

    // take :: Int -> [a] -> [a]
    // take :: Int -> String -> String
    const take = (n, xs) =>
        'GeneratorFunction' !== xs.constructor.constructor.name ? (
            xs.slice(0, n)
        ) : [].concat.apply([], Array.from({
            length: n
        }, () => {
            const x = xs.next();
            return x.done ? [] : [x.value];
        }));

    // unlines :: [String] -> String
    const unlines = xs => xs.join('\n');

    // Use of `take` and `length` here allows zipping with non-finite lists
    // i.e. generators like cycle, repeat, iterate.

    // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
    const zipWith = (f, xs, ys) => {
        const
            lng = Math.min(length(xs), length(ys)),
            as = take(lng, xs),
            bs = take(lng, ys);
        return Array.from({
            length: lng
        }, (_, i) => f(as[i], bs[i], i));
    };

    // MAIN ---
    return main();
})();


}:r:     Start reader loop.
  !~>&   Push a character to the "stack".
  <:a:=- Stop reading on newline.
^:r:
@>       Rotate the newline to the end and enqueue a sentinel 0.
{~       Dequeue and rotate the first character into place.
}:p:
  ${~    Print the current character until it's 0.
^:p:
#:r:     Read again.


fs:rename(‘input.txt’, ‘output.txt’)
fs:rename(‘docs’, ‘mydocs’)

fs:rename(fs:path:sep‘input.txt’, fs:path:sep‘output.txt’)
fs:rename(fs:path:sep‘docs’, fs:path:sep‘mydocs’)


def is_rep_string:
  # if self is a rep-string then return [n, prefix]
  # where n is the number of full occurrences of prefix
  def _check(prefix; n; sofar):
    length as $length
    | if length <= (sofar|length) then [n, prefix]
      else (sofar+prefix) as $sofar
      | if  startswith($sofar) then _check(prefix; n+1; $sofar)
        elif ($sofar|length) > $length and
             startswith($sofar[0:$length]) then [n, prefix]
        else [0, prefix]
        end
      end
  ;

  [range (1; length/2 + 1) as $i
     | .[0:$i] as $prefix
     | _check($prefix; 1; $prefix)
     | select( .[0] > 1 ) ]
  ;


function repstring(r::AbstractString)
    n = length(r)
    replst = String[]
    for m in 1:n÷2
        s = r[1:chr2ind(r, m)]
        if (s ^ cld(n, m))[1:chr2ind(r, n)] != r continue end
        push!(replst, s)
    end
    return replst
end

tests = ["1001110011", "1110111011", "0010010010", "1010101010", "1111111111",
         "0100101101", "0100100", "101", "11", "00", "1",
         "\u2200\u2203\u2200\u2203\u2200\u2203\u2200\u2203"]

for r in tests
    replst = repstring(r)
    if isempty(replst)
        println("$r is not a rep-string.")
    else
        println("$r is a rep-string of ", join(replst, ", "), ".")
    end
end


// version 1.0.6

fun repString(s: String): MutableList<String> {
    val reps = mutableListOf<String>()
    if (s.length < 2) return reps
    for (c in s) if (c != '0' && c != '1') throw IllegalArgumentException("Not a binary string")
    for (len in 1..s.length / 2) {
        val t = s.take(len)
        val n = s.length / len
        val r = s.length % len
        val u = t.repeat(n) + t.take(r)
        if (u == s) reps.add(t)
    }
    return reps
}

fun main(args: Array<String>) {
    val strings = listOf(
        "1001110011",
        "1110111011",
        "0010010010",
        "1010101010",
        "1111111111",
        "0100101101",
        "0100100",
        "101",
        "11",
        "00",
        "1"
    )
    println("The (longest) rep-strings are:\n")
    for (s in strings) {
        val reps = repString(s)
        val size = reps.size
        println("${s.padStart(10)} -> ${if (size > 0) reps[size - 1] else "Not a rep-string"}")
    }
}


*        Reverse a string          21/05/2016
REVERSE  CSECT
         USING  REVERSE,R13        base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         "
         ST     R15,8(R13)         "
         LR     R13,R15            "
         MVC    TMP(L'C),C         tmp=c
         LA     R8,C               @c[1]
         LA     R9,TMP+L'C-1       @tmp[n-1]
         LA     R6,1               i=1
         LA     R7,L'C             n=length(c)
LOOPI    CR     R6,R7              do i=1 to n
         BH     ELOOPI             leave i
         MVC    0(1,R8),0(R9)        substr(c,i,1)=substr(tmp,n-i+1,1)
         LA     R8,1(R8)             @[email protected]+1
         BCTR   R9,0                 @[email protected]
         LA     R6,1(R6)             i=i+1
         B      LOOPI              next i
ELOOPI   XPRNT  C,L'C              print c
         L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    "
         XR     R15,R15            "
         BR     R14                exit
C        DC     CL12'edoC attesoR'
TMP      DS     CL12
         REGEQU
         END    REVERSE


INCLUDE "D2:IO.ACT" ;from the Action! Tool Kit

PROC Dir(CHAR ARRAY filter)
  BYTE dev=[1]
  CHAR ARRAY line(255)

  Close(dev)
  Open(dev,filter,6)
  DO
    InputSD(dev,line)
    PrintE(line)
    IF line(0)=0 THEN
      EXIT
    FI
  OD
  Close(dev)
RETURN

PROC Main()
  CHAR ARRAY filter="D:*.*",
    cmd="D:INPUT.TXT OUTPUT.TXT"

  Put(125) PutE() ;clear screen

  PrintF("Dir ""%S""%E",filter)
  Dir(filter)

  PrintF("Rename ""%S""%E%E",cmd)
  Rename(cmd)

  PrintF("Dir ""%S""%E",filter)
  Dir(filter)
RETURN


with Ada.Directories;  use Ada.Directories;
   ...
Rename ("input.txt", "output.txt");
Rename ("docs", "mydocs");
Rename ("/input.txt", "/output.txt");
Rename ("/docs", "/mydocs");


main:(
  PROC rename = (STRING source name, dest name)INT:
  BEGIN
    FILE actual file;
    INT errno = open(actual file, source name, stand back channel);
    IF errno NE 0 THEN
      errno
    ELSE
      IF reidf possible(actual file) THEN
        reidf(actual file, dest name); # change the identification of the book #
        errno
      ELSE
        close(actual file);
        -1
      FI
    FI
  END;
  rename("input.txt", "output.txt");
  rename("/input.txt", "/output.txt");
  rename("docs", "mydocs");
  rename("/docs", "/mydocs")
)


fileFrom: "input.txt"
fileTo:   "output.txt"
docsFrom: "docs"
docsTo:   "mydocs"

rename fileFrom fileTo
rename.directory docsFrom docsTo

rename join.path ["/" fileFrom]
       join.path ["/" fileTo]

rename.directory join.path ["/" docsFrom]
                 join.path ["/" docsTo]


(defun get-reps (text)
  (lists:filtermap
   (lambda (x)
     (case (get-rep text (lists:split x text))
       ('() 'false)
       (x `#(true ,x))))
   (lists:seq 1 (div (length text) 2))))

(defun get-rep
  ((text `#(,head ,tail))
   (case (string:str text tail)
     (1 head)
     (_ '()))))


repstr? := proc( s :: string )
  local   per := StringTools:-Period( s );
  if 2 * per <= length( s ) then
    true, s[ 1 .. per ]
  else
    false, ""
  end if
end proc:


		org	100h
		jmp	test

		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Reverse a string under HL in place
		;; strrev0: reverse a zero-terminated string
		;; strrev: reverse a string terminated by the value in A
		;; arrayrev: reverse bytes starting at DE and ending at HL
		;; Destroys a, b, d, e, h, l registers.

strrev0:	xra	a	; Zero A
strrev:		mov	d,h	; Copy string begin to DE
		mov	e,l
		dcx	h
strrev_end:	inx	h	; Find string end in HL
		cmp	m
		jnz	strrev_end
		dcx	h	; Point HL to last character
arrayrev:	mov	a,h	; If HL<DE, we're done
		cmp	d
		rc
		mov	a,l
		cmp	e
		rc
		ldax	d	; Get low character in string
		mov	b,m	; Get high character in string
		mov	m,a	; Swap them
		mov	a,b
		stax	d
		inx	d	; Move the low pointer up,
		dcx	h	; and the high pointer down
		jmp	arrayrev

		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Test code (CP/M): ask the user for a string, and reverse it

prompt:		db	" :gnirts a retne esaelP$"
bufdef:		db	127, 0
buf:		ds	128		; one extra byte that will remain 0

newline:	lxi	d,newline_str
		mvi	c,9
		jmp	5
newline_str:	db	13, 10, "$"

test:		;; Reverse and output the prompt
		mvi	a,'$'		; CP/M string is $-terminated
		lxi	h,prompt	; Reverse the string
		call	strrev
		lxi	d,prompt	; Output the string
		mvi	c,9
		call	5

		;; Get input and reverse it
		lxi	d,bufdef
		mvi	c,10
		call	5
		call	newline
		lxi	h,buf
		call	strrev0		; 0-terminated due to buffer definition

		;; Output reversed input
		lxi	h,buf
loop:		mov	e,m
		xra	a
		ora	e
		rz			; Stop when done
		mvi	c,2
		push	h
		call	5
		pop	h
		inx	h
		jmp	loop


$ awk 'BEGIN{system("mv input.txt output.txt")}'
$ awk 'BEGIN{system("mv docs mydocs")}'
$ awk 'BEGIN{system("mv /input.txt /output.txt")}'
$ awk 'BEGIN{system("mv docs mydocs")}'


RENAME "input.txt" TO "output.txt"
RENAME "/input.txt" TO "/output.txt"
RENAME "docs" TO "mydocs"
RENAME "/docs" TO "/mydocs"


NAME "input.txt" AS "output.txt"
NAME "\input.txt" AS "\output.txt"
NAME "docs" AS "mydocs"
NAME "\docs" AS "\mydocs"


MODULE RepStrings;
FROM InOut IMPORT Write, WriteString, WriteLn, WriteCard;
FROM Strings IMPORT Copy, Length;

(* Find the length of the longest rep-string given a string.
   If there is no rep-string, the result is 0. *)
PROCEDURE repLength(s: ARRAY OF CHAR): CARDINAL;
    VAR strlen, replen, i, j: CARDINAL;
        ok: BOOLEAN;
BEGIN
    strlen := Length(s);
    FOR replen := strlen DIV 2 TO 1 BY -1 DO
        ok := TRUE;
        i := 0;
        WHILE ok AND (i < replen) DO
            j := i + replen;
            WHILE (i+j < strlen) AND (s[i] = s[j]) DO
                j := j + replen;
            END;
            ok := ok AND (i+j >= strlen);
            INC(i);
        END;
        IF ok THEN RETURN replen; END;
    END;
    RETURN 0;
END repLength;

(* Store the longest rep-string in the given buffer. *)
PROCEDURE repString(in: ARRAY OF CHAR; VAR out: ARRAY OF CHAR);
    VAR len: CARDINAL;
BEGIN
    len := repLength(in);
    Copy(in, 0, len, out);
    out[len] := CHR(0);
END repString;

(* Display the longest rep-string given a string *)
PROCEDURE rep(s: ARRAY OF CHAR);
    VAR buf: ARRAY [0..63] OF CHAR;
BEGIN
    WriteString(s);
    WriteString(": ");
    repString(s, buf);
    WriteString(buf);
    WriteLn();
END rep;

(* Test cases *)
BEGIN
    rep("1001110011");
    rep("1110111011");
    rep("0010010010");
    rep("1010101010");
    rep("1111111111");
    rep("0100101101");
    rep("0100100");
    rep("101");
    rep("11");
    rep("00");
    rep("1");
END RepStrings.


PROC Reverse(CHAR ARRAY src,dst)
  BYTE i,j

  i=1 j=src(0) dst(0)=j
  WHILE j>0
  DO
    dst(j)=src(i)
    i==+1 j==-1
  OD
RETURN

PROC Test(CHAR ARRAY src)
  CHAR ARRAY dst(40)

  Reverse(src,dst)
  PrintF("'%S' -> '%S'%E",src,dst)
RETURN

PROC Main()
  Test("Hello World!")
  Test("123456789")
  Test("!noitcA iratA")
RETURN


ren input.txt output.txt
ren \input.txt output.txt
ren docs mydocs
ren \docs mydocs


      *RENAME input.txt output.txt
      *RENAME \input.txt \output.txt
      *RENAME docs. mydocs.
      *RENAME \docs. \mydocs.


ren$("input.txt"."output.txt")         { 'ren' is based on standard C function 'rename()' }
ren$(docs.mydocs)                      { No quotes needed: names don't contain dots or colons. }
ren$("d:\\input.txt"."d:\\output.txt") { Backslash is escape character, so we need to escape it. }
ren$(@"d:\docs"[email protected]"d:\mydocs")          { @ used as syntactic sugar as in C# for inhibiting escape. }


#include <stdio.h>

int main()
{
  rename("input.txt", "output.txt");
  rename("docs", "mydocs");
  rename("/input.txt", "/output.txt");
  rename("/docs", "/mydocs");
  return 0;
}


using System;
using System.IO;

class Program {
    static void Main(string[] args) {
        File.Move("input.txt","output.txt");
        File.Move(@"\input.txt",@"\output.txt");

        Directory.Move("docs","mydocs");
        Directory.Move(@"\docs",@"\mydocs");
    }
}


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

/* REXX ***************************************************************
* 11.05.2013 Walter Pachl
**********************************************************************/
runSample(arg)
return

/**
 * Test for rep-strings
 * @param s_str a string to check for rep-strings
 * @return Rexx string: boolean indication of reps, length, repeated value
 */
method repstring(s_str) public static
  s_str_n = s_str.length()
  rep_str = ''
  Loop lx = s_str.length() % 2 to 1 By -1
    If s_str.substr(lx + 1, lx) = s_str.left(lx) Then Leave lx
    End lx
  If lx > 0 Then Do label reps
    rep_str = s_str.left(lx)
    Loop ix = 1 By 1
      If s_str.substr(ix * lx + 1, lx) <> rep_str Then
        Leave ix
      End ix
    If rep_str.copies(s_str_n).left(s_str.length()) <> s_str Then
      rep_str = ''
    End reps
  Return (rep_str.length() > 0) rep_str.length() rep_str

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) public static
  parse arg samples
  if samples = '' then -
    samples = -
      '1001110011' -
      '1110111011' -
      '0010010010' -
      '1010101010' -
      '1111111111' -
      '0100101101' -
      '0100100' -
      '101' -
      '11' -
      '00' -
      '1'

  loop w_ = 1 to samples.words()
    in_str = samples.word(w_)
    parse repstring(in_str) is_rep_str rep_str_len rep_str

    sq = ''''in_str''''
    tstrlen = sq.length().max(20)
    sq=sq.right(tstrlen)
    if is_rep_str then
      Say sq 'has a repetition length of' rep_str_len "i.e. '"rep_str"'"
    else
      Say sq 'is not a repeated string'
    end w_
  return


function reverseString(string:String):String
{
	var reversed:String = new String();
	for(var i:int = string.length -1; i >= 0; i--)
		reversed += string.charAt(i);
	return reversed;
}

function reverseStringCQAlternative(string:String):String
{
	return string.split('').reverse().join('');
}


with Ada.Text_IO; use Ada.Text_IO;

procedure Reverse_String is
   function Reverse_It (Item : String) return String is
      Result : String (Item'Range);
   begin
      for I in Item'range loop
         Result (Result'Last - I + Item'First) := Item (I);
      end loop;
      return Result;
   end Reverse_It;
begin
   Put_Line (Reverse_It (Get_Line));
end Reverse_String;


#include <cstdio>

int main()
{
    std::rename("input.txt", "output.txt");
    std::rename("docs", "mydocs");
    std::rename("/input.txt", "/output.txt");
    std::rename("/docs", "/mydocs");
    return 0;
}


FRename( "input.txt","output.txt")
or
RENAME input.txt TO output.txt

FRename("\input.txt","\output.txt")
or
RENAME \input.txt TO \output.txt


(import '(java.io File))

(.renameTo (File. "input.txt") (File. "output.txt"))
(.renameTo (File. "docs") (File. "mydocs"))

(.renameTo
 (File. (str (File/separator) "input.txt"))
 (File. (str (File/separator) "output.txt")))
(.renameTo
 (File. (str (File/separator) "docs"))
 (File. (str (File/separator) "mydocs")))


(rename-file "input.txt" "output.txt")
(rename-file "docs" "mydocs")
(rename-file "/input.txt" "/output.txt")
(rename-file "/docs" "/mydocs")


import strutils

proc isRepeated(text: string): int =
  for x in countdown(text.len div 2, 0):
    if text.startsWith(text[x..text.high]): return x

const matchstr = """1001110011
1110111011
0010010010
1010101010
1111111111
0100101101
0100100
101
11
00
1"""

for line in matchstr.split():
  let ln = isRepeated(line)
  echo "'", line, "' has a repetition length of ", ln, " i.e ",
    (if ln > 0: "'" & line[0 ..< ln] & "'" else: "*not* a rep-string")


class RepString {
  function : Main(args : String[]) ~ Nil {
    strings := ["1001110011", "1110111011", "0010010010", "1111111111",
        "0100101101", "0100100", "101", "11", "00", "1"];
    each(i : strings) {
      string := strings[i];
      repstring := RepString(string);
      if(repstring->Size() > 0) {
        "\"{$string}\" = rep-string \"{$repstring}\""->PrintLine();
      }
      else {
        "\"{$string}\" = not a rep-string"->PrintLine();
      };
    };
  }

  function : RepString(string : String) ~ String {
    offset := string->Size() / 2;

    while(offset > 0) {
      left := string->SubString(offset);
      right := string->SubString(left->Size(),left->Size());
      if(left->Equals(right)) {
        if(ValidateMatch(left, string)) {
          return left;
        }
        else {
          return "";
        };
      };

      offset--;
    };

    return "";
  }

  function : ValidateMatch(left : String, string : String) ~ Bool {
    parts := string->Size() / left->Size();
    tail := string->Size() % left->Size() <> 0;

    for(i := 1; i < parts; i+=1;) {
      offset := i * left->Size();
      right := string->SubString(offset, left->Size());
      if(<>left->Equals(right)) {
        return false;
      };
    };

    if(tail) {
      offset := parts * left->Size();
      right := string->SubString(offset, string->Size() - offset);
      each(i : right) {
        if(left->Get(i) <> right->Get(i)) {
          return false;
        };
      };
    };

    return true;
  }
}


module reverse_string where

open import Data.String
open import Data.List

reverse_string : String → String
reverse_string s = fromList (reverse (toList s))


XCALL RENAM ("output.txt","input.txt")
.IFDEF UNIX
XCALL SPAWN ("mv docs mydocs")
.ENDC
.IFDEF DOS
XCALL SPAWN ("ren docs mydocs")
.ENDC
.IFDEF VMS
XCALL SPAWN ("rename docs.dir mydocs.dir")
.ENDC


rename input.txt output.txt
rename docs.dir mydocs.dir
rename [000000]input.txt [000000]output.txt
rename [000000]docs.dir [000000]mydocs.dir


program RenameFile;

{$APPTYPE CONSOLE}

uses SysUtils;

begin
  SysUtils.RenameFile('input.txt', 'output.txt');
  SysUtils.RenameFile('\input.txt', '\output.txt');

  // RenameFile works for both files and folders
  SysUtils.RenameFile('docs', 'MyDocs');
  SysUtils.RenameFile('\docs', '\MyDocs');
end.


: repString(s)
| sz i |
   s size dup ->sz 2 / 1 -1 step: i [
      s left(sz i - ) s right(sz i -) == ifTrue: [ s left(i) return ]
      ]
   null ;


PROC reverse = (REF STRING s)VOID:
  FOR i TO UPB s OVER 2 DO
    CHAR c = s[i];
    s[i] := s[UPB s - i + 1];
    s[UPB s - i + 1] := c
  OD;

main:
(
  STRING text := "Was it a cat I saw";
  reverse(text);
  print((text, new line))
)


#include <hopper.h>

main:
   s="mañana será otro día"
   reverse(s),strtoutf8, println
{0}return


for where in [<file:.>, <file:///>] {
  where["input.txt"].renameTo(where["output.txt"], null)
  where["docs"].renameTo(where["mydocs"], null)
}


File.rename "input.txt","output.txt"
File.rename "docs", "mydocs"
File.rename "/input.txt", "/output.txt"
File.rename "/docs", "/mydocs"


(rename-file "input.txt" "output.txt")
(rename-file "/input.txt" "/output.txt")
(rename-file "docs" "mydocs")
(rename-file "/docs" "/mydocs")


file:rename("input.txt","output.txt"),
file:rename( "docs", "mydocs" ),
file:rename( "/input.txt", "/output.txt" ),
file:rename( "/docs", "/mydocs" ).


function list_reps(string r)
sequence replist = {}
integer n = length(r)
    for m=1 to floor(n/2) do
        string s = r[1..m]
        if join(repeat(s,floor(n/m)+1),"")[1..n]=r then
            replist = append(replist,s)
        end if
    end for
    return replist
end function

constant tests = {"1001110011",
                  "1110111011",
                  "0010010010",
                  "1010101010",
                  "1111111111",
                  "0100101101",
                  "0100100",
                  "101",
                  "11",
                  "00",
                  "1"}

for i=1 to length(tests) do
    printf(1,"%s\n",{tests[i]})
    sequence replist = list_reps(tests[i])
    if length(replist)=0 then
        printf(1,"not a rep-string.\n")
    else
        for j=1 to length(replist) do
            string rj = replist[j],
                   pad = repeat(' ',length(rj))
            printf(1,"%s%s\n",{pad,rj})
        end for
    end if
    printf(1,"\n")
end for


String str = 'Hello World!';
str = str.reverse();
system.debug(str);


  CMD$="REN "+OLDFILENAME$+" "+NEWFILENAME$
  SHELL CMD$


open System.IO

[<EntryPoint>]
let main args =
    File.Move("input.txt","output.txt")
    File.Move(@"\input.txt",@"\output.txt")
    Directory.Move("docs","mydocs")
    Directory.Move(@"\docs",@"\mydocs")
    0


"" "/" [
    [ "input.txt" "output.txt" move-file "docs" "mydocs" move-file ] with-directory
] [email protected]


class Rename
{
  public static Void main ()
  {
    // rename file/dir in current directory
    File.rename("input.txt".toUri).rename("output.txt")
    File.rename("docs/".toUri).rename("mydocs/")
    // rename file/dir in root directory
    File.rename("/input.txt".toUri).rename("/output.txt")
    File.rename("/docs/".toUri).rename("/mydocs/")
  }
}


 s" input.txt"  s" output.txt" rename-file throw
s" /input.txt" s" /output.txt" rename-file throw


      PROGRAM EX_RENAME
      CALL RENAME('input.txt','output.txt')
      CALL RENAME('docs','mydocs')
      CALL RENAME('/input.txt','/output.txt')
      CALL RENAME('/docs','/mydocs')
      END


include ..\Utilitys.pmt

def repstr  /# s n -- s #/
    "" swap
    for drop
        over chain
    endfor
    nip
enddef

def repString   /# s -- s #/
    len dup var sz
    2 / 1 swap 2 tolist for
        var i
        1 i slice var chunk
        chunk sz i / 1 + repstr
        1 sz slice nip over
        == if chunk exitfor endif
    endfor
    len sz == sz 1 == or if ":  No repeat string" chain else ": " swap chain chain endif
enddef

( "1001110011" "1110111011" "0010010010" "1010101010" "1111111111" "0100101101" "0100100" "101" "11" "00" "1" )

len for
    get repString print nl
endfor


go =>
  Strings = [
                 "1001110011",       % 10011
                 "1110111011",       % 1110
                 "0010010010",       % 001
                 "1010101010",       % 1010
                 "1111111111",       % 11111
                 "0100101101",       % no solution
                 "0100100",          % 010
                 "101",              % no solution
                 "11",               % 1
                 "00",               % 0
                 "1",                % no solution
                 "",                 % no solution
                 "123123123123123",  % 123123
                 "12312312312312",   % 123123
                 "123123123123124",  % no solution
                 "abcabcdabcabcdabc", % abcabcd
                 [1,2,3,4,1,2,3,4,1,2,3] % 1,2,3,4

            ],
  foreach(S in Strings)
    printf("%w: ", S),
    if maxrep(S,Substr,N) then
      println([substr=Substr,n=N])
    else
      println("no solution")
    end
  end,
  nl.

% the largest repeating substring
maxrep(S,Substr,N) =>
  maxof(rep(S,Substr,N),N).

rep(S,Substr,N) =>
  between(1,S.length div 2, N),
  Len = S.length,
  Len2 = Len - (Len mod N),
  Substr = slice(S,1,N),
  % count the number of proper slices
  SS = [1 : I in 1..N..Len2, slice(S,I,I+N-1) = Substr],
  SS.length = Len div N,
  % the last (truncated) slice (or []) must be a substring of Substr
  Rest = slice(S,Len2+1,Len),
  find(Substr,Rest,1,_).


(de repString (Str)
   (let Lst (chop Str)
      (for (N (/ (length Lst) 2)  (gt0 N)  (dec N))
         (T
            (use (Lst X)
               (let H (cut N 'Lst)
                  (loop
                     (setq X (cut N 'Lst))
                     (NIL (head X H))
                     (NIL Lst T) ) ) )
            N ) ) ) )


rep: procedure options (main); /* 5 May 2015 */
   declare s bit (10) varying;
   declare (i, k) fixed binary;

main_loop:
   do s = '1001110011'b, '1110111011'b, '0010010010'b, '1010101010'b,
          '1111111111'b, '0100101101'b, '0100100'b, '101'b, '11'b, '00'b, '1'b;
      k = length(s);
      do i = k/2 to 1 by -1;
         if substr(s, 1, i) = substr(s, i+1, i) then
            do;
               put skip edit (s, ' is a rep-string containing ', substr(s, 1, i) ) (a);
               iterate main_loop;
            end;
      end;
      put skip edit (s, ' is not a rep-string') (a);
   end;

end rep;


reverseString("Hello World!")

on reverseString(str)
    reverse of characters of str as string
end reverseString


10 A$ = "THE FIVE BOXING WIZARDS JUMP QUICKLY"
20 GOSUB 100REVERSE
30 PRINT R$
40 END

100 REMREVERSE A$
110 R$ = ""
120 FOR I = 1 TO LEN(A$)
130    R$ = MID$(A$, I, 1) + R$
140 NEXT I
150 RETURN


' FB 1.05.0 Win64

Dim result As Long
result = Name("input.txt", "output.txt")
If result <> 0 Then
  Print "Renaming file failed"
End If

result = Name("docs", "mydocs")
If result <> 0 Then
  Print "Renaming directory failed"
End If

Sleep


package main
import "os"

func main() {
  os.Rename("input.txt", "output.txt")
  os.Rename("docs", "mydocs")
  os.Rename("/input.txt", "/output.txt")
  os.Rename("/docs", "/mydocs")
}


['input.txt':'output.txt', 'docs':'mydocs'].each { src, dst ->
  ['.', ''].each { dir ->
    new File("$dir/$src").renameTo(new File("$dir/$dst"))
  }
}


FRename( "input.txt","output.txt")
// or
RENAME input.txt TO output.txt

FRename( hb_ps() + "input.txt", hb_ps() + "output.txt")


100H:

   DECLARE MAX$REP  LITERALLY '32';
   DECLARE FALSE    LITERALLY '0';
   DECLARE TRUE     LITERALLY '1';
   DECLARE CR       LITERALLY '0DH';
   DECLARE LF       LITERALLY '0AH';

   /* CP/M BDOS SYSTEM CALL */
   BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
   /* PRINTS A BYTE AS A CHARACTER */
   PRINT$CHAR: PROCEDURE( CH ); DECLARE CH BYTE; CALL BDOS( 2, CH ); END;
   /* PRINTS A $ TERMINATED STRING */
   PRINT$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;

   /* PRINTS A BYTE AS A NUMBER */
   PRINT$BYTE: PROCEDURE( N );
      DECLARE N BYTE;
      DECLARE ( V, D2, D3 ) BYTE;
      V  = N;
      D3 = V MOD 10;
      IF ( V := V / 10 ) <> 0 THEN DO;
         D2 = V MOD 10;
         IF ( V := V / 10 ) <> 0 THEN CALL PRINT$CHAR( '0' + V );
         CALL PRINT$CHAR( '0' + D2 );
      END;
      CALL PRINT$CHAR( '0' + D3 );
   END PRINT$BYTE;
   /* PRINTS A FIXED LENGTH STRING */
   PRINT$SUBSTRING: PROCEDURE( S$PTR, LEN );
      DECLARE S$PTR ADDRESS, LEN BYTE, S BASED S$PTR ( MAX$REP )BYTE;
      DECLARE S$POS BYTE;
      DO S$POS = 0 TO LEN - 1;
         CALL PRINT$CHAR( S( S$POS ) );
      END;
   END PRINT$SUBSTRING;

   /* RETURNS THE LENGTH OF A $ TERMINATED STRING */
   STR$LENGTH: PROCEDURE( S$PTR )BYTE;
      DECLARE S$PTR ADDRESS, S BASED S$PTR ( MAX$REP )BYTE;
      DECLARE RESULT BYTE;
      RESULT = 0;
      DO WHILE( S( RESULT ) <> '$' );
         RESULT = RESULT + 1;
      END;
   RETURN RESULT;
   END STR$LENGTH;

   /* RETURNS THE LENGTH OF THE LONGEST REP-STRING IN S$PTR, */
   LONGEST$REP$STRING: PROCEDURE( S$PTR )BYTE;
      DECLARE S$PTR ADDRESS, S BASED S$PTR ( MAX$REP )BYTE;
      DECLARE ( S$LEN, RESULT, S$POS, R$POS, I, FOUND ) BYTE;
      RESULT = 0;
      FOUND  = FALSE;
      S$LEN  = STR$LENGTH( S$PTR );
      S$POS  = ( S$LEN / 2 ) - 1; /* IF ( S$LEN / 2 ) = 0, S$POS WILL BE 255 */
      DO WHILE( NOT FOUND AND S$POS < 255 ); /* AS BYTE/ADDRESS ARE UNSIGNED */
         /* CHECK THE POTENTIAL REP-STRING REPEATED A SUFFICIENT NUMBER */
         /* OF TIMES (TRUNCATED IF NECESSARY) EQUALS THE ORIGINAL STRING */
         FOUND = TRUE;
         R$POS = S$POS + 1;
         DO WHILE( FOUND AND R$POS < S$LEN AND FOUND );
            I = 0;
            DO WHILE( I <= S$POS AND R$POS < S$LEN AND FOUND );
               FOUND = S( R$POS ) = S( I );
               R$POS = R$POS + 1;
               I     = I + 1;
            END;
         END;
         IF NOT FOUND THEN DO;
            /* HAVEN'T FOUND A REP-STRING, TRY A SHORTER ONE */
            S$POS = S$POS - 1; /* S$POS WILL BECOME 255 IF S$POS = 0 */
         END;
      END;
      IF FOUND THEN DO;
         RESULT = S$POS + 1;
      END;
   RETURN RESULT;
   END LONGEST$REP$STRING;

   DECLARE ( TEST$NUMBER, REP$STRING$LEN ) BYTE;
   DECLARE TESTS ( 11 )ADDRESS;
   TESTS(  0 ) = .'1001110011$';
   TESTS(  1 ) = .'1110111011$';
   TESTS(  2 ) = .'0010010010$';
   TESTS(  3 ) = .'1010101010$';
   TESTS(  4 ) = .'1111111111$';
   TESTS(  5 ) = .'0100101101$';
   TESTS(  6 ) = .'0100100$';
   TESTS(  7 ) = .'101$';
   TESTS(  8 ) = .'11$';
   TESTS(  9 ) = .'00$';
   TESTS( 10 ) = .'1$';

   DO TEST$NUMBER = 0 TO LAST( TESTS );
      REP$STRING$LEN = LONGEST$REP$STRING( TESTS( TEST$NUMBER ) );
      CALL PRINT$STRING( TESTS( TEST$NUMBER ) );
      IF REP$STRING$LEN = 0 THEN DO;
         CALL PRINT$STRING( .': NO REP STRING$' );
         END;
      ELSE DO;
         CALL PRINT$STRING( .': LONGEST REP STRING: $' );
         CALL PRINT$SUBSTRING( TESTS( TEST$NUMBER ), REP$STRING$LEN );
      END;
      CALL PRINT$STRING( .( CR, LF, '$' ) );
   END;
EOF


:- use_module(library(func)).

%% Implementation logic:

test_for_repstring(String, (String, Result, Reps)) :-
    ( setof(Rep, repstring(String, Rep), Reps)
    -> Result = 'no repstring'
    ;  Result = 'repstrings', Reps = []
    ).

repstring(Codes, R) :-
    RepLength = between(1) of (_//2) of length $ Codes,
    length(R, RepLength),
    phrase( (rep(R), prefix(~,R)),
            Codes).

rep(X) --> X, X.
rep(X) --> X, rep(X).

%% Demonstration output:

test_strings([`1001110011`, `1110111011`, `0010010010`, `1010101010`,
              `1111111111`, `0100101101`, `0100100`, `101`, `11`, `00`, `1`]).

report_repstring((S,Result,Reps)):-
    format('~s -- ~w: ', [S, Result]),
    foreach(member(R, Reps), format('~s, ', [R])), nl.

report_repstrings :-
    Results = maplist(test_for_repstring) $ test_strings(~),
    maplist(report_repstring, Results).


MsgBox % reverse("asdf")

reverse(string)
{
  Loop, Parse, string
    reversed := A_LoopField . reversed
  Return reversed
}


import System.IO
import System.Directory

main = do
  renameFile "input.txt" "output.txt"
  renameDirectory "docs" "mydocs"
  renameFile "/input.txt" "/output.txt"
  renameDirectory "/docs" "/mydocs"


WRITE(FIle='input.txt', REName='.\output.txt')
SYSTEM(DIR='E:\HicEst\Rosetta')
WRITE(FIle='.\docs', REName='.\mydocs')

WRITE(FIle='\input.txt', REName='\output.txt')
SYSTEM(DIR='\')
WRITE(FIle='\docs', REName='\mydocs')


every dir := !["./","/"] do {
   rename(f := dir || "input.txt", dir || "output.txt")  |stop("failure for file rename ",f)
   rename(f := dir || "docs", dir || "mydocs")           |stop("failure for directory rename ",f)
   }


// rename file in current directory
f := File with("input.txt")
f moveTo("output.txt")

// rename file in root directory
f := File with("/input.txt")
f moveTo("/output.txt")

// rename directory in current directory
d := Directory with("docs")
d moveTo("mydocs")

// rename directory in root directory
d := Directory with("/docs")
d moveTo("/mydocs")


a$="1001110011"+#CRLF$+"1110111011"+#CRLF$+"0010010010"+#CRLF$+"1010101010"+#CRLF$+"1111111111"+#CRLF$+
   "0100101101"+#CRLF$+"0100100"   +#CRLF$+"101"       +#CRLF$+"11"        +#CRLF$+"00"        +#CRLF$+
   "1"         +#CRLF$

OpenConsole()

Procedure isRepStr(s1$,s2$)
  If Int(Len(s1$)/Len(s2$))>=2 : ProcedureReturn isRepStr(s1$,s2$+s2$)                         : EndIf
  If Len(s1$)>Len(s2$)         : ProcedureReturn isRepStr(s1$,s2$+Left(s2$,Len(s1$)%Len(s2$))) : EndIf
  If s1$=s2$                   : ProcedureReturn #True : Else : ProcedureReturn #False         : EndIf
EndProcedure

For k=1 To CountString(a$,#CRLF$)
  s1$=StringField(a$,k,#CRLF$) : s2$=Left(s1$,Len(s1$)/2)
  While Len(s2$)
    r=isRepStr(s1$,s2$)
    If Not r : s2$=Left(s2$,Len(s2$)-1) : Else : Break : EndIf
  Wend
  If Len(s2$) And r : PrintN(LSet(s1$,15,Chr(32))+#TAB$+"longest sequence: "+s2$) : EndIf
  If Not Len(s2$)   : PrintN(LSet(s1$,15,Chr(32))+#TAB$+"found nothing.")         : EndIf
Next
Input()


def is_repeated(text):
    'check if the first part of the string is repeated throughout the string'
    for x in range(len(text)//2, 0, -1):
        if text.startswith(text[x:]): return x
    return 0

matchstr = """\
1001110011
1110111011
0010010010
1010101010
1111111111
0100101101
0100100
101
11
00
1
"""
for line in matchstr.split():
    ln = is_repeated(line)
    print('%r has a repetition length of %i i.e. %s'
           % (line, ln, repr(line[:ln]) if ln else '*not* a rep-string'))


#AutoIt Version: 3.2.10.0
$mystring="asdf"
$reverse_string = ""
$string_length = StringLen($mystring)

For $i = 1 to $string_length
   $last_n_chrs = StringRight($mystring, $i)
   $nth_chr = StringTrimRight($last_n_chrs, $i-1)
   $reverse_string= $reverse_string & $nth_chr
Next

MsgBox(0, "Reversed string is:", $reverse_string)


frename=: 4 : 0
 if. x -: y do. return. end.
 if. IFUNIX do.
   hostcmd=. [: 2!:0 '('"_ , ] , ' || true)'"_
   hostcmd 'mv "',y,'" "',x,'"'
 else.
   'kernel32 MoveFileA i *c *c' 15!:0 y;x
 end.
)


import java.io.File;
public class FileRenameTest {
   public static boolean renameFile(String oldname, String newname) {
       // File (or directory) with old name
       File file = new File(oldname);

       // File (or directory) with new name
       File file2 = new File(newname);

       // Rename file (or directory)
       boolean success = file.renameTo(file2);
       return success;
   }
   public static void test(String type, String oldname, String newname) {
       System.out.println("The following " + type + " called " + oldname +
           ( renameFile(oldname, newname) ? " was renamed as " : " could not be renamed into ")
           + newname + "."
       );
   }
   public static void main(String args[]) {
        test("file", "input.txt", "output.txt");
        test("file", File.separator + "input.txt", File.separator + "output.txt");
        test("directory", "docs", "mydocs");
        test("directory", File.separator + "docs" + File.separator, File.separator + "mydocs" + File.separator);
   }
}


var fso = new ActiveXObject("Scripting.FileSystemObject")
fso.MoveFile("input.txt", "output.txt")
fso.MoveFile("c:/input.txt", "c:/output.txt")
fso.MoveFolder("docs", "mydocs")
fso.MoveFolder("c:/docs", "c:/mydocs")


  [ false swap
    dup size 1 > if
      [ [] temp put
        dup size factors
        -1 split drop
        witheach
          [ 2dup split drop
            dip [ over size swap / ]
            dup temp replace
            swap of over = if
              [ drop not
                temp share
                conclude ] ]
    temp release ] swap ]            is rep$ ( $ --> $ b )

  [ dup rep$ iff
      [ say 'The shortest rep-string in "'
        swap echo$
        say '" is "' echo$
        say '".' ]
    else
      [ say 'There is no rep-string for "'
        nip echo$ say '".' ]
    cr ]                             is task ( $ -->     )


#lang racket

(define (rep-string str)
  (define len (string-length str))
  (for/or ([n (in-range 1 len)])
    (and (let loop ([from n])
           (or (>= from len)
               (let ([m (min (- len from) n)])
                 (and (equal? (substring str from (+ from m))
                              (substring str 0 m))
                      (loop (+ n from))))))
         (<= n (quotient len 2))
         (substring str 0 n))))

(for ([str '("1001110011"
             "1110111011"
             "0010010010"
             "1010101010"
             "1111111111"
             "0100101101"
             "0100100"
             "101"
             "11"
             "00"
             "1")])
  (printf "~a => ~a\n" str (or (rep-string str) "not a rep-string")))


function reverse(s)
{
  p = ""
  for(i=length(s); i > 0; i--) { p = p substr(s, i, 1) }
  return p
}

BEGIN {
  print reverse("edoCattesoR")
}


strrev: { str2ar ar2ls reverse ls2lf ar2str }


"input.txt" "output.txt" frename
"/input.txt" "/output.txt" frename
"docs" "mydocs" frename
"/docs" "/mydocs" frename.


/* File rename, in jsish */
try { File.rename('input.txt', 'output.txt', false); } catch (str) { puts(str); }

exec('touch input.txt');
puts("overwrite set true if output.txt exists");
File.rename('input.txt', 'output.txt', true);

try { File.rename('docs', 'mydocs', false); } catch (str) { puts(str); }
try { File.rename('/docs', '/mydocs', false); } catch (str) { puts(str); }


mv("input.txt", "output.txt")
mv("docs", "mydocs")
mv("/input.txt", "/output.txt")
mv("/docs", "/mydocs")


// version 1.0.6

/* testing on Windows 10 which needs administrative privileges
   to rename files in the root */

import java.io.File

fun main(args: Array<String>) {
    val oldPaths = arrayOf("input.txt", "docs", "c:\\input.txt", "c:\\docs")
    val newPaths = arrayOf("output.txt", "mydocs", "c:\\output.txt", "c:\\mydocs")
    var oldFile: File
    var newFile: File
    for (i in 0 until oldPaths.size) {
        oldFile = File(oldPaths[i])
        newFile = File(newPaths[i])
        if (oldFile.renameTo(newFile))
            println("${oldPaths[i]} successfully renamed to ${newPaths[i]}")
        else
            println("${oldPaths[i]} could not be renamed")
    }
}


Detailed Description of Programming Task

select
   Server.Wake_Up (Parameters);
or delay 5.0;
   -- No response, try something else
   ...
end select;


/* REXX ***************************************************************
* 11.05.2013 Walter Pachl
* 14.05.2013 Walter Pachl extend to show additional rep-strings
**********************************************************************/
Call repstring '1001110011'
Call repstring '1110111011'
Call repstring '0010010010'
Call repstring '1010101010'
Call repstring '1111111111'
Call repstring '0100101101'
Call repstring '0100100'
Call repstring '101'
Call repstring '11'
Call repstring '00'
Call repstring '1'
Exit

repstring:
Parse Arg s
sq=''''s''''
n=length(s)
Do l=length(s)%2 to 1 By -1
  If substr(s,l+1,l)=left(s,l) Then Leave
  End
If l>0 Then Do
  rep_str=left(s,l)
  Do i=1 By 1
    If substr(s,i*l+1,l)<>rep_str Then
      Leave
    End
  If left(copies(rep_str,n),length(s))=s Then Do
    Call show_rep rep_str              /* show result                */
    Do i=length(rep_str)-1 To 1 By -1  /* look for shorter rep_str-s */
      rep_str=left(s,i)
      If left(copies(rep_str,n),length(s))=s Then
        Call show_rep rep_str
      End
    End
  Else
    Call show_norep
  End
Else
  Call show_norep
Return

show_rep:
  Parse Arg rs
  Say right(sq,12) 'has a repetition length of' length(rs) 'i.e.' ''''rs''''
  Return
show_norep:
  Say right(sq,12) 'is not a repeated string'
  Return


# Project : Rep-string

test = ["1001110011",
        "1110111011",
        "0010010010",
        "1010101010",
        "1111111111",
        "0100101101",
        "0100100",
        "101",
        "11",
        "00",
        "1"]

for n = 1 to len(test)
    strend = ""
    for m=1 to len(test[n])
        strbegin = substr(test[n], 1, m)
        strcut = right(test[n], len(test[n]) - m)
        nr = substr(strcut, strbegin)
        if nr=1 and len(test[n]) > 1
           strend = strbegin
        ok
    next
    if strend = ""
       see "" + test[n] + " -> (none)" + nl
    else
       see "" + test[n] + " -> " + strend + nl
    ok
next


OPTION UTF8 TRUE
s$ = "asdf"
PRINT REVERSE$(s$)


FUNCTION reverse$(a$)
   b$ = ""
   FOR i = 1 TO LEN(a$)
      b$ = MID$(a$, i, 1) + b$
   NEXT i
   reverse$ = b$
END FUNCTION


// move file
local(f = file('input.txt'))
#f->moveTo('output.txt')
#f->close

// move directory, just like a file
local(d = dir('docs'))
#d->moveTo('mydocs')

// move file in root file system (requires permissions at user OS level)
local(f = file('//input.txt'))
#f->moveTo('//output.txt')
#f->close

// move directory in root file system (requires permissions at user OS level)
local(d = file('//docs'))
#d->moveTo('//mydocs')


(file:rename "input.txt" "output.txt")
(file:rename "docs" "mydocs")
(file:rename "/input.txt" "/output.txt")
(file:rename "/docs" "/mydocs")


'   LB has inbuilt 'name' command, but can also run batch files

nomainwin

name "input.txt" as "output.txt"
run "cmd.exe /c ren docs mydocs", HIDE
name "C:\input.txt" as "C:\output.txt"
run "cmd.exe /c ren C:\docs mydocs", HIDE

end


rename file "input.txt" to "output.txt"
rename folder "docs" to "mydocs"
rename file "/input.txt" to "/output.txt"
rename folder "/docs" to "/mydocs"


os.rename( "input.txt", "output.txt" )
os.rename( "/input.txt", "/output.txt" )
os.rename( "docs", "mydocs" )
os.rename( "/docs", "/mydocs" )


OnMessage(0x4a, "PrintMonitor")
SetTimer, print2, 400

print1:
  print("Old Mother Goose")
  print("When she wanted to wander,")
  print("Would ride through the air")
  print("On a very fine gander.")
  print("Jack's mother came in,")
  print("And caught the goose soon,")
  print("And mounting its back,")
  print("Flew up to the moon.")
Return

print2:
  SetTimer, print2, Off
  print("Humpty Dumpty sat on a wall.")
  print("Humpty Dumpty had a great fall.")
  print("All the king's horses and all the king's men")
  print("Couldn't put Humpty together again.")
Return

print(message)
{
  Static StringToSend
  StringToSend := message
  Gui +LastFound
  VarSetCapacity(CopyDataStruct, 12, 0)
  NumPut(StrLen(StringToSend) + 1, CopyDataStruct, 4)
  NumPut(&StringToSend, CopyDataStruct, 8)
  SendMessage, 0x4a, 0, &CopyDataStruct
  If ErrorLevel
    MsgBox out of ink
  Sleep, 200
  Return
}

PrintMonitor(wParam, lParam, msg)
{
  Static ink = 5
  Global printed
  Critical
  If ink
  {
    StringAddress := NumGet(lParam + 8)
    StringLength := DllCall("lstrlen", UInt, StringAddress)
    VarSetCapacity(CopyOfData, StringLength)
    DllCall("lstrcpy", "str", CopyOfData, "uint", StringAddress)
    printed .= "primaryprinter: " . CopyOfData . "`n"
    ToolTip, primary printer`n: %printed%
    ink--
  }
  Else
  {
    OnMessage(0x4a, "Reserve")
    print(CopyOfData)
  }
}

Reserve(wParam, lParam, msg)
{
  Static ink = 5
  Global printed
  Critical
  If ink
  {
    StringAddress := NumGet(lParam + 8)
    StringLength := DllCall("lstrlen", UInt, StringAddress)
    VarSetCapacity(CopyOfData, StringLength)
    DllCall("lstrcpy", "str", CopyOfData, "uint", StringAddress)
    printed .= "reserveprinter: " . CopyOfData . "`n"
    ToolTip, Reserve printer`n: %printed%
    ink--
  }
  Else
    Return -1
}